*** 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',
1047 `gnus-group-sort-by-method', and `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-shell-command-separator ";"
1101   "String used to separate to shell commands.")
1102
1103 (defvar gnus-view-pseudo-asynchronously nil
1104   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
1105
1106 (defvar gnus-view-pseudos nil
1107   "*If `automatic', pseudo-articles will be viewed automatically.
1108 If `not-confirm', pseudos will be viewed automatically, and the user
1109 will not be asked to confirm the command.")
1110
1111 (defvar gnus-view-pseudos-separately t
1112   "*If non-nil, one pseudo-article will be created for each file to be viewed.
1113 If nil, all files that use the same viewing command will be given as a
1114 list of parameters to that command.")
1115
1116 (defvar gnus-insert-pseudo-articles t
1117   "*If non-nil, insert pseudo-articles when decoding articles.")
1118
1119 (defvar gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n"
1120   "*Format of group lines.
1121 It works along the same lines as a normal formatting string,
1122 with some simple extensions.
1123
1124 %M    Only marked articles (character, \"*\" or \" \")
1125 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
1126 %L    Level of subscribedness (integer)
1127 %N    Number of unread articles (integer)
1128 %I    Number of dormant articles (integer)
1129 %i    Number of ticked and dormant (integer)
1130 %T    Number of ticked articles (integer)
1131 %R    Number of read articles (integer)
1132 %t    Total number of articles (integer)
1133 %y    Number of unread, unticked articles (integer)
1134 %G    Group name (string)
1135 %g    Qualified group name (string)
1136 %D    Group description (string)
1137 %s    Select method (string)
1138 %o    Moderated group (char, \"m\")
1139 %p    Process mark (char)
1140 %O    Moderated group (string, \"(m)\" or \"\")
1141 %P    Topic indentation (string)
1142 %l    Whether there are GroupLens predictions for this group (string)
1143 %n    Select from where (string)
1144 %z    A string that look like `<%s:%n>' if a foreign select method is used
1145 %u    User defined specifier.  The next character in the format string should
1146       be a letter.  Gnus will call the function gnus-user-format-function-X,
1147       where X is the letter following %u.  The function will be passed the
1148       current header as argument.  The function should return a string, which
1149       will be inserted into the buffer just like information from any other
1150       group specifier.
1151
1152 Text between %( and %) will be highlighted with `gnus-mouse-face' when
1153 the mouse point move inside the area.  There can only be one such area.
1154
1155 Note that this format specification is not always respected.  For
1156 reasons of efficiency, when listing killed groups, this specification
1157 is ignored altogether.  If the spec is changed considerably, your
1158 output may end up looking strange when listing both alive and killed
1159 groups.
1160
1161 If you use %o or %O, reading the active file will be slower and quite
1162 a bit of extra memory will be used. %D will also worsen performance.
1163 Also note that if you change the format specification to include any
1164 of these specs, you must probably re-start Gnus to see them go into
1165 effect.")
1166
1167 (defvar gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
1168   "*The format specification of the lines in the summary buffer.
1169
1170 It works along the same lines as a normal formatting string,
1171 with some simple extensions.
1172
1173 %N   Article number, left padded with spaces (string)
1174 %S   Subject (string)
1175 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
1176 %n   Name of the poster (string)
1177 %a   Extracted name of the poster (string)
1178 %A   Extracted address of the poster (string)
1179 %F   Contents of the From: header (string)
1180 %x   Contents of the Xref: header (string)
1181 %D   Date of the article (string)
1182 %d   Date of the article (string) in DD-MMM format
1183 %M   Message-id of the article (string)
1184 %r   References of the article (string)
1185 %c   Number of characters in the article (integer)
1186 %L   Number of lines in the article (integer)
1187 %I   Indentation based on thread level (a string of spaces)
1188 %T   A string with two possible values: 80 spaces if the article
1189      is on thread level two or larger and 0 spaces on level one
1190 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
1191 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
1192 %[   Opening bracket (character, \"[\" or \"<\")
1193 %]   Closing bracket (character, \"]\" or \">\")
1194 %>   Spaces of length thread-level (string)
1195 %<   Spaces of length (- 20 thread-level) (string)
1196 %i   Article score (number)
1197 %z   Article zcore (character)
1198 %t   Number of articles under the current thread (number).
1199 %e   Whether the thread is empty or not (character).
1200 %l   GroupLens score (string).
1201 %u   User defined specifier.  The next character in the format string should
1202      be a letter.  Gnus will call the function gnus-user-format-function-X,
1203      where X is the letter following %u.  The function will be passed the
1204      current header as argument.  The function should return a string, which
1205      will be inserted into the summary just like information from any other
1206      summary specifier.
1207
1208 Text between %( and %) will be highlighted with `gnus-mouse-face'
1209 when the mouse point is placed inside the area.  There can only be one
1210 such area.
1211
1212 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1213 with care.  For reasons of efficiency, Gnus will compute what column
1214 these characters will end up in, and \"hard-code\" that.  This means that
1215 it is illegal to have these specs after a variable-length spec.  Well,
1216 you might not be arrested, but your summary buffer will look strange,
1217 which is bad enough.
1218
1219 The smart choice is to have these specs as for to the left as
1220 possible.
1221
1222 This restriction may disappear in later versions of Gnus.")
1223
1224 (defvar gnus-summary-dummy-line-format
1225   "*  %(:                          :%) %S\n"
1226   "*The format specification for the dummy roots in the summary buffer.
1227 It works along the same lines as a normal formatting string,
1228 with some simple extensions.
1229
1230 %S  The subject")
1231
1232 (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
1233   "*The format specification for the summary mode line.
1234 It works along the same lines as a normal formatting string,
1235 with some simple extensions:
1236
1237 %G  Group name
1238 %p  Unprefixed group name
1239 %A  Current article number
1240 %V  Gnus version
1241 %U  Number of unread articles in the group
1242 %e  Number of unselected articles in the group
1243 %Z  A string with unread/unselected article counts
1244 %g  Shortish group name
1245 %S  Subject of the current article
1246 %u  User-defined spec
1247 %s  Current score file name
1248 %d  Number of dormant articles
1249 %r  Number of articles that have been marked as read in this session
1250 %E  Number of articles expunged by the score files")
1251
1252 (defvar gnus-article-mode-line-format "Gnus: %%b %S"
1253   "*The format specification for the article mode line.
1254 See `gnus-summary-mode-line-format' for a closer description.")
1255
1256 (defvar gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
1257   "*The format specification for the group mode line.
1258 It works along the same lines as a normal formatting string,
1259 with some simple extensions:
1260
1261 %S   The native news server.
1262 %M   The native select method.
1263 %:   \":\" if %S isn't \"\".")
1264
1265 (defvar gnus-valid-select-methods
1266   '(("nntp" post address prompt-address)
1267     ("nnspool" post address)
1268     ("nnvirtual" post-mail virtual prompt-address)
1269     ("nnmbox" mail respool address)
1270     ("nnml" mail respool address)
1271     ("nnmh" mail respool address)
1272     ("nndir" post-mail prompt-address address)
1273     ("nneething" none address prompt-address)
1274     ("nndoc" none address prompt-address)
1275     ("nnbabyl" mail address respool)
1276     ("nnkiboze" post virtual)
1277     ("nnsoup" post-mail address)
1278     ("nndraft" post-mail)
1279     ("nnfolder" mail respool address))
1280   "An alist of valid select methods.
1281 The first element of each list lists should be a string with the name
1282 of the select method.  The other elements may be the category of
1283 this method (ie. `post', `mail', `none' or whatever) or other
1284 properties that this method has (like being respoolable).
1285 If you implement a new select method, all you should have to change is
1286 this variable.  I think.")
1287
1288 (defvar gnus-updated-mode-lines '(group article summary tree)
1289   "*List of buffers that should update their mode lines.
1290 The list may contain the symbols `group', `article' and `summary'.  If
1291 the corresponding symbol is present, Gnus will keep that mode line
1292 updated with information that may be pertinent.
1293 If this variable is nil, screen refresh may be quicker.")
1294
1295 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1296 (defvar gnus-mode-non-string-length nil
1297   "*Max length of mode-line non-string contents.
1298 If this is nil, Gnus will take space as is needed, leaving the rest
1299 of the modeline intact.")
1300
1301 ;see gnus-cus.el
1302 ;(defvar gnus-mouse-face 'highlight
1303 ;  "*Face used for mouse highlighting in Gnus.
1304 ;No mouse highlights will be done if `gnus-visual' is nil.")
1305
1306 (defvar gnus-summary-mark-below 0
1307   "*Mark all articles with a score below this variable as read.
1308 This variable is local to each summary buffer and usually set by the
1309 score file.")
1310
1311 (defvar gnus-article-sort-functions '(gnus-article-sort-by-number)
1312   "*List of functions used for sorting articles in the summary buffer.
1313 This variable is only used when not using a threaded display.")
1314
1315 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
1316   "*List of functions used for sorting threads in the summary buffer.
1317 By default, threads are sorted by article number.
1318
1319 Each function takes two threads and return non-nil if the first thread
1320 should be sorted before the other.  If you use more than one function,
1321 the primary sort function should be the last.  You should probably
1322 always include `gnus-thread-sort-by-number' in the list of sorting
1323 functions -- preferably first.
1324
1325 Ready-mady functions include `gnus-thread-sort-by-number',
1326 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
1327 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
1328 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
1329
1330 (defvar gnus-thread-score-function '+
1331   "*Function used for calculating the total score of a thread.
1332
1333 The function is called with the scores of the article and each
1334 subthread and should then return the score of the thread.
1335
1336 Some functions you can use are `+', `max', or `min'.")
1337
1338 (defvar gnus-summary-expunge-below nil
1339   "All articles that have a score less than this variable will be expunged.")
1340
1341 (defvar gnus-thread-expunge-below nil
1342   "All threads that have a total score less than this variable will be expunged.
1343 See `gnus-thread-score-function' for en explanation of what a
1344 \"thread score\" is.")
1345
1346 (defvar gnus-auto-subscribed-groups
1347   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
1348   "*All new groups that match this regexp will be subscribed automatically.
1349 Note that this variable only deals with new groups.  It has no effect
1350 whatsoever on old groups.
1351
1352 New groups that match this regexp will not be handled by
1353 `gnus-subscribe-newsgroup-method'.  Instead, they will
1354 be subscribed using `gnus-subscribe-options-newsgroup-method'.")
1355
1356 (defvar gnus-options-subscribe nil
1357   "*All new groups matching this regexp will be subscribed unconditionally.
1358 Note that this variable deals only with new newsgroups.  This variable
1359 does not affect old newsgroups.
1360
1361 New groups that match this regexp will not be handled by
1362 `gnus-subscribe-newsgroup-method'.  Instead, they will
1363 be subscribed using `gnus-subscribe-options-newsgroup-method'.")
1364
1365 (defvar gnus-options-not-subscribe nil
1366   "*All new groups matching this regexp will be ignored.
1367 Note that this variable deals only with new newsgroups.  This variable
1368 does not affect old (already subscribed) newsgroups.")
1369
1370 (defvar gnus-auto-expirable-newsgroups nil
1371   "*Groups in which to automatically mark read articles as expirable.
1372 If non-nil, this should be a regexp that should match all groups in
1373 which to perform auto-expiry.  This only makes sense for mail groups.")
1374
1375 (defvar gnus-total-expirable-newsgroups nil
1376   "*Groups in which to perform expiry of all read articles.
1377 Use with extreme caution.  All groups that match this regexp will be
1378 expiring - which means that all read articles will be deleted after
1379 (say) one week.  (This only goes for mail groups and the like, of
1380 course.)")
1381
1382 (defvar gnus-group-uncollapsed-levels 1
1383   "Number of group name elements to leave alone when making a short group name.")
1384
1385 (defvar gnus-hidden-properties '(invisible t intangible t)
1386   "Property list to use for hiding text.")
1387
1388 (defvar gnus-modtime-botch nil
1389   "*Non-nil means .newsrc should be deleted prior to save.  
1390 Its use is due to the bogus appearance that .newsrc was modified on
1391 disc.")
1392
1393 ;; Hooks.
1394
1395 (defvar gnus-group-mode-hook nil
1396   "*A hook for Gnus group mode.")
1397
1398 (defvar gnus-summary-mode-hook nil
1399   "*A hook for Gnus summary mode.
1400 This hook is run before any variables are set in the summary buffer.")
1401
1402 (defvar gnus-article-mode-hook nil
1403   "*A hook for Gnus article mode.")
1404
1405 (defvar gnus-summary-prepare-exit-hook nil
1406   "*A hook called when preparing to exit from the summary buffer.
1407 It calls `gnus-summary-expire-articles' by default.")
1408 (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
1409
1410 (defvar gnus-summary-exit-hook nil
1411   "*A hook called on exit from the summary buffer.")
1412
1413 (defvar gnus-check-bogus-groups-hook nil
1414   "A hook run after removing bogus groups.")
1415
1416 (defvar gnus-group-catchup-group-hook nil
1417   "*A hook run when catching up a group from the group buffer.")
1418
1419 (defvar gnus-group-update-group-hook nil
1420   "*A hook called when updating group lines.")
1421
1422 (defvar gnus-open-server-hook nil
1423   "*A hook called just before opening connection to the news server.")
1424
1425 (defvar gnus-load-hook nil
1426   "*A hook run while Gnus is loaded.")
1427
1428 (defvar gnus-startup-hook nil
1429   "*A hook called at startup.
1430 This hook is called after Gnus is connected to the NNTP server.")
1431
1432 (defvar gnus-get-new-news-hook nil
1433   "*A hook run just before Gnus checks for new news.")
1434
1435 (defvar gnus-after-getting-new-news-hook nil
1436   "*A hook run after Gnus checks for new news.")
1437
1438 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
1439   "*A function that is called to generate the group buffer.
1440 The function is called with three arguments: The first is a number;
1441 all group with a level less or equal to that number should be listed,
1442 if the second is non-nil, empty groups should also be displayed.  If
1443 the third is non-nil, it is a number.  No groups with a level lower
1444 than this number should be displayed.
1445
1446 The only current function implemented is `gnus-group-prepare-flat'.")
1447
1448 (defvar gnus-group-prepare-hook nil
1449   "*A hook called after the group buffer has been generated.
1450 If you want to modify the group buffer, you can use this hook.")
1451
1452 (defvar gnus-summary-prepare-hook nil
1453   "*A hook called after the summary buffer has been generated.
1454 If you want to modify the summary buffer, you can use this hook.")
1455
1456 (defvar gnus-summary-generate-hook nil
1457   "*A hook run just before generating the summary buffer.
1458 This hook is commonly used to customize threading variables and the
1459 like.")
1460
1461 (defvar gnus-article-prepare-hook nil
1462   "*A hook called after an article has been prepared in the article buffer.
1463 If you want to run a special decoding program like nkf, use this hook.")
1464
1465 ;(defvar gnus-article-display-hook nil
1466 ;  "*A hook called after the article is displayed in the article buffer.
1467 ;The hook is designed to change the contents of the article
1468 ;buffer.  Typical functions that this hook may contain are
1469 ;`gnus-article-hide-headers' (hide selected headers),
1470 ;`gnus-article-maybe-highlight' (perform fancy article highlighting),
1471 ;`gnus-article-hide-signature' (hide signature) and
1472 ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
1473 ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
1474 ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
1475 ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight)
1476
1477 (defvar gnus-article-x-face-too-ugly nil
1478   "Regexp matching posters whose face shouldn't be shown automatically.")
1479
1480 (defvar gnus-select-group-hook nil
1481   "*A hook called when a newsgroup is selected.
1482
1483 If you'd like to simplify subjects like the
1484 `gnus-summary-next-same-subject' command does, you can use the
1485 following hook:
1486
1487  (setq gnus-select-group-hook
1488       (list
1489         (lambda ()
1490           (mapcar (lambda (header)
1491                      (mail-header-set-subject
1492                       header
1493                       (gnus-simplify-subject
1494                        (mail-header-subject header) 're-only)))
1495                   gnus-newsgroup-headers))))")
1496
1497 (defvar gnus-select-article-hook nil
1498   "*A hook called when an article is selected.")
1499
1500 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
1501   "*A hook called to apply kill files to a group.
1502 This hook is intended to apply a kill file to the selected newsgroup.
1503 The function `gnus-apply-kill-file' is called by default.
1504
1505 Since a general kill file is too heavy to use only for a few
1506 newsgroups, I recommend you to use a lighter hook function.  For
1507 example, if you'd like to apply a kill file to articles which contains
1508 a string `rmgroup' in subject in newsgroup `control', you can use the
1509 following hook:
1510
1511  (setq gnus-apply-kill-hook
1512       (list
1513         (lambda ()
1514           (cond ((string-match \"control\" gnus-newsgroup-name)
1515                  (gnus-kill \"Subject\" \"rmgroup\")
1516                  (gnus-expunge \"X\"))))))")
1517
1518 (defvar gnus-visual-mark-article-hook
1519   (list 'gnus-highlight-selected-summary)
1520   "*Hook run after selecting an article in the summary buffer.
1521 It is meant to be used for highlighting the article in some way.  It
1522 is not run if `gnus-visual' is nil.")
1523
1524 (defvar gnus-parse-headers-hook nil
1525   "*A hook called before parsing the headers.")
1526 (add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522)
1527
1528 (defvar gnus-exit-group-hook nil
1529   "*A hook called when exiting (not quitting) summary mode.")
1530
1531 (defvar gnus-suspend-gnus-hook nil
1532   "*A hook called when suspending (not exiting) Gnus.")
1533
1534 (defvar gnus-exit-gnus-hook nil
1535   "*A hook called when exiting Gnus.")
1536
1537 (defvar gnus-after-exiting-gnus-hook nil
1538   "*A hook called after exiting Gnus.")
1539
1540 (defvar gnus-save-newsrc-hook nil
1541   "*A hook called before saving any of the newsrc files.")
1542
1543 (defvar gnus-save-quick-newsrc-hook nil
1544   "*A hook called just before saving the quick newsrc file.
1545 Can be used to turn version control on or off.")
1546
1547 (defvar gnus-save-standard-newsrc-hook nil
1548   "*A hook called just before saving the standard newsrc file.
1549 Can be used to turn version control on or off.")
1550
1551 (defvar gnus-summary-update-hook
1552   (list 'gnus-summary-highlight-line)
1553   "*A hook called when a summary line is changed.
1554 The hook will not be called if `gnus-visual' is nil.
1555
1556 The default function `gnus-summary-highlight-line' will
1557 highlight the line according to the `gnus-summary-highlight'
1558 variable.")
1559
1560 (defvar gnus-group-update-hook '(gnus-group-highlight-line)
1561   "*A hook called when a group line is changed.
1562 The hook will not be called if `gnus-visual' is nil.
1563
1564 The default function `gnus-group-highlight-line' will
1565 highlight the line according to the `gnus-group-highlight'
1566 variable.")
1567
1568 (defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
1569   "*A hook called when an article is selected for the first time.
1570 The hook is intended to mark an article as read (or unread)
1571 automatically when it is selected.")
1572
1573 (defvar gnus-group-change-level-function nil
1574   "Function run when a group level is changed.
1575 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.")
1576
1577 ;; Remove any hilit infestation.
1578 (add-hook 'gnus-startup-hook
1579           (lambda ()
1580             (remove-hook 'gnus-summary-prepare-hook
1581                          'hilit-rehighlight-buffer-quietly)
1582             (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
1583             (setq gnus-mark-article-hook
1584                   '(gnus-summary-mark-read-and-unread-as-read))
1585             (remove-hook 'gnus-article-prepare-hook
1586                          'hilit-rehighlight-buffer-quietly)))
1587
1588 \f
1589 ;; Internal variables
1590
1591 (defvar gnus-tree-buffer "*Tree*"
1592   "Buffer where Gnus thread trees are displayed.")
1593
1594 ;; Dummy variable.
1595 (defvar gnus-use-generic-from nil)
1596
1597 (defvar gnus-thread-indent-array nil)
1598 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
1599
1600 (defvar gnus-newsrc-file-version nil)
1601
1602 (defvar gnus-method-history nil)
1603 ;; Variable holding the user answers to all method prompts.
1604
1605 (defvar gnus-group-history nil)
1606 ;; Variable holding the user answers to all group prompts.
1607
1608 (defvar gnus-server-alist nil
1609   "List of available servers.")
1610
1611 (defvar gnus-group-indentation-function nil)
1612
1613 (defvar gnus-topic-indentation "") ;; Obsolete variable.
1614
1615 (defvar gnus-goto-missing-group-function nil)
1616
1617 (defvar gnus-override-subscribe-method nil)
1618
1619 (defvar gnus-group-goto-next-group-function nil
1620   "Function to override finding the next group after listing groups.")
1621
1622 (defconst gnus-article-mark-lists
1623   '((marked . tick) (replied . reply)
1624     (expirable . expire) (killed . killed)
1625     (bookmarks . bookmark) (dormant . dormant)
1626     (scored . score) (saved . save)
1627     (cached . cache)
1628     ))
1629
1630 ;; Avoid highlighting in kill files.
1631 (defvar gnus-summary-inhibit-highlight nil)
1632 (defvar gnus-newsgroup-selected-overlay nil)
1633
1634 (defvar gnus-inhibit-hiding nil)
1635 (defvar gnus-group-indentation "")
1636 (defvar gnus-inhibit-limiting nil)
1637 (defvar gnus-created-frames nil)
1638
1639 (defvar gnus-article-mode-map nil)
1640 (defvar gnus-dribble-buffer nil)
1641 (defvar gnus-headers-retrieved-by nil)
1642 (defvar gnus-article-reply nil)
1643 (defvar gnus-override-method nil)
1644 (defvar gnus-article-check-size nil)
1645
1646 (defvar gnus-current-score-file nil)
1647 (defvar gnus-newsgroup-adaptive-score-file nil)
1648 (defvar gnus-scores-exclude-files nil)
1649
1650 (defvar gnus-opened-servers nil)
1651
1652 (defvar gnus-current-move-group nil)
1653 (defvar gnus-current-copy-group nil)
1654 (defvar gnus-current-crosspost-group nil)
1655
1656 (defvar gnus-newsgroup-dependencies nil)
1657 (defvar gnus-newsgroup-async nil)
1658 (defvar gnus-group-edit-buffer nil)
1659
1660 (defvar gnus-newsgroup-adaptive nil)
1661
1662 (defvar gnus-summary-display-table nil)
1663 (defvar gnus-summary-display-article-function nil)
1664
1665 (defvar gnus-summary-highlight-line-function nil
1666   "Function called after highlighting a summary line.")
1667
1668 (defvar gnus-group-line-format-alist
1669   `((?M gnus-tmp-marked-mark ?c)
1670     (?S gnus-tmp-subscribed ?c)
1671     (?L gnus-tmp-level ?d)
1672     (?N (cond ((eq number t) "*" )
1673               ((numberp number) 
1674                (int-to-string
1675                 (+ number
1676                    (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1677                    (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
1678               (t number)) ?s)
1679     (?R gnus-tmp-number-of-read ?s)
1680     (?t gnus-tmp-number-total ?d)
1681     (?y gnus-tmp-number-of-unread ?s)
1682     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
1683     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
1684     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1685            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
1686     (?g gnus-tmp-group ?s)
1687     (?G gnus-tmp-qualified-group ?s)
1688     (?c (gnus-short-group-name gnus-tmp-group) ?s)
1689     (?D gnus-tmp-newsgroup-description ?s)
1690     (?o gnus-tmp-moderated ?c)
1691     (?O gnus-tmp-moderated-string ?s)
1692     (?p gnus-tmp-process-marked ?c)
1693     (?s gnus-tmp-news-server ?s)
1694     (?n gnus-tmp-news-method ?s)
1695     (?P gnus-group-indentation ?s)
1696     (?l gnus-tmp-grouplens ?s)
1697     (?z gnus-tmp-news-method-string ?s)
1698     (?u gnus-tmp-user-defined ?s)))
1699
1700 (defvar gnus-summary-line-format-alist
1701   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1702     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1703     (?s gnus-tmp-subject-or-nil ?s)
1704     (?n gnus-tmp-name ?s)
1705     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1706         ?s)
1707     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
1708             gnus-tmp-from) ?s)
1709     (?F gnus-tmp-from ?s)
1710     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1711     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1712     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1713     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1714     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1715     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1716     (?L gnus-tmp-lines ?d)
1717     (?I gnus-tmp-indentation ?s)
1718     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1719     (?R gnus-tmp-replied ?c)
1720     (?\[ gnus-tmp-opening-bracket ?c)
1721     (?\] gnus-tmp-closing-bracket ?c)
1722     (?\> (make-string gnus-tmp-level ? ) ?s)
1723     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1724     (?i gnus-tmp-score ?d)
1725     (?z gnus-tmp-score-char ?c)
1726     (?l (bbb-grouplens-score gnus-tmp-header) ?s)
1727     (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
1728     (?U gnus-tmp-unread ?c)
1729     (?t (gnus-summary-number-of-articles-in-thread
1730          (and (boundp 'thread) (car thread)) gnus-tmp-level)
1731         ?d)
1732     (?e (gnus-summary-number-of-articles-in-thread
1733          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1734         ?c)
1735     (?u gnus-tmp-user-defined ?s))
1736   "An alist of format specifications that can appear in summary lines,
1737 and what variables they correspond with, along with the type of the
1738 variable (string, integer, character, etc).")
1739
1740 (defvar gnus-summary-dummy-line-format-alist
1741   `((?S gnus-tmp-subject ?s)
1742     (?N gnus-tmp-number ?d)
1743     (?u gnus-tmp-user-defined ?s)))
1744
1745 (defvar gnus-summary-mode-line-format-alist
1746   `((?G gnus-tmp-group-name ?s)
1747     (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1748     (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1749     (?A gnus-tmp-article-number ?d)
1750     (?Z gnus-tmp-unread-and-unselected ?s)
1751     (?V gnus-version ?s)
1752     (?U gnus-tmp-unread-and-unticked ?d)
1753     (?S gnus-tmp-subject ?s)
1754     (?e gnus-tmp-unselected ?d)
1755     (?u gnus-tmp-user-defined ?s)
1756     (?d (length gnus-newsgroup-dormant) ?d)
1757     (?t (length gnus-newsgroup-marked) ?d)
1758     (?r (length gnus-newsgroup-reads) ?d)
1759     (?E gnus-newsgroup-expunged-tally ?d)
1760     (?s (gnus-current-score-file-nondirectory) ?s)))
1761
1762 (defvar gnus-article-mode-line-format-alist
1763   gnus-summary-mode-line-format-alist)
1764
1765 (defvar gnus-group-mode-line-format-alist
1766   `((?S gnus-tmp-news-server ?s)
1767     (?M gnus-tmp-news-method ?s)
1768     (?u gnus-tmp-user-defined ?s)
1769     (?: gnus-tmp-colon ?s)))
1770
1771 (defvar gnus-have-read-active-file nil)
1772
1773 (defconst gnus-maintainer
1774   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1775   "The mail address of the Gnus maintainers.")
1776
1777 (defconst gnus-version-number "5.2.37"
1778   "Version number for this version of Gnus.")
1779
1780 (defconst gnus-version (format "Gnus v%s" gnus-version-number)
1781   "Version string for this version of Gnus.")
1782
1783 (defvar gnus-info-nodes
1784   '((gnus-group-mode "(gnus)The Group Buffer")
1785     (gnus-summary-mode "(gnus)The Summary Buffer")
1786     (gnus-article-mode "(gnus)The Article Buffer")
1787     (gnus-server-mode "(gnus)The Server Buffer")
1788     (gnus-browse-mode "(gnus)Browse Foreign Server")
1789     (gnus-tree-mode "(gnus)Tree Display")
1790     )
1791   "Alist of major modes and related Info nodes.")
1792
1793 (defvar gnus-group-buffer "*Group*")
1794 (defvar gnus-summary-buffer "*Summary*")
1795 (defvar gnus-article-buffer "*Article*")
1796 (defvar gnus-server-buffer "*Server*")
1797
1798 (defvar gnus-work-buffer " *gnus work*")
1799
1800 (defvar gnus-original-article-buffer " *Original Article*")
1801 (defvar gnus-original-article nil)
1802
1803 (defvar gnus-buffer-list nil
1804   "Gnus buffers that should be killed on exit.")
1805
1806 (defvar gnus-slave nil
1807   "Whether this Gnus is a slave or not.")
1808
1809 (defvar gnus-variable-list
1810   '(gnus-newsrc-options gnus-newsrc-options-n
1811     gnus-newsrc-last-checked-date
1812     gnus-newsrc-alist gnus-server-alist
1813     gnus-killed-list gnus-zombie-list
1814     gnus-topic-topology gnus-topic-alist
1815     gnus-format-specs)
1816   "Gnus variables saved in the quick startup file.")
1817
1818 (defvar gnus-newsrc-options nil
1819   "Options line in the .newsrc file.")
1820
1821 (defvar gnus-newsrc-options-n nil
1822   "List of regexps representing groups to be subscribed/ignored unconditionally.")
1823
1824 (defvar gnus-newsrc-last-checked-date nil
1825   "Date Gnus last asked server for new newsgroups.")
1826
1827 (defvar gnus-topic-topology nil
1828   "The complete topic hierarchy.")
1829
1830 (defvar gnus-topic-alist nil
1831   "The complete topic-group alist.")
1832
1833 (defvar gnus-newsrc-alist nil
1834   "Assoc list of read articles.
1835 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1836
1837 (defvar gnus-newsrc-hashtb nil
1838   "Hashtable of gnus-newsrc-alist.")
1839
1840 (defvar gnus-killed-list nil
1841   "List of killed newsgroups.")
1842
1843 (defvar gnus-killed-hashtb nil
1844   "Hash table equivalent of gnus-killed-list.")
1845
1846 (defvar gnus-zombie-list nil
1847   "List of almost dead newsgroups.")
1848
1849 (defvar gnus-description-hashtb nil
1850   "Descriptions of newsgroups.")
1851
1852 (defvar gnus-list-of-killed-groups nil
1853   "List of newsgroups that have recently been killed by the user.")
1854
1855 (defvar gnus-active-hashtb nil
1856   "Hashtable of active articles.")
1857
1858 (defvar gnus-moderated-list nil
1859   "List of moderated newsgroups.")
1860
1861 (defvar gnus-group-marked nil)
1862
1863 (defvar gnus-current-startup-file nil
1864   "Startup file for the current host.")
1865
1866 (defvar gnus-last-search-regexp nil
1867   "Default regexp for article search command.")
1868
1869 (defvar gnus-last-shell-command nil
1870   "Default shell command on article.")
1871
1872 (defvar gnus-current-select-method nil
1873   "The current method for selecting a newsgroup.")
1874
1875 (defvar gnus-group-list-mode nil)
1876
1877 (defvar gnus-article-internal-prepare-hook nil)
1878
1879 (defvar gnus-newsgroup-name nil)
1880 (defvar gnus-newsgroup-begin nil)
1881 (defvar gnus-newsgroup-end nil)
1882 (defvar gnus-newsgroup-last-rmail nil)
1883 (defvar gnus-newsgroup-last-mail nil)
1884 (defvar gnus-newsgroup-last-folder nil)
1885 (defvar gnus-newsgroup-last-file nil)
1886 (defvar gnus-newsgroup-auto-expire nil)
1887 (defvar gnus-newsgroup-active nil)
1888
1889 (defvar gnus-newsgroup-data nil)
1890 (defvar gnus-newsgroup-data-reverse nil)
1891 (defvar gnus-newsgroup-limit nil)
1892 (defvar gnus-newsgroup-limits nil)
1893
1894 (defvar gnus-newsgroup-unreads nil
1895   "List of unread articles in the current newsgroup.")
1896
1897 (defvar gnus-newsgroup-unselected nil
1898   "List of unselected unread articles in the current newsgroup.")
1899
1900 (defvar gnus-newsgroup-reads nil
1901   "Alist of read articles and article marks in the current newsgroup.")
1902
1903 (defvar gnus-newsgroup-expunged-tally nil)
1904
1905 (defvar gnus-newsgroup-marked nil
1906   "List of ticked articles in the current newsgroup (a subset of unread art).")
1907
1908 (defvar gnus-newsgroup-killed nil
1909   "List of ranges of articles that have been through the scoring process.")
1910
1911 (defvar gnus-newsgroup-cached nil
1912   "List of articles that come from the article cache.")
1913
1914 (defvar gnus-newsgroup-saved nil
1915   "List of articles that have been saved.")
1916
1917 (defvar gnus-newsgroup-kill-headers nil)
1918
1919 (defvar gnus-newsgroup-replied nil
1920   "List of articles that have been replied to in the current newsgroup.")
1921
1922 (defvar gnus-newsgroup-expirable nil
1923   "List of articles in the current newsgroup that can be expired.")
1924
1925 (defvar gnus-newsgroup-processable nil
1926   "List of articles in the current newsgroup that can be processed.")
1927
1928 (defvar gnus-newsgroup-bookmarks nil
1929   "List of articles in the current newsgroup that have bookmarks.")
1930
1931 (defvar gnus-newsgroup-dormant nil
1932   "List of dormant articles in the current newsgroup.")
1933
1934 (defvar gnus-newsgroup-scored nil
1935   "List of scored articles in the current newsgroup.")
1936
1937 (defvar gnus-newsgroup-headers nil
1938   "List of article headers in the current newsgroup.")
1939
1940 (defvar gnus-newsgroup-threads nil)
1941
1942 (defvar gnus-newsgroup-prepared nil
1943   "Whether the current group has been prepared properly.")
1944
1945 (defvar gnus-newsgroup-ancient nil
1946   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1947
1948 (defvar gnus-newsgroup-sparse nil)
1949
1950 (defvar gnus-current-article nil)
1951 (defvar gnus-article-current nil)
1952 (defvar gnus-current-headers nil)
1953 (defvar gnus-have-all-headers nil)
1954 (defvar gnus-last-article nil)
1955 (defvar gnus-newsgroup-history nil)
1956 (defvar gnus-current-kill-article nil)
1957
1958 ;; Save window configuration.
1959 (defvar gnus-prev-winconf nil)
1960
1961 (defvar gnus-summary-mark-positions nil)
1962 (defvar gnus-group-mark-positions nil)
1963
1964 (defvar gnus-reffed-article-number nil)
1965
1966 ;;; Let the byte-compiler know that we know about this variable.
1967 (defvar rmail-default-rmail-file)
1968
1969 (defvar gnus-cache-removable-articles nil)
1970
1971 (defvar gnus-dead-summary nil)
1972
1973 (defconst gnus-summary-local-variables
1974   '(gnus-newsgroup-name
1975     gnus-newsgroup-begin gnus-newsgroup-end
1976     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1977     gnus-newsgroup-last-folder gnus-newsgroup-last-file
1978     gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1979     gnus-newsgroup-unselected gnus-newsgroup-marked
1980     gnus-newsgroup-reads gnus-newsgroup-saved
1981     gnus-newsgroup-replied gnus-newsgroup-expirable
1982     gnus-newsgroup-processable gnus-newsgroup-killed
1983     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1984     gnus-newsgroup-headers gnus-newsgroup-threads
1985     gnus-newsgroup-prepared gnus-summary-highlight-line-function
1986     gnus-current-article gnus-current-headers gnus-have-all-headers
1987     gnus-last-article gnus-article-internal-prepare-hook
1988     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1989     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1990     gnus-newsgroup-async gnus-thread-expunge-below
1991     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
1992     (gnus-summary-mark-below . global)
1993     gnus-newsgroup-active gnus-scores-exclude-files
1994     gnus-newsgroup-history gnus-newsgroup-ancient
1995     gnus-newsgroup-sparse
1996     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1997     gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1)
1998     (gnus-newsgroup-expunged-tally . 0)
1999     gnus-cache-removable-articles gnus-newsgroup-cached
2000     gnus-newsgroup-data gnus-newsgroup-data-reverse
2001     gnus-newsgroup-limit gnus-newsgroup-limits)
2002   "Variables that are buffer-local to the summary buffers.")
2003
2004 (defconst gnus-bug-message
2005   "Sending a bug report to the Gnus Towers.
2006 ========================================
2007
2008 The buffer below is a mail buffer.  When you press `C-c C-c', it will
2009 be sent to the Gnus Bug Exterminators.
2010
2011 At the bottom of the buffer you'll see lots of variable settings.
2012 Please do not delete those.  They will tell the Bug People what your
2013 environment is, so that it will be easier to locate the bugs.
2014
2015 If you have found a bug that makes Emacs go \"beep\", set
2016 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
2017 and include the backtrace in your bug report.
2018
2019 Please describe the bug in annoying, painstaking detail.
2020
2021 Thank you for your help in stamping out bugs.
2022 ")
2023
2024 ;;; End of variables.
2025
2026 ;; Define some autoload functions Gnus might use.
2027 (eval-and-compile
2028
2029   ;; This little mapcar goes through the list below and marks the
2030   ;; symbols in question as autoloaded functions.
2031   (mapcar
2032    (lambda (package)
2033      (let ((interactive (nth 1 (memq ':interactive package))))
2034        (mapcar
2035         (lambda (function)
2036           (let (keymap)
2037             (when (consp function)
2038               (setq keymap (car (memq 'keymap function)))
2039               (setq function (car function)))
2040             (autoload function (car package) nil interactive keymap)))
2041         (if (eq (nth 1 package) ':interactive)
2042             (cdddr package)
2043           (cdr package)))))
2044    '(("metamail" metamail-buffer)
2045      ("info" Info-goto-node)
2046      ("hexl" hexl-hex-string-to-integer)
2047      ("pp" pp pp-to-string pp-eval-expression)
2048      ("mail-extr" mail-extract-address-components)
2049      ("nnmail" nnmail-split-fancy nnmail-article-group)
2050      ("nnvirtual" nnvirtual-catchup-group)
2051      ("timezone" timezone-make-date-arpa-standard timezone-fix-time
2052       timezone-make-sortable-date timezone-make-time-string)
2053      ("rmailout" rmail-output)
2054      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
2055       rmail-show-message)
2056      ("gnus-soup" :interactive t
2057       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
2058       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
2059      ("nnsoup" nnsoup-pack-replies)
2060      ("score-mode" :interactive t gnus-score-mode)
2061      ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
2062       gnus-Folder-save-name gnus-folder-save-name)
2063      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
2064      ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
2065       gnus-server-make-menu-bar gnus-article-make-menu-bar
2066       gnus-browse-make-menu-bar gnus-highlight-selected-summary
2067       gnus-summary-highlight-line gnus-carpal-setup-buffer
2068       gnus-group-highlight-line
2069       gnus-article-add-button gnus-insert-next-page-button
2070       gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu)
2071      ("gnus-vis" :interactive t
2072       gnus-article-push-button gnus-article-press-button
2073       gnus-article-highlight gnus-article-highlight-some
2074       gnus-article-highlight-headers gnus-article-highlight-signature
2075       gnus-article-add-buttons gnus-article-add-buttons-to-head
2076       gnus-article-next-button gnus-article-prev-button)
2077      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
2078       gnus-demon-add-disconnection gnus-demon-add-handler
2079       gnus-demon-remove-handler)
2080      ("gnus-demon" :interactive t
2081       gnus-demon-init gnus-demon-cancel)
2082      ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
2083       gnus-tree-open gnus-tree-close)
2084      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
2085       gnus-nocem-unwanted-article-p)
2086      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
2087      ("gnus-srvr" gnus-browse-foreign-server)
2088      ("gnus-cite" :interactive t
2089       gnus-article-highlight-citation gnus-article-hide-citation-maybe
2090       gnus-article-hide-citation gnus-article-fill-cited-article
2091       gnus-article-hide-citation-in-followups)
2092      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
2093       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
2094       gnus-execute gnus-expunge)
2095      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
2096       gnus-cache-possibly-remove-articles gnus-cache-request-article
2097       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
2098       gnus-cache-enter-remove-article gnus-cached-article-p
2099       gnus-cache-open gnus-cache-close gnus-cache-update-article)
2100      ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
2101       gnus-cache-remove-article)
2102      ("gnus-score" :interactive t
2103       gnus-summary-increase-score gnus-summary-lower-score
2104       gnus-score-flush-cache gnus-score-close
2105       gnus-score-raise-same-subject-and-select
2106       gnus-score-raise-same-subject gnus-score-default
2107       gnus-score-raise-thread gnus-score-lower-same-subject-and-select
2108       gnus-score-lower-same-subject gnus-score-lower-thread
2109       gnus-possibly-score-headers gnus-summary-raise-score 
2110       gnus-summary-set-score gnus-summary-current-score)
2111      ("gnus-score"
2112       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
2113       gnus-current-score-file-nondirectory gnus-score-adaptive
2114       gnus-score-find-trace gnus-score-file-name)
2115      ("gnus-edit" :interactive t gnus-score-customize)
2116      ("gnus-topic" :interactive t gnus-topic-mode)
2117      ("gnus-topic" gnus-topic-remove-group)
2118      ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
2119      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
2120      ("gnus-uu" :interactive t
2121       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
2122       gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
2123       gnus-uu-mark-by-regexp gnus-uu-mark-all
2124       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
2125       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
2126       gnus-uu-decode-unshar-and-save gnus-uu-decode-save
2127       gnus-uu-decode-binhex gnus-uu-decode-uu-view
2128       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
2129       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
2130       gnus-uu-decode-binhex-view)
2131      ("gnus-msg" (gnus-summary-send-map keymap)
2132       gnus-mail-yank-original gnus-mail-send-and-exit
2133       gnus-article-mail gnus-new-mail gnus-mail-reply
2134       gnus-copy-article-buffer)
2135      ("gnus-msg" :interactive t
2136       gnus-group-post-news gnus-group-mail gnus-summary-post-news
2137       gnus-summary-followup gnus-summary-followup-with-original
2138       gnus-summary-cancel-article gnus-summary-supersede-article
2139       gnus-post-news gnus-inews-news 
2140       gnus-summary-reply gnus-summary-reply-with-original
2141       gnus-summary-mail-forward gnus-summary-mail-other-window
2142       gnus-bug)
2143      ("gnus-picon" :interactive t gnus-article-display-picons
2144       gnus-group-display-picons gnus-picons-article-display-x-face
2145       gnus-picons-display-x-face)
2146      ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p 
2147       gnus-grouplens-mode)
2148      ("smiley" :interactive t gnus-smiley-display)
2149      ("gnus-vm" gnus-vm-mail-setup)
2150      ("gnus-vm" :interactive t gnus-summary-save-in-vm
2151       gnus-summary-save-article-vm))))
2152
2153 \f
2154
2155 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2156 ;; If you want the cursor to go somewhere else, set these two
2157 ;; functions in some startup hook to whatever you want.
2158 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
2159 (defalias 'gnus-group-position-point 'gnus-goto-colon)
2160
2161 ;;; Various macros and substs.
2162
2163 (defun gnus-header-from (header)
2164   (mail-header-from header))
2165
2166 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
2167   "Pop to BUFFER, evaluate FORMS, and then return to the original window."
2168   (let ((tempvar (make-symbol "GnusStartBufferWindow"))
2169         (w (make-symbol "w"))
2170         (buf (make-symbol "buf")))
2171     `(let* ((,tempvar (selected-window))
2172             (,buf ,buffer)
2173             (,w (get-buffer-window ,buf 'visible)))
2174        (unwind-protect
2175            (progn
2176              (if ,w
2177                  (select-window ,w)
2178                (pop-to-buffer ,buf))
2179              ,@forms)
2180          (select-window ,tempvar)))))
2181
2182 (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
2183 (put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1)
2184 (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
2185
2186 (defmacro gnus-gethash (string hashtable)
2187   "Get hash value of STRING in HASHTABLE."
2188   `(symbol-value (intern-soft ,string ,hashtable)))
2189
2190 (defmacro gnus-sethash (string value hashtable)
2191   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2192   `(set (intern ,string ,hashtable) ,value))
2193
2194 (defmacro gnus-intern-safe (string hashtable)
2195   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2196   `(let ((symbol (intern ,string ,hashtable)))
2197      (or (boundp symbol)
2198          (set symbol nil))
2199      symbol))
2200
2201 (defmacro gnus-group-unread (group)
2202   "Get the currently computed number of unread articles in GROUP."
2203   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
2204
2205 (defmacro gnus-group-entry (group)
2206   "Get the newsrc entry for GROUP."
2207   `(gnus-gethash ,group gnus-newsrc-hashtb))
2208
2209 (defmacro gnus-active (group)
2210   "Get active info on GROUP."
2211   `(gnus-gethash ,group gnus-active-hashtb))
2212
2213 (defmacro gnus-set-active (group active)
2214   "Set GROUP's active info."
2215   `(gnus-sethash ,group ,active gnus-active-hashtb))
2216
2217 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2218 ;;   function `substring' might cut on a middle of multi-octet
2219 ;;   character.
2220 (defun gnus-truncate-string (str width)
2221   (substring str 0 width))
2222
2223 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
2224 ;; to limit the length of a string.  This function is necessary since
2225 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
2226 (defsubst gnus-limit-string (str width)
2227   (if (> (length str) width)
2228       (substring str 0 width)
2229     str))
2230
2231 (defsubst gnus-simplify-subject-re (subject)
2232   "Remove \"Re:\" from subject lines."
2233   (if (string-match "^[Rr][Ee]: *" subject)
2234       (substring subject (match-end 0))
2235     subject))
2236
2237 (defsubst gnus-functionp (form)
2238   "Return non-nil if FORM is funcallable."
2239   (or (and (symbolp form) (fboundp form))
2240       (and (listp form) (eq (car form) 'lambda))))
2241
2242 (defsubst gnus-goto-char (point)
2243   (and point (goto-char point)))
2244
2245 (defmacro gnus-buffer-exists-p (buffer)
2246   `(let ((buffer ,buffer))
2247      (and buffer
2248           (funcall (if (stringp buffer) 'get-buffer 'buffer-name)
2249                    buffer))))
2250
2251 (defmacro gnus-kill-buffer (buffer)
2252   `(let ((buf ,buffer))
2253      (if (gnus-buffer-exists-p buf)
2254          (kill-buffer buf))))
2255
2256 (defsubst gnus-point-at-bol ()
2257   "Return point at the beginning of the line."
2258   (let ((p (point)))
2259     (beginning-of-line)
2260     (prog1
2261         (point)
2262       (goto-char p))))
2263
2264 (defsubst gnus-point-at-eol ()
2265   "Return point at the end of the line."
2266   (let ((p (point)))
2267     (end-of-line)
2268     (prog1
2269         (point)
2270       (goto-char p))))
2271
2272 (defun gnus-alive-p ()
2273   "Say whether Gnus is running or not."
2274   (and gnus-group-buffer
2275        (get-buffer gnus-group-buffer)))
2276
2277 (defun gnus-delete-first (elt list)
2278   "Delete by side effect the first occurrence of ELT as a member of LIST."
2279   (if (equal (car list) elt)
2280       (cdr list)
2281     (let ((total list))
2282       (while (and (cdr list)
2283                   (not (equal (cadr list) elt)))
2284         (setq list (cdr list)))
2285       (when (cdr list)
2286         (setcdr list (cddr list)))
2287       total)))
2288
2289 ;; Delete the current line (and the next N lines.);
2290 (defmacro gnus-delete-line (&optional n)
2291   `(delete-region (progn (beginning-of-line) (point))
2292                   (progn (forward-line ,(or n 1)) (point))))
2293
2294 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
2295 (defvar gnus-init-inhibit nil)
2296 (defun gnus-read-init-file (&optional inhibit-next)
2297   (if gnus-init-inhibit
2298       (setq gnus-init-inhibit nil)
2299     (setq gnus-init-inhibit inhibit-next)
2300     (and gnus-init-file
2301          (or (and (file-exists-p gnus-init-file)
2302                   ;; Don't try to load a directory.
2303                   (not (file-directory-p gnus-init-file)))
2304              (file-exists-p (concat gnus-init-file ".el"))
2305              (file-exists-p (concat gnus-init-file ".elc")))
2306          (condition-case var
2307              (load gnus-init-file nil t)
2308            (error
2309             (error "Error in %s: %s" gnus-init-file var))))))
2310
2311 ;; Info access macros.
2312
2313 (defmacro gnus-info-group (info)
2314   `(nth 0 ,info))
2315 (defmacro gnus-info-rank (info)
2316   `(nth 1 ,info))
2317 (defmacro gnus-info-read (info)
2318   `(nth 2 ,info))
2319 (defmacro gnus-info-marks (info)
2320   `(nth 3 ,info))
2321 (defmacro gnus-info-method (info)
2322   `(nth 4 ,info))
2323 (defmacro gnus-info-params (info)
2324   `(nth 5 ,info))
2325
2326 (defmacro gnus-info-level (info)
2327   `(let ((rank (gnus-info-rank ,info)))
2328      (if (consp rank)
2329          (car rank)
2330        rank)))
2331 (defmacro gnus-info-score (info)
2332   `(let ((rank (gnus-info-rank ,info)))
2333      (or (and (consp rank) (cdr rank)) 0)))
2334
2335 (defmacro gnus-info-set-group (info group)
2336   `(setcar ,info ,group))
2337 (defmacro gnus-info-set-rank (info rank)
2338   `(setcar (nthcdr 1 ,info) ,rank))
2339 (defmacro gnus-info-set-read (info read)
2340   `(setcar (nthcdr 2 ,info) ,read))
2341 (defmacro gnus-info-set-marks (info marks)
2342   `(setcar (nthcdr 3 ,info) ,marks))
2343 (defmacro gnus-info-set-method (info method)
2344   `(setcar (nthcdr 4 ,info) ,method))
2345 (defmacro gnus-info-set-params (info params)
2346   `(setcar (nthcdr 5 ,info) ,params))
2347
2348 (defmacro gnus-info-set-level (info level)
2349   `(let ((rank (cdr ,info)))
2350      (if (consp (car rank))
2351          (setcar (car rank) ,level)
2352        (setcar rank ,level))))
2353 (defmacro gnus-info-set-score (info score)
2354   `(let ((rank (cdr ,info)))
2355      (if (consp (car rank))
2356          (setcdr (car rank) ,score)
2357        (setcar rank (cons (car rank) ,score)))))
2358
2359 (defmacro gnus-get-info (group)
2360   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2361
2362 (defun gnus-byte-code (func)
2363   "Return a form that can be `eval'ed based on FUNC."
2364   (let ((fval (symbol-function func)))
2365     (if (byte-code-function-p fval)
2366         (let ((flist (append fval nil)))
2367           (setcar flist 'byte-code)
2368           flist)
2369       (cons 'progn (cddr fval)))))
2370
2371 ;; Find out whether the gnus-visual TYPE is wanted.
2372 (defun gnus-visual-p (&optional type class)
2373   (and gnus-visual                      ; Has to be non-nil, at least.
2374        (if (not type)                   ; We don't care about type.
2375            gnus-visual
2376          (if (listp gnus-visual)        ; It's a list, so we check it.
2377              (or (memq type gnus-visual)
2378                  (memq class gnus-visual))
2379            t))))
2380
2381 ;;; Load the compatability functions.
2382
2383 (require 'gnus-cus)
2384 (require 'gnus-ems)
2385
2386 \f
2387 ;;;
2388 ;;; Shutdown
2389 ;;;
2390
2391 (defvar gnus-shutdown-alist nil)
2392
2393 (defun gnus-add-shutdown (function &rest symbols)
2394   "Run FUNCTION whenever one of SYMBOLS is shut down."
2395   (push (cons function symbols) gnus-shutdown-alist))
2396
2397 (defun gnus-shutdown (symbol)
2398   "Shut down everything that waits for SYMBOL."
2399   (let ((alist gnus-shutdown-alist)
2400         entry)
2401     (while (setq entry (pop alist))
2402       (when (memq symbol (cdr entry))
2403         (funcall (car entry))))))
2404
2405 \f
2406
2407 ;; Format specs.  The chunks below are the machine-generated forms
2408 ;; that are to be evaled as the result of the default format strings.
2409 ;; We write them in here to get them byte-compiled.  That way the
2410 ;; default actions will be quite fast, while still retaining the full
2411 ;; flexibility of the user-defined format specs.
2412
2413 ;; First we have lots of dummy defvars to let the compiler know these
2414 ;; are really dynamic variables.
2415
2416 (defvar gnus-tmp-unread)
2417 (defvar gnus-tmp-replied)
2418 (defvar gnus-tmp-score-char)
2419 (defvar gnus-tmp-indentation)
2420 (defvar gnus-tmp-opening-bracket)
2421 (defvar gnus-tmp-lines)
2422 (defvar gnus-tmp-name)
2423 (defvar gnus-tmp-closing-bracket)
2424 (defvar gnus-tmp-subject-or-nil)
2425 (defvar gnus-tmp-subject)
2426 (defvar gnus-tmp-marked)
2427 (defvar gnus-tmp-marked-mark)
2428 (defvar gnus-tmp-subscribed)
2429 (defvar gnus-tmp-process-marked)
2430 (defvar gnus-tmp-number-of-unread)
2431 (defvar gnus-tmp-group-name)
2432 (defvar gnus-tmp-group)
2433 (defvar gnus-tmp-article-number)
2434 (defvar gnus-tmp-unread-and-unselected)
2435 (defvar gnus-tmp-news-method)
2436 (defvar gnus-tmp-news-server)
2437 (defvar gnus-tmp-article-number)
2438 (defvar gnus-mouse-face)
2439 (defvar gnus-mouse-face-prop)
2440
2441 (defun gnus-summary-line-format-spec ()
2442   (insert gnus-tmp-unread gnus-tmp-replied
2443           gnus-tmp-score-char gnus-tmp-indentation)
2444   (gnus-put-text-property
2445    (point)
2446    (progn
2447      (insert
2448       gnus-tmp-opening-bracket
2449       (format "%4d: %-20s"
2450               gnus-tmp-lines
2451               (if (> (length gnus-tmp-name) 20)
2452                   (substring gnus-tmp-name 0 20)
2453                 gnus-tmp-name))
2454       gnus-tmp-closing-bracket)
2455      (point))
2456    gnus-mouse-face-prop gnus-mouse-face)
2457   (insert " " gnus-tmp-subject-or-nil "\n"))
2458
2459 (defvar gnus-summary-line-format-spec
2460   (gnus-byte-code 'gnus-summary-line-format-spec))
2461
2462 (defun gnus-summary-dummy-line-format-spec ()
2463   (insert "*  ")
2464   (gnus-put-text-property
2465    (point)
2466    (progn
2467      (insert ":                          :")
2468      (point))
2469    gnus-mouse-face-prop gnus-mouse-face)
2470   (insert " " gnus-tmp-subject "\n"))
2471
2472 (defvar gnus-summary-dummy-line-format-spec
2473   (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
2474
2475 (defun gnus-group-line-format-spec ()
2476   (insert gnus-tmp-marked-mark gnus-tmp-subscribed
2477           gnus-tmp-process-marked
2478           gnus-group-indentation
2479           (format "%5s: " gnus-tmp-number-of-unread))
2480   (gnus-put-text-property
2481    (point)
2482    (progn
2483      (insert gnus-tmp-group "\n")
2484      (1- (point)))
2485    gnus-mouse-face-prop gnus-mouse-face))
2486 (defvar gnus-group-line-format-spec
2487   (gnus-byte-code 'gnus-group-line-format-spec))
2488
2489 (defvar gnus-format-specs
2490   `((version . ,emacs-version)
2491     (group ,gnus-group-line-format ,gnus-group-line-format-spec)
2492     (summary-dummy ,gnus-summary-dummy-line-format
2493                    ,gnus-summary-dummy-line-format-spec)
2494     (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec)))
2495
2496 (defvar gnus-article-mode-line-format-spec nil)
2497 (defvar gnus-summary-mode-line-format-spec nil)
2498 (defvar gnus-group-mode-line-format-spec nil)
2499
2500 ;;; Phew.  All that gruft is over, fortunately.
2501
2502 \f
2503 ;;;
2504 ;;; Gnus Utility Functions
2505 ;;;
2506
2507 (defun gnus-extract-address-components (from)
2508   (let (name address)
2509     ;; First find the address - the thing with the @ in it.  This may
2510     ;; not be accurate in mail addresses, but does the trick most of
2511     ;; the time in news messages.
2512     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
2513         (setq address (substring from (match-beginning 0) (match-end 0))))
2514     ;; Then we check whether the "name <address>" format is used.
2515     (and address
2516          ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2517          ;; Linear white space is not required.
2518          (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
2519          (and (setq name (substring from 0 (match-beginning 0)))
2520               ;; Strip any quotes from the name.
2521               (string-match "\".*\"" name)
2522               (setq name (substring name 1 (1- (match-end 0))))))
2523     ;; If not, then "address (name)" is used.
2524     (or name
2525         (and (string-match "(.+)" from)
2526              (setq name (substring from (1+ (match-beginning 0))
2527                                    (1- (match-end 0)))))
2528         (and (string-match "()" from)
2529              (setq name address))
2530         ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
2531         ;; XOVER might not support folded From headers.
2532         (and (string-match "(.*" from)
2533              (setq name (substring from (1+ (match-beginning 0))
2534                                    (match-end 0)))))
2535     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2536     (list (or name from) (or address from))))
2537
2538 (defun gnus-fetch-field (field)
2539   "Return the value of the header FIELD of current article."
2540   (save-excursion
2541     (save-restriction
2542       (let ((case-fold-search t)
2543             (inhibit-point-motion-hooks t))
2544         (nnheader-narrow-to-headers)
2545         (message-fetch-field field)))))
2546
2547 (defun gnus-goto-colon ()
2548   (beginning-of-line)
2549   (search-forward ":" (gnus-point-at-eol) t))
2550
2551 ;;;###autoload
2552 (defun gnus-update-format (var)
2553   "Update the format specification near point."
2554   (interactive
2555    (list
2556     (save-excursion
2557       (eval-defun nil)
2558       ;; Find the end of the current word.
2559       (re-search-forward "[ \t\n]" nil t)
2560       ;; Search backward.
2561       (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
2562         (match-string 1)))))
2563   (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
2564                               (match-string 1 var))))
2565          (entry (assq type gnus-format-specs))
2566          value spec)
2567     (when entry
2568       (setq gnus-format-specs (delq entry gnus-format-specs)))
2569     (set
2570      (intern (format "%s-spec" var))
2571      (gnus-parse-format (setq value (symbol-value (intern var)))
2572                         (symbol-value (intern (format "%s-alist" var)))
2573                         (not (string-match "mode" var))))
2574     (setq spec (symbol-value (intern (format "%s-spec" var))))
2575     (push (list type value spec) gnus-format-specs)
2576
2577     (pop-to-buffer "*Gnus Format*")
2578     (erase-buffer)
2579     (lisp-interaction-mode)
2580     (insert (pp-to-string spec))))
2581
2582 (defun gnus-update-format-specifications (&optional force)
2583   "Update all (necessary) format specifications."
2584   ;; Make the indentation array.
2585   (gnus-make-thread-indent-array)
2586
2587   ;; See whether all the stored info needs to be flushed.
2588   (when (or force
2589             (not (equal emacs-version
2590                         (cdr (assq 'version gnus-format-specs)))))
2591     (setq gnus-format-specs nil))
2592
2593   ;; Go through all the formats and see whether they need updating.
2594   (let ((types '(summary summary-dummy group
2595                          summary-mode group-mode article-mode))
2596         new-format entry type val)
2597     (while (setq type (pop types))
2598       ;; Jump to the proper buffer to find out the value of
2599       ;; the variable, if possible.  (It may be buffer-local.)
2600       (save-excursion
2601         (let ((buffer (intern (format "gnus-%s-buffer" type)))
2602               val)
2603           (when (and (boundp buffer)
2604                      (setq val (symbol-value buffer))
2605                      (get-buffer val)
2606                      (buffer-name (get-buffer val)))
2607             (set-buffer (get-buffer val)))
2608           (setq new-format (symbol-value
2609                             (intern (format "gnus-%s-line-format" type))))))
2610       (setq entry (cdr (assq type gnus-format-specs)))
2611       (if (and entry
2612                (equal (car entry) new-format))
2613           ;; Use the old format.
2614           (set (intern (format "gnus-%s-line-format-spec" type))
2615                (cadr entry))
2616         ;; This is a new format.
2617         (setq val
2618               (if (not (stringp new-format))
2619                   ;; This is a function call or something.
2620                   new-format
2621                 ;; This is a "real" format.
2622                 (gnus-parse-format
2623                  new-format
2624                  (symbol-value
2625                   (intern (format "gnus-%s-line-format-alist"
2626                                   (if (eq type 'article-mode)
2627                                       'summary-mode type))))
2628                  (not (string-match "mode$" (symbol-name type))))))
2629         ;; Enter the new format spec into the list.
2630         (if entry
2631             (progn
2632               (setcar (cdr entry) val)
2633               (setcar entry new-format))
2634           (push (list type new-format val) gnus-format-specs))
2635         (set (intern (format "gnus-%s-line-format-spec" type)) val))))
2636
2637   (unless (assq 'version gnus-format-specs)
2638     (push (cons 'version emacs-version) gnus-format-specs))
2639
2640   (gnus-update-group-mark-positions)
2641   (gnus-update-summary-mark-positions))
2642
2643 (defun gnus-update-summary-mark-positions ()
2644   "Compute where the summary marks are to go."
2645   (save-excursion
2646     (when (and gnus-summary-buffer
2647                (get-buffer gnus-summary-buffer)
2648                (buffer-name (get-buffer gnus-summary-buffer)))
2649       (set-buffer gnus-summary-buffer))
2650     (let ((gnus-replied-mark 129)
2651           (gnus-score-below-mark 130)
2652           (gnus-score-over-mark 130)
2653           (thread nil)
2654           (gnus-visual nil)
2655           (spec gnus-summary-line-format-spec)
2656           pos)
2657       (save-excursion
2658         (gnus-set-work-buffer)
2659         (let ((gnus-summary-line-format-spec spec))
2660           (gnus-summary-insert-line
2661            [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
2662           (goto-char (point-min))
2663           (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
2664                                              (- (point) 2)))))
2665           (goto-char (point-min))
2666           (push (cons 'replied (and (search-forward "\201" nil t) 
2667                                     (- (point) 2)))
2668                 pos)
2669           (goto-char (point-min))
2670           (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
2671                 pos)))
2672       (setq gnus-summary-mark-positions pos))))
2673
2674 (defun gnus-update-group-mark-positions ()
2675   (save-excursion
2676     (let ((gnus-process-mark 128)
2677           (gnus-group-marked '("dummy.group"))
2678           (gnus-active-hashtb (make-vector 10 0)))
2679       (gnus-set-active "dummy.group" '(0 . 0))
2680       (gnus-set-work-buffer)
2681       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
2682       (goto-char (point-min))
2683       (setq gnus-group-mark-positions
2684             (list (cons 'process (and (search-forward "\200" nil t)
2685                                       (- (point) 2))))))))
2686
2687 (defvar gnus-mouse-face-0 'highlight)
2688 (defvar gnus-mouse-face-1 'highlight)
2689 (defvar gnus-mouse-face-2 'highlight)
2690 (defvar gnus-mouse-face-3 'highlight)
2691 (defvar gnus-mouse-face-4 'highlight)
2692
2693 (defun gnus-mouse-face-function (form type)
2694   `(gnus-put-text-property
2695     (point) (progn ,@form (point))
2696     gnus-mouse-face-prop
2697     ,(if (equal type 0)
2698          'gnus-mouse-face
2699        `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
2700
2701 (defvar gnus-face-0 'bold)
2702 (defvar gnus-face-1 'italic)
2703 (defvar gnus-face-2 'bold-italic)
2704 (defvar gnus-face-3 'bold)
2705 (defvar gnus-face-4 'bold)
2706
2707 (defun gnus-face-face-function (form type)
2708   `(gnus-put-text-property
2709     (point) (progn ,@form (point))
2710     'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
2711
2712 (defun gnus-max-width-function (el max-width)
2713   (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
2714   (if (symbolp el)
2715       `(if (> (length ,el) ,max-width)
2716            (substring ,el 0 ,max-width)
2717          ,el)
2718     `(let ((val (eval ,el)))
2719        (if (numberp val)
2720            (setq val (int-to-string val)))
2721        (if (> (length val) ,max-width)
2722            (substring val 0 ,max-width)
2723          val))))
2724
2725 (defun gnus-parse-format (format spec-alist &optional insert)
2726   ;; This function parses the FORMAT string with the help of the
2727   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
2728   ;; string.  If the FORMAT string contains the specifiers %( and %)
2729   ;; the text between them will have the mouse-face text property.
2730   (if (string-match
2731        "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
2732        format)
2733       (gnus-parse-complex-format format spec-alist)
2734     ;; This is a simple format.
2735     (gnus-parse-simple-format format spec-alist insert)))
2736
2737 (defun gnus-parse-complex-format (format spec-alist)
2738   (save-excursion
2739     (gnus-set-work-buffer)
2740     (insert format)
2741     (goto-char (point-min))
2742     (while (re-search-forward "\"" nil t)
2743       (replace-match "\\\"" nil t))
2744     (goto-char (point-min))
2745     (insert "(\"")
2746     (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
2747       (let ((number (if (match-beginning 1)
2748                         (match-string 1) "0"))
2749             (delim (aref (match-string 2) 0)))
2750         (if (or (= delim ?\() (= delim ?\{))
2751             (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
2752                                    " " number " \""))
2753           (replace-match "\")\""))))
2754     (goto-char (point-max))
2755     (insert "\")")
2756     (goto-char (point-min))
2757     (let ((form (read (current-buffer))))
2758       (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
2759
2760 (defun gnus-complex-form-to-spec (form spec-alist)
2761   (delq nil
2762         (mapcar
2763          (lambda (sform)
2764            (if (stringp sform)
2765                (gnus-parse-simple-format sform spec-alist t)
2766              (funcall (intern (format "gnus-%s-face-function" (car sform)))
2767                       (gnus-complex-form-to-spec (cddr sform) spec-alist)
2768                       (nth 1 sform))))
2769          form)))
2770
2771 (defun gnus-parse-simple-format (format spec-alist &optional insert)
2772   ;; This function parses the FORMAT string with the help of the
2773   ;; SPEC-ALIST and returns a list that can be eval'ed to return a
2774   ;; string.
2775   (let ((max-width 0)
2776         spec flist fstring newspec elem beg result dontinsert)
2777     (save-excursion
2778       (gnus-set-work-buffer)
2779       (insert format)
2780       (goto-char (point-min))
2781       (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
2782                                 nil t)
2783         (if (= (setq spec (string-to-char (match-string 2))) ?%)
2784               (setq newspec "%"
2785                     beg (1+ (match-beginning 0)))
2786           ;; First check if there are any specs that look anything like
2787           ;; "%12,12A", ie. with a "max width specification".  These have
2788           ;; to be treated specially.
2789           (if (setq beg (match-beginning 1))
2790               (setq max-width
2791                     (string-to-int
2792                      (buffer-substring
2793                       (1+ (match-beginning 1)) (match-end 1))))
2794             (setq max-width 0)
2795             (setq beg (match-beginning 2)))
2796           ;; Find the specification from `spec-alist'.
2797           (unless (setq elem (cdr (assq spec spec-alist)))
2798             (setq elem '("*" ?s)))
2799           ;; Treat user defined format specifiers specially.
2800           (when (eq (car elem) 'gnus-tmp-user-defined)
2801             (setq elem
2802                   (list
2803                    (list (intern (concat "gnus-user-format-function-"
2804                                          (match-string 3)))
2805                          'gnus-tmp-header) ?s))
2806             (delete-region (match-beginning 3) (match-end 3)))
2807           (if (not (zerop max-width))
2808               (let ((el (car elem)))
2809                 (cond ((= (cadr elem) ?c)
2810                        (setq el (list 'char-to-string el)))
2811                       ((= (cadr elem) ?d)
2812                        (setq el (list 'int-to-string el))))
2813                 (setq flist (cons (gnus-max-width-function el max-width)
2814                                   flist))
2815                 (setq newspec ?s))
2816             (progn
2817               (setq flist (cons (car elem) flist))
2818               (setq newspec (cadr elem)))))
2819         ;; Remove the old specification (and possibly a ",12" string).
2820         (delete-region beg (match-end 2))
2821         ;; Insert the new specification.
2822         (goto-char beg)
2823         (insert newspec))
2824       (setq fstring (buffer-substring 1 (point-max))))
2825     ;; Do some postprocessing to increase efficiency.
2826     (setq
2827      result
2828      (cond
2829       ;; Emptyness.
2830       ((string= fstring "")
2831        nil)
2832       ;; Not a format string.
2833       ((not (string-match "%" fstring))
2834        (list fstring))
2835       ;; A format string with just a single string spec.
2836       ((string= fstring "%s")
2837        (list (car flist)))
2838       ;; A single character.
2839       ((string= fstring "%c")
2840        (list (car flist)))
2841       ;; A single number.
2842       ((string= fstring "%d")
2843        (setq dontinsert)
2844        (if insert
2845            (list `(princ ,(car flist)))
2846          (list `(int-to-string ,(car flist)))))
2847       ;; Just lots of chars and strings.
2848       ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
2849        (nreverse flist))
2850       ;; A single string spec at the beginning of the spec.
2851       ((string-match "\\`%[sc][^%]+\\'" fstring)
2852        (list (car flist) (substring fstring 2)))
2853       ;; A single string spec in the middle of the spec.
2854       ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
2855        (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
2856       ;; A single string spec in the end of the spec.
2857       ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
2858        (list (match-string 1 fstring) (car flist)))
2859       ;; A more complex spec.
2860       (t
2861        (list (cons 'format (cons fstring (nreverse flist)))))))
2862
2863     (if insert
2864         (when result
2865           (if dontinsert
2866               result
2867             (cons 'insert result)))
2868       (cond ((stringp result)
2869              result)
2870             ((consp result)
2871              (cons 'concat result))
2872             (t "")))))
2873
2874 (defun gnus-eval-format (format &optional alist props)
2875   "Eval the format variable FORMAT, using ALIST.
2876 If PROPS, insert the result."
2877   (let ((form (gnus-parse-format format alist props)))
2878     (if props
2879         (gnus-add-text-properties (point) (progn (eval form) (point)) props)
2880       (eval form))))
2881
2882 (defun gnus-remove-text-with-property (prop)
2883   "Delete all text in the current buffer with text property PROP."
2884   (save-excursion
2885     (goto-char (point-min))
2886     (while (not (eobp))
2887       (while (get-text-property (point) prop)
2888         (delete-char 1))
2889       (goto-char (next-single-property-change (point) prop nil (point-max))))))
2890
2891 (defun gnus-set-work-buffer ()
2892   (if (get-buffer gnus-work-buffer)
2893       (progn
2894         (set-buffer gnus-work-buffer)
2895         (erase-buffer))
2896     (set-buffer (get-buffer-create gnus-work-buffer))
2897     (kill-all-local-variables)
2898     (buffer-disable-undo (current-buffer))
2899     (gnus-add-current-to-buffer-list)))
2900
2901 ;; Article file names when saving.
2902
2903 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
2904   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2905 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
2906 Otherwise, it is like ~/News/news/group/num."
2907   (let ((default
2908           (expand-file-name
2909            (concat (if (gnus-use-long-file-name 'not-save)
2910                        (gnus-capitalize-newsgroup newsgroup)
2911                      (gnus-newsgroup-directory-form newsgroup))
2912                    "/" (int-to-string (mail-header-number headers)))
2913            gnus-article-save-directory)))
2914     (if (and last-file
2915              (string-equal (file-name-directory default)
2916                            (file-name-directory last-file))
2917              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2918         default
2919       (or last-file default))))
2920
2921 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
2922   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2923 If variable `gnus-use-long-file-name' is non-nil, it is
2924 ~/News/news.group/num.  Otherwise, it is like ~/News/news/group/num."
2925   (let ((default
2926           (expand-file-name
2927            (concat (if (gnus-use-long-file-name 'not-save)
2928                        newsgroup
2929                      (gnus-newsgroup-directory-form newsgroup))
2930                    "/" (int-to-string (mail-header-number headers)))
2931            gnus-article-save-directory)))
2932     (if (and last-file
2933              (string-equal (file-name-directory default)
2934                            (file-name-directory last-file))
2935              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2936         default
2937       (or last-file default))))
2938
2939 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
2940   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2941 If variable `gnus-use-long-file-name' is non-nil, it is
2942 ~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
2943   (or last-file
2944       (expand-file-name
2945        (if (gnus-use-long-file-name 'not-save)
2946            (gnus-capitalize-newsgroup newsgroup)
2947          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2948        gnus-article-save-directory)))
2949
2950 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2951   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2952 If variable `gnus-use-long-file-name' is non-nil, it is
2953 ~/News/news.group.  Otherwise, it is like ~/News/news/group/news."
2954   (or last-file
2955       (expand-file-name
2956        (if (gnus-use-long-file-name 'not-save)
2957            newsgroup
2958          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2959        gnus-article-save-directory)))
2960
2961 ;; For subscribing new newsgroup
2962
2963 (defun gnus-subscribe-hierarchical-interactive (groups)
2964   (let ((groups (sort groups 'string<))
2965         prefixes prefix start ans group starts)
2966     (while groups
2967       (setq prefixes (list "^"))
2968       (while (and groups prefixes)
2969         (while (not (string-match (car prefixes) (car groups)))
2970           (setq prefixes (cdr prefixes)))
2971         (setq prefix (car prefixes))
2972         (setq start (1- (length prefix)))
2973         (if (and (string-match "[^\\.]\\." (car groups) start)
2974                  (cdr groups)
2975                  (setq prefix
2976                        (concat "^" (substring (car groups) 0 (match-end 0))))
2977                  (string-match prefix (cadr groups)))
2978             (progn
2979               (setq prefixes (cons prefix prefixes))
2980               (message "Descend hierarchy %s? ([y]nsq): "
2981                        (substring prefix 1 (1- (length prefix))))
2982               (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q)))
2983                 (ding)
2984                 (message "Descend hierarchy %s? ([y]nsq): "
2985                          (substring prefix 1 (1- (length prefix)))))
2986               (cond ((= ans ?n)
2987                      (while (and groups
2988                                  (string-match prefix
2989                                                (setq group (car groups))))
2990                        (setq gnus-killed-list
2991                              (cons group gnus-killed-list))
2992                        (gnus-sethash group group gnus-killed-hashtb)
2993                        (setq groups (cdr groups)))
2994                      (setq starts (cdr starts)))
2995                     ((= ans ?s)
2996                      (while (and groups
2997                                  (string-match prefix
2998                                                (setq group (car groups))))
2999                        (gnus-sethash group group gnus-killed-hashtb)
3000                        (gnus-subscribe-alphabetically (car groups))
3001                        (setq groups (cdr groups)))
3002                      (setq starts (cdr starts)))
3003                     ((= ans ?q)
3004                      (while groups
3005                        (setq group (car groups))
3006                        (setq gnus-killed-list (cons group gnus-killed-list))
3007                        (gnus-sethash group group gnus-killed-hashtb)
3008                        (setq groups (cdr groups))))
3009                     (t nil)))
3010           (message "Subscribe %s? ([n]yq)" (car groups))
3011           (while (not (memq (setq ans (read-char)) '(?y ?\n ?q ?n)))
3012             (ding)
3013             (message "Subscribe %s? ([n]yq)" (car groups)))
3014           (setq group (car groups))
3015           (cond ((= ans ?y)
3016                  (gnus-subscribe-alphabetically (car groups))
3017                  (gnus-sethash group group gnus-killed-hashtb))
3018                 ((= ans ?q)
3019                  (while groups
3020                    (setq group (car groups))
3021                    (setq gnus-killed-list (cons group gnus-killed-list))
3022                    (gnus-sethash group group gnus-killed-hashtb)
3023                    (setq groups (cdr groups))))
3024                 (t
3025                  (setq gnus-killed-list (cons group gnus-killed-list))
3026                  (gnus-sethash group group gnus-killed-hashtb)))
3027           (setq groups (cdr groups)))))))
3028
3029 (defun gnus-subscribe-randomly (newsgroup)
3030   "Subscribe new NEWSGROUP by making it the first newsgroup."
3031   (gnus-subscribe-newsgroup newsgroup))
3032
3033 (defun gnus-subscribe-alphabetically (newgroup)
3034   "Subscribe new NEWSGROUP and insert it in alphabetical order."
3035   (let ((groups (cdr gnus-newsrc-alist))
3036         before)
3037     (while (and (not before) groups)
3038       (if (string< newgroup (caar groups))
3039           (setq before (caar groups))
3040         (setq groups (cdr groups))))
3041     (gnus-subscribe-newsgroup newgroup before)))
3042
3043 (defun gnus-subscribe-hierarchically (newgroup)
3044   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
3045   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
3046   (save-excursion
3047     (set-buffer (find-file-noselect gnus-current-startup-file))
3048     (let ((groupkey newgroup)
3049           before)
3050       (while (and (not before) groupkey)
3051         (goto-char (point-min))
3052         (let ((groupkey-re
3053                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
3054           (while (and (re-search-forward groupkey-re nil t)
3055                       (progn
3056                         (setq before (match-string 1))
3057                         (string< before newgroup)))))
3058         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
3059         (setq groupkey
3060               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
3061                   (substring groupkey (match-beginning 1) (match-end 1)))))
3062       (gnus-subscribe-newsgroup newgroup before))
3063     (kill-buffer (current-buffer))))
3064
3065 (defun gnus-subscribe-interactively (group)
3066   "Subscribe the new GROUP interactively.
3067 It is inserted in hierarchical newsgroup order if subscribed.  If not,
3068 it is killed."
3069   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
3070       (gnus-subscribe-hierarchically group)
3071     (push group gnus-killed-list)))
3072
3073 (defun gnus-subscribe-zombies (group)
3074   "Make the new GROUP into a zombie group."
3075   (push group gnus-zombie-list))
3076
3077 (defun gnus-subscribe-killed (group)
3078   "Make the new GROUP a killed group."
3079   (push group gnus-killed-list))
3080
3081 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
3082   "Subscribe new NEWSGROUP.
3083 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
3084 the first newsgroup."
3085   (save-excursion
3086     (goto-char (point-min))
3087     ;; We subscribe the group by changing its level to `subscribed'.
3088     (gnus-group-change-level
3089      newsgroup gnus-level-default-subscribed
3090      gnus-level-killed (gnus-gethash (or next "dummy.group")
3091                                      gnus-newsrc-hashtb))
3092     (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)))
3093
3094 ;; For directories
3095
3096 (defun gnus-newsgroup-directory-form (newsgroup)
3097   "Make hierarchical directory name from NEWSGROUP name."
3098   (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
3099         (len (length newsgroup))
3100         idx)
3101     ;; If this is a foreign group, we don't want to translate the
3102     ;; entire name.
3103     (if (setq idx (string-match ":" newsgroup))
3104         (aset newsgroup idx ?/)
3105       (setq idx 0))
3106     ;; Replace all occurrences of `.' with `/'.
3107     (while (< idx len)
3108       (if (= (aref newsgroup idx) ?.)
3109           (aset newsgroup idx ?/))
3110       (setq idx (1+ idx)))
3111     newsgroup))
3112
3113 (defun gnus-newsgroup-savable-name (group)
3114   ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
3115   ;; with dots.
3116   (nnheader-replace-chars-in-string group ?/ ?.))
3117
3118 (defun gnus-make-directory (dir)
3119   "Make DIRECTORY recursively."
3120   ;; Why don't we use `(make-directory dir 'parents)'?  That's just one
3121   ;; of the many mysteries of the universe.
3122   (let* ((dir (expand-file-name dir default-directory))
3123          dirs err)
3124     (if (string-match "/$" dir)
3125         (setq dir (substring dir 0 (match-beginning 0))))
3126     ;; First go down the path until we find a directory that exists.
3127     (while (not (file-exists-p dir))
3128       (setq dirs (cons dir dirs))
3129       (string-match "/[^/]+$" dir)
3130       (setq dir (substring dir 0 (match-beginning 0))))
3131     ;; Then create all the subdirs.
3132     (while (and dirs (not err))
3133       (condition-case ()
3134           (make-directory (car dirs))
3135         (error (setq err t)))
3136       (setq dirs (cdr dirs)))
3137     ;; We return whether we were successful or not.
3138     (not dirs)))
3139
3140 (defun gnus-capitalize-newsgroup (newsgroup)
3141   "Capitalize NEWSGROUP name."
3142   (and (not (zerop (length newsgroup)))
3143        (concat (char-to-string (upcase (aref newsgroup 0)))
3144                (substring newsgroup 1))))
3145
3146 ;; Various... things.
3147
3148 (defun gnus-simplify-subject (subject &optional re-only)
3149   "Remove `Re:' and words in parentheses.
3150 If RE-ONLY is non-nil, strip leading `Re:'s only."
3151   (let ((case-fold-search t))           ;Ignore case.
3152     ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
3153     (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
3154       (setq subject (substring subject (match-end 0))))
3155     ;; Remove uninteresting prefixes.
3156     (if (and (not re-only)
3157              gnus-simplify-ignored-prefixes
3158              (string-match gnus-simplify-ignored-prefixes subject))
3159         (setq subject (substring subject (match-end 0))))
3160     ;; Remove words in parentheses from end.
3161     (unless re-only
3162       (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
3163         (setq subject (substring subject 0 (match-beginning 0)))))
3164     ;; Return subject string.
3165     subject))
3166
3167 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
3168 ;; all whitespace.
3169 ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
3170 (defun gnus-simplify-buffer-fuzzy ()
3171   (let ((case-fold-search t))
3172     (goto-char (point-min))
3173     (while (search-forward "\t" nil t)
3174       (replace-match " " t t))
3175     (goto-char (point-min))
3176     (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t)
3177     (goto-char (match-beginning 0))
3178     (while (or
3179             (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
3180             (looking-at "^[[].*: .*[]]$"))
3181       (goto-char (point-min))
3182       (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
3183                                 nil t)
3184         (replace-match "" t t))
3185       (goto-char (point-min))
3186       (while (re-search-forward "^[[].*: .*[]]$" nil t)
3187         (goto-char (match-end 0))
3188         (delete-char -1)
3189         (delete-region
3190          (progn (goto-char (match-beginning 0)))
3191          (re-search-forward ":"))))
3192     (goto-char (point-min))
3193     (while (re-search-forward " *[[{(][^()\n]*[]})] *$" 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     (while (re-search-forward " $" nil t)
3200       (replace-match "" t t))
3201     (goto-char (point-min))
3202     (while (re-search-forward "^ +" nil t)
3203       (replace-match "" t t))
3204     (goto-char (point-min))
3205     (when gnus-simplify-subject-fuzzy-regexp
3206       (if (listp gnus-simplify-subject-fuzzy-regexp)
3207           (let ((list gnus-simplify-subject-fuzzy-regexp))
3208             (while list
3209               (goto-char (point-min))
3210               (while (re-search-forward (car list) nil t)
3211                 (replace-match "" t t))
3212               (setq list (cdr list))))
3213         (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
3214           (replace-match "" t t))))))
3215
3216 (defun gnus-simplify-subject-fuzzy (subject)
3217   "Siplify a subject string fuzzily."
3218   (save-excursion
3219     (gnus-set-work-buffer)
3220     (let ((case-fold-search t))
3221       (insert subject)
3222       (inline (gnus-simplify-buffer-fuzzy))
3223       (buffer-string))))
3224
3225 ;; Add the current buffer to the list of buffers to be killed on exit.
3226 (defun gnus-add-current-to-buffer-list ()
3227   (or (memq (current-buffer) gnus-buffer-list)
3228       (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
3229
3230 (defun gnus-string> (s1 s2)
3231   (not (or (string< s1 s2)
3232            (string= s1 s2))))
3233
3234 (defun gnus-read-active-file-p ()
3235   "Say whether the active file has been read from `gnus-select-method'."
3236   (memq gnus-select-method gnus-have-read-active-file))
3237
3238 ;;; General various misc type functions.
3239
3240 (defun gnus-clear-system ()
3241   "Clear all variables and buffers."
3242   ;; Clear Gnus variables.
3243   (let ((variables gnus-variable-list))
3244     (while variables
3245       (set (car variables) nil)
3246       (setq variables (cdr variables))))
3247   ;; Clear other internal variables.
3248   (setq gnus-list-of-killed-groups nil
3249         gnus-have-read-active-file nil
3250         gnus-newsrc-alist nil
3251         gnus-newsrc-hashtb nil
3252         gnus-killed-list nil
3253         gnus-zombie-list nil
3254         gnus-killed-hashtb nil
3255         gnus-active-hashtb nil
3256         gnus-moderated-list nil
3257         gnus-description-hashtb nil
3258         gnus-current-headers nil
3259         gnus-thread-indent-array nil
3260         gnus-newsgroup-headers nil
3261         gnus-newsgroup-name nil
3262         gnus-server-alist nil
3263         gnus-group-list-mode nil
3264         gnus-opened-servers nil
3265         gnus-group-mark-positions nil
3266         gnus-newsgroup-data nil
3267         gnus-newsgroup-unreads nil
3268         nnoo-state-alist nil
3269         gnus-current-select-method nil)
3270   (gnus-shutdown 'gnus)
3271   ;; Kill the startup file.
3272   (and gnus-current-startup-file
3273        (get-file-buffer gnus-current-startup-file)
3274        (kill-buffer (get-file-buffer gnus-current-startup-file)))
3275   ;; Clear the dribble buffer.
3276   (gnus-dribble-clear)
3277   ;; Kill global KILL file buffer.
3278   (when (get-file-buffer (gnus-newsgroup-kill-file nil))
3279     (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
3280   (gnus-kill-buffer nntp-server-buffer)
3281   ;; Kill Gnus buffers.
3282   (while gnus-buffer-list
3283     (gnus-kill-buffer (pop gnus-buffer-list)))
3284   ;; Remove Gnus frames.
3285   (gnus-kill-gnus-frames))
3286
3287 (defun gnus-kill-gnus-frames ()
3288   "Kill all frames Gnus has created."
3289   (while gnus-created-frames
3290     (when (frame-live-p (car gnus-created-frames))
3291       ;; We slap a condition-case around this `delete-frame' to ensure 
3292       ;; against errors if we try do delete the single frame that's left.
3293       (condition-case ()
3294           (delete-frame (car gnus-created-frames))
3295         (error nil)))
3296     (pop gnus-created-frames)))
3297
3298 (defun gnus-windows-old-to-new (setting)
3299   ;; First we take care of the really, really old Gnus 3 actions.
3300   (when (symbolp setting)
3301     (setq setting
3302           ;; Take care of ooold GNUS 3.x values.
3303           (cond ((eq setting 'SelectArticle) 'article)
3304                 ((memq setting '(SelectSubject ExpandSubject)) 'summary)
3305                 ((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group)
3306                 (t setting))))
3307   (if (or (listp setting)
3308           (not (and gnus-window-configuration
3309                     (memq setting '(group summary article)))))
3310       setting
3311     (let* ((setting (if (eq setting 'group)
3312                         (if (assq 'newsgroup gnus-window-configuration)
3313                             'newsgroup
3314                           'newsgroups) setting))
3315            (elem (cadr (assq setting gnus-window-configuration)))
3316            (total (apply '+ elem))
3317            (types '(group summary article))
3318            (pbuf (if (eq setting 'newsgroups) 'group 'summary))
3319            (i 0)
3320            perc
3321            out)
3322       (while (< i 3)
3323         (or (not (numberp (nth i elem)))
3324             (zerop (nth i elem))
3325             (progn
3326               (setq perc (if (= i 2)
3327                              1.0
3328                            (/ (float (nth 0 elem)) total)))
3329               (setq out (cons (if (eq pbuf (nth i types))
3330                                   (list (nth i types) perc 'point)
3331                                 (list (nth i types) perc))
3332                               out))))
3333         (setq i (1+ i)))
3334       `(vertical 1.0 ,@(nreverse out)))))
3335
3336 ;;;###autoload
3337 (defun gnus-add-configuration (conf)
3338   "Add the window configuration CONF to `gnus-buffer-configuration'."
3339   (setq gnus-buffer-configuration
3340         (cons conf (delq (assq (car conf) gnus-buffer-configuration)
3341                          gnus-buffer-configuration))))
3342
3343 (defvar gnus-frame-list nil)
3344
3345 (defun gnus-configure-frame (split &optional window)
3346   "Split WINDOW according to SPLIT."
3347   (unless window
3348     (setq window (get-buffer-window (current-buffer))))
3349   (select-window window)
3350   ;; This might be an old-stylee buffer config.
3351   (when (vectorp split)
3352     (setq split (append split nil)))
3353   (when (or (consp (car split))
3354             (vectorp (car split)))
3355     (push 1.0 split)
3356     (push 'vertical split))
3357   ;; The SPLIT might be something that is to be evaled to
3358   ;; return a new SPLIT.
3359   (while (and (not (assq (car split) gnus-window-to-buffer))
3360               (gnus-functionp (car split)))
3361     (setq split (eval split)))
3362   (let* ((type (car split))
3363          (subs (cddr split))
3364          (len (if (eq type 'horizontal) (window-width) (window-height)))
3365          (total 0)
3366          (window-min-width (or gnus-window-min-width window-min-width))
3367          (window-min-height (or gnus-window-min-height window-min-height))
3368          s result new-win rest comp-subs size sub)
3369     (cond
3370      ;; Nothing to do here.
3371      ((null split))
3372      ;; Don't switch buffers.
3373      ((null type)
3374       (and (memq 'point split) window))
3375      ;; This is a buffer to be selected.
3376      ((not (memq type '(frame horizontal vertical)))
3377       (let ((buffer (cond ((stringp type) type)
3378                           (t (cdr (assq type gnus-window-to-buffer)))))
3379             buf)
3380         (unless buffer
3381           (error "Illegal buffer type: %s" type))
3382         (unless (setq buf (get-buffer (if (symbolp buffer)
3383                                           (symbol-value buffer) buffer)))
3384           (setq buf (get-buffer-create (if (symbolp buffer)
3385                                            (symbol-value buffer) buffer))))
3386         (switch-to-buffer buf)
3387         ;; We return the window if it has the `point' spec.
3388         (and (memq 'point split) window)))
3389      ;; This is a frame split.
3390      ((eq type 'frame)
3391       (unless gnus-frame-list
3392         (setq gnus-frame-list (list (window-frame
3393                                      (get-buffer-window (current-buffer))))))
3394       (let ((i 0)
3395             params frame fresult)
3396         (while (< i (length subs))
3397           ;; Frame parameter is gotten from the sub-split.
3398           (setq params (cadr (elt subs i)))
3399           ;; It should be a list.
3400           (unless (listp params)
3401             (setq params nil))
3402           ;; Create a new frame?
3403           (unless (setq frame (elt gnus-frame-list i))
3404             (nconc gnus-frame-list (list (setq frame (make-frame params))))
3405             (push frame gnus-created-frames))
3406           ;; Is the old frame still alive?
3407           (unless (frame-live-p frame)
3408             (setcar (nthcdr i gnus-frame-list)
3409                     (setq frame (make-frame params))))
3410           ;; Select the frame in question and do more splits there.
3411           (select-frame frame)
3412           (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
3413           (incf i))
3414         ;; Select the frame that has the selected buffer.
3415         (when fresult
3416           (select-frame (window-frame fresult)))))
3417      ;; This is a normal split.
3418      (t
3419       (when (> (length subs) 0)
3420         ;; First we have to compute the sizes of all new windows.
3421         (while subs
3422           (setq sub (append (pop subs) nil))
3423           (while (and (not (assq (car sub) gnus-window-to-buffer))
3424                       (gnus-functionp (car sub)))
3425             (setq sub (eval sub)))
3426           (when sub
3427             (push sub comp-subs)
3428             (setq size (cadar comp-subs))
3429             (cond ((equal size 1.0)
3430                    (setq rest (car comp-subs))
3431                    (setq s 0))
3432                   ((floatp size)
3433                    (setq s (floor (* size len))))
3434                   ((integerp size)
3435                    (setq s size))
3436                   (t
3437                    (error "Illegal size: %s" size)))
3438             ;; Try to make sure that we are inside the safe limits.
3439             (cond ((zerop s))
3440                   ((eq type 'horizontal)
3441                    (setq s (max s window-min-width)))
3442                   ((eq type 'vertical)
3443                    (setq s (max s window-min-height))))
3444             (setcar (cdar comp-subs) s)
3445             (incf total s)))
3446         ;; Take care of the "1.0" spec.
3447         (if rest
3448             (setcar (cdr rest) (- len total))
3449           (error "No 1.0 specs in %s" split))
3450         ;; The we do the actual splitting in a nice recursive
3451         ;; fashion.
3452         (setq comp-subs (nreverse comp-subs))
3453         (while comp-subs
3454           (if (null (cdr comp-subs))
3455               (setq new-win window)
3456             (setq new-win
3457                   (split-window window (cadar comp-subs)
3458                                 (eq type 'horizontal))))
3459           (setq result (or (gnus-configure-frame
3460                             (car comp-subs) window) result))
3461           (select-window new-win)
3462           (setq window new-win)
3463           (setq comp-subs (cdr comp-subs))))
3464       ;; Return the proper window, if any.
3465       (when result
3466         (select-window result))))))
3467
3468 (defvar gnus-frame-split-p nil)
3469
3470 (defun gnus-configure-windows (setting &optional force)
3471   (setq setting (gnus-windows-old-to-new setting))
3472   (let ((split (if (symbolp setting)
3473                    (cadr (assq setting gnus-buffer-configuration))
3474                  setting))
3475         all-visible)
3476
3477     (setq gnus-frame-split-p nil)
3478
3479     (unless split
3480       (error "No such setting: %s" setting))
3481
3482     (if (and (setq all-visible (gnus-all-windows-visible-p split))
3483              (not force))
3484         ;; All the windows mentioned are already visible, so we just
3485         ;; put point in the assigned buffer, and do not touch the
3486         ;; winconf.
3487         (select-window all-visible)
3488
3489       ;; Either remove all windows or just remove all Gnus windows.
3490       (let ((frame (selected-frame)))
3491         (unwind-protect
3492             (if gnus-use-full-window
3493                 ;; We want to remove all other windows.
3494                 (if (not gnus-frame-split-p)
3495                     ;; This is not a `frame' split, so we ignore the
3496                     ;; other frames.  
3497                     (delete-other-windows)
3498                   ;; This is a `frame' split, so we delete all windows
3499                   ;; on all frames.
3500                   (mapcar 
3501                    (lambda (frame)
3502                      (unless (eq (cdr (assq 'minibuffer
3503                                             (frame-parameters frame)))
3504                                  'only)
3505                        (select-frame frame)
3506                        (delete-other-windows)))
3507                    (frame-list)))
3508               ;; Just remove some windows.
3509               (gnus-remove-some-windows)
3510               (switch-to-buffer nntp-server-buffer))
3511           (select-frame frame)))
3512
3513       (switch-to-buffer nntp-server-buffer)
3514       (gnus-configure-frame split (get-buffer-window (current-buffer))))))
3515
3516 (defun gnus-all-windows-visible-p (split)
3517   "Say whether all buffers in SPLIT are currently visible.
3518 In particular, the value returned will be the window that
3519 should have point."
3520   (let ((stack (list split))
3521         (all-visible t)
3522         type buffer win buf)
3523     (while (and (setq split (pop stack))
3524                 all-visible)
3525       ;; Be backwards compatible.
3526       (when (vectorp split)
3527         (setq split (append split nil)))
3528       (when (or (consp (car split))
3529                 (vectorp (car split)))
3530         (push 1.0 split)
3531         (push 'vertical split))
3532       ;; The SPLIT might be something that is to be evaled to
3533       ;; return a new SPLIT.
3534       (while (and (not (assq (car split) gnus-window-to-buffer))
3535                   (gnus-functionp (car split)))
3536         (setq split (eval split)))
3537
3538       (setq type (elt split 0))
3539       (cond
3540        ;; Nothing here.
3541        ((null split) t)
3542        ;; A buffer.
3543        ((not (memq type '(horizontal vertical frame)))
3544         (setq buffer (cond ((stringp type) type)
3545                            (t (cdr (assq type gnus-window-to-buffer)))))
3546         (unless buffer
3547           (error "Illegal buffer type: %s" type))
3548         (when (setq buf (get-buffer (if (symbolp buffer)
3549                                         (symbol-value buffer)
3550                                       buffer)))
3551           (setq win (get-buffer-window buf t)))
3552         (if win
3553             (when (memq 'point split)
3554                 (setq all-visible win))
3555           (setq all-visible nil)))
3556        (t
3557         (when (eq type 'frame)
3558           (setq gnus-frame-split-p t))
3559         (setq stack (append (cddr split) stack)))))
3560     (unless (eq all-visible t)
3561       all-visible)))
3562
3563 (defun gnus-window-top-edge (&optional window)
3564   (nth 1 (window-edges window)))
3565
3566 (defun gnus-remove-some-windows ()
3567   (let ((buffers gnus-window-to-buffer)
3568         buf bufs lowest-buf lowest)
3569     (save-excursion
3570       ;; Remove windows on all known Gnus buffers.
3571       (while buffers
3572         (setq buf (cdar buffers))
3573         (if (symbolp buf)
3574             (setq buf (and (boundp buf) (symbol-value buf))))
3575         (and buf
3576              (get-buffer-window buf)
3577              (progn
3578                (setq bufs (cons buf bufs))
3579                (pop-to-buffer buf)
3580                (if (or (not lowest)
3581                        (< (gnus-window-top-edge) lowest))
3582                    (progn
3583                      (setq lowest (gnus-window-top-edge))
3584                      (setq lowest-buf buf)))))
3585         (setq buffers (cdr buffers)))
3586       ;; Remove windows on *all* summary buffers.
3587       (walk-windows
3588        (lambda (win)
3589          (let ((buf (window-buffer win)))
3590            (if (string-match    "^\\*Summary" (buffer-name buf))
3591                (progn
3592                  (setq bufs (cons buf bufs))
3593                  (pop-to-buffer buf)
3594                  (if (or (not lowest)
3595                          (< (gnus-window-top-edge) lowest))
3596                      (progn
3597                        (setq lowest-buf buf)
3598                        (setq lowest (gnus-window-top-edge)))))))))
3599       (and lowest-buf
3600            (progn
3601              (pop-to-buffer lowest-buf)
3602              (switch-to-buffer nntp-server-buffer)))
3603       (while bufs
3604         (and (not (eq (car bufs) lowest-buf))
3605              (delete-windows-on (car bufs)))
3606         (setq bufs (cdr bufs))))))
3607
3608 (defun gnus-version (&optional arg)
3609   "Version number of this version of Gnus.
3610 If ARG, insert string at point."
3611   (interactive "P")
3612   (let ((methods gnus-valid-select-methods)
3613         (mess gnus-version)
3614         meth)
3615     ;; Go through all the legal select methods and add their version
3616     ;; numbers to the total version string.  Only the backends that are
3617     ;; currently in use will have their message numbers taken into
3618     ;; consideration.
3619     (while methods
3620       (setq meth (intern (concat (caar methods) "-version")))
3621       (and (boundp meth)
3622            (stringp (symbol-value meth))
3623            (setq mess (concat mess "; " (symbol-value meth))))
3624       (setq methods (cdr methods)))
3625     (if arg
3626         (insert (message mess))
3627       (message mess))))
3628
3629 (defun gnus-info-find-node ()
3630   "Find Info documentation of Gnus."
3631   (interactive)
3632   ;; Enlarge info window if needed.
3633   (let ((mode major-mode)
3634         gnus-info-buffer)
3635     (Info-goto-node (cadr (assq mode gnus-info-nodes)))
3636     (setq gnus-info-buffer (current-buffer))
3637     (gnus-configure-windows 'info)))
3638
3639 (defun gnus-days-between (date1 date2)
3640   ;; Return the number of days between date1 and date2.
3641   (- (gnus-day-number date1) (gnus-day-number date2)))
3642
3643 (defun gnus-day-number (date)
3644   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
3645                      (timezone-parse-date date))))
3646     (timezone-absolute-from-gregorian
3647      (nth 1 dat) (nth 2 dat) (car dat))))
3648
3649 (defun gnus-encode-date (date)
3650   "Convert DATE to internal time."
3651   (let* ((parse (timezone-parse-date date))
3652          (date (mapcar (lambda (d) (and d (string-to-int d))) parse))
3653          (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
3654     (encode-time (caddr time) (cadr time) (car time)
3655                  (caddr date) (cadr date) (car date) (nth 4 date))))
3656
3657 (defun gnus-time-minus (t1 t2)
3658   "Subtract two internal times."
3659   (let ((borrow (< (cadr t1) (cadr t2))))
3660     (list (- (car t1) (car t2) (if borrow 1 0))
3661           (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
3662
3663 (defun gnus-file-newer-than (file date)
3664   (let ((fdate (nth 5 (file-attributes file))))
3665     (or (> (car fdate) (car date))
3666         (and (= (car fdate) (car date))
3667              (> (nth 1 fdate) (nth 1 date))))))
3668
3669 (defmacro gnus-local-set-keys (&rest plist)
3670   "Set the keys in PLIST in the current keymap."
3671   `(gnus-define-keys-1 (current-local-map) ',plist))
3672
3673 (defmacro gnus-define-keys (keymap &rest plist)
3674   "Define all keys in PLIST in KEYMAP."
3675   `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
3676
3677 (put 'gnus-define-keys 'lisp-indent-function 1)
3678 (put 'gnus-define-keys 'lisp-indent-hook 1)
3679 (put 'gnus-define-keymap 'lisp-indent-function 1)
3680 (put 'gnus-define-keymap 'lisp-indent-hook 1)
3681
3682 (defmacro gnus-define-keymap (keymap &rest plist)
3683   "Define all keys in PLIST in KEYMAP."
3684   `(gnus-define-keys-1 ,keymap (quote ,plist)))
3685
3686 (defun gnus-define-keys-1 (keymap plist)
3687   (when (null keymap)
3688     (error "Can't set keys in a null keymap"))
3689   (cond ((symbolp keymap)
3690          (setq keymap (symbol-value keymap)))
3691         ((keymapp keymap))
3692         ((listp keymap)
3693          (set (car keymap) nil)
3694          (define-prefix-command (car keymap))
3695          (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
3696          (setq keymap (symbol-value (car keymap)))))
3697   (let (key)
3698     (while plist
3699       (when (symbolp (setq key (pop plist)))
3700         (setq key (symbol-value key)))
3701       (define-key keymap key (pop plist)))))
3702
3703 (defun gnus-group-read-only-p (&optional group)
3704   "Check whether GROUP supports editing or not.
3705 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
3706 that that variable is buffer-local to the summary buffers."
3707   (let ((group (or group gnus-newsgroup-name)))
3708     (not (gnus-check-backend-function 'request-replace-article group))))
3709
3710 (defun gnus-group-total-expirable-p (group)
3711   "Check whether GROUP is total-expirable or not."
3712   (let ((params (gnus-info-params (gnus-get-info group))))
3713     (or (memq 'total-expire params)
3714         (cdr (assq 'total-expire params)) ; (total-expire . t)
3715         (and gnus-total-expirable-newsgroups ; Check var.
3716              (string-match gnus-total-expirable-newsgroups group)))))
3717
3718 (defun gnus-group-auto-expirable-p (group)
3719   "Check whether GROUP is total-expirable or not."
3720   (let ((params (gnus-info-params (gnus-get-info group))))
3721     (or (memq 'auto-expire params)
3722         (cdr (assq 'auto-expire params)) ; (auto-expire . t)
3723         (and gnus-auto-expirable-newsgroups ; Check var.
3724              (string-match gnus-auto-expirable-newsgroups group)))))
3725
3726 (defun gnus-virtual-group-p (group)
3727   "Say whether GROUP is virtual or not."
3728   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
3729                         gnus-valid-select-methods)))
3730
3731 (defun gnus-news-group-p (group &optional article)
3732   "Return non-nil if GROUP (and ARTICLE) come from a news server."
3733   (or (gnus-member-of-valid 'post group) ; Ordinary news group.
3734       (and (gnus-member-of-valid 'post-mail group) ; Combined group.
3735            (eq (gnus-request-type group article) 'news))))
3736
3737 (defsubst gnus-simplify-subject-fully (subject)
3738   "Simplify a subject string according to the user's wishes."
3739   (cond
3740    ((null gnus-summary-gather-subject-limit)
3741     (gnus-simplify-subject-re subject))
3742    ((eq gnus-summary-gather-subject-limit 'fuzzy)
3743     (gnus-simplify-subject-fuzzy subject))
3744    ((numberp gnus-summary-gather-subject-limit)
3745     (gnus-limit-string (gnus-simplify-subject-re subject)
3746                        gnus-summary-gather-subject-limit))
3747    (t
3748     subject)))
3749
3750 (defsubst gnus-subject-equal (s1 s2 &optional simple-first)
3751   "Check whether two subjects are equal.  If optional argument
3752 simple-first is t, first argument is already simplified."
3753   (cond
3754    ((null simple-first)
3755     (equal (gnus-simplify-subject-fully s1)
3756            (gnus-simplify-subject-fully s2)))
3757    (t
3758     (equal s1
3759            (gnus-simplify-subject-fully s2)))))
3760
3761 ;; Returns a list of writable groups.
3762 (defun gnus-writable-groups ()
3763   (let ((alist gnus-newsrc-alist)
3764         groups group)
3765     (while (setq group (car (pop alist)))
3766       (unless (gnus-group-read-only-p group)
3767         (push group groups)))
3768     (nreverse groups)))
3769
3770 (defun gnus-completing-read (default prompt &rest args)
3771   ;; Like `completing-read', except that DEFAULT is the default argument.
3772   (let* ((prompt (if default 
3773                      (concat prompt " (default " default ") ")
3774                    (concat prompt " ")))
3775          (answer (apply 'completing-read prompt args)))
3776     (if (or (null answer) (zerop (length answer)))
3777         default
3778       answer)))
3779
3780 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
3781 ;; the echo area.
3782 (defun gnus-y-or-n-p (prompt)
3783   (prog1
3784       (y-or-n-p prompt)
3785     (message "")))
3786
3787 (defun gnus-yes-or-no-p (prompt)
3788   (prog1
3789       (yes-or-no-p prompt)
3790     (message "")))
3791
3792 ;; Check whether to use long file names.
3793 (defun gnus-use-long-file-name (symbol)
3794   ;; The variable has to be set...
3795   (and gnus-use-long-file-name
3796        ;; If it isn't a list, then we return t.
3797        (or (not (listp gnus-use-long-file-name))
3798            ;; If it is a list, and the list contains `symbol', we
3799            ;; return nil.
3800            (not (memq symbol gnus-use-long-file-name)))))
3801
3802 ;; I suspect there's a better way, but I haven't taken the time to do
3803 ;; it yet. -erik selberg@cs.washington.edu
3804 (defun gnus-dd-mmm (messy-date)
3805   "Return a string like DD-MMM from a big messy string"
3806   (let ((datevec (condition-case () (timezone-parse-date messy-date) 
3807                    (error nil))))
3808     (if (not datevec)
3809         "??-???"
3810       (format "%2s-%s"
3811               (condition-case ()
3812                   ;; Make sure leading zeroes are stripped.
3813                   (number-to-string (string-to-number (aref datevec 2)))
3814                 (error "??"))
3815               (capitalize
3816                (or (car
3817                     (nth (1- (string-to-number (aref datevec 1)))
3818                          timezone-months-assoc))
3819                    "???"))))))
3820
3821 (defun gnus-mode-string-quote (string)
3822   "Quote all \"%\" in STRING."
3823   (save-excursion
3824     (gnus-set-work-buffer)
3825     (insert string)
3826     (goto-char (point-min))
3827     (while (search-forward "%" nil t)
3828       (insert "%"))
3829     (buffer-string)))
3830
3831 ;; Make a hash table (default and minimum size is 255).
3832 ;; Optional argument HASHSIZE specifies the table size.
3833 (defun gnus-make-hashtable (&optional hashsize)
3834   (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
3835
3836 ;; Make a number that is suitable for hashing; bigger than MIN and one
3837 ;; less than 2^x.
3838 (defun gnus-create-hash-size (min)
3839   (let ((i 1))
3840     (while (< i min)
3841       (setq i (* 2 i)))
3842     (1- i)))
3843
3844 ;; Show message if message has a lower level than `gnus-verbose'.
3845 ;; Guideline for numbers:
3846 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
3847 ;; for things that take a long time, 7 - not very important messages
3848 ;; on stuff, 9 - messages inside loops.
3849 (defun gnus-message (level &rest args)
3850   (if (<= level gnus-verbose)
3851       (apply 'message args)
3852     ;; We have to do this format thingy here even if the result isn't
3853     ;; shown - the return value has to be the same as the return value
3854     ;; from `message'.
3855     (apply 'format args)))
3856
3857 (defun gnus-error (level &rest args)
3858   "Beep an error if LEVEL is equal to or less than `gnus-verbose'."
3859   (when (<= (floor level) gnus-verbose)
3860     (apply 'message args)
3861     (ding)
3862     (let (duration)
3863       (when (and (floatp level)
3864                  (not (zerop (setq duration (* 10 (- level (floor level)))))))
3865         (sit-for duration))))
3866   nil)
3867
3868 ;; Generate a unique new group name.
3869 (defun gnus-generate-new-group-name (leaf)
3870   (let ((name leaf)
3871         (num 0))
3872     (while (gnus-gethash name gnus-newsrc-hashtb)
3873       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3874     name))
3875
3876 (defsubst gnus-hide-text (b e props)
3877   "Set text PROPS on the B to E region, extending `intangible' 1 past B."
3878   (gnus-add-text-properties b e props)
3879   (when (memq 'intangible props)
3880     (gnus-put-text-property (max (1- b) (point-min))
3881                        b 'intangible (cddr (memq 'intangible props)))))
3882
3883 (defsubst gnus-unhide-text (b e)
3884   "Remove hidden text properties from region between B and E."
3885   (remove-text-properties b e gnus-hidden-properties)
3886   (when (memq 'intangible gnus-hidden-properties)
3887     (gnus-put-text-property (max (1- b) (point-min))
3888                             b 'intangible nil)))
3889
3890 (defun gnus-hide-text-type (b e type)
3891   "Hide text of TYPE between B and E."
3892   (gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties))))
3893
3894 (defun gnus-parent-headers (headers &optional generation)
3895   "Return the headers of the GENERATIONeth parent of HEADERS."
3896   (unless generation 
3897     (setq generation 1))
3898   (let (references parent)
3899     (while (and headers (not (zerop generation)))
3900       (setq references (mail-header-references headers))
3901       (when (and references
3902                  (setq parent (gnus-parent-id references))
3903                  (setq headers (car (gnus-id-to-thread parent))))
3904         (decf generation)))
3905     headers))
3906
3907 (defun gnus-parent-id (references)
3908   "Return the last Message-ID in REFERENCES."
3909   (when (and references
3910              (string-match "\\(<[^\n<>]+>\\)[ \t\n]*\\'" references))
3911     (substring references (match-beginning 1) (match-end 1))))
3912
3913 (defun gnus-split-references (references)
3914   "Return a list of Message-IDs in REFERENCES."
3915   (let ((beg 0)
3916         ids)
3917     (while (string-match "<[^>]+>" references beg)
3918       (push (substring references (match-beginning 0) (setq beg (match-end 0)))
3919             ids))
3920     (nreverse ids)))
3921
3922 (defun gnus-buffer-live-p (buffer)
3923   "Say whether BUFFER is alive or not."
3924   (and buffer
3925        (get-buffer buffer)
3926        (buffer-name (get-buffer buffer))))
3927
3928 (defun gnus-ephemeral-group-p (group)
3929   "Say whether GROUP is ephemeral or not."
3930   (gnus-group-get-parameter group 'quit-config))
3931
3932 (defun gnus-group-quit-config (group)
3933   "Return the quit-config of GROUP."
3934   (gnus-group-get-parameter group 'quit-config))
3935
3936 (defun gnus-simplify-mode-line ()
3937   "Make mode lines a bit simpler."
3938   (setq mode-line-modified "-- ")
3939   (when (listp mode-line-format)
3940     (make-local-variable 'mode-line-format)
3941     (setq mode-line-format (copy-sequence mode-line-format))
3942     (when (equal (nth 3 mode-line-format) "   ")
3943       (setcar (nthcdr 3 mode-line-format) " "))))
3944
3945 ;;; List and range functions
3946
3947 (defun gnus-last-element (list)
3948   "Return last element of LIST."
3949   (while (cdr list)
3950     (setq list (cdr list)))
3951   (car list))
3952
3953 (defun gnus-copy-sequence (list)
3954   "Do a complete, total copy of a list."
3955   (if (and (consp list) (not (consp (cdr list))))
3956       (cons (car list) (cdr list))
3957     (mapcar (lambda (elem) (if (consp elem)
3958                                (if (consp (cdr elem))
3959                                    (gnus-copy-sequence elem)
3960                                  (cons (car elem) (cdr elem)))
3961                              elem))
3962             list)))
3963
3964 (defun gnus-set-difference (list1 list2)
3965   "Return a list of elements of LIST1 that do not appear in LIST2."
3966   (let ((list1 (copy-sequence list1)))
3967     (while list2
3968       (setq list1 (delq (car list2) list1))
3969       (setq list2 (cdr list2)))
3970     list1))
3971
3972 (defun gnus-sorted-complement (list1 list2)
3973   "Return a list of elements of LIST1 that do not appear in LIST2.
3974 Both lists have to be sorted over <."
3975   (let (out)
3976     (if (or (null list1) (null list2))
3977         (or list1 list2)
3978       (while (and list1 list2)
3979         (cond ((= (car list1) (car list2))
3980                (setq list1 (cdr list1)
3981                      list2 (cdr list2)))
3982               ((< (car list1) (car list2))
3983                (setq out (cons (car list1) out))
3984                (setq list1 (cdr list1)))
3985               (t
3986                (setq out (cons (car list2) out))
3987                (setq list2 (cdr list2)))))
3988       (nconc (nreverse out) (or list1 list2)))))
3989
3990 (defun gnus-intersection (list1 list2)
3991   (let ((result nil))
3992     (while list2
3993       (if (memq (car list2) list1)
3994           (setq result (cons (car list2) result)))
3995       (setq list2 (cdr list2)))
3996     result))
3997
3998 (defun gnus-sorted-intersection (list1 list2)
3999   ;; LIST1 and LIST2 have to be sorted over <.
4000   (let (out)
4001     (while (and list1 list2)
4002       (cond ((= (car list1) (car list2))
4003              (setq out (cons (car list1) out)
4004                    list1 (cdr list1)
4005                    list2 (cdr list2)))
4006             ((< (car list1) (car list2))
4007              (setq list1 (cdr list1)))
4008             (t
4009              (setq list2 (cdr list2)))))
4010     (nreverse out)))
4011
4012 (defun gnus-set-sorted-intersection (list1 list2)
4013   ;; LIST1 and LIST2 have to be sorted over <.
4014   ;; This function modifies LIST1.
4015   (let* ((top (cons nil list1))
4016          (prev top))
4017     (while (and list1 list2)
4018       (cond ((= (car list1) (car list2))
4019              (setq prev list1
4020                    list1 (cdr list1)
4021                    list2 (cdr list2)))
4022             ((< (car list1) (car list2))
4023              (setcdr prev (cdr list1))
4024              (setq list1 (cdr list1)))
4025             (t
4026              (setq list2 (cdr list2)))))
4027     (setcdr prev nil)
4028     (cdr top)))
4029
4030 (defun gnus-compress-sequence (numbers &optional always-list)
4031   "Convert list of numbers to a list of ranges or a single range.
4032 If ALWAYS-LIST is non-nil, this function will always release a list of
4033 ranges."
4034   (let* ((first (car numbers))
4035          (last (car numbers))
4036          result)
4037     (if (null numbers)
4038         nil
4039       (if (not (listp (cdr numbers)))
4040           numbers
4041         (while numbers
4042           (cond ((= last (car numbers)) nil) ;Omit duplicated number
4043                 ((= (1+ last) (car numbers)) ;Still in sequence
4044                  (setq last (car numbers)))
4045                 (t                      ;End of one sequence
4046                  (setq result
4047                        (cons (if (= first last) first
4048                                (cons first last)) result))
4049                  (setq first (car numbers))
4050                  (setq last  (car numbers))))
4051           (setq numbers (cdr numbers)))
4052         (if (and (not always-list) (null result))
4053             (if (= first last) (list first) (cons first last))
4054           (nreverse (cons (if (= first last) first (cons first last))
4055                           result)))))))
4056
4057 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
4058 (defun gnus-uncompress-range (ranges)
4059   "Expand a list of ranges into a list of numbers.
4060 RANGES is either a single range on the form `(num . num)' or a list of
4061 these ranges."
4062   (let (first last result)
4063     (cond
4064      ((null ranges)
4065       nil)
4066      ((not (listp (cdr ranges)))
4067       (setq first (car ranges))
4068       (setq last (cdr ranges))
4069       (while (<= first last)
4070         (setq result (cons first result))
4071         (setq first (1+ first)))
4072       (nreverse result))
4073      (t
4074       (while ranges
4075         (if (atom (car ranges))
4076             (if (numberp (car ranges))
4077                 (setq result (cons (car ranges) result)))
4078           (setq first (caar ranges))
4079           (setq last  (cdar ranges))
4080           (while (<= first last)
4081             (setq result (cons first result))
4082             (setq first (1+ first))))
4083         (setq ranges (cdr ranges)))
4084       (nreverse result)))))
4085
4086 (defun gnus-add-to-range (ranges list)
4087   "Return a list of ranges that has all articles from both RANGES and LIST.
4088 Note: LIST has to be sorted over `<'."
4089   (if (not ranges)
4090       (gnus-compress-sequence list t)
4091     (setq list (copy-sequence list))
4092     (or (listp (cdr ranges))
4093         (setq ranges (list ranges)))
4094     (let ((out ranges)
4095           ilist lowest highest temp)
4096       (while (and ranges list)
4097         (setq ilist list)
4098         (setq lowest (or (and (atom (car ranges)) (car ranges))
4099                          (caar ranges)))
4100         (while (and list (cdr list) (< (cadr list) lowest))
4101           (setq list (cdr list)))
4102         (if (< (car ilist) lowest)
4103             (progn
4104               (setq temp list)
4105               (setq list (cdr list))
4106               (setcdr temp nil)
4107               (setq out (nconc (gnus-compress-sequence ilist t) out))))
4108         (setq highest (or (and (atom (car ranges)) (car ranges))
4109                           (cdar ranges)))
4110         (while (and list (<= (car list) highest))
4111           (setq list (cdr list)))
4112         (setq ranges (cdr ranges)))
4113       (if list
4114           (setq out (nconc (gnus-compress-sequence list t) out)))
4115       (setq out (sort out (lambda (r1 r2)
4116                             (< (or (and (atom r1) r1) (car r1))
4117                                (or (and (atom r2) r2) (car r2))))))
4118       (setq ranges out)
4119       (while ranges
4120         (if (atom (car ranges))
4121             (if (cdr ranges)
4122                 (if (atom (cadr ranges))
4123                     (if (= (1+ (car ranges)) (cadr ranges))
4124                         (progn
4125                           (setcar ranges (cons (car ranges)
4126                                                (cadr ranges)))
4127                           (setcdr ranges (cddr ranges))))
4128                   (if (= (1+ (car ranges)) (caadr ranges))
4129                       (progn
4130                         (setcar (cadr ranges) (car ranges))
4131                         (setcar ranges (cadr ranges))
4132                         (setcdr ranges (cddr ranges))))))
4133           (if (cdr ranges)
4134               (if (atom (cadr ranges))
4135                   (if (= (1+ (cdar ranges)) (cadr ranges))
4136                       (progn
4137                         (setcdr (car ranges) (cadr ranges))
4138                         (setcdr ranges (cddr ranges))))
4139                 (if (= (1+ (cdar ranges)) (caadr ranges))
4140                     (progn
4141                       (setcdr (car ranges) (cdadr ranges))
4142                       (setcdr ranges (cddr ranges)))))))
4143         (setq ranges (cdr ranges)))
4144       out)))
4145
4146 (defun gnus-remove-from-range (ranges list)
4147   "Return a list of ranges that has all articles from LIST removed from RANGES.
4148 Note: LIST has to be sorted over `<'."
4149   ;; !!! This function shouldn't look like this, but I've got a headache.
4150   (gnus-compress-sequence
4151    (gnus-sorted-complement
4152     (gnus-uncompress-range ranges) list)))
4153
4154 (defun gnus-member-of-range (number ranges)
4155   (if (not (listp (cdr ranges)))
4156       (and (>= number (car ranges))
4157            (<= number (cdr ranges)))
4158     (let ((not-stop t))
4159       (while (and ranges
4160                   (if (numberp (car ranges))
4161                       (>= number (car ranges))
4162                     (>= number (caar ranges)))
4163                   not-stop)
4164         (if (if (numberp (car ranges))
4165                 (= number (car ranges))
4166               (and (>= number (caar ranges))
4167                    (<= number (cdar ranges))))
4168             (setq not-stop nil))
4169         (setq ranges (cdr ranges)))
4170       (not not-stop))))
4171
4172 (defun gnus-range-length (range)
4173   "Return the length RANGE would have if uncompressed."
4174   (length (gnus-uncompress-range range)))
4175
4176 (defun gnus-sublist-p (list sublist)
4177   "Test whether all elements in SUBLIST are members of LIST."
4178   (let ((sublistp t))
4179     (while sublist
4180       (unless (memq (pop sublist) list)
4181         (setq sublistp nil
4182               sublist nil)))
4183     sublistp))
4184
4185 \f
4186 ;;;
4187 ;;; Gnus group mode
4188 ;;;
4189
4190 (defvar gnus-group-mode-map nil)
4191 (put 'gnus-group-mode 'mode-class 'special)
4192
4193 (unless gnus-group-mode-map
4194   (setq gnus-group-mode-map (make-keymap))
4195   (suppress-keymap gnus-group-mode-map)
4196
4197   (gnus-define-keys gnus-group-mode-map
4198     " " gnus-group-read-group
4199     "=" gnus-group-select-group
4200     "\r" gnus-group-select-group
4201     "\M-\r" gnus-group-quick-select-group
4202     "j" gnus-group-jump-to-group
4203     "n" gnus-group-next-unread-group
4204     "p" gnus-group-prev-unread-group
4205     "\177" gnus-group-prev-unread-group
4206     [delete] gnus-group-prev-unread-group
4207     "N" gnus-group-next-group
4208     "P" gnus-group-prev-group
4209     "\M-n" gnus-group-next-unread-group-same-level
4210     "\M-p" gnus-group-prev-unread-group-same-level
4211     "," gnus-group-best-unread-group
4212     "." gnus-group-first-unread-group
4213     "u" gnus-group-unsubscribe-current-group
4214     "U" gnus-group-unsubscribe-group
4215     "c" gnus-group-catchup-current
4216     "C" gnus-group-catchup-current-all
4217     "l" gnus-group-list-groups
4218     "L" gnus-group-list-all-groups
4219     "m" gnus-group-mail
4220     "g" gnus-group-get-new-news
4221     "\M-g" gnus-group-get-new-news-this-group
4222     "R" gnus-group-restart
4223     "r" gnus-group-read-init-file
4224     "B" gnus-group-browse-foreign-server
4225     "b" gnus-group-check-bogus-groups
4226     "F" gnus-find-new-newsgroups
4227     "\C-c\C-d" gnus-group-describe-group
4228     "\M-d" gnus-group-describe-all-groups
4229     "\C-c\C-a" gnus-group-apropos
4230     "\C-c\M-\C-a" gnus-group-description-apropos
4231     "a" gnus-group-post-news
4232     "\ek" gnus-group-edit-local-kill
4233     "\eK" gnus-group-edit-global-kill
4234     "\C-k" gnus-group-kill-group
4235     "\C-y" gnus-group-yank-group
4236     "\C-w" gnus-group-kill-region
4237     "\C-x\C-t" gnus-group-transpose-groups
4238     "\C-c\C-l" gnus-group-list-killed
4239     "\C-c\C-x" gnus-group-expire-articles
4240     "\C-c\M-\C-x" gnus-group-expire-all-groups
4241     "V" gnus-version
4242     "s" gnus-group-save-newsrc
4243     "z" gnus-group-suspend
4244 ;    "Z" gnus-group-clear-dribble
4245     "q" gnus-group-exit
4246     "Q" gnus-group-quit
4247     "?" gnus-group-describe-briefly
4248     "\C-c\C-i" gnus-info-find-node
4249     "\M-e" gnus-group-edit-group-method
4250     "^" gnus-group-enter-server-mode
4251     gnus-mouse-2 gnus-mouse-pick-group
4252     "<" beginning-of-buffer
4253     ">" end-of-buffer
4254     "\C-c\C-b" gnus-bug
4255     "\C-c\C-s" gnus-group-sort-groups
4256     "t" gnus-topic-mode
4257     "\C-c\M-g" gnus-activate-all-groups
4258     "\M-&" gnus-group-universal-argument
4259     "#" gnus-group-mark-group
4260     "\M-#" gnus-group-unmark-group)
4261
4262   (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
4263     "m" gnus-group-mark-group
4264     "u" gnus-group-unmark-group
4265     "w" gnus-group-mark-region
4266     "m" gnus-group-mark-buffer
4267     "r" gnus-group-mark-regexp
4268     "U" gnus-group-unmark-all-groups)
4269
4270   (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
4271     "d" gnus-group-make-directory-group
4272     "h" gnus-group-make-help-group
4273     "a" gnus-group-make-archive-group
4274     "k" gnus-group-make-kiboze-group
4275     "m" gnus-group-make-group
4276     "E" gnus-group-edit-group
4277     "e" gnus-group-edit-group-method
4278     "p" gnus-group-edit-group-parameters
4279     "v" gnus-group-add-to-virtual
4280     "V" gnus-group-make-empty-virtual
4281     "D" gnus-group-enter-directory
4282     "f" gnus-group-make-doc-group
4283     "r" gnus-group-rename-group
4284     "\177" gnus-group-delete-group
4285     [delete] gnus-group-delete-group)
4286
4287    (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
4288      "b" gnus-group-brew-soup
4289      "w" gnus-soup-save-areas
4290      "s" gnus-soup-send-replies
4291      "p" gnus-soup-pack-packet
4292      "r" nnsoup-pack-replies)
4293
4294    (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
4295      "s" gnus-group-sort-groups
4296      "a" gnus-group-sort-groups-by-alphabet
4297      "u" gnus-group-sort-groups-by-unread
4298      "l" gnus-group-sort-groups-by-level
4299      "v" gnus-group-sort-groups-by-score
4300      "r" gnus-group-sort-groups-by-rank
4301      "m" gnus-group-sort-groups-by-method)
4302
4303    (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
4304      "k" gnus-group-list-killed
4305      "z" gnus-group-list-zombies
4306      "s" gnus-group-list-groups
4307      "u" gnus-group-list-all-groups
4308      "A" gnus-group-list-active
4309      "a" gnus-group-apropos
4310      "d" gnus-group-description-apropos
4311      "m" gnus-group-list-matching
4312      "M" gnus-group-list-all-matching
4313      "l" gnus-group-list-level)
4314
4315    (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
4316      "f" gnus-score-flush-cache)
4317
4318    (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
4319      "f" gnus-group-fetch-faq)
4320
4321    (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
4322      "l" gnus-group-set-current-level
4323      "t" gnus-group-unsubscribe-current-group
4324      "s" gnus-group-unsubscribe-group
4325      "k" gnus-group-kill-group
4326      "y" gnus-group-yank-group
4327      "w" gnus-group-kill-region
4328      "\C-k" gnus-group-kill-level
4329      "z" gnus-group-kill-all-zombies))
4330
4331 (defun gnus-group-mode ()
4332   "Major mode for reading news.
4333
4334 All normal editing commands are switched off.
4335 \\<gnus-group-mode-map>
4336 The group buffer lists (some of) the groups available.  For instance,
4337 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
4338 lists all zombie groups.
4339
4340 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
4341 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
4342
4343 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
4344
4345 The following commands are available:
4346
4347 \\{gnus-group-mode-map}"
4348   (interactive)
4349   (when (and menu-bar-mode
4350              (gnus-visual-p 'group-menu 'menu))
4351     (gnus-group-make-menu-bar))
4352   (kill-all-local-variables)
4353   (gnus-simplify-mode-line)
4354   (setq major-mode 'gnus-group-mode)
4355   (setq mode-name "Group")
4356   (gnus-group-set-mode-line)
4357   (setq mode-line-process nil)
4358   (use-local-map gnus-group-mode-map)
4359   (buffer-disable-undo (current-buffer))
4360   (setq truncate-lines t)
4361   (setq buffer-read-only t)
4362   (gnus-make-local-hook 'post-command-hook)
4363   (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
4364   (run-hooks 'gnus-group-mode-hook))
4365
4366 (defun gnus-clear-inboxes-moved ()
4367   (setq nnmail-moved-inboxes nil))
4368
4369 (defun gnus-mouse-pick-group (e)
4370   "Enter the group under the mouse pointer."
4371   (interactive "e")
4372   (mouse-set-point e)
4373   (gnus-group-read-group nil))
4374
4375 ;; Look at LEVEL and find out what the level is really supposed to be.
4376 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
4377 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
4378 (defun gnus-group-default-level (&optional level number-or-nil)
4379   (cond
4380    (gnus-group-use-permanent-levels
4381     (or (setq gnus-group-use-permanent-levels
4382               (or level (if (numberp gnus-group-use-permanent-levels)
4383                             gnus-group-use-permanent-levels
4384                           (or gnus-group-default-list-level
4385                               gnus-level-subscribed))))
4386         gnus-group-default-list-level gnus-level-subscribed))
4387    (number-or-nil
4388     level)
4389    (t
4390     (or level gnus-group-default-list-level gnus-level-subscribed))))
4391
4392 ;;;###autoload
4393 (defun gnus-slave-no-server (&optional arg)
4394   "Read network news as a slave, without connecting to local server"
4395   (interactive "P")
4396   (gnus-no-server arg t))
4397
4398 ;;;###autoload
4399 (defun gnus-no-server (&optional arg slave)
4400   "Read network news.
4401 If ARG is a positive number, Gnus will use that as the
4402 startup level.  If ARG is nil, Gnus will be started at level 2.
4403 If ARG is non-nil and not a positive number, Gnus will
4404 prompt the user for the name of an NNTP server to use.
4405 As opposed to `gnus', this command will not connect to the local server."
4406   (interactive "P")
4407   (let ((val (or arg (1- gnus-level-default-subscribed))))
4408     (gnus val t slave)
4409     (make-local-variable 'gnus-group-use-permanent-levels)
4410     (setq gnus-group-use-permanent-levels val)))
4411
4412 ;;;###autoload
4413 (defun gnus-slave (&optional arg)
4414   "Read news as a slave."
4415   (interactive "P")
4416   (gnus arg nil 'slave))
4417
4418 ;;;###autoload
4419 (defun gnus-other-frame (&optional arg)
4420   "Pop up a frame to read news."
4421   (interactive "P")
4422   (if (get-buffer gnus-group-buffer)
4423       (let ((pop-up-frames t))
4424         (gnus arg))
4425     (select-frame (make-frame))
4426     (gnus arg)))
4427
4428 ;;;###autoload
4429 (defun gnus (&optional arg dont-connect slave)
4430   "Read network news.
4431 If ARG is non-nil and a positive number, Gnus will use that as the
4432 startup level.  If ARG is non-nil and not a positive number, Gnus will
4433 prompt the user for the name of an NNTP server to use."
4434   (interactive "P")
4435
4436   (if (get-buffer gnus-group-buffer)
4437       (progn
4438         (switch-to-buffer gnus-group-buffer)
4439         (gnus-group-get-new-news))
4440
4441     (gnus-clear-system)
4442     (nnheader-init-server-buffer)
4443     (gnus-read-init-file)
4444     (setq gnus-slave slave)
4445
4446     (gnus-group-setup-buffer)
4447     (let ((buffer-read-only nil))
4448       (erase-buffer)
4449       (if (not gnus-inhibit-startup-message)
4450           (progn
4451             (gnus-group-startup-message)
4452             (sit-for 0))))
4453
4454     (let ((level (and (numberp arg) (> arg 0) arg))
4455           did-connect)
4456       (unwind-protect
4457           (progn
4458             (or dont-connect
4459                 (setq did-connect
4460                       (gnus-start-news-server (and arg (not level))))))
4461         (if (and (not dont-connect)
4462                  (not did-connect))
4463             (gnus-group-quit)
4464           (run-hooks 'gnus-startup-hook)
4465           ;; NNTP server is successfully open.
4466
4467           ;; Find the current startup file name.
4468           (setq gnus-current-startup-file
4469                 (gnus-make-newsrc-file gnus-startup-file))
4470
4471           ;; Read the dribble file.
4472           (when (or gnus-slave gnus-use-dribble-file)
4473             (gnus-dribble-read-file))
4474
4475           ;; Allow using GroupLens predictions.
4476           (when gnus-use-grouplens
4477             (bbb-login)
4478             (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
4479
4480           (gnus-summary-make-display-table)
4481           ;; Do the actual startup.
4482           (gnus-setup-news nil level dont-connect)
4483           ;; Generate the group buffer.
4484           (gnus-group-list-groups level)
4485           (gnus-group-first-unread-group)
4486           (gnus-configure-windows 'group)
4487           (gnus-group-set-mode-line))))))
4488
4489 (defun gnus-unload ()
4490   "Unload all Gnus features."
4491   (interactive)
4492   (or (boundp 'load-history)
4493       (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
4494   (let ((history load-history)
4495         feature)
4496     (while history
4497       (and (string-match "^\\(gnus\\|nn\\)" (caar history))
4498            (setq feature (cdr (assq 'provide (car history))))
4499            (unload-feature feature 'force))
4500       (setq history (cdr history)))))
4501
4502 (defun gnus-compile ()
4503   "Byte-compile the user-defined format specs."
4504   (interactive)
4505   (let ((entries gnus-format-specs)
4506         entry gnus-tmp-func)
4507     (save-excursion
4508       (gnus-message 7 "Compiling format specs...")
4509
4510       (while entries
4511         (setq entry (pop entries))
4512         (if (eq (car entry) 'version)
4513             (setq gnus-format-specs (delq entry gnus-format-specs))
4514           (when (and (listp (caddr entry))
4515                      (not (eq 'byte-code (caaddr entry))))
4516             (fset 'gnus-tmp-func
4517                   `(lambda () ,(caddr entry)))
4518             (byte-compile 'gnus-tmp-func)
4519             (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
4520
4521       (push (cons 'version emacs-version) gnus-format-specs)
4522       ;; Mark the .newsrc.eld file as "dirty".
4523       (gnus-dribble-enter " ")
4524       (gnus-message 7 "Compiling user specs...done"))))
4525
4526 (defun gnus-indent-rigidly (start end arg)
4527   "Indent rigidly using only spaces and no tabs."
4528   (save-excursion
4529     (save-restriction
4530       (narrow-to-region start end)
4531       (indent-rigidly start end arg)
4532       (goto-char (point-min))
4533       (while (search-forward "\t" nil t)
4534         (replace-match "        " t t)))))
4535
4536 (defun gnus-group-startup-message (&optional x y)
4537   "Insert startup message in current buffer."
4538   ;; Insert the message.
4539   (erase-buffer)
4540   (insert
4541    (format "              %s
4542           _    ___ _             _
4543           _ ___ __ ___  __    _ ___
4544           __   _     ___    __  ___
4545               _           ___     _
4546              _  _ __             _
4547              ___   __            _
4548                    __           _
4549                     _      _   _
4550                    _      _    _
4551                       _  _    _
4552                   __  ___
4553                  _   _ _     _
4554                 _   _
4555               _    _
4556              _    _
4557             _
4558           __
4559
4560 "
4561            ""))
4562   ;; And then hack it.
4563   (gnus-indent-rigidly (point-min) (point-max)
4564                        (/ (max (- (window-width) (or x 46)) 0) 2))
4565   (goto-char (point-min))
4566   (forward-line 1)
4567   (let* ((pheight (count-lines (point-min) (point-max)))
4568          (wheight (window-height))
4569          (rest (- wheight pheight)))
4570     (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
4571   ;; Fontify some.
4572   (goto-char (point-min))
4573   (and (search-forward "Praxis" nil t)
4574        (gnus-put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
4575   (goto-char (point-min))
4576   (let* ((mode-string (gnus-group-set-mode-line)))
4577     (setq mode-line-buffer-identification
4578           (list (concat gnus-version (substring (car mode-string) 4))))
4579     (set-buffer-modified-p t)))
4580
4581 (defun gnus-group-setup-buffer ()
4582   (or (get-buffer gnus-group-buffer)
4583       (progn
4584         (switch-to-buffer gnus-group-buffer)
4585         (gnus-add-current-to-buffer-list)
4586         (gnus-group-mode)
4587         (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
4588
4589 (defun gnus-group-list-groups (&optional level unread lowest)
4590   "List newsgroups with level LEVEL or lower that have unread articles.
4591 Default is all subscribed groups.
4592 If argument UNREAD is non-nil, groups with no unread articles are also
4593 listed."
4594   (interactive (list (if current-prefix-arg
4595                          (prefix-numeric-value current-prefix-arg)
4596                        (or
4597                         (gnus-group-default-level nil t)
4598                         gnus-group-default-list-level
4599                         gnus-level-subscribed))))
4600   (or level
4601       (setq level (car gnus-group-list-mode)
4602             unread (cdr gnus-group-list-mode)))
4603   (setq level (gnus-group-default-level level))
4604   (gnus-group-setup-buffer)             ;May call from out of group buffer
4605   (gnus-update-format-specifications)
4606   (let ((case-fold-search nil)
4607         (props (text-properties-at (gnus-point-at-bol)))
4608         (group (gnus-group-group-name)))
4609     (set-buffer gnus-group-buffer)
4610     (funcall gnus-group-prepare-function level unread lowest)
4611     (if (zerop (buffer-size))
4612         (gnus-message 5 gnus-no-groups-message)
4613       (goto-char (point-max))
4614       (when (or (not gnus-group-goto-next-group-function)
4615                 (not (funcall gnus-group-goto-next-group-function 
4616                               group props)))
4617         (if (not group)
4618             ;; Go to the first group with unread articles.
4619             (gnus-group-search-forward t)
4620           ;; Find the right group to put point on.  If the current group
4621           ;; has disappeared in the new listing, try to find the next
4622           ;; one.        If no next one can be found, just leave point at the
4623           ;; first newsgroup in the buffer.
4624           (if (not (gnus-goto-char
4625                     (text-property-any
4626                      (point-min) (point-max)
4627                      'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
4628               (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
4629                 (while (and newsrc
4630                             (not (gnus-goto-char
4631                                   (text-property-any
4632                                    (point-min) (point-max) 'gnus-group
4633                                    (gnus-intern-safe
4634                                     (caar newsrc) gnus-active-hashtb)))))
4635                   (setq newsrc (cdr newsrc)))
4636                 (or newsrc (progn (goto-char (point-max))
4637                                   (forward-line -1)))))))
4638       ;; Adjust cursor point.
4639       (gnus-group-position-point))))
4640
4641 (defun gnus-group-list-level (level &optional all)
4642   "List groups on LEVEL.
4643 If ALL (the prefix), also list groups that have no unread articles."
4644   (interactive "nList groups on level: \nP")
4645   (gnus-group-list-groups level all level))
4646
4647 (defun gnus-group-prepare-flat (level &optional all lowest regexp)
4648   "List all newsgroups with unread articles of level LEVEL or lower.
4649 If ALL is non-nil, list groups that have no unread articles.
4650 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
4651 If REGEXP, only list groups matching REGEXP."
4652   (set-buffer gnus-group-buffer)
4653   (let ((buffer-read-only nil)
4654         (newsrc (cdr gnus-newsrc-alist))
4655         (lowest (or lowest 1))
4656         info clevel unread group params)
4657     (erase-buffer)
4658     (if (< lowest gnus-level-zombie)
4659         ;; List living groups.
4660         (while newsrc
4661           (setq info (car newsrc)
4662                 group (gnus-info-group info)
4663                 params (gnus-info-params info)
4664                 newsrc (cdr newsrc)
4665                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
4666           (and unread                   ; This group might be bogus
4667                (or (not regexp)
4668                    (string-match regexp group))
4669                (<= (setq clevel (gnus-info-level info)) level)
4670                (>= clevel lowest)
4671                (or all                  ; We list all groups?
4672                    (if (eq unread t)    ; Unactivated?
4673                        gnus-group-list-inactive-groups ; We list unactivated 
4674                      (> unread 0))      ; We list groups with unread articles
4675                    (and gnus-list-groups-with-ticked-articles
4676                         (cdr (assq 'tick (gnus-info-marks info))))
4677                                         ; And groups with tickeds
4678                    ;; Check for permanent visibility.
4679                    (and gnus-permanently-visible-groups
4680                         (string-match gnus-permanently-visible-groups
4681                                       group))
4682                    (memq 'visible params)
4683                    (cdr (assq 'visible params)))
4684                (gnus-group-insert-group-line
4685                 group (gnus-info-level info)
4686                 (gnus-info-marks info) unread (gnus-info-method info)))))
4687
4688     ;; List dead groups.
4689     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
4690          (gnus-group-prepare-flat-list-dead
4691           (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
4692           gnus-level-zombie ?Z
4693           regexp))
4694     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
4695          (gnus-group-prepare-flat-list-dead
4696           (setq gnus-killed-list (sort gnus-killed-list 'string<))
4697           gnus-level-killed ?K regexp))
4698
4699     (gnus-group-set-mode-line)
4700     (setq gnus-group-list-mode (cons level all))
4701     (run-hooks 'gnus-group-prepare-hook)))
4702
4703 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
4704   ;; List zombies and killed lists somewhat faster, which was
4705   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
4706   ;; this by ignoring the group format specification altogether.
4707   (let (group)
4708     (if regexp
4709         ;; This loop is used when listing groups that match some
4710         ;; regexp.
4711         (while groups
4712           (setq group (pop groups))
4713           (when (string-match regexp group)
4714             (gnus-add-text-properties
4715              (point) (prog1 (1+ (point))
4716                        (insert " " mark "     *: " group "\n"))
4717              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4718                    'gnus-unread t
4719                    'gnus-level level))))
4720       ;; This loop is used when listing all groups.
4721       (while groups
4722         (gnus-add-text-properties
4723          (point) (prog1 (1+ (point))
4724                    (insert " " mark "     *: "
4725                            (setq group (pop groups)) "\n"))
4726          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4727                'gnus-unread t
4728                'gnus-level level))))))
4729
4730 (defmacro gnus-group-real-name (group)
4731   "Find the real name of a foreign newsgroup."
4732   `(let ((gname ,group))
4733      (if (string-match ":[^:]+$" gname)
4734          (substring gname (1+ (match-beginning 0)))
4735        gname)))
4736
4737 (defsubst gnus-server-add-address (method)
4738   (let ((method-name (symbol-name (car method))))
4739     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
4740              (not (assq (intern (concat method-name "-address")) method)))
4741         (append method (list (list (intern (concat method-name "-address"))
4742                                    (nth 1 method))))
4743       method)))
4744
4745 (defsubst gnus-server-get-method (group method)
4746   ;; Input either a server name, and extended server name, or a
4747   ;; select method, and return a select method.
4748   (cond ((stringp method)
4749          (gnus-server-to-method method))
4750         ((equal method gnus-select-method)
4751          gnus-select-method)
4752         ((and (stringp (car method)) group)
4753          (gnus-server-extend-method group method))
4754         ((and method (not group)
4755               (equal (cadr method) ""))
4756          method)
4757         (t
4758          (gnus-server-add-address method))))
4759
4760 (defun gnus-server-to-method (server)
4761   "Map virtual server names to select methods."
4762   (or 
4763    ;; Is this a method, perhaps?
4764    (and server (listp server) server)
4765    ;; Perhaps this is the native server?
4766    (and (equal server "native") gnus-select-method)
4767    ;; It should be in the server alist.
4768    (cdr (assoc server gnus-server-alist))
4769    ;; If not, we look through all the opened server
4770    ;; to see whether we can find it there.
4771    (let ((opened gnus-opened-servers))
4772      (while (and opened
4773                  (not (equal server (format "%s:%s" (caaar opened)
4774                                             (cadaar opened)))))
4775        (pop opened))
4776      (caar opened))))
4777
4778 (defmacro gnus-method-equal (ss1 ss2)
4779   "Say whether two servers are equal."
4780   `(let ((s1 ,ss1)
4781          (s2 ,ss2))
4782      (or (equal s1 s2)
4783          (and (= (length s1) (length s2))
4784               (progn
4785                 (while (and s1 (member (car s1) s2))
4786                   (setq s1 (cdr s1)))
4787                 (null s1))))))
4788
4789 (defun gnus-server-equal (m1 m2)
4790   "Say whether two methods are equal."
4791   (let ((m1 (cond ((null m1) gnus-select-method)
4792                   ((stringp m1) (gnus-server-to-method m1))
4793                   (t m1)))
4794         (m2 (cond ((null m2) gnus-select-method)
4795                   ((stringp m2) (gnus-server-to-method m2))
4796                   (t m2))))
4797     (gnus-method-equal m1 m2)))
4798
4799 (defun gnus-servers-using-backend (backend)
4800   "Return a list of known servers using BACKEND."
4801   (let ((opened gnus-opened-servers)
4802         out)
4803     (while opened
4804       (when (eq backend (caaar opened))
4805         (push (caar opened) out))
4806       (pop opened))
4807     out))
4808
4809 (defun gnus-archive-server-wanted-p ()
4810   "Say whether the user wants to use the archive server."
4811   (cond 
4812    ((or (not gnus-message-archive-method)
4813         (not gnus-message-archive-group))
4814     nil)
4815    ((and gnus-message-archive-method gnus-message-archive-group)
4816     t)
4817    (t
4818     (let ((active (cadr (assq 'nnfolder-active-file
4819                               gnus-message-archive-method))))
4820       (and active
4821            (file-exists-p active))))))
4822
4823 (defun gnus-group-prefixed-name (group method)
4824   "Return the whole name from GROUP and METHOD."
4825   (and (stringp method) (setq method (gnus-server-to-method method)))
4826   (concat (format "%s" (car method))
4827           (if (and
4828                (or (assoc (format "%s" (car method)) 
4829                           (gnus-methods-using 'address))
4830                    (gnus-server-equal method gnus-message-archive-method))
4831                (nth 1 method)
4832                (not (string= (nth 1 method) "")))
4833               (concat "+" (nth 1 method)))
4834           ":" group))
4835
4836 (defun gnus-group-real-prefix (group)
4837   "Return the prefix of the current group name."
4838   (if (string-match "^[^:]+:" group)
4839       (substring group 0 (match-end 0))
4840     ""))
4841
4842 (defun gnus-group-method (group)
4843   "Return the server or method used for selecting GROUP."
4844   (let ((prefix (gnus-group-real-prefix group)))
4845     (if (equal prefix "")
4846         gnus-select-method
4847       (let ((servers gnus-opened-servers)
4848             (server "")
4849             backend possible found)
4850         (if (string-match "^[^\\+]+\\+" prefix)
4851             (setq backend (intern (substring prefix 0 (1- (match-end 0))))
4852                   server (substring prefix (match-end 0) (1- (length prefix))))
4853           (setq backend (intern (substring prefix 0 (1- (length prefix))))))
4854         (while servers
4855           (when (eq (caaar servers) backend)
4856             (setq possible (caar servers))
4857             (when (equal (cadaar servers) server)
4858               (setq found (caar servers))))
4859           (pop servers))
4860         (or (car (rassoc found gnus-server-alist))
4861             found
4862             (car (rassoc possible gnus-server-alist))
4863             possible
4864             (list backend server))))))
4865
4866 (defsubst gnus-secondary-method-p (method)
4867   "Return whether METHOD is a secondary select method."
4868   (let ((methods gnus-secondary-select-methods)
4869         (gmethod (gnus-server-get-method nil method)))
4870     (while (and methods
4871                 (not (equal (gnus-server-get-method nil (car methods))
4872                             gmethod)))
4873       (setq methods (cdr methods)))
4874     methods))
4875
4876 (defun gnus-group-foreign-p (group)
4877   "Say whether a group is foreign or not."
4878   (and (not (gnus-group-native-p group))
4879        (not (gnus-group-secondary-p group))))
4880
4881 (defun gnus-group-native-p (group)
4882   "Say whether the group is native or not."
4883   (not (string-match ":" group)))
4884
4885 (defun gnus-group-secondary-p (group)
4886   "Say whether the group is secondary or not."
4887   (gnus-secondary-method-p (gnus-find-method-for-group group)))
4888
4889 (defun gnus-group-get-parameter (group &optional symbol)
4890   "Returns the group parameters for GROUP.
4891 If SYMBOL, return the value of that symbol in the group parameters."
4892   (let ((params (gnus-info-params (gnus-get-info group))))
4893     (if symbol
4894         (gnus-group-parameter-value params symbol)
4895       params)))
4896
4897 (defun gnus-group-parameter-value (params symbol)
4898   "Return the value of SYMBOL in group PARAMS."
4899   (or (car (memq symbol params))        ; It's either a simple symbol
4900       (cdr (assq symbol params))))      ; or a cons.
4901
4902 (defun gnus-group-add-parameter (group param)
4903   "Add parameter PARAM to GROUP."
4904   (let ((info (gnus-get-info group)))
4905     (if (not info)
4906         () ; This is a dead group.  We just ignore it.
4907       ;; Cons the new param to the old one and update.
4908       (gnus-group-set-info (cons param (gnus-info-params info))
4909                            group 'params))))
4910
4911 (defun gnus-group-set-parameter (group name value)
4912   "Set parameter NAME to VALUE in GROUP."
4913   (let ((info (gnus-get-info group)))
4914     (if (not info)
4915         () ; This is a dead group.  We just ignore it.
4916       (let ((old-params (gnus-info-params info))
4917             (new-params (list (cons name value))))
4918         (while old-params
4919           (if (or (not (listp (car old-params)))
4920                   (not (eq (caar old-params) name)))
4921               (setq new-params (append new-params (list (car old-params)))))
4922           (setq old-params (cdr old-params)))
4923         (gnus-group-set-info new-params group 'params)))))
4924
4925 (defun gnus-group-add-score (group &optional score)
4926   "Add SCORE to the GROUP score.
4927 If SCORE is nil, add 1 to the score of GROUP."
4928   (let ((info (gnus-get-info group)))
4929     (when info
4930       (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
4931
4932 (defun gnus-summary-bubble-group ()
4933   "Increase the score of the current group.
4934 This is a handy function to add to `gnus-summary-exit-hook' to
4935 increase the score of each group you read."
4936   (gnus-group-add-score gnus-newsgroup-name))
4937
4938 (defun gnus-group-set-info (info &optional method-only-group part)
4939   (let* ((entry (gnus-gethash
4940                  (or method-only-group (gnus-info-group info))
4941                  gnus-newsrc-hashtb))
4942          (part-info info)
4943          (info (if method-only-group (nth 2 entry) info))
4944          method)
4945     (when method-only-group
4946       (unless entry
4947         (error "Trying to change non-existent group %s" method-only-group))
4948       ;; We have received parts of the actual group info - either the
4949       ;; select method or the group parameters.  We first check
4950       ;; whether we have to extend the info, and if so, do that.
4951       (let ((len (length info))
4952             (total (if (eq part 'method) 5 6)))
4953         (when (< len total)
4954           (setcdr (nthcdr (1- len) info)
4955                   (make-list (- total len) nil)))
4956         ;; Then we enter the new info.
4957         (setcar (nthcdr (1- total) info) part-info)))
4958     (unless entry
4959       ;; This is a new group, so we just create it.
4960       (save-excursion
4961         (set-buffer gnus-group-buffer)
4962         (setq method (gnus-info-method info))
4963         (when (gnus-server-equal method "native")
4964           (setq method nil))
4965         (save-excursion
4966           (set-buffer gnus-group-buffer)
4967           (if method
4968               ;; It's a foreign group...
4969               (gnus-group-make-group
4970                (gnus-group-real-name (gnus-info-group info))
4971                (if (stringp method) method
4972                  (prin1-to-string (car method)))
4973                (and (consp method)
4974                     (nth 1 (gnus-info-method info))))
4975             ;; It's a native group.
4976             (gnus-group-make-group (gnus-info-group info))))
4977         (gnus-message 6 "Note: New group created")
4978         (setq entry
4979               (gnus-gethash (gnus-group-prefixed-name
4980                              (gnus-group-real-name (gnus-info-group info))
4981                              (or (gnus-info-method info) gnus-select-method))
4982                             gnus-newsrc-hashtb))))
4983     ;; Whether it was a new group or not, we now have the entry, so we
4984     ;; can do the update.
4985     (if entry
4986         (progn
4987           (setcar (nthcdr 2 entry) info)
4988           (when (and (not (eq (car entry) t))
4989                      (gnus-active (gnus-info-group info)))
4990             (setcar entry (length (gnus-list-of-unread-articles (car info))))))
4991       (error "No such group: %s" (gnus-info-group info)))))
4992
4993 (defun gnus-group-set-method-info (group select-method)
4994   (gnus-group-set-info select-method group 'method))
4995
4996 (defun gnus-group-set-params-info (group params)
4997   (gnus-group-set-info params group 'params))
4998
4999 (defun gnus-group-update-group-line ()
5000   "Update the current line in the group buffer."
5001   (let* ((buffer-read-only nil)
5002          (group (gnus-group-group-name))
5003          (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
5004          gnus-group-indentation)
5005     (when group
5006       (and entry
5007            (not (gnus-ephemeral-group-p group))
5008            (gnus-dribble-enter
5009             (concat "(gnus-group-set-info '"
5010                     (prin1-to-string (nth 2 entry)) ")")))
5011       (setq gnus-group-indentation (gnus-group-group-indentation))
5012       (gnus-delete-line)
5013       (gnus-group-insert-group-line-info group)
5014       (forward-line -1)
5015       (gnus-group-position-point))))
5016
5017 (defun gnus-group-insert-group-line-info (group)
5018   "Insert GROUP on the current line."
5019   (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
5020         active info)
5021     (if entry
5022         (progn
5023           ;; (Un)subscribed group.
5024           (setq info (nth 2 entry))
5025           (gnus-group-insert-group-line
5026            group (gnus-info-level info) (gnus-info-marks info)
5027            (or (car entry) t) (gnus-info-method info)))
5028       ;; This group is dead.
5029       (gnus-group-insert-group-line
5030        group
5031        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
5032        nil
5033        (if (setq active (gnus-active group))
5034            (- (1+ (cdr active)) (car active)) 0)
5035        nil))))
5036
5037 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level 
5038                                                     gnus-tmp-marked number
5039                                                     gnus-tmp-method)
5040   "Insert a group line in the group buffer."
5041   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
5042          (gnus-tmp-number-total
5043           (if gnus-tmp-active
5044               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
5045             0))
5046          (gnus-tmp-number-of-unread
5047           (if (numberp number) (int-to-string (max 0 number))
5048             "*"))
5049          (gnus-tmp-number-of-read
5050           (if (numberp number)
5051               (int-to-string (max 0 (- gnus-tmp-number-total number)))
5052             "*"))
5053          (gnus-tmp-subscribed
5054           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
5055                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
5056                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
5057                 (t ?K)))
5058          (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
5059          (gnus-tmp-newsgroup-description
5060           (if gnus-description-hashtb
5061               (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
5062             ""))
5063          (gnus-tmp-moderated
5064           (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
5065          (gnus-tmp-moderated-string
5066           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
5067          (gnus-tmp-method
5068           (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
5069          (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
5070          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
5071          (gnus-tmp-news-method-string
5072           (if gnus-tmp-method
5073               (format "(%s:%s)" (car gnus-tmp-method)
5074                       (cadr gnus-tmp-method)) ""))
5075          (gnus-tmp-marked-mark
5076           (if (and (numberp number)
5077                    (zerop number)
5078                    (cdr (assq 'tick gnus-tmp-marked)))
5079               ?* ? ))
5080          (gnus-tmp-process-marked
5081           (if (member gnus-tmp-group gnus-group-marked)
5082               gnus-process-mark ? ))
5083          (gnus-tmp-grouplens
5084           (or (and gnus-use-grouplens
5085                    (bbb-grouplens-group-p gnus-tmp-group))
5086               ""))
5087          (buffer-read-only nil)
5088          header gnus-tmp-header)        ; passed as parameter to user-funcs.
5089     (beginning-of-line)
5090     (gnus-add-text-properties
5091      (point)
5092      (prog1 (1+ (point))
5093        ;; Insert the text.
5094        (eval gnus-group-line-format-spec))
5095      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
5096        gnus-unread ,(if (numberp number)
5097                         (string-to-int gnus-tmp-number-of-unread)
5098                       t)
5099        gnus-marked ,gnus-tmp-marked-mark
5100        gnus-indentation ,gnus-group-indentation
5101        gnus-level ,gnus-tmp-level))
5102     (when (inline (gnus-visual-p 'group-highlight 'highlight))
5103       (forward-line -1)
5104       (run-hooks 'gnus-group-update-hook)
5105       (forward-line))
5106     ;; Allow XEmacs to remove front-sticky text properties.
5107     (gnus-group-remove-excess-properties)))
5108
5109 (defun gnus-group-update-group (group &optional visible-only)
5110   "Update all lines where GROUP appear.
5111 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
5112 already."
5113   (save-excursion
5114     (set-buffer gnus-group-buffer)
5115     ;; The buffer may be narrowed.
5116     (save-restriction
5117       (widen)
5118       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
5119             (loc (point-min))
5120             found buffer-read-only)
5121         ;; Enter the current status into the dribble buffer.
5122         (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
5123           (if (and entry (not (gnus-ephemeral-group-p group)))
5124               (gnus-dribble-enter
5125                (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
5126                        ")"))))
5127         ;; Find all group instances.  If topics are in use, each group
5128         ;; may be listed in more than once.
5129         (while (setq loc (text-property-any
5130                           loc (point-max) 'gnus-group ident))
5131           (setq found t)
5132           (goto-char loc)
5133           (let ((gnus-group-indentation (gnus-group-group-indentation)))
5134             (gnus-delete-line)
5135             (gnus-group-insert-group-line-info group)
5136             (save-excursion
5137               (forward-line -1)
5138               (run-hooks 'gnus-group-update-group-hook)))
5139           (setq loc (1+ loc)))
5140         (unless (or found visible-only)
5141           ;; No such line in the buffer, find out where it's supposed to
5142           ;; go, and insert it there (or at the end of the buffer).
5143           (if gnus-goto-missing-group-function
5144               (funcall gnus-goto-missing-group-function group)
5145             (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb))))
5146               (while (and entry (car entry)
5147                           (not
5148                            (gnus-goto-char
5149                             (text-property-any
5150                              (point-min) (point-max)
5151                              'gnus-group (gnus-intern-safe
5152                                           (caar entry) gnus-active-hashtb)))))
5153                 (setq entry (cdr entry)))
5154               (or entry (goto-char (point-max)))))
5155           ;; Finally insert the line.
5156           (let ((gnus-group-indentation (gnus-group-group-indentation)))
5157             (gnus-group-insert-group-line-info group)
5158             (save-excursion
5159               (forward-line -1)
5160               (run-hooks 'gnus-group-update-group-hook))))
5161         (gnus-group-set-mode-line)))))
5162
5163 (defun gnus-group-set-mode-line ()
5164   "Update the mode line in the group buffer."
5165   (when (memq 'group gnus-updated-mode-lines)
5166     ;; Yes, we want to keep this mode line updated.
5167     (save-excursion
5168       (set-buffer gnus-group-buffer)
5169       (let* ((gformat (or gnus-group-mode-line-format-spec
5170                           (setq gnus-group-mode-line-format-spec
5171                                 (gnus-parse-format
5172                                  gnus-group-mode-line-format
5173                                  gnus-group-mode-line-format-alist))))
5174              (gnus-tmp-news-server (cadr gnus-select-method))
5175              (gnus-tmp-news-method (car gnus-select-method))
5176              (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
5177              (max-len 60)
5178              gnus-tmp-header            ;Dummy binding for user-defined formats
5179              ;; Get the resulting string.
5180              (modified 
5181               (and gnus-dribble-buffer
5182                    (buffer-name gnus-dribble-buffer)
5183                    (buffer-modified-p gnus-dribble-buffer)
5184                    (save-excursion
5185                      (set-buffer gnus-dribble-buffer)
5186                      (not (zerop (buffer-size))))))
5187              (mode-string (eval gformat)))
5188         ;; Say whether the dribble buffer has been modified.
5189         (setq mode-line-modified
5190               (if modified "---*- " "----- "))
5191         ;; If the line is too long, we chop it off.
5192         (when (> (length mode-string) max-len)
5193           (setq mode-string (substring mode-string 0 (- max-len 4))))
5194         (prog1
5195             (setq mode-line-buffer-identification 
5196                   (gnus-mode-line-buffer-identification
5197                    (list mode-string)))
5198           (set-buffer-modified-p modified))))))
5199
5200 (defun gnus-group-group-name ()
5201   "Get the name of the newsgroup on the current line."
5202   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
5203     (and group (symbol-name group))))
5204
5205 (defun gnus-group-group-level ()
5206   "Get the level of the newsgroup on the current line."
5207   (get-text-property (gnus-point-at-bol) 'gnus-level))
5208
5209 (defun gnus-group-group-indentation ()
5210   "Get the indentation of the newsgroup on the current line."
5211   (or (get-text-property (gnus-point-at-bol) 'gnus-indentation)
5212       (and gnus-group-indentation-function
5213            (funcall gnus-group-indentation-function))
5214       ""))
5215
5216 (defun gnus-group-group-unread ()
5217   "Get the number of unread articles of the newsgroup on the current line."
5218   (get-text-property (gnus-point-at-bol) 'gnus-unread))
5219
5220 (defun gnus-group-search-forward (&optional backward all level first-too)
5221   "Find the next newsgroup with unread articles.
5222 If BACKWARD is non-nil, find the previous newsgroup instead.
5223 If ALL is non-nil, just find any newsgroup.
5224 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
5225 group exists.
5226 If FIRST-TOO, the current line is also eligible as a target."
5227   (let ((way (if backward -1 1))
5228         (low gnus-level-killed)
5229         (beg (point))
5230         pos found lev)
5231     (if (and backward (progn (beginning-of-line)) (bobp))
5232         nil
5233       (or first-too (forward-line way))
5234       (while (and
5235               (not (eobp))
5236               (not (setq
5237                     found
5238                     (and (or all
5239                              (and
5240                               (let ((unread
5241                                      (get-text-property (point) 'gnus-unread)))
5242                                 (and (numberp unread) (> unread 0)))
5243                               (setq lev (get-text-property (point)
5244                                                            'gnus-level))
5245                               (<= lev gnus-level-subscribed)))
5246                          (or (not level)
5247                              (and (setq lev (get-text-property (point)
5248                                                                'gnus-level))
5249                                   (or (= lev level)
5250                                       (and (< lev low)
5251                                            (< level lev)
5252                                            (progn
5253                                              (setq low lev)
5254                                              (setq pos (point))
5255                                              nil))))))))
5256               (zerop (forward-line way)))))
5257     (if found
5258         (progn (gnus-group-position-point) t)
5259       (goto-char (or pos beg))
5260       (and pos t))))
5261
5262 ;;; Gnus group mode commands
5263
5264 ;; Group marking.
5265
5266 (defun gnus-group-mark-group (n &optional unmark no-advance)
5267   "Mark the current group."
5268   (interactive "p")
5269   (let ((buffer-read-only nil)
5270         group)
5271     (while (and (> n 0)
5272                 (not (eobp)))
5273       (when (setq group (gnus-group-group-name))
5274         ;; Update the mark.
5275         (beginning-of-line)
5276         (forward-char
5277          (or (cdr (assq 'process gnus-group-mark-positions)) 2))
5278         (delete-char 1)
5279         (if unmark
5280             (progn
5281               (insert " ")
5282               (setq gnus-group-marked (delete group gnus-group-marked)))
5283           (insert "#")
5284           (setq gnus-group-marked
5285                 (cons group (delete group gnus-group-marked)))))
5286       (or no-advance (gnus-group-next-group 1))
5287       (decf n))
5288     (gnus-summary-position-point)
5289     n))
5290
5291 (defun gnus-group-unmark-group (n)
5292   "Remove the mark from the current group."
5293   (interactive "p")
5294   (gnus-group-mark-group n 'unmark)
5295   (gnus-group-position-point))
5296
5297 (defun gnus-group-unmark-all-groups ()
5298   "Unmark all groups."
5299   (interactive)
5300   (let ((groups gnus-group-marked))
5301     (save-excursion
5302       (while groups
5303         (gnus-group-remove-mark (pop groups)))))
5304   (gnus-group-position-point))
5305
5306 (defun gnus-group-mark-region (unmark beg end)
5307   "Mark all groups between point and mark.
5308 If UNMARK, remove the mark instead."
5309   (interactive "P\nr")
5310   (let ((num (count-lines beg end)))
5311     (save-excursion
5312       (goto-char beg)
5313       (- num (gnus-group-mark-group num unmark)))))
5314
5315 (defun gnus-group-mark-buffer (&optional unmark)
5316   "Mark all groups in the buffer.
5317 If UNMARK, remove the mark instead."
5318   (interactive "P")
5319   (gnus-group-mark-region unmark (point-min) (point-max)))
5320
5321 (defun gnus-group-mark-regexp (regexp)
5322   "Mark all groups that match some regexp."
5323   (interactive "sMark (regexp): ")
5324   (let ((alist (cdr gnus-newsrc-alist))
5325         group)
5326     (while alist
5327       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
5328         (gnus-group-set-mark group))))
5329   (gnus-group-position-point))
5330
5331 (defun gnus-group-remove-mark (group)
5332   "Remove the process mark from GROUP and move point there.
5333 Return nil if the group isn't displayed."
5334   (if (gnus-group-goto-group group)
5335       (save-excursion
5336         (gnus-group-mark-group 1 'unmark t)
5337         t)
5338     (setq gnus-group-marked
5339           (delete group gnus-group-marked))
5340     nil))
5341
5342 (defun gnus-group-set-mark (group)
5343   "Set the process mark on GROUP."
5344   (if (gnus-group-goto-group group) 
5345       (save-excursion
5346         (gnus-group-mark-group 1 nil t))
5347     (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
5348
5349 (defun gnus-group-universal-argument (arg &optional groups func)
5350   "Perform any command on all groups accoring to the process/prefix convention."
5351   (interactive "P")
5352   (let ((groups (or groups (gnus-group-process-prefix arg)))
5353         group func)
5354     (if (eq (setq func (or func
5355                            (key-binding
5356                             (read-key-sequence
5357                              (substitute-command-keys
5358                               "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
5359             'undefined)
5360         (gnus-error 1 "Undefined key")
5361       (while groups
5362         (gnus-group-remove-mark (setq group (pop groups)))
5363         (command-execute func))))
5364   (gnus-group-position-point))
5365
5366 (defun gnus-group-process-prefix (n)
5367   "Return a list of groups to work on.
5368 Take into consideration N (the prefix) and the list of marked groups."
5369   (cond
5370    (n
5371     (setq n (prefix-numeric-value n))
5372     ;; There is a prefix, so we return a list of the N next
5373     ;; groups.
5374     (let ((way (if (< n 0) -1 1))
5375           (n (abs n))
5376           group groups)
5377       (save-excursion
5378         (while (and (> n 0)
5379                     (setq group (gnus-group-group-name)))
5380           (setq groups (cons group groups))
5381           (setq n (1- n))
5382           (gnus-group-next-group way)))
5383       (nreverse groups)))
5384    ((and (boundp 'transient-mark-mode)
5385          transient-mark-mode
5386          (boundp 'mark-active)
5387          mark-active)
5388     ;; Work on the region between point and mark.
5389     (let ((max (max (point) (mark)))
5390           groups)
5391       (save-excursion
5392         (goto-char (min (point) (mark)))
5393         (while
5394             (and
5395              (push (gnus-group-group-name) groups)
5396              (zerop (gnus-group-next-group 1))
5397              (< (point) max)))
5398         (nreverse groups))))
5399    (gnus-group-marked
5400     ;; No prefix, but a list of marked articles.
5401     (reverse gnus-group-marked))
5402    (t
5403     ;; Neither marked articles or a prefix, so we return the
5404     ;; current group.
5405     (let ((group (gnus-group-group-name)))
5406       (and group (list group))))))
5407
5408 ;; Selecting groups.
5409
5410 (defun gnus-group-read-group (&optional all no-article group)
5411   "Read news in this newsgroup.
5412 If the prefix argument ALL is non-nil, already read articles become
5413 readable.  IF ALL is a number, fetch this number of articles.  If the
5414 optional argument NO-ARTICLE is non-nil, no article will be
5415 auto-selected upon group entry.  If GROUP is non-nil, fetch that
5416 group."
5417   (interactive "P")
5418   (let ((group (or group (gnus-group-group-name)))
5419         number active marked entry)
5420     (or group (error "No group on current line"))
5421     (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
5422                                             group gnus-newsrc-hashtb)))))
5423     ;; This group might be a dead group.  In that case we have to get
5424     ;; the number of unread articles from `gnus-active-hashtb'.
5425     (setq number
5426           (cond ((numberp all) all)
5427                 (entry (car entry))
5428                 ((setq active (gnus-active group))
5429                  (- (1+ (cdr active)) (car active)))))
5430     (gnus-summary-read-group
5431      group (or all (and (numberp number)
5432                         (zerop (+ number (length (cdr (assq 'tick marked)))
5433                                   (length (cdr (assq 'dormant marked)))))))
5434      no-article)))
5435
5436 (defun gnus-group-select-group (&optional all)
5437   "Select this newsgroup.
5438 No article is selected automatically.
5439 If ALL is non-nil, already read articles become readable.
5440 If ALL is a number, fetch this number of articles."
5441   (interactive "P")
5442   (gnus-group-read-group all t))
5443
5444 (defun gnus-group-quick-select-group (&optional all)
5445   "Select the current group \"quickly\".
5446 This means that no highlighting or scoring will be performed."
5447   (interactive "P")
5448   (let (gnus-visual
5449         gnus-score-find-score-files-function
5450         gnus-apply-kill-hook
5451         gnus-summary-expunge-below)
5452     (gnus-group-read-group all t)))
5453
5454 (defun gnus-group-visible-select-group (&optional all)
5455   "Select the current group without hiding any articles."
5456   (interactive "P")
5457   (let ((gnus-inhibit-limiting t))
5458     (gnus-group-read-group all t)))
5459
5460 ;;;###autoload
5461 (defun gnus-fetch-group (group)
5462   "Start Gnus if necessary and enter GROUP.
5463 Returns whether the fetching was successful or not."
5464   (interactive "sGroup name: ")
5465   (or (get-buffer gnus-group-buffer)
5466       (gnus))
5467   (gnus-group-read-group nil nil group))
5468
5469 ;; Enter a group that is not in the group buffer.  Non-nil is returned
5470 ;; if selection was successful.
5471 (defun gnus-group-read-ephemeral-group
5472   (group method &optional activate quit-config)
5473   (let ((group (if (gnus-group-foreign-p group) group
5474                  (gnus-group-prefixed-name group method))))
5475     (gnus-sethash
5476      group
5477      `(t nil (,group ,gnus-level-default-subscribed nil nil ,method
5478                      ((quit-config . ,(if quit-config quit-config
5479                                         (cons (current-buffer) 'summary))))))
5480      gnus-newsrc-hashtb)
5481     (set-buffer gnus-group-buffer)
5482     (or (gnus-check-server method)
5483         (error "Unable to contact server: %s" (gnus-status-message method)))
5484     (if activate (or (gnus-request-group group)
5485                      (error "Couldn't request group")))
5486     (condition-case ()
5487         (gnus-group-read-group t t group)
5488       (error nil)
5489       (quit nil))))
5490
5491 (defun gnus-group-jump-to-group (group)
5492   "Jump to newsgroup GROUP."
5493   (interactive
5494    (list (completing-read
5495           "Group: " gnus-active-hashtb nil
5496           (gnus-read-active-file-p)
5497           nil
5498           'gnus-group-history)))
5499
5500   (when (equal group "")
5501     (error "Empty group name"))
5502
5503   (when (string-match "[\000-\032]" group)
5504     (error "Control characters in group: %s" group))
5505
5506   (let ((b (text-property-any
5507             (point-min) (point-max)
5508             'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
5509     (unless (gnus-ephemeral-group-p group)
5510       (if b
5511           ;; Either go to the line in the group buffer...
5512           (goto-char b)
5513         ;; ... or insert the line.
5514         (or
5515          (gnus-active group)
5516          (gnus-activate-group group)
5517          (error "%s error: %s" group (gnus-status-message group)))
5518
5519         (gnus-group-update-group group)
5520         (goto-char (text-property-any
5521                     (point-min) (point-max)
5522                     'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
5523     ;; Adjust cursor point.
5524     (gnus-group-position-point)))
5525
5526 (defun gnus-group-goto-group (group)
5527   "Goto to newsgroup GROUP."
5528   (when group
5529     ;; It's quite likely that we are on the right line, so
5530     ;; we check the current line first.
5531     (beginning-of-line)
5532     (if (eq (get-text-property (point) 'gnus-group)
5533             (gnus-intern-safe group gnus-active-hashtb))
5534         (point)
5535       ;; Search through the entire buffer.
5536       (let ((b (text-property-any 
5537                 (point-min) (point-max)
5538                 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
5539         (when b 
5540           (goto-char b))))))
5541
5542 (defun gnus-group-next-group (n &optional silent)
5543   "Go to next N'th newsgroup.
5544 If N is negative, search backward instead.
5545 Returns the difference between N and the number of skips actually
5546 done."
5547   (interactive "p")
5548   (gnus-group-next-unread-group n t nil silent))
5549
5550 (defun gnus-group-next-unread-group (n &optional all level silent)
5551   "Go to next N'th unread newsgroup.
5552 If N is negative, search backward instead.
5553 If ALL is non-nil, choose any newsgroup, unread or not.
5554 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
5555 such group can be found, the next group with a level higher than
5556 LEVEL.
5557 Returns the difference between N and the number of skips actually
5558 made."
5559   (interactive "p")
5560   (let ((backward (< n 0))
5561         (n (abs n)))
5562     (while (and (> n 0)
5563                 (gnus-group-search-forward
5564                  backward (or (not gnus-group-goto-unread) all) level))
5565       (setq n (1- n)))
5566     (when (and (/= 0 n)
5567                (not silent))
5568       (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
5569                     (if level " on this level or higher" "")))
5570     n))
5571
5572 (defun gnus-group-prev-group (n)
5573   "Go to previous N'th newsgroup.
5574 Returns the difference between N and the number of skips actually
5575 done."
5576   (interactive "p")
5577   (gnus-group-next-unread-group (- n) t))
5578
5579 (defun gnus-group-prev-unread-group (n)
5580   "Go to previous N'th unread newsgroup.
5581 Returns the difference between N and the number of skips actually
5582 done."
5583   (interactive "p")
5584   (gnus-group-next-unread-group (- n)))
5585
5586 (defun gnus-group-next-unread-group-same-level (n)
5587   "Go to next N'th unread newsgroup on the same level.
5588 If N is negative, search backward instead.
5589 Returns the difference between N and the number of skips actually
5590 done."
5591   (interactive "p")
5592   (gnus-group-next-unread-group n t (gnus-group-group-level))
5593   (gnus-group-position-point))
5594
5595 (defun gnus-group-prev-unread-group-same-level (n)
5596   "Go to next N'th unread newsgroup on the same level.
5597 Returns the difference between N and the number of skips actually
5598 done."
5599   (interactive "p")
5600   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
5601   (gnus-group-position-point))
5602
5603 (defun gnus-group-best-unread-group (&optional exclude-group)
5604   "Go to the group with the highest level.
5605 If EXCLUDE-GROUP, do not go to that group."
5606   (interactive)
5607   (goto-char (point-min))
5608   (let ((best 100000)
5609         unread best-point)
5610     (while (not (eobp))
5611       (setq unread (get-text-property (point) 'gnus-unread))
5612       (if (and (numberp unread) (> unread 0))
5613           (progn
5614             (if (and (get-text-property (point) 'gnus-level)
5615                      (< (get-text-property (point) 'gnus-level) best)
5616                      (or (not exclude-group)
5617                          (not (equal exclude-group (gnus-group-group-name)))))
5618                 (progn
5619                   (setq best (get-text-property (point) 'gnus-level))
5620                   (setq best-point (point))))))
5621       (forward-line 1))
5622     (if best-point (goto-char best-point))
5623     (gnus-summary-position-point)
5624     (and best-point (gnus-group-group-name))))
5625
5626 (defun gnus-group-first-unread-group ()
5627   "Go to the first group with unread articles."
5628   (interactive)
5629   (prog1
5630       (let ((opoint (point))
5631             unread)
5632         (goto-char (point-min))
5633         (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
5634                 (and (numberp unread)   ; Not a topic.
5635                      (not (zerop unread))) ; Has unread articles.
5636                 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
5637             (point)                     ; Success.
5638           (goto-char opoint)
5639           nil))                         ; Not success.
5640     (gnus-group-position-point)))
5641
5642 (defun gnus-group-enter-server-mode ()
5643   "Jump to the server buffer."
5644   (interactive)
5645   (gnus-enter-server-buffer))
5646
5647 (defun gnus-group-make-group (name &optional method address)
5648   "Add a new newsgroup.
5649 The user will be prompted for a NAME, for a select METHOD, and an
5650 ADDRESS."
5651   (interactive
5652    (cons
5653     (read-string "Group name: ")
5654     (let ((method
5655            (completing-read
5656             "Method: " (append gnus-valid-select-methods gnus-server-alist)
5657             nil t nil 'gnus-method-history)))
5658       (cond ((assoc method gnus-valid-select-methods)
5659              (list method
5660                    (if (memq 'prompt-address
5661                              (assoc method gnus-valid-select-methods))
5662                        (read-string "Address: ")
5663                      "")))
5664             ((assoc method gnus-server-alist)
5665              (list method))
5666             (t
5667              (list method ""))))))
5668
5669   (let* ((meth (and method (if address (list (intern method) address)
5670                              method)))
5671          (nname (if method (gnus-group-prefixed-name name meth) name))
5672          backend info)
5673     (when (gnus-gethash nname gnus-newsrc-hashtb)
5674       (error "Group %s already exists" nname))
5675     ;; Subscribe to the new group.
5676     (gnus-group-change-level
5677      (setq info (list t nname gnus-level-default-subscribed nil nil meth))
5678      gnus-level-default-subscribed gnus-level-killed
5679      (and (gnus-group-group-name)
5680           (gnus-gethash (gnus-group-group-name)
5681                         gnus-newsrc-hashtb))
5682      t)
5683     ;; Make it active.
5684     (gnus-set-active nname (cons 1 0))
5685     (or (gnus-ephemeral-group-p name)
5686         (gnus-dribble-enter
5687          (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
5688     ;; Insert the line.
5689     (gnus-group-insert-group-line-info nname)
5690     (forward-line -1)
5691     (gnus-group-position-point)
5692
5693     ;; Load the backend and try to make the backend create
5694     ;; the group as well.
5695     (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
5696                                                   nil meth))))
5697                  gnus-valid-select-methods)
5698       (require backend))
5699     (gnus-check-server meth)
5700     (and (gnus-check-backend-function 'request-create-group nname)
5701          (gnus-request-create-group nname))
5702     t))
5703
5704 (defun gnus-group-delete-group (group &optional force)
5705   "Delete the current group.  Only meaningful with mail groups.
5706 If FORCE (the prefix) is non-nil, all the articles in the group will
5707 be deleted.  This is \"deleted\" as in \"removed forever from the face
5708 of the Earth\".  There is no undo.  The user will be prompted before
5709 doing the deletion."
5710   (interactive
5711    (list (gnus-group-group-name)
5712          current-prefix-arg))
5713   (or group (error "No group to rename"))
5714   (or (gnus-check-backend-function 'request-delete-group group)
5715       (error "This backend does not support group deletion"))
5716   (prog1
5717       (if (not (gnus-yes-or-no-p
5718                 (format
5719                  "Do you really want to delete %s%s? "
5720                  group (if force " and all its contents" ""))))
5721           () ; Whew!
5722         (gnus-message 6 "Deleting group %s..." group)
5723         (if (not (gnus-request-delete-group group force))
5724             (gnus-error 3 "Couldn't delete group %s" group)
5725           (gnus-message 6 "Deleting group %s...done" group)
5726           (gnus-group-goto-group group)
5727           (gnus-group-kill-group 1 t)
5728           (gnus-sethash group nil gnus-active-hashtb)
5729           t))
5730     (gnus-group-position-point)))
5731
5732 (defun gnus-group-rename-group (group new-name)
5733   (interactive
5734    (list
5735     (gnus-group-group-name)
5736     (progn
5737       (or (gnus-check-backend-function
5738            'request-rename-group (gnus-group-group-name))
5739           (error "This backend does not support renaming groups"))
5740       (read-string "New group name: "))))
5741
5742   (or (gnus-check-backend-function 'request-rename-group group)
5743       (error "This backend does not support renaming groups"))
5744
5745   (or group (error "No group to rename"))
5746   (and (string-match "^[ \t]*$" new-name)
5747        (error "Not a valid group name"))
5748
5749   ;; We find the proper prefixed name.
5750   (setq new-name
5751         (gnus-group-prefixed-name
5752          (gnus-group-real-name new-name)
5753          (gnus-info-method (gnus-get-info group))))
5754
5755   (gnus-message 6 "Renaming group %s to %s..." group new-name)
5756   (prog1
5757       (if (not (gnus-request-rename-group group new-name))
5758           (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
5759         ;; We rename the group internally by killing it...
5760         (gnus-group-goto-group group)
5761         (gnus-group-kill-group)
5762         ;; ... changing its name ...
5763         (setcar (cdar gnus-list-of-killed-groups) new-name)
5764         ;; ... and then yanking it.  Magic!
5765         (gnus-group-yank-group)
5766         (gnus-set-active new-name (gnus-active group))
5767         (gnus-message 6 "Renaming group %s to %s...done" group new-name)
5768         new-name)
5769     (gnus-group-position-point)))
5770
5771 (defun gnus-group-edit-group (group &optional part)
5772   "Edit the group on the current line."
5773   (interactive (list (gnus-group-group-name)))
5774   (let* ((part (or part 'info))
5775          (done-func `(lambda ()
5776                        "Exit editing mode and update the information."
5777                        (interactive)
5778                        (gnus-group-edit-group-done ',part ,group)))
5779          (winconf (current-window-configuration))
5780          info)
5781     (or group (error "No group on current line"))
5782     (or (setq info (gnus-get-info group))
5783         (error "Killed group; can't be edited"))
5784     (set-buffer (setq gnus-group-edit-buffer 
5785                       (get-buffer-create
5786                        (format "*Gnus edit %s*" group))))
5787     (gnus-configure-windows 'edit-group)
5788     (gnus-add-current-to-buffer-list)
5789     (emacs-lisp-mode)
5790     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
5791     (use-local-map (copy-keymap emacs-lisp-mode-map))
5792     (local-set-key "\C-c\C-c" done-func)
5793     (make-local-variable 'gnus-prev-winconf)
5794     (setq gnus-prev-winconf winconf)
5795     (erase-buffer)
5796     (insert
5797      (cond
5798       ((eq part 'method)
5799        ";; Type `C-c C-c' after editing the select method.\n\n")
5800       ((eq part 'params)
5801        ";; Type `C-c C-c' after editing the group parameters.\n\n")
5802       ((eq part 'info)
5803        ";; Type `C-c C-c' after editing the group info.\n\n")))
5804     (insert
5805      (pp-to-string
5806       (cond ((eq part 'method)
5807              (or (gnus-info-method info) "native"))
5808             ((eq part 'params)
5809              (gnus-info-params info))
5810             (t info)))
5811      "\n")))
5812
5813 (defun gnus-group-edit-group-method (group)
5814   "Edit the select method of GROUP."
5815   (interactive (list (gnus-group-group-name)))
5816   (gnus-group-edit-group group 'method))
5817
5818 (defun gnus-group-edit-group-parameters (group)
5819   "Edit the group parameters of GROUP."
5820   (interactive (list (gnus-group-group-name)))
5821   (gnus-group-edit-group group 'params))
5822
5823 (defun gnus-group-edit-group-done (part group)
5824   "Get info from buffer, update variables and jump to the group buffer."
5825   (when (and gnus-group-edit-buffer
5826              (buffer-name gnus-group-edit-buffer))
5827     (set-buffer gnus-group-edit-buffer)
5828     (goto-char (point-min))
5829     (let* ((form (read (current-buffer)))
5830            (winconf gnus-prev-winconf)
5831            (method (cond ((eq part 'info) (nth 4 form))
5832                          ((eq part 'method) form)
5833                          (t nil)))
5834            (info (cond ((eq part 'info) form)
5835                        ((eq part 'method) (gnus-get-info group))
5836                        (t nil)))
5837            (new-group (if info
5838                           (if (or (not method)
5839                                   (gnus-server-equal
5840                                    gnus-select-method method))
5841                               (gnus-group-real-name (car info))
5842                             (gnus-group-prefixed-name
5843                              (gnus-group-real-name (car info)) method))
5844                         nil)))
5845       (when (and new-group
5846                  (not (equal new-group group)))
5847         (when (gnus-group-goto-group group)
5848           (gnus-group-kill-group 1))
5849         (gnus-activate-group new-group))
5850       ;; Set the info.
5851       (if (and info new-group)
5852           (progn
5853             (setq info (gnus-copy-sequence info))
5854             (setcar info new-group)
5855             (unless (gnus-server-equal method "native")
5856               (unless (nthcdr 3 info)
5857                 (nconc info (list nil nil)))
5858               (unless (nthcdr 4 info)
5859                 (nconc info (list nil)))
5860               (gnus-info-set-method info method))
5861             (gnus-group-set-info info))
5862         (gnus-group-set-info form (or new-group group) part))
5863       (kill-buffer (current-buffer))
5864       (and winconf (set-window-configuration winconf))
5865       (set-buffer gnus-group-buffer)
5866       (gnus-group-update-group (or new-group group))
5867       (gnus-group-position-point))))
5868
5869 (defun gnus-group-make-help-group ()
5870   "Create the Gnus documentation group."
5871   (interactive)
5872   (let ((path load-path)
5873         (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
5874         file dir)
5875     (and (gnus-gethash name gnus-newsrc-hashtb)
5876          (error "Documentation group already exists"))
5877     (while path
5878       (setq dir (file-name-as-directory (expand-file-name (pop path)))
5879             file nil)
5880       (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt")))
5881                 (file-exists-p
5882                  (setq file (concat (file-name-directory
5883                                      (directory-file-name dir))
5884                                     "etc/gnus-tut.txt"))))
5885         (setq path nil)))
5886     (if (not file)
5887         (gnus-message 1 "Couldn't find doc group")
5888       (gnus-group-make-group
5889        (gnus-group-real-name name)
5890        (list 'nndoc "gnus-help"
5891              (list 'nndoc-address file)
5892              (list 'nndoc-article-type 'mbox)))))
5893   (gnus-group-position-point))
5894
5895 (defun gnus-group-make-doc-group (file type)
5896   "Create a group that uses a single file as the source."
5897   (interactive
5898    (list (read-file-name "File name: ")
5899          (and current-prefix-arg 'ask)))
5900   (when (eq type 'ask)
5901     (let ((err "")
5902           char found)
5903       (while (not found)
5904         (message
5905          "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
5906          err)
5907         (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
5908                           ((= char ?b) 'babyl)
5909                           ((= char ?d) 'digest)
5910                           ((= char ?f) 'forward)
5911                           ((= char ?a) 'mmfd)
5912                           (t (setq err (format "%c unknown. " char))
5913                              nil))))
5914       (setq type found)))
5915   (let* ((file (expand-file-name file))
5916          (name (gnus-generate-new-group-name
5917                 (gnus-group-prefixed-name
5918                  (file-name-nondirectory file) '(nndoc "")))))
5919     (gnus-group-make-group
5920      (gnus-group-real-name name)
5921      (list 'nndoc (file-name-nondirectory file)
5922            (list 'nndoc-address file)
5923            (list 'nndoc-article-type (or type 'guess))))))
5924
5925 (defun gnus-group-make-archive-group (&optional all)
5926   "Create the (ding) Gnus archive group of the most recent articles.
5927 Given a prefix, create a full group."
5928   (interactive "P")
5929   (let ((group (gnus-group-prefixed-name
5930                 (if all "ding.archives" "ding.recent") '(nndir ""))))
5931     (when (gnus-gethash group gnus-newsrc-hashtb)
5932       (error "Archive group already exists"))
5933     (gnus-group-make-group
5934      (gnus-group-real-name group)
5935      (list 'nndir (if all "hpc" "edu")
5936            (list 'nndir-directory
5937                  (if all gnus-group-archive-directory
5938                    gnus-group-recent-archive-directory))))
5939     (gnus-group-add-parameter group (cons 'to-address "ding@ifi.uio.no"))))
5940
5941 (defun gnus-group-make-directory-group (dir)
5942   "Create an nndir group.
5943 The user will be prompted for a directory.  The contents of this
5944 directory will be used as a newsgroup.  The directory should contain
5945 mail messages or news articles in files that have numeric names."
5946   (interactive
5947    (list (read-file-name "Create group from directory: ")))
5948   (or (file-exists-p dir) (error "No such directory"))
5949   (or (file-directory-p dir) (error "Not a directory"))
5950   (let ((ext "")
5951         (i 0)
5952         group)
5953     (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
5954       (setq group
5955             (gnus-group-prefixed-name
5956              (concat (file-name-as-directory (directory-file-name dir))
5957                      ext)
5958              '(nndir "")))
5959       (setq ext (format "<%d>" (setq i (1+ i)))))
5960     (gnus-group-make-group
5961      (gnus-group-real-name group)
5962      (list 'nndir group (list 'nndir-directory dir)))))
5963
5964 (defun gnus-group-make-kiboze-group (group address scores)
5965   "Create an nnkiboze group.
5966 The user will be prompted for a name, a regexp to match groups, and
5967 score file entries for articles to include in the group."
5968   (interactive
5969    (list
5970     (read-string "nnkiboze group name: ")
5971     (read-string "Source groups (regexp): ")
5972     (let ((headers (mapcar (lambda (group) (list group))
5973                            '("subject" "from" "number" "date" "message-id"
5974                              "references" "chars" "lines" "xref"
5975                              "followup" "all" "body" "head")))
5976           scores header regexp regexps)
5977       (while (not (equal "" (setq header (completing-read
5978                                           "Match on header: " headers nil t))))
5979         (setq regexps nil)
5980         (while (not (equal "" (setq regexp (read-string
5981                                             (format "Match on %s (string): "
5982                                                     header)))))
5983           (setq regexps (cons (list regexp nil nil 'r) regexps)))
5984         (setq scores (cons (cons header regexps) scores)))
5985       scores)))
5986   (gnus-group-make-group group "nnkiboze" address)
5987   (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group))
5988     (let (emacs-lisp-mode-hook)
5989       (pp scores (current-buffer)))))
5990
5991 (defun gnus-group-add-to-virtual (n vgroup)
5992   "Add the current group to a virtual group."
5993   (interactive
5994    (list current-prefix-arg
5995          (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
5996                           "nnvirtual:")))
5997   (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
5998       (error "%s is not an nnvirtual group" vgroup))
5999   (let* ((groups (gnus-group-process-prefix n))
6000          (method (gnus-info-method (gnus-get-info vgroup))))
6001     (setcar (cdr method)
6002             (concat
6003              (nth 1 method) "\\|"
6004              (mapconcat
6005               (lambda (s)
6006                 (gnus-group-remove-mark s)
6007                 (concat "\\(^" (regexp-quote s) "$\\)"))
6008               groups "\\|"))))
6009   (gnus-group-position-point))
6010
6011 (defun gnus-group-make-empty-virtual (group)
6012   "Create a new, fresh, empty virtual group."
6013   (interactive "sCreate new, empty virtual group: ")
6014   (let* ((method (list 'nnvirtual "^$"))
6015          (pgroup (gnus-group-prefixed-name group method)))
6016     ;; Check whether it exists already.
6017     (and (gnus-gethash pgroup gnus-newsrc-hashtb)
6018          (error "Group %s already exists." pgroup))
6019     ;; Subscribe the new group after the group on the current line.
6020     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
6021     (gnus-group-update-group pgroup)
6022     (forward-line -1)
6023     (gnus-group-position-point)))
6024
6025 (defun gnus-group-enter-directory (dir)
6026   "Enter an ephemeral nneething group."
6027   (interactive "DDirectory to read: ")
6028   (let* ((method (list 'nneething dir))
6029          (leaf (gnus-group-prefixed-name
6030                 (file-name-nondirectory (directory-file-name dir))
6031                 method))
6032          (name (gnus-generate-new-group-name leaf)))
6033     (let ((nneething-read-only t))
6034       (or (gnus-group-read-ephemeral-group
6035            name method t
6036            (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
6037                                       'summary 'group)))
6038           (error "Couldn't enter %s" dir)))))
6039
6040 ;; Group sorting commands
6041 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
6042
6043 (defun gnus-group-sort-groups (func &optional reverse)
6044   "Sort the group buffer according to FUNC.
6045 If REVERSE, reverse the sorting order."
6046   (interactive (list gnus-group-sort-function
6047                      current-prefix-arg))
6048   (let ((func (cond 
6049                ((not (listp func)) func)
6050                ((null func) func)
6051                ((= 1 (length func)) (car func))
6052                (t `(lambda (t1 t2)
6053                      ,(gnus-make-sort-function 
6054                        (reverse func)))))))
6055     ;; We peel off the dummy group from the alist.
6056     (when func
6057       (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
6058         (pop gnus-newsrc-alist))
6059       ;; Do the sorting.
6060       (setq gnus-newsrc-alist
6061             (sort gnus-newsrc-alist func))
6062       (when reverse
6063         (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
6064       ;; Regenerate the hash table.
6065       (gnus-make-hashtable-from-newsrc-alist)
6066       (gnus-group-list-groups))))
6067
6068 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
6069   "Sort the group buffer alphabetically by group name.
6070 If REVERSE, sort in reverse order."
6071   (interactive "P")
6072   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
6073
6074 (defun gnus-group-sort-groups-by-unread (&optional reverse)
6075   "Sort the group buffer by number of unread articles.
6076 If REVERSE, sort in reverse order."
6077   (interactive "P")
6078   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
6079
6080 (defun gnus-group-sort-groups-by-level (&optional reverse)
6081   "Sort the group buffer by group level.
6082 If REVERSE, sort in reverse order."
6083   (interactive "P")
6084   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
6085
6086 (defun gnus-group-sort-groups-by-score (&optional reverse)
6087   "Sort the group buffer by group score.
6088 If REVERSE, sort in reverse order."
6089   (interactive "P")
6090   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
6091
6092 (defun gnus-group-sort-groups-by-rank (&optional reverse)
6093   "Sort the group buffer by group rank.
6094 If REVERSE, sort in reverse order."
6095   (interactive "P")
6096   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
6097
6098 (defun gnus-group-sort-groups-by-method (&optional reverse)
6099   "Sort the group buffer alphabetically by backend name.
6100 If REVERSE, sort in reverse order."
6101   (interactive "P")
6102   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
6103
6104 (defun gnus-group-sort-by-alphabet (info1 info2)
6105   "Sort alphabetically."
6106   (string< (gnus-info-group info1) (gnus-info-group info2)))
6107
6108 (defun gnus-group-sort-by-unread (info1 info2)
6109   "Sort by number of unread articles."
6110   (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
6111         (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
6112     (< (or (and (numberp n1) n1) 0)
6113        (or (and (numberp n2) n2) 0))))
6114
6115 (defun gnus-group-sort-by-level (info1 info2)
6116   "Sort by level."
6117   (< (gnus-info-level info1) (gnus-info-level info2)))
6118
6119 (defun gnus-group-sort-by-method (info1 info2)
6120   "Sort alphabetically by backend name."
6121   (string< (symbol-name (car (gnus-find-method-for-group
6122                               (gnus-info-group info1) info1)))
6123            (symbol-name (car (gnus-find-method-for-group
6124                               (gnus-info-group info2) info2)))))
6125
6126 (defun gnus-group-sort-by-score (info1 info2)
6127   "Sort by group score."
6128   (< (gnus-info-score info1) (gnus-info-score info2)))
6129
6130 (defun gnus-group-sort-by-rank (info1 info2)
6131   "Sort by level and score."
6132   (let ((level1 (gnus-info-level info1))
6133         (level2 (gnus-info-level info2)))
6134     (or (< level1 level2)
6135         (and (= level1 level2)
6136              (> (gnus-info-score info1) (gnus-info-score info2))))))
6137
6138 ;; Group catching up.
6139
6140 (defun gnus-group-clear-data (n)
6141   "Clear all marks and read ranges from the current group."
6142   (interactive "P")
6143   (let ((groups (gnus-group-process-prefix n))
6144         group info)
6145     (while (setq group (pop groups))
6146       (setq info (gnus-get-info group))
6147       (gnus-info-set-read info nil)
6148       (when (gnus-info-marks info)
6149         (gnus-info-set-marks info nil))
6150       (gnus-get-unread-articles-in-group info (gnus-active group) t)
6151       (when (gnus-group-goto-group group)
6152         (gnus-group-remove-mark group)
6153         (gnus-group-update-group-line)))))
6154
6155 (defun gnus-group-catchup-current (&optional n all)
6156   "Mark all articles not marked as unread in current newsgroup as read.
6157 If prefix argument N is numeric, the ARG next newsgroups will be
6158 caught up.  If ALL is non-nil, marked articles will also be marked as
6159 read.  Cross references (Xref: header) of articles are ignored.
6160 The difference between N and actual number of newsgroups that were
6161 caught up is returned."
6162   (interactive "P")
6163   (unless (gnus-group-group-name)
6164     (error "No group on the current line"))
6165   (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
6166                gnus-expert-user
6167                (gnus-y-or-n-p
6168                 (if all
6169                     "Do you really want to mark all articles as read? "
6170                   "Mark all unread articles as read? "))))
6171       n
6172     (let ((groups (gnus-group-process-prefix n))
6173           (ret 0))
6174       (while groups
6175         ;; Virtual groups have to be given special treatment.
6176         (let ((method (gnus-find-method-for-group (car groups))))
6177           (if (eq 'nnvirtual (car method))
6178               (nnvirtual-catchup-group
6179                (gnus-group-real-name (car groups)) (nth 1 method) all)))
6180         (gnus-group-remove-mark (car groups))
6181         (if (>= (gnus-group-group-level) gnus-level-zombie)
6182             (gnus-message 2 "Dead groups can't be caught up")
6183           (if (prog1
6184                   (gnus-group-goto-group (car groups))
6185                 (gnus-group-catchup (car groups) all))
6186               (gnus-group-update-group-line)
6187             (setq ret (1+ ret))))
6188         (setq groups (cdr groups)))
6189       (gnus-group-next-unread-group 1)
6190       ret)))
6191
6192 (defun gnus-group-catchup-current-all (&optional n)
6193   "Mark all articles in current newsgroup as read.
6194 Cross references (Xref: header) of articles are ignored."
6195   (interactive "P")
6196   (gnus-group-catchup-current n 'all))
6197
6198 (defun gnus-group-catchup (group &optional all)
6199   "Mark all articles in GROUP as read.
6200 If ALL is non-nil, all articles are marked as read.
6201 The return value is the number of articles that were marked as read,
6202 or nil if no action could be taken."
6203   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
6204          (num (car entry)))
6205     ;; Do the updating only if the newsgroup isn't killed.
6206     (if (not (numberp (car entry)))
6207         (gnus-message 1 "Can't catch up; non-active group")
6208       ;; Do auto-expirable marks if that's required.
6209       (when (gnus-group-auto-expirable-p group)
6210         (gnus-add-marked-articles
6211          group 'expire (gnus-list-of-unread-articles group))
6212         (when all
6213           (let ((marks (nth 3 (nth 2 entry))))
6214             (gnus-add-marked-articles
6215              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
6216             (gnus-add-marked-articles
6217              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
6218       (when entry
6219         (gnus-update-read-articles group nil)
6220         ;; Also nix out the lists of marks and dormants.
6221         (when all
6222           (gnus-add-marked-articles group 'tick nil nil 'force)
6223           (gnus-add-marked-articles group 'dormant nil nil 'force))
6224         (run-hooks 'gnus-group-catchup-group-hook)
6225         num))))
6226
6227 (defun gnus-group-expire-articles (&optional n)
6228   "Expire all expirable articles in the current newsgroup."
6229   (interactive "P")
6230   (let ((groups (gnus-group-process-prefix n))
6231         group)
6232     (unless groups
6233       (error "No groups to expire"))
6234     (while (setq group (pop groups))
6235       (gnus-group-remove-mark group)
6236       (when (gnus-check-backend-function 'request-expire-articles group)
6237         (gnus-message 6 "Expiring articles in %s..." group)
6238         (let* ((info (gnus-get-info group))
6239                (expirable (if (gnus-group-total-expirable-p group)
6240                               (cons nil (gnus-list-of-read-articles group))
6241                             (assq 'expire (gnus-info-marks info))))
6242                (expiry-wait (gnus-group-get-parameter group 'expiry-wait)))
6243           (when expirable
6244             (setcdr
6245              expirable
6246              (gnus-compress-sequence
6247               (if expiry-wait
6248                   ;; We set the expiry variables to the groupp
6249                   ;; parameter. 
6250                   (let ((nnmail-expiry-wait-function nil)
6251                         (nnmail-expiry-wait expiry-wait))
6252                     (gnus-request-expire-articles
6253                      (gnus-uncompress-sequence (cdr expirable)) group))
6254                 ;; Just expire using the normal expiry values.
6255                 (gnus-request-expire-articles
6256                  (gnus-uncompress-sequence (cdr expirable)) group))))
6257             (gnus-close-group group))
6258           (gnus-message 6 "Expiring articles in %s...done" group)))
6259       (gnus-group-position-point))))
6260
6261 (defun gnus-group-expire-all-groups ()
6262   "Expire all expirable articles in all newsgroups."
6263   (interactive)
6264   (save-excursion
6265     (gnus-message 5 "Expiring...")
6266     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
6267                                      (cdr gnus-newsrc-alist))))
6268       (gnus-group-expire-articles nil)))
6269   (gnus-group-position-point)
6270   (gnus-message 5 "Expiring...done"))
6271
6272 (defun gnus-group-set-current-level (n level)
6273   "Set the level of the next N groups to LEVEL."
6274   (interactive
6275    (list
6276     current-prefix-arg
6277     (string-to-int
6278      (let ((s (read-string
6279                (format "Level (default %s): "
6280                        (or (gnus-group-group-level) 
6281                            gnus-level-default-subscribed)))))
6282        (if (string-match "^\\s-*$" s)
6283            (int-to-string (or (gnus-group-group-level) 
6284                               gnus-level-default-subscribed))
6285          s)))))
6286   (or (and (>= level 1) (<= level gnus-level-killed))
6287       (error "Illegal level: %d" level))
6288   (let ((groups (gnus-group-process-prefix n))
6289         group)
6290     (while (setq group (pop groups))
6291       (gnus-group-remove-mark group)
6292       (gnus-message 6 "Changed level of %s from %d to %d"
6293                     group (or (gnus-group-group-level) gnus-level-killed)
6294                     level)
6295       (gnus-group-change-level
6296        group level (or (gnus-group-group-level) gnus-level-killed))
6297       (gnus-group-update-group-line)))
6298   (gnus-group-position-point))
6299
6300 (defun gnus-group-unsubscribe-current-group (&optional n)
6301   "Toggle subscription of the current group.
6302 If given numerical prefix, toggle the N next groups."
6303   (interactive "P")
6304   (let ((groups (gnus-group-process-prefix n))
6305         group)
6306     (while groups
6307       (setq group (car groups)
6308             groups (cdr groups))
6309       (gnus-group-remove-mark group)
6310       (gnus-group-unsubscribe-group
6311        group (if (<= (gnus-group-group-level) gnus-level-subscribed)
6312                  gnus-level-default-unsubscribed
6313                gnus-level-default-subscribed) t)
6314       (gnus-group-update-group-line))
6315     (gnus-group-next-group 1)))
6316
6317 (defun gnus-group-unsubscribe-group (group &optional level silent)
6318   "Toggle subscription to GROUP.
6319 Killed newsgroups are subscribed.  If SILENT, don't try to update the
6320 group line."
6321   (interactive
6322    (list (completing-read
6323           "Group: " gnus-active-hashtb nil
6324           (gnus-read-active-file-p)
6325           nil 
6326           'gnus-group-history)))
6327   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
6328     (cond
6329      ((string-match "^[ \t]$" group)
6330       (error "Empty group name"))
6331      (newsrc
6332       ;; Toggle subscription flag.
6333       (gnus-group-change-level
6334        newsrc (if level level (if (<= (nth 1 (nth 2 newsrc))
6335                                       gnus-level-subscribed)
6336                                   (1+ gnus-level-subscribed)
6337                                 gnus-level-default-subscribed)))
6338       (unless silent
6339         (gnus-group-update-group group)))
6340      ((and (stringp group)
6341            (or (not (gnus-read-active-file-p))
6342                (gnus-active group)))
6343       ;; Add new newsgroup.
6344       (gnus-group-change-level
6345        group
6346        (if level level gnus-level-default-subscribed)
6347        (or (and (member group gnus-zombie-list)
6348                 gnus-level-zombie)
6349            gnus-level-killed)
6350        (and (gnus-group-group-name)
6351             (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
6352       (unless silent
6353         (gnus-group-update-group group)))
6354      (t (error "No such newsgroup: %s" group)))
6355     (gnus-group-position-point)))
6356
6357 (defun gnus-group-transpose-groups (n)
6358   "Move the current newsgroup up N places.
6359 If given a negative prefix, move down instead.  The difference between
6360 N and the number of steps taken is returned."
6361   (interactive "p")
6362   (or (gnus-group-group-name)
6363       (error "No group on current line"))
6364   (gnus-group-kill-group 1)
6365   (prog1
6366       (forward-line (- n))
6367     (gnus-group-yank-group)
6368     (gnus-group-position-point)))
6369
6370 (defun gnus-group-kill-all-zombies ()
6371   "Kill all zombie newsgroups."
6372   (interactive)
6373   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
6374   (setq gnus-zombie-list nil)
6375   (gnus-group-list-groups))
6376
6377 (defun gnus-group-kill-region (begin end)
6378   "Kill newsgroups in current region (excluding current point).
6379 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
6380   (interactive "r")
6381   (let ((lines
6382          ;; Count lines.
6383          (save-excursion
6384            (count-lines
6385             (progn
6386               (goto-char begin)
6387               (beginning-of-line)
6388               (point))
6389             (progn
6390               (goto-char end)
6391               (beginning-of-line)
6392               (point))))))
6393     (goto-char begin)
6394     (beginning-of-line)                 ;Important when LINES < 1
6395     (gnus-group-kill-group lines)))
6396
6397 (defun gnus-group-kill-group (&optional n discard)
6398   "Kill the next N groups.
6399 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
6400 However, only groups that were alive can be yanked; already killed
6401 groups or zombie groups can't be yanked.
6402 The return value is the name of the group that was killed, or a list
6403 of groups killed."
6404   (interactive "P")
6405   (let ((buffer-read-only nil)
6406         (groups (gnus-group-process-prefix n))
6407         group entry level out)
6408     (if (< (length groups) 10)
6409         ;; This is faster when there are few groups.
6410         (while groups
6411           (push (setq group (pop groups)) out)
6412           (gnus-group-remove-mark group)
6413           (setq level (gnus-group-group-level))
6414           (gnus-delete-line)
6415           (when (and (not discard)
6416                      (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
6417             (push (cons (car entry) (nth 2 entry))
6418                   gnus-list-of-killed-groups))
6419           (gnus-group-change-level
6420            (if entry entry group) gnus-level-killed (if entry nil level)))
6421       ;; If there are lots and lots of groups to be killed, we use
6422       ;; this thing instead.
6423       (let (entry)
6424         (setq groups (nreverse groups))
6425         (while groups
6426           (gnus-group-remove-mark (setq group (pop groups)))
6427           (gnus-delete-line)
6428           (push group gnus-killed-list)
6429           (setq gnus-newsrc-alist
6430                 (delq (assoc group gnus-newsrc-alist)
6431                       gnus-newsrc-alist))
6432           (when gnus-group-change-level-function
6433             (funcall gnus-group-change-level-function group 9 3))
6434           (cond
6435            ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
6436             (push (cons (car entry) (nth 2 entry))
6437                   gnus-list-of-killed-groups)
6438             (setcdr (cdr entry) (cdddr entry)))
6439            ((member group gnus-zombie-list)
6440             (setq gnus-zombie-list (delete group gnus-zombie-list)))))
6441         (gnus-make-hashtable-from-newsrc-alist)))
6442
6443     (gnus-group-position-point)
6444     (if (< (length out) 2) (car out) (nreverse out))))
6445
6446 (defun gnus-group-yank-group (&optional arg)
6447   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
6448 inserting it before the current newsgroup.  The numeric ARG specifies
6449 how many newsgroups are to be yanked.  The name of the newsgroup yanked
6450 is returned, or (if several groups are yanked) a list of yanked groups
6451 is returned."
6452   (interactive "p")
6453   (setq arg (or arg 1))
6454   (let (info group prev out)
6455     (while (>= (decf arg) 0)
6456       (if (not (setq info (pop gnus-list-of-killed-groups)))
6457           (error "No more newsgroups to yank"))
6458       (push (setq group (nth 1 info)) out)
6459       ;; Find which newsgroup to insert this one before - search
6460       ;; backward until something suitable is found.  If there are no
6461       ;; other newsgroups in this buffer, just make this newsgroup the
6462       ;; first newsgroup.
6463       (setq prev (gnus-group-group-name))
6464       (gnus-group-change-level
6465        info (gnus-info-level (cdr info)) gnus-level-killed
6466        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
6467        t)
6468       (gnus-group-insert-group-line-info group))
6469     (forward-line -1)
6470     (gnus-group-position-point)
6471     (if (< (length out) 2) (car out) (nreverse out))))
6472
6473 (defun gnus-group-kill-level (level)
6474   "Kill all groups that is on a certain LEVEL."
6475   (interactive "nKill all groups on level: ")
6476   (cond
6477    ((= level gnus-level-zombie)
6478     (setq gnus-killed-list
6479           (nconc gnus-zombie-list gnus-killed-list))
6480     (setq gnus-zombie-list nil))
6481    ((and (< level gnus-level-zombie)
6482          (> level 0)
6483          (or gnus-expert-user
6484              (gnus-yes-or-no-p
6485               (format
6486                "Do you really want to kill all groups on level %d? "
6487                level))))
6488     (let* ((prev gnus-newsrc-alist)
6489            (alist (cdr prev)))
6490       (while alist
6491         (if (= (gnus-info-level (car alist)) level)
6492             (progn
6493               (push (gnus-info-group (car alist)) gnus-killed-list)
6494               (setcdr prev (cdr alist)))
6495           (setq prev alist))
6496         (setq alist (cdr alist)))
6497       (gnus-make-hashtable-from-newsrc-alist)
6498       (gnus-group-list-groups)))
6499    (t
6500     (error "Can't kill; illegal level: %d" level))))
6501
6502 (defun gnus-group-list-all-groups (&optional arg)
6503   "List all newsgroups with level ARG or lower.
6504 Default is gnus-level-unsubscribed, which lists all subscribed and most
6505 unsubscribed groups."
6506   (interactive "P")
6507   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
6508
6509 ;; Redefine this to list ALL killed groups if prefix arg used.
6510 ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
6511 (defun gnus-group-list-killed (&optional arg)
6512   "List all killed newsgroups in the group buffer.
6513 If ARG is non-nil, list ALL killed groups known to Gnus.  This may
6514 entail asking the server for the groups."
6515   (interactive "P")
6516   ;; Find all possible killed newsgroups if arg.
6517   (when arg
6518     (gnus-get-killed-groups))
6519   (if (not gnus-killed-list)
6520       (gnus-message 6 "No killed groups")
6521     (let (gnus-group-list-mode)
6522       (funcall gnus-group-prepare-function
6523                gnus-level-killed t gnus-level-killed))
6524     (goto-char (point-min)))
6525   (gnus-group-position-point))
6526
6527 (defun gnus-group-list-zombies ()
6528   "List all zombie newsgroups in the group buffer."
6529   (interactive)
6530   (if (not gnus-zombie-list)
6531       (gnus-message 6 "No zombie groups")
6532     (let (gnus-group-list-mode)
6533       (funcall gnus-group-prepare-function
6534                gnus-level-zombie t gnus-level-zombie))
6535     (goto-char (point-min)))
6536   (gnus-group-position-point))
6537
6538 (defun gnus-group-list-active ()
6539   "List all groups that are available from the server(s)."
6540   (interactive)
6541   ;; First we make sure that we have really read the active file.
6542   (unless (gnus-read-active-file-p)
6543     (let ((gnus-read-active-file t))
6544       (gnus-read-active-file)))
6545   ;; Find all groups and sort them.
6546   (let ((groups
6547          (sort
6548           (let (list)
6549             (mapatoms
6550              (lambda (sym)
6551                (and (boundp sym)
6552                     (symbol-value sym)
6553                     (setq list (cons (symbol-name sym) list))))
6554              gnus-active-hashtb)
6555             list)
6556           'string<))
6557         (buffer-read-only nil))
6558     (erase-buffer)
6559     (while groups
6560       (gnus-group-insert-group-line-info (pop groups)))
6561     (goto-char (point-min))))
6562
6563 (defun gnus-activate-all-groups (level)
6564   "Activate absolutely all groups."
6565   (interactive (list 7))
6566   (let ((gnus-activate-level level)
6567         (gnus-activate-foreign-newsgroups level))
6568     (gnus-group-get-new-news)))
6569
6570 (defun gnus-group-get-new-news (&optional arg)
6571   "Get newly arrived articles.
6572 If ARG is a number, it specifies which levels you are interested in
6573 re-scanning.  If ARG is non-nil and not a number, this will force
6574 \"hard\" re-reading of the active files from all servers."
6575   (interactive "P")
6576   (run-hooks 'gnus-get-new-news-hook)
6577   ;; We might read in new NoCeM messages here.
6578   (when (and gnus-use-nocem 
6579              (null arg))
6580     (gnus-nocem-scan-groups))
6581   ;; If ARG is not a number, then we read the active file.
6582   (when (and arg (not (numberp arg)))
6583     (let ((gnus-read-active-file t))
6584       (gnus-read-active-file))
6585     (setq arg nil))
6586
6587   (setq arg (gnus-group-default-level arg t))
6588   (if (and gnus-read-active-file (not arg))
6589       (progn
6590         (gnus-read-active-file)
6591         (gnus-get-unread-articles arg))
6592     (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
6593       (gnus-get-unread-articles arg)))
6594   (run-hooks 'gnus-after-getting-new-news-hook)
6595   (gnus-group-list-groups))
6596
6597 (defun gnus-group-get-new-news-this-group (&optional n)
6598   "Check for newly arrived news in the current group (and the N-1 next groups).
6599 The difference between N and the number of newsgroup checked is returned.
6600 If N is negative, this group and the N-1 previous groups will be checked."
6601   (interactive "P")
6602   (let* ((groups (gnus-group-process-prefix n))
6603          (ret (if (numberp n) (- n (length groups)) 0))
6604          (beg (unless n (point)))
6605          group)
6606     (while (setq group (pop groups))
6607       (gnus-group-remove-mark group)
6608       (if (gnus-activate-group group 'scan)
6609           (progn
6610             (gnus-get-unread-articles-in-group
6611              (gnus-get-info group) (gnus-active group) t)
6612             (unless (gnus-virtual-group-p group)
6613               (gnus-close-group group))
6614             (gnus-group-update-group group))
6615         (if (eq (gnus-server-status (gnus-find-method-for-group group))
6616                 'denied)
6617             (gnus-error "Server denied access")
6618           (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
6619     (when beg (goto-char beg))
6620     (when gnus-goto-next-group-when-activating
6621       (gnus-group-next-unread-group 1 t))
6622     (gnus-summary-position-point)
6623     ret))
6624
6625 (defun gnus-group-fetch-faq (group &optional faq-dir)
6626   "Fetch the FAQ for the current group."
6627   (interactive
6628    (list
6629     (and (gnus-group-group-name)
6630          (gnus-group-real-name (gnus-group-group-name)))
6631     (cond (current-prefix-arg
6632            (completing-read
6633             "Faq dir: " (and (listp gnus-group-faq-directory)
6634                              (mapcar (lambda (file) (list file))
6635                                      gnus-group-faq-directory)))))))
6636   (or faq-dir
6637       (setq faq-dir (if (listp gnus-group-faq-directory)
6638                         (car gnus-group-faq-directory)
6639                       gnus-group-faq-directory)))
6640   (or group (error "No group name given"))
6641   (let ((file (concat (file-name-as-directory faq-dir)
6642                       (gnus-group-real-name group))))
6643     (if (not (file-exists-p file))
6644         (error "No such file: %s" file)
6645       (find-file file))))
6646
6647 (defun gnus-group-describe-group (force &optional group)
6648   "Display a description of the current newsgroup."
6649   (interactive (list current-prefix-arg (gnus-group-group-name)))
6650   (let* ((method (gnus-find-method-for-group group))
6651          (mname (gnus-group-prefixed-name "" method))
6652          desc)
6653     (when (and force
6654                gnus-description-hashtb)
6655       (gnus-sethash mname nil gnus-description-hashtb))
6656     (or group (error "No group name given"))
6657     (and (or (and gnus-description-hashtb
6658                   ;; We check whether this group's method has been
6659                   ;; queried for a description file.
6660                   (gnus-gethash mname gnus-description-hashtb))
6661              (setq desc (gnus-group-get-description group))
6662              (gnus-read-descriptions-file method))
6663          (gnus-message 1
6664           (or desc (gnus-gethash group gnus-description-hashtb)
6665               "No description available")))))
6666
6667 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6668 (defun gnus-group-describe-all-groups (&optional force)
6669   "Pop up a buffer with descriptions of all newsgroups."
6670   (interactive "P")
6671   (and force (setq gnus-description-hashtb nil))
6672   (if (not (or gnus-description-hashtb
6673                (gnus-read-all-descriptions-files)))
6674       (error "Couldn't request descriptions file"))
6675   (let ((buffer-read-only nil)
6676         b)
6677     (erase-buffer)
6678     (mapatoms
6679      (lambda (group)
6680        (setq b (point))
6681        (insert (format "      *: %-20s %s\n" (symbol-name group)
6682                        (symbol-value group)))
6683        (gnus-add-text-properties
6684         b (1+ b) (list 'gnus-group group
6685                        'gnus-unread t 'gnus-marked nil
6686                        'gnus-level (1+ gnus-level-subscribed))))
6687      gnus-description-hashtb)
6688     (goto-char (point-min))
6689     (gnus-group-position-point)))
6690
6691 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
6692 (defun gnus-group-apropos (regexp &optional search-description)
6693   "List all newsgroups that have names that match a regexp."
6694   (interactive "sGnus apropos (regexp): ")
6695   (let ((prev "")
6696         (obuf (current-buffer))
6697         groups des)
6698     ;; Go through all newsgroups that are known to Gnus.
6699     (mapatoms
6700      (lambda (group)
6701        (and (symbol-name group)
6702             (string-match regexp (symbol-name group))
6703             (setq groups (cons (symbol-name group) groups))))
6704      gnus-active-hashtb)
6705     ;; Also go through all descriptions that are known to Gnus.
6706     (when search-description
6707       (mapatoms
6708        (lambda (group)
6709          (and (string-match regexp (symbol-value group))
6710               (gnus-active (symbol-name group))
6711               (setq groups (cons (symbol-name group) groups))))
6712        gnus-description-hashtb))
6713     (if (not groups)
6714         (gnus-message 3 "No groups matched \"%s\"." regexp)
6715       ;; Print out all the groups.
6716       (save-excursion
6717         (pop-to-buffer "*Gnus Help*")
6718         (buffer-disable-undo (current-buffer))
6719         (erase-buffer)
6720         (setq groups (sort groups 'string<))
6721         (while groups
6722           ;; Groups may be entered twice into the list of groups.
6723           (if (not (string= (car groups) prev))
6724               (progn
6725                 (insert (setq prev (car groups)) "\n")
6726                 (if (and gnus-description-hashtb
6727                          (setq des (gnus-gethash (car groups)
6728                                                  gnus-description-hashtb)))
6729                     (insert "  " des "\n"))))
6730           (setq groups (cdr groups)))
6731         (goto-char (point-min))))
6732     (pop-to-buffer obuf)))
6733
6734 (defun gnus-group-description-apropos (regexp)
6735   "List all newsgroups that have names or descriptions that match a regexp."
6736   (interactive "sGnus description apropos (regexp): ")
6737   (if (not (or gnus-description-hashtb
6738                (gnus-read-all-descriptions-files)))
6739       (error "Couldn't request descriptions file"))
6740   (gnus-group-apropos regexp t))
6741
6742 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6743 (defun gnus-group-list-matching (level regexp &optional all lowest)
6744   "List all groups with unread articles that match REGEXP.
6745 If the prefix LEVEL is non-nil, it should be a number that says which
6746 level to cut off listing groups.
6747 If ALL, also list groups with no unread articles.
6748 If LOWEST, don't list groups with level lower than LOWEST.
6749
6750 This command may read the active file."
6751   (interactive "P\nsList newsgroups matching: ")
6752   ;; First make sure active file has been read.
6753   (when (and level
6754              (> (prefix-numeric-value level) gnus-level-killed))
6755     (gnus-get-killed-groups))
6756   (gnus-group-prepare-flat (or level gnus-level-subscribed)
6757                            all (or lowest 1) regexp)
6758   (goto-char (point-min))
6759   (gnus-group-position-point))
6760
6761 (defun gnus-group-list-all-matching (level regexp &optional lowest)
6762   "List all groups that match REGEXP.
6763 If the prefix LEVEL is non-nil, it should be a number that says which
6764 level to cut off listing groups.
6765 If LOWEST, don't list groups with level lower than LOWEST."
6766   (interactive "P\nsList newsgroups matching: ")
6767   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
6768
6769 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
6770 (defun gnus-group-save-newsrc (&optional force)
6771   "Save the Gnus startup files.
6772 If FORCE, force saving whether it is necessary or not."
6773   (interactive "P")
6774   (gnus-save-newsrc-file force))
6775
6776 (defun gnus-group-restart (&optional arg)
6777   "Force Gnus to read the .newsrc file."
6778   (interactive "P")
6779   (when (gnus-yes-or-no-p
6780          (format "Are you sure you want to read %s? "
6781                  gnus-current-startup-file))
6782     (gnus-save-newsrc-file)
6783     (gnus-setup-news 'force)
6784     (gnus-group-list-groups arg)))
6785
6786 (defun gnus-group-read-init-file ()
6787   "Read the Gnus elisp init file."
6788   (interactive)
6789   (gnus-read-init-file))
6790
6791 (defun gnus-group-check-bogus-groups (&optional silent)
6792   "Check bogus newsgroups.
6793 If given a prefix, don't ask for confirmation before removing a bogus
6794 group."
6795   (interactive "P")
6796   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
6797   (gnus-group-list-groups))
6798
6799 (defun gnus-group-edit-global-kill (&optional article group)
6800   "Edit the global kill file.
6801 If GROUP, edit that local kill file instead."
6802   (interactive "P")
6803   (setq gnus-current-kill-article article)
6804   (gnus-kill-file-edit-file group)
6805   (gnus-message
6806    6
6807    (substitute-command-keys
6808     (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
6809             (if group "local" "global")))))
6810
6811 (defun gnus-group-edit-local-kill (article group)
6812   "Edit a local kill file."
6813   (interactive (list nil (gnus-group-group-name)))
6814   (gnus-group-edit-global-kill article group))
6815
6816 (defun gnus-group-force-update ()
6817   "Update `.newsrc' file."
6818   (interactive)
6819   (gnus-save-newsrc-file))
6820
6821 (defun gnus-group-suspend ()
6822   "Suspend the current Gnus session.
6823 In fact, cleanup buffers except for group mode buffer.
6824 The hook gnus-suspend-gnus-hook is called before actually suspending."
6825   (interactive)
6826   (run-hooks 'gnus-suspend-gnus-hook)
6827   ;; Kill Gnus buffers except for group mode buffer.
6828   (let* ((group-buf (get-buffer gnus-group-buffer))
6829          ;; Do this on a separate list in case the user does a ^G before we finish
6830          (gnus-buffer-list
6831           (delete group-buf (delete gnus-dribble-buffer
6832                                     (append gnus-buffer-list nil)))))
6833     (while gnus-buffer-list
6834       (gnus-kill-buffer (pop gnus-buffer-list)))
6835     (gnus-kill-gnus-frames)
6836     (when group-buf
6837       (setq gnus-buffer-list (list group-buf))
6838       (bury-buffer group-buf)
6839       (delete-windows-on group-buf t))))
6840
6841 (defun gnus-group-clear-dribble ()
6842   "Clear all information from the dribble buffer."
6843   (interactive)
6844   (gnus-dribble-clear)
6845   (gnus-message 7 "Cleared dribble buffer"))
6846
6847 (defun gnus-group-exit ()
6848   "Quit reading news after updating .newsrc.eld and .newsrc.
6849 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6850   (interactive)
6851   (when 
6852       (or noninteractive                ;For gnus-batch-kill
6853           (not gnus-interactive-exit)   ;Without confirmation
6854           gnus-expert-user
6855           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
6856     (run-hooks 'gnus-exit-gnus-hook)
6857     ;; Offer to save data from non-quitted summary buffers.
6858     (gnus-offer-save-summaries)
6859     ;; Save the newsrc file(s).
6860     (gnus-save-newsrc-file)
6861     ;; Kill-em-all.
6862     (gnus-close-backends)
6863     ;; Reset everything.
6864     (gnus-clear-system)
6865     ;; Allow the user to do things after cleaning up.
6866     (run-hooks 'gnus-after-exiting-gnus-hook)))
6867
6868 (defun gnus-close-backends ()
6869   ;; Send a close request to all backends that support such a request.
6870   (let ((methods gnus-valid-select-methods)
6871         func)
6872     (while methods
6873       (if (fboundp (setq func (intern (concat (caar methods)
6874                                               "-request-close"))))
6875           (funcall func))
6876       (setq methods (cdr methods)))))
6877
6878 (defun gnus-group-quit ()
6879   "Quit reading news without updating .newsrc.eld or .newsrc.
6880 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6881   (interactive)
6882   (when (or noninteractive              ;For gnus-batch-kill
6883             (zerop (buffer-size))
6884             (not (gnus-server-opened gnus-select-method))
6885             gnus-expert-user
6886             (not gnus-current-startup-file)
6887             (gnus-yes-or-no-p
6888              (format "Quit reading news without saving %s? "
6889                      (file-name-nondirectory gnus-current-startup-file))))
6890     (run-hooks 'gnus-exit-gnus-hook)
6891     (if gnus-use-full-window
6892         (delete-other-windows)
6893       (gnus-remove-some-windows))
6894     (gnus-dribble-save)
6895     (gnus-close-backends)
6896     (gnus-clear-system)
6897     ;; Allow the user to do things after cleaning up.
6898     (run-hooks 'gnus-after-exiting-gnus-hook)))
6899
6900 (defun gnus-offer-save-summaries ()
6901   "Offer to save all active summary buffers."
6902   (save-excursion
6903     (let ((buflist (buffer-list))
6904           buffers bufname)
6905       ;; Go through all buffers and find all summaries.
6906       (while buflist
6907         (and (setq bufname (buffer-name (car buflist)))
6908              (string-match "Summary" bufname)
6909              (save-excursion
6910                (set-buffer bufname)
6911                ;; We check that this is, indeed, a summary buffer.
6912                (and (eq major-mode 'gnus-summary-mode)
6913                     ;; Also make sure this isn't bogus.
6914                     gnus-newsgroup-prepared))
6915              (push bufname buffers))
6916         (setq buflist (cdr buflist)))
6917       ;; Go through all these summary buffers and offer to save them.
6918       (when buffers
6919         (map-y-or-n-p
6920          "Update summary buffer %s? "
6921          (lambda (buf) (set-buffer buf) (gnus-summary-exit))
6922          buffers)))))
6923
6924 (defun gnus-group-describe-briefly ()
6925   "Give a one line description of the group mode commands."
6926   (interactive)
6927   (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")))
6928
6929 (defun gnus-group-browse-foreign-server (method)
6930   "Browse a foreign news server.
6931 If called interactively, this function will ask for a select method
6932  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
6933 If not, METHOD should be a list where the first element is the method
6934 and the second element is the address."
6935   (interactive
6936    (list (let ((how (completing-read
6937                      "Which backend: "
6938                      (append gnus-valid-select-methods gnus-server-alist)
6939                      nil t (cons "nntp" 0) 'gnus-method-history)))
6940            ;; We either got a backend name or a virtual server name.
6941            ;; If the first, we also need an address.
6942            (if (assoc how gnus-valid-select-methods)
6943                (list (intern how)
6944                      ;; Suggested by mapjph@bath.ac.uk.
6945                      (completing-read
6946                       "Address: "
6947                       (mapcar (lambda (server) (list server))
6948                               gnus-secondary-servers)))
6949              ;; We got a server name, so we find the method.
6950              (gnus-server-to-method how)))))
6951   (gnus-browse-foreign-server method))
6952
6953 \f
6954 ;;;
6955 ;;; Gnus summary mode
6956 ;;;
6957
6958 (defvar gnus-summary-mode-map nil)
6959
6960 (put 'gnus-summary-mode 'mode-class 'special)
6961
6962 (unless gnus-summary-mode-map
6963   (setq gnus-summary-mode-map (make-keymap))
6964   (suppress-keymap gnus-summary-mode-map)
6965
6966   ;; Non-orthogonal keys
6967
6968   (gnus-define-keys gnus-summary-mode-map
6969     " " gnus-summary-next-page
6970     "\177" gnus-summary-prev-page
6971     [delete] gnus-summary-prev-page
6972     "\r" gnus-summary-scroll-up
6973     "n" gnus-summary-next-unread-article
6974     "p" gnus-summary-prev-unread-article
6975     "N" gnus-summary-next-article
6976     "P" gnus-summary-prev-article
6977     "\M-\C-n" gnus-summary-next-same-subject
6978     "\M-\C-p" gnus-summary-prev-same-subject
6979     "\M-n" gnus-summary-next-unread-subject
6980     "\M-p" gnus-summary-prev-unread-subject
6981     "." gnus-summary-first-unread-article
6982     "," gnus-summary-best-unread-article
6983     "\M-s" gnus-summary-search-article-forward
6984     "\M-r" gnus-summary-search-article-backward
6985     "<" gnus-summary-beginning-of-article
6986     ">" gnus-summary-end-of-article
6987     "j" gnus-summary-goto-article
6988     "^" gnus-summary-refer-parent-article
6989     "\M-^" gnus-summary-refer-article
6990     "u" gnus-summary-tick-article-forward
6991     "!" gnus-summary-tick-article-forward
6992     "U" gnus-summary-tick-article-backward
6993     "d" gnus-summary-mark-as-read-forward
6994     "D" gnus-summary-mark-as-read-backward
6995     "E" gnus-summary-mark-as-expirable
6996     "\M-u" gnus-summary-clear-mark-forward
6997     "\M-U" gnus-summary-clear-mark-backward
6998     "k" gnus-summary-kill-same-subject-and-select
6999     "\C-k" gnus-summary-kill-same-subject
7000     "\M-\C-k" gnus-summary-kill-thread
7001     "\M-\C-l" gnus-summary-lower-thread
7002     "e" gnus-summary-edit-article
7003     "#" gnus-summary-mark-as-processable
7004     "\M-#" gnus-summary-unmark-as-processable
7005     "\M-\C-t" gnus-summary-toggle-threads
7006     "\M-\C-s" gnus-summary-show-thread
7007     "\M-\C-h" gnus-summary-hide-thread
7008     "\M-\C-f" gnus-summary-next-thread
7009     "\M-\C-b" gnus-summary-prev-thread
7010     "\M-\C-u" gnus-summary-up-thread
7011     "\M-\C-d" gnus-summary-down-thread
7012     "&" gnus-summary-execute-command
7013     "c" gnus-summary-catchup-and-exit
7014     "\C-w" gnus-summary-mark-region-as-read
7015     "\C-t" gnus-summary-toggle-truncation
7016     "?" gnus-summary-mark-as-dormant
7017     "\C-c\M-\C-s" gnus-summary-limit-include-expunged
7018     "\C-c\C-s\C-n" gnus-summary-sort-by-number
7019     "\C-c\C-s\C-a" gnus-summary-sort-by-author
7020     "\C-c\C-s\C-s" gnus-summary-sort-by-subject
7021     "\C-c\C-s\C-d" gnus-summary-sort-by-date
7022     "\C-c\C-s\C-i" gnus-summary-sort-by-score
7023     "=" gnus-summary-expand-window
7024     "\C-x\C-s" gnus-summary-reselect-current-group
7025     "\M-g" gnus-summary-rescan-group
7026     "w" gnus-summary-stop-page-breaking
7027     "\C-c\C-r" gnus-summary-caesar-message
7028     "\M-t" gnus-summary-toggle-mime
7029     "f" gnus-summary-followup
7030     "F" gnus-summary-followup-with-original
7031     "C" gnus-summary-cancel-article
7032     "r" gnus-summary-reply
7033     "R" gnus-summary-reply-with-original
7034     "\C-c\C-f" gnus-summary-mail-forward
7035     "o" gnus-summary-save-article
7036     "\C-o" gnus-summary-save-article-mail
7037     "|" gnus-summary-pipe-output
7038     "\M-k" gnus-summary-edit-local-kill
7039     "\M-K" gnus-summary-edit-global-kill
7040     "V" gnus-version
7041     "\C-c\C-d" gnus-summary-describe-group
7042     "q" gnus-summary-exit
7043     "Q" gnus-summary-exit-no-update
7044     "\C-c\C-i" gnus-info-find-node
7045     gnus-mouse-2 gnus-mouse-pick-article
7046     "m" gnus-summary-mail-other-window
7047     "a" gnus-summary-post-news
7048     "x" gnus-summary-limit-to-unread
7049     "s" gnus-summary-isearch-article
7050     "t" gnus-article-hide-headers
7051     "g" gnus-summary-show-article
7052     "l" gnus-summary-goto-last-article
7053     "\C-c\C-v\C-v" gnus-uu-decode-uu-view
7054     "\C-d" gnus-summary-enter-digest-group
7055     "\C-c\C-b" gnus-bug
7056     "*" gnus-cache-enter-article
7057     "\M-*" gnus-cache-remove-article
7058     "\M-&" gnus-summary-universal-argument
7059     "\C-l" gnus-recenter
7060     "I" gnus-summary-increase-score
7061     "L" gnus-summary-lower-score
7062
7063     "V" gnus-summary-score-map
7064     "X" gnus-uu-extract-map
7065     "S" gnus-summary-send-map)
7066
7067   ;; Sort of orthogonal keymap
7068   (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
7069     "t" gnus-summary-tick-article-forward
7070     "!" gnus-summary-tick-article-forward
7071     "d" gnus-summary-mark-as-read-forward
7072     "r" gnus-summary-mark-as-read-forward
7073     "c" gnus-summary-clear-mark-forward
7074     " " gnus-summary-clear-mark-forward
7075     "e" gnus-summary-mark-as-expirable
7076     "x" gnus-summary-mark-as-expirable
7077     "?" gnus-summary-mark-as-dormant
7078     "b" gnus-summary-set-bookmark
7079     "B" gnus-summary-remove-bookmark
7080     "#" gnus-summary-mark-as-processable
7081     "\M-#" gnus-summary-unmark-as-processable
7082     "S" gnus-summary-limit-include-expunged
7083     "C" gnus-summary-catchup
7084     "H" gnus-summary-catchup-to-here
7085     "\C-c" gnus-summary-catchup-all
7086     "k" gnus-summary-kill-same-subject-and-select
7087     "K" gnus-summary-kill-same-subject
7088     "P" gnus-uu-mark-map)
7089
7090   (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mode-map)
7091     "c" gnus-summary-clear-above
7092     "u" gnus-summary-tick-above
7093     "m" gnus-summary-mark-above
7094     "k" gnus-summary-kill-below)
7095
7096   (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
7097     "/" gnus-summary-limit-to-subject
7098     "n" gnus-summary-limit-to-articles
7099     "w" gnus-summary-pop-limit
7100     "s" gnus-summary-limit-to-subject
7101     "a" gnus-summary-limit-to-author
7102     "u" gnus-summary-limit-to-unread
7103     "m" gnus-summary-limit-to-marks
7104     "v" gnus-summary-limit-to-score
7105     "D" gnus-summary-limit-include-dormant
7106     "d" gnus-summary-limit-exclude-dormant
7107     ;;  "t" gnus-summary-limit-exclude-thread
7108     "E" gnus-summary-limit-include-expunged
7109     "c" gnus-summary-limit-exclude-childless-dormant
7110     "C" gnus-summary-limit-mark-excluded-as-read)
7111
7112   (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
7113     "n" gnus-summary-next-unread-article
7114     "p" gnus-summary-prev-unread-article
7115     "N" gnus-summary-next-article
7116     "P" gnus-summary-prev-article
7117     "\C-n" gnus-summary-next-same-subject
7118     "\C-p" gnus-summary-prev-same-subject
7119     "\M-n" gnus-summary-next-unread-subject
7120     "\M-p" gnus-summary-prev-unread-subject
7121     "f" gnus-summary-first-unread-article
7122     "b" gnus-summary-best-unread-article
7123     "j" gnus-summary-goto-article
7124     "g" gnus-summary-goto-subject
7125     "l" gnus-summary-goto-last-article
7126     "p" gnus-summary-pop-article)
7127
7128   (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
7129     "k" gnus-summary-kill-thread
7130     "l" gnus-summary-lower-thread
7131     "i" gnus-summary-raise-thread
7132     "T" gnus-summary-toggle-threads
7133     "t" gnus-summary-rethread-current
7134     "^" gnus-summary-reparent-thread
7135     "s" gnus-summary-show-thread
7136     "S" gnus-summary-show-all-threads
7137     "h" gnus-summary-hide-thread
7138     "H" gnus-summary-hide-all-threads
7139     "n" gnus-summary-next-thread
7140     "p" gnus-summary-prev-thread
7141     "u" gnus-summary-up-thread
7142     "o" gnus-summary-top-thread
7143     "d" gnus-summary-down-thread
7144     "#" gnus-uu-mark-thread
7145     "\M-#" gnus-uu-unmark-thread)
7146
7147   (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
7148     "c" gnus-summary-catchup-and-exit
7149     "C" gnus-summary-catchup-all-and-exit
7150     "E" gnus-summary-exit-no-update
7151     "Q" gnus-summary-exit
7152     "Z" gnus-summary-exit
7153     "n" gnus-summary-catchup-and-goto-next-group
7154     "R" gnus-summary-reselect-current-group
7155     "G" gnus-summary-rescan-group
7156     "N" gnus-summary-next-group
7157     "P" gnus-summary-prev-group)
7158
7159   (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
7160     " " gnus-summary-next-page
7161     "n" gnus-summary-next-page
7162     "\177" gnus-summary-prev-page
7163     [delete] gnus-summary-prev-page
7164     "p" gnus-summary-prev-page
7165     "\r" gnus-summary-scroll-up
7166     "<" gnus-summary-beginning-of-article
7167     ">" gnus-summary-end-of-article
7168     "b" gnus-summary-beginning-of-article
7169     "e" gnus-summary-end-of-article
7170     "^" gnus-summary-refer-parent-article
7171     "r" gnus-summary-refer-parent-article
7172     "R" gnus-summary-refer-references
7173     "g" gnus-summary-show-article
7174     "s" gnus-summary-isearch-article)
7175
7176   (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
7177     "b" gnus-article-add-buttons
7178     "B" gnus-article-add-buttons-to-head
7179     "o" gnus-article-treat-overstrike
7180     ;;  "w" gnus-article-word-wrap
7181     "w" gnus-article-fill-cited-article
7182     "c" gnus-article-remove-cr
7183     "L" gnus-article-remove-trailing-blank-lines
7184     "q" gnus-article-de-quoted-unreadable
7185     "f" gnus-article-display-x-face
7186     "l" gnus-summary-stop-page-breaking
7187     "r" gnus-summary-caesar-message
7188     "t" gnus-article-hide-headers
7189     "v" gnus-summary-verbose-headers
7190     "m" gnus-summary-toggle-mime)
7191
7192   (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
7193     "a" gnus-article-hide
7194     "h" gnus-article-hide-headers
7195     "b" gnus-article-hide-boring-headers
7196     "s" gnus-article-hide-signature
7197     "c" gnus-article-hide-citation
7198     "p" gnus-article-hide-pgp
7199     "P" gnus-article-hide-pem
7200     "\C-c" gnus-article-hide-citation-maybe)
7201
7202   (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
7203     "a" gnus-article-highlight
7204     "h" gnus-article-highlight-headers
7205     "c" gnus-article-highlight-citation
7206     "s" gnus-article-highlight-signature)
7207
7208   (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
7209     "z" gnus-article-date-ut
7210     "u" gnus-article-date-ut
7211     "l" gnus-article-date-local
7212     "e" gnus-article-date-lapsed
7213     "o" gnus-article-date-original)
7214
7215   (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
7216     "v" gnus-version
7217     "f" gnus-summary-fetch-faq
7218     "d" gnus-summary-describe-group
7219     "h" gnus-summary-describe-briefly
7220     "i" gnus-info-find-node)
7221
7222   (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
7223     "e" gnus-summary-expire-articles
7224     "\M-\C-e" gnus-summary-expire-articles-now
7225     "\177" gnus-summary-delete-article
7226     [delete] gnus-summary-delete-article
7227     "m" gnus-summary-move-article
7228     "r" gnus-summary-respool-article
7229     "w" gnus-summary-edit-article
7230     "c" gnus-summary-copy-article
7231     "B" gnus-summary-crosspost-article
7232     "q" gnus-summary-respool-query
7233     "i" gnus-summary-import-article)
7234
7235   (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
7236     "o" gnus-summary-save-article
7237     "m" gnus-summary-save-article-mail
7238     "r" gnus-summary-save-article-rmail
7239     "f" gnus-summary-save-article-file
7240     "b" gnus-summary-save-article-body-file
7241     "h" gnus-summary-save-article-folder
7242     "v" gnus-summary-save-article-vm
7243     "p" gnus-summary-pipe-output
7244     "s" gnus-soup-add-article)
7245   )
7246
7247 \f
7248
7249 (defun gnus-summary-mode (&optional group)
7250   "Major mode for reading articles.
7251
7252 All normal editing commands are switched off.
7253 \\<gnus-summary-mode-map>
7254 Each line in this buffer represents one article.  To read an
7255 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
7256 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
7257 respectively.
7258
7259 You can also post articles and send mail from this buffer.  To
7260 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author
7261 of an article, type `\\[gnus-summary-reply]'.
7262
7263 There are approx. one gazillion commands you can execute in this
7264 buffer; read the info pages for more information (`\\[gnus-info-find-node]').
7265
7266 The following commands are available:
7267
7268 \\{gnus-summary-mode-map}"
7269   (interactive)
7270   (when (and menu-bar-mode
7271              (gnus-visual-p 'summary-menu 'menu))
7272     (gnus-summary-make-menu-bar))
7273   (kill-all-local-variables)
7274   (gnus-summary-make-local-variables)
7275   (gnus-make-thread-indent-array)
7276   (gnus-simplify-mode-line)
7277   (setq major-mode 'gnus-summary-mode)
7278   (setq mode-name "Summary")
7279   (make-local-variable 'minor-mode-alist)
7280   (use-local-map gnus-summary-mode-map)
7281   (buffer-disable-undo (current-buffer))
7282   (setq buffer-read-only t)             ;Disable modification
7283   (setq truncate-lines t)
7284   (setq selective-display t)
7285   (setq selective-display-ellipses t)   ;Display `...'
7286   (setq buffer-display-table gnus-summary-display-table)
7287   (setq gnus-newsgroup-name group)
7288   (make-local-variable 'gnus-summary-line-format)
7289   (make-local-variable 'gnus-summary-line-format-spec)
7290   (make-local-variable 'gnus-summary-mark-positions)
7291   (gnus-make-local-hook 'post-command-hook)
7292   (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
7293   (run-hooks 'gnus-summary-mode-hook))
7294
7295 (defun gnus-summary-make-local-variables ()
7296   "Make all the local summary buffer variables."
7297   (let ((locals gnus-summary-local-variables)
7298         global local)
7299     (while (setq local (pop locals))
7300       (if (consp local)
7301           (progn
7302             (if (eq (cdr local) 'global)
7303                 ;; Copy the global value of the variable.
7304                 (setq global (symbol-value (car local)))
7305               ;; Use the value from the list.
7306               (setq global (eval (cdr local))))
7307             (make-local-variable (car local))
7308             (set (car local) global))
7309         ;; Simple nil-valued local variable.
7310         (make-local-variable local)
7311         (set local nil)))))
7312
7313 (defun gnus-summary-make-display-table ()
7314   ;; Change the display table.  Odd characters have a tendency to mess
7315   ;; up nicely formatted displays - we make all possible glyphs
7316   ;; display only a single character.
7317
7318   ;; We start from the standard display table, if any.
7319   (setq gnus-summary-display-table
7320         (or (copy-sequence standard-display-table)
7321             (make-display-table)))
7322   ;; Nix out all the control chars...
7323   (let ((i 32))
7324     (while (>= (setq i (1- i)) 0)
7325       (aset gnus-summary-display-table i [??])))
7326   ;; ... but not newline and cr, of course. (cr is necessary for the
7327   ;; selective display).
7328   (aset gnus-summary-display-table ?\n nil)
7329   (aset gnus-summary-display-table ?\r nil)
7330   ;; We nix out any glyphs over 126 that are not set already.
7331   (let ((i 256))
7332     (while (>= (setq i (1- i)) 127)
7333       ;; Only modify if the entry is nil.
7334       (or (aref gnus-summary-display-table i)
7335           (aset gnus-summary-display-table i [??])))))
7336
7337 (defun gnus-summary-clear-local-variables ()
7338   (let ((locals gnus-summary-local-variables))
7339     (while locals
7340       (if (consp (car locals))
7341           (and (vectorp (caar locals))
7342                (set (caar locals) nil))
7343         (and (vectorp (car locals))
7344              (set (car locals) nil)))
7345       (setq locals (cdr locals)))))
7346
7347 ;; Summary data functions.
7348
7349 (defmacro gnus-data-number (data)
7350   `(car ,data))
7351
7352 (defmacro gnus-data-set-number (data number)
7353   `(setcar ,data ,number))
7354
7355 (defmacro gnus-data-mark (data)
7356   `(nth 1 ,data))
7357
7358 (defmacro gnus-data-set-mark (data mark)
7359   `(setcar (nthcdr 1 ,data) ,mark))
7360
7361 (defmacro gnus-data-pos (data)
7362   `(nth 2 ,data))
7363
7364 (defmacro gnus-data-set-pos (data pos)
7365   `(setcar (nthcdr 2 ,data) ,pos))
7366
7367 (defmacro gnus-data-header (data)
7368   `(nth 3 ,data))
7369
7370 (defmacro gnus-data-level (data)
7371   `(nth 4 ,data))
7372
7373 (defmacro gnus-data-unread-p (data)
7374   `(= (nth 1 ,data) gnus-unread-mark))
7375
7376 (defmacro gnus-data-pseudo-p (data)
7377   `(consp (nth 3 ,data)))
7378
7379 (defmacro gnus-data-find (number)
7380   `(assq ,number gnus-newsgroup-data))
7381
7382 (defmacro gnus-data-find-list (number &optional data)
7383   `(let ((bdata ,(or data 'gnus-newsgroup-data)))
7384      (memq (assq ,number bdata)
7385            bdata)))
7386
7387 (defmacro gnus-data-make (number mark pos header level)
7388   `(list ,number ,mark ,pos ,header ,level))
7389
7390 (defun gnus-data-enter (after-article number mark pos header level offset)
7391   (let ((data (gnus-data-find-list after-article)))
7392     (or data (error "No such article: %d" after-article))
7393     (setcdr data (cons (gnus-data-make number mark pos header level)
7394                        (cdr data)))
7395     (setq gnus-newsgroup-data-reverse nil)
7396     (gnus-data-update-list (cddr data) offset)))
7397
7398 (defun gnus-data-enter-list (after-article list &optional offset)
7399   (when list
7400     (let ((data (and after-article (gnus-data-find-list after-article)))
7401           (ilist list))
7402       (or data (not after-article) (error "No such article: %d" after-article))
7403       ;; Find the last element in the list to be spliced into the main
7404       ;; list.
7405       (while (cdr list)
7406         (setq list (cdr list)))
7407       (if (not data)
7408           (progn
7409             (setcdr list gnus-newsgroup-data)
7410             (setq gnus-newsgroup-data ilist)
7411             (and offset (gnus-data-update-list (cdr list) offset)))
7412         (setcdr list (cdr data))
7413         (setcdr data ilist)
7414         (and offset (gnus-data-update-list (cdr data) offset)))
7415       (setq gnus-newsgroup-data-reverse nil))))
7416
7417 (defun gnus-data-remove (article &optional offset)
7418   (let ((data gnus-newsgroup-data))
7419     (if (= (gnus-data-number (car data)) article)
7420         (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
7421               gnus-newsgroup-data-reverse nil)
7422       (while (cdr data)
7423         (and (= (gnus-data-number (cadr data)) article)
7424              (progn
7425                (setcdr data (cddr data))
7426                (and offset (gnus-data-update-list (cdr data) offset))
7427                (setq data nil
7428                      gnus-newsgroup-data-reverse nil)))
7429         (setq data (cdr data))))))
7430
7431 (defmacro gnus-data-list (backward)
7432   `(if ,backward
7433        (or gnus-newsgroup-data-reverse
7434            (setq gnus-newsgroup-data-reverse
7435                  (reverse gnus-newsgroup-data)))
7436      gnus-newsgroup-data))
7437
7438 (defun gnus-data-update-list (data offset)
7439   "Add OFFSET to the POS of all data entries in DATA."
7440   (while data
7441     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
7442     (setq data (cdr data))))
7443
7444 (defun gnus-data-compute-positions ()
7445   "Compute the positions of all articles."
7446   (let ((data gnus-newsgroup-data)
7447         pos)
7448     (while data
7449       (when (setq pos (text-property-any
7450                        (point-min) (point-max)
7451                        'gnus-number (gnus-data-number (car data))))
7452         (gnus-data-set-pos (car data) (+ pos 3)))
7453       (setq data (cdr data)))))
7454
7455 (defun gnus-summary-article-pseudo-p (article)
7456   "Say whether this article is a pseudo article or not."
7457   (not (vectorp (gnus-data-header (gnus-data-find article)))))
7458
7459 (defun gnus-article-parent-p (number)
7460   "Say whether this article is a parent or not."
7461   (let ((data (gnus-data-find-list number)))
7462     (and (cdr data)                     ; There has to be an article after...
7463          (< (gnus-data-level (car data)) ; And it has to have a higher level.
7464             (gnus-data-level (nth 1 data))))))
7465
7466 (defun gnus-article-children (number)
7467   "Return a list of all children to NUMBER."
7468   (let* ((data (gnus-data-find-list number))
7469          (level (gnus-data-level (car data)))
7470          children)
7471     (setq data (cdr data))
7472     (while (and data            
7473                 (= (gnus-data-level (car data)) (1+ level)))
7474       (push (gnus-data-number (car data)) children)
7475       (setq data (cdr data)))
7476     children))
7477
7478 (defmacro gnus-summary-skip-intangible ()
7479   "If the current article is intangible, then jump to a different article."
7480   '(let ((to (get-text-property (point) 'gnus-intangible)))
7481     (and to (gnus-summary-goto-subject to))))
7482
7483 (defmacro gnus-summary-article-intangible-p ()
7484   "Say whether this article is intangible or not."
7485   '(get-text-property (point) 'gnus-intangible))
7486
7487 ;; Some summary mode macros.
7488
7489 (defmacro gnus-summary-article-number ()
7490   "The article number of the article on the current line.
7491 If there isn's an article number here, then we return the current
7492 article number."
7493   '(progn
7494      (gnus-summary-skip-intangible)
7495      (or (get-text-property (point) 'gnus-number)
7496          (gnus-summary-last-subject))))
7497
7498 (defmacro gnus-summary-article-header (&optional number)
7499   `(gnus-data-header (gnus-data-find
7500                       ,(or number '(gnus-summary-article-number)))))
7501
7502 (defmacro gnus-summary-thread-level (&optional number)
7503   `(if (and (eq gnus-summary-make-false-root 'dummy)
7504             (get-text-property (point) 'gnus-intangible))
7505        0
7506      (gnus-data-level (gnus-data-find
7507                        ,(or number '(gnus-summary-article-number))))))
7508
7509 (defmacro gnus-summary-article-mark (&optional number)
7510   `(gnus-data-mark (gnus-data-find
7511                     ,(or number '(gnus-summary-article-number)))))
7512
7513 (defmacro gnus-summary-article-pos (&optional number)
7514   `(gnus-data-pos (gnus-data-find
7515                    ,(or number '(gnus-summary-article-number)))))
7516
7517 (defalias 'gnus-summary-subject-string 'gnus-summary-article-subject)
7518 (defmacro gnus-summary-article-subject (&optional number)
7519   "Return current subject string or nil if nothing."
7520   `(let ((headers
7521           ,(if number
7522                `(gnus-data-header (assq ,number gnus-newsgroup-data))
7523              '(gnus-data-header (assq (gnus-summary-article-number)
7524                                       gnus-newsgroup-data)))))
7525      (and headers
7526           (vectorp headers)
7527           (mail-header-subject headers))))
7528
7529 (defmacro gnus-summary-article-score (&optional number)
7530   "Return current article score."
7531   `(or (cdr (assq ,(or number '(gnus-summary-article-number))
7532                   gnus-newsgroup-scored))
7533        gnus-summary-default-score 0))
7534
7535 (defun gnus-summary-article-children (&optional number)
7536   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
7537          (level (gnus-data-level (car data)))
7538          l children)
7539     (while (and (setq data (cdr data))
7540                 (> (setq l (gnus-data-level (car data))) level))
7541       (and (= (1+ level) l)
7542            (setq children (cons (gnus-data-number (car data))
7543                                 children))))
7544     (nreverse children)))
7545
7546 (defun gnus-summary-article-parent (&optional number)
7547   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
7548                                     (gnus-data-list t)))
7549          (level (gnus-data-level (car data))))
7550     (if (zerop level)
7551         () ; This is a root.
7552       ;; We search until we find an article with a level less than
7553       ;; this one.  That function has to be the parent.
7554       (while (and (setq data (cdr data))
7555                   (not (< (gnus-data-level (car data)) level))))
7556       (and data (gnus-data-number (car data))))))
7557
7558 (defun gnus-unread-mark-p (mark)
7559   "Say whether MARK is the unread mark."
7560   (= mark gnus-unread-mark))
7561
7562 (defun gnus-read-mark-p (mark)
7563   "Say whether MARK is one of the marks that mark as read.
7564 This is all marks except unread, ticked, dormant, and expirable."
7565   (not (or (= mark gnus-unread-mark)
7566            (= mark gnus-ticked-mark)
7567            (= mark gnus-dormant-mark)
7568            (= mark gnus-expirable-mark))))
7569
7570 ;; Saving hidden threads.
7571
7572 (put 'gnus-save-hidden-threads 'lisp-indent-function 0)
7573 (put 'gnus-save-hidden-threads 'lisp-indent-hook 0)
7574 (put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
7575
7576 (defmacro gnus-save-hidden-threads (&rest forms)
7577   "Save hidden threads, eval FORMS, and restore the hidden threads."
7578   (let ((config (make-symbol "config")))
7579     `(let ((,config (gnus-hidden-threads-configuration)))
7580        (unwind-protect
7581            (progn
7582              ,@forms)
7583          (gnus-restore-hidden-threads-configuration ,config)))))
7584
7585 (defun gnus-hidden-threads-configuration ()
7586   "Return the current hidden threads configuration."
7587   (save-excursion
7588     (let (config)
7589       (goto-char (point-min))
7590       (while (search-forward "\r" nil t)
7591         (push (1- (point)) config))
7592       config)))
7593
7594 (defun gnus-restore-hidden-threads-configuration (config)
7595   "Restore hidden threads configuration from CONFIG."
7596   (let (point buffer-read-only)
7597     (while (setq point (pop config))
7598       (when (and (< point (point-max))
7599                  (goto-char point)
7600                  (= (following-char) ?\n))
7601         (subst-char-in-region point (1+ point) ?\n ?\r)))))
7602
7603 ;; Various summary mode internalish functions.
7604
7605 (defun gnus-mouse-pick-article (e)
7606   (interactive "e")
7607   (mouse-set-point e)
7608   (gnus-summary-next-page nil t))
7609
7610 (defun gnus-summary-setup-buffer (group)
7611   "Initialize summary buffer."
7612   (let ((buffer (concat "*Summary " group "*")))
7613     (if (get-buffer buffer)
7614         (progn
7615           (set-buffer buffer)
7616           (setq gnus-summary-buffer (current-buffer))
7617           (not gnus-newsgroup-prepared))
7618       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
7619       (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
7620       (gnus-add-current-to-buffer-list)
7621       (gnus-summary-mode group)
7622       (when gnus-carpal
7623         (gnus-carpal-setup-buffer 'summary))
7624       (unless gnus-single-article-buffer
7625         (make-local-variable 'gnus-article-buffer)
7626         (make-local-variable 'gnus-article-current)
7627         (make-local-variable 'gnus-original-article-buffer))
7628       (setq gnus-newsgroup-name group)
7629       t)))
7630
7631 (defun gnus-set-global-variables ()
7632   ;; Set the global equivalents of the summary buffer-local variables
7633   ;; to the latest values they had.  These reflect the summary buffer
7634   ;; that was in action when the last article was fetched.
7635   (when (eq major-mode 'gnus-summary-mode)
7636     (setq gnus-summary-buffer (current-buffer))
7637     (let ((name gnus-newsgroup-name)
7638           (marked gnus-newsgroup-marked)
7639           (unread gnus-newsgroup-unreads)
7640           (headers gnus-current-headers)
7641           (data gnus-newsgroup-data)
7642           (summary gnus-summary-buffer)
7643           (article-buffer gnus-article-buffer)
7644           (original gnus-original-article-buffer)
7645           (gac gnus-article-current)
7646           (reffed gnus-reffed-article-number)
7647           (score-file gnus-current-score-file))
7648       (save-excursion
7649         (set-buffer gnus-group-buffer)
7650         (setq gnus-newsgroup-name name)
7651         (setq gnus-newsgroup-marked marked)
7652         (setq gnus-newsgroup-unreads unread)
7653         (setq gnus-current-headers headers)
7654         (setq gnus-newsgroup-data data)
7655         (setq gnus-article-current gac)
7656         (setq gnus-summary-buffer summary)
7657         (setq gnus-article-buffer article-buffer)
7658         (setq gnus-original-article-buffer original)
7659         (setq gnus-reffed-article-number reffed)
7660         (setq gnus-current-score-file score-file)))))
7661
7662 (defun gnus-summary-last-article-p (&optional article)
7663   "Return whether ARTICLE is the last article in the buffer."
7664   (if (not (setq article (or article (gnus-summary-article-number))))
7665       t ; All non-existant numbers are the last article. :-)
7666     (not (cdr (gnus-data-find-list article)))))
7667
7668 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
7669   "Insert a dummy root in the summary buffer."
7670   (beginning-of-line)
7671   (gnus-add-text-properties
7672    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
7673    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
7674
7675 (defun gnus-make-thread-indent-array ()
7676   (let ((n 200))
7677     (unless (and gnus-thread-indent-array
7678                  (= gnus-thread-indent-level gnus-thread-indent-array-level))
7679       (setq gnus-thread-indent-array (make-vector 201 "")
7680             gnus-thread-indent-array-level gnus-thread-indent-level)
7681       (while (>= n 0)
7682         (aset gnus-thread-indent-array n
7683               (make-string (* n gnus-thread-indent-level) ? ))
7684         (setq n (1- n))))))
7685
7686 (defun gnus-summary-insert-line
7687   (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread
7688                    gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
7689                    &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
7690   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
7691          (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
7692          (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
7693          (gnus-tmp-score-char
7694           (if (or (null gnus-summary-default-score)
7695                   (<= (abs (- gnus-tmp-score gnus-summary-default-score))
7696                       gnus-summary-zcore-fuzz)) ? 
7697             (if (< gnus-tmp-score gnus-summary-default-score)
7698                 gnus-score-below-mark gnus-score-over-mark)))
7699          (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark)
7700                                  ((memq gnus-tmp-current gnus-newsgroup-cached)
7701                                   gnus-cached-mark)
7702                                  (gnus-tmp-replied gnus-replied-mark)
7703                                  ((memq gnus-tmp-current gnus-newsgroup-saved)
7704                                   gnus-saved-mark)
7705                                  (t gnus-unread-mark)))
7706          (gnus-tmp-from (mail-header-from gnus-tmp-header))
7707          (gnus-tmp-name
7708           (cond
7709            ((string-match "(.+)" gnus-tmp-from)
7710             (substring gnus-tmp-from
7711                        (1+ (match-beginning 0)) (1- (match-end 0))))
7712            ((string-match "<[^>]+> *$" gnus-tmp-from)
7713             (let ((beg (match-beginning 0)))
7714               (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
7715                        (substring gnus-tmp-from (1+ (match-beginning 0))
7716                                   (1- (match-end 0))))
7717                   (substring gnus-tmp-from 0 beg))))
7718            (t gnus-tmp-from)))
7719          (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
7720          (gnus-tmp-number (mail-header-number gnus-tmp-header))
7721          (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
7722          (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
7723          (buffer-read-only nil))
7724     (when (string= gnus-tmp-name "")
7725       (setq gnus-tmp-name gnus-tmp-from))
7726     (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
7727     (gnus-put-text-property
7728      (point)
7729      (progn (eval gnus-summary-line-format-spec) (point))
7730      'gnus-number gnus-tmp-number)
7731     (when (gnus-visual-p 'summary-highlight 'highlight)
7732       (forward-line -1)
7733       (run-hooks 'gnus-summary-update-hook)
7734       (forward-line 1))))
7735
7736 (defun gnus-summary-update-line (&optional dont-update)
7737   ;; Update summary line after change.
7738   (when (and gnus-summary-default-score
7739              (not gnus-summary-inhibit-highlight))
7740     (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
7741            (article (gnus-summary-article-number))
7742            (score (gnus-summary-article-score article)))
7743       (unless dont-update
7744         (if (and gnus-summary-mark-below
7745                  (< (gnus-summary-article-score)
7746                     gnus-summary-mark-below))
7747             ;; This article has a low score, so we mark it as read.
7748             (when (memq article gnus-newsgroup-unreads)
7749               (gnus-summary-mark-article-as-read gnus-low-score-mark))
7750           (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
7751             ;; This article was previously marked as read on account
7752             ;; of a low score, but now it has risen, so we mark it as
7753             ;; unread.
7754             (gnus-summary-mark-article-as-unread gnus-unread-mark)))
7755         (gnus-summary-update-mark
7756          (if (or (null gnus-summary-default-score)
7757                  (<= (abs (- score gnus-summary-default-score))
7758                      gnus-summary-zcore-fuzz)) ? 
7759            (if (< score gnus-summary-default-score)
7760                gnus-score-below-mark gnus-score-over-mark)) 'score))
7761       ;; Do visual highlighting.
7762       (when (gnus-visual-p 'summary-highlight 'highlight)
7763         (run-hooks 'gnus-summary-update-hook)))))
7764
7765 (defvar gnus-tmp-new-adopts nil)
7766
7767 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
7768   ;; Sum up all elements (and sub-elements) in a list.
7769   (let* ((number
7770           ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
7771           (cond
7772            ((and (consp thread) (cdr thread))
7773             (apply
7774              '+ 1 (mapcar
7775                    'gnus-summary-number-of-articles-in-thread (cdr thread))))
7776            ((null thread)
7777             1)
7778            ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
7779             1)
7780            (t 0))))
7781     (when (and level (zerop level) gnus-tmp-new-adopts)
7782       (incf number
7783             (apply '+ (mapcar
7784                        'gnus-summary-number-of-articles-in-thread
7785                        gnus-tmp-new-adopts))))
7786     (if char
7787         (if (> number 1) gnus-not-empty-thread-mark
7788           gnus-empty-thread-mark)
7789       number)))
7790
7791 (defun gnus-summary-set-local-parameters (group)
7792  "Go through the local params of GROUP and set all variable specs in that list."
7793   (let ((params (gnus-info-params (gnus-get-info group)))
7794         elem)
7795     (while params
7796       (setq elem (car params)
7797             params (cdr params))
7798       (and (consp elem)                 ; Has to be a cons.
7799            (consp (cdr elem))           ; The cdr has to be a list.
7800            (symbolp (car elem))         ; Has to be a symbol in there.
7801            (not (memq (car elem) 
7802                       '(quit-config to-address to-list to-group)))
7803            (progn                       ; So we set it.
7804              (make-local-variable (car elem))
7805              (set (car elem) (eval (nth 1 elem))))))))
7806
7807 (defun gnus-summary-read-group (group &optional show-all no-article
7808                                       kill-buffer no-display)
7809   "Start reading news in newsgroup GROUP.
7810 If SHOW-ALL is non-nil, already read articles are also listed.
7811 If NO-ARTICLE is non-nil, no article is selected initially.
7812 If NO-DISPLAY, don't generate a summary buffer."
7813   (gnus-message 5 "Retrieving newsgroup: %s..." group)
7814   (let* ((new-group (gnus-summary-setup-buffer group))
7815          (quit-config (gnus-group-quit-config group))
7816          (did-select (and new-group (gnus-select-newsgroup group show-all))))
7817     (cond
7818      ;; This summary buffer exists already, so we just select it.
7819      ((not new-group)
7820       (gnus-set-global-variables)
7821       (when kill-buffer
7822         (gnus-kill-or-deaden-summary kill-buffer))
7823       (gnus-configure-windows 'summary 'force)
7824       (gnus-set-mode-line 'summary)
7825       (gnus-summary-position-point)
7826       (message "")
7827       t)
7828      ;; We couldn't select this group.
7829      ((null did-select)
7830       (when (and (eq major-mode 'gnus-summary-mode)
7831                  (not (equal (current-buffer) kill-buffer)))
7832         (kill-buffer (current-buffer))
7833         (if (not quit-config)
7834             (progn
7835               (set-buffer gnus-group-buffer)
7836               (gnus-group-jump-to-group group)
7837               (gnus-group-next-unread-group 1))
7838           (if (not (buffer-name (car quit-config)))
7839               (gnus-configure-windows 'group 'force)
7840             (set-buffer (car quit-config))
7841             (and (eq major-mode 'gnus-summary-mode)
7842                  (gnus-set-global-variables))
7843             (gnus-configure-windows (cdr quit-config)))))
7844       (gnus-message 3 "Can't select group")
7845       nil)
7846      ;; The user did a `C-g' while prompting for number of articles,
7847      ;; so we exit this group.
7848      ((eq did-select 'quit)
7849       (and (eq major-mode 'gnus-summary-mode)
7850            (not (equal (current-buffer) kill-buffer))
7851            (kill-buffer (current-buffer)))
7852       (when kill-buffer
7853         (gnus-kill-or-deaden-summary kill-buffer))
7854       (if (not quit-config)
7855           (progn
7856             (set-buffer gnus-group-buffer)
7857             (gnus-group-jump-to-group group)
7858             (gnus-group-next-unread-group 1)
7859             (gnus-configure-windows 'group 'force))
7860         (if (not (buffer-name (car quit-config)))
7861             (gnus-configure-windows 'group 'force)
7862           (set-buffer (car quit-config))
7863           (and (eq major-mode 'gnus-summary-mode)
7864                (gnus-set-global-variables))
7865           (gnus-configure-windows (cdr quit-config))))
7866       ;; Finally signal the quit.
7867       (signal 'quit nil))
7868      ;; The group was successfully selected.
7869      (t
7870       (gnus-set-global-variables)
7871       ;; Save the active value in effect when the group was entered.
7872       (setq gnus-newsgroup-active
7873             (gnus-copy-sequence
7874              (gnus-active gnus-newsgroup-name)))
7875       ;; You can change the summary buffer in some way with this hook.
7876       (run-hooks 'gnus-select-group-hook)
7877       ;; Set any local variables in the group parameters.
7878       (gnus-summary-set-local-parameters gnus-newsgroup-name)
7879       (gnus-update-format-specifications)
7880       ;; Do score processing.
7881       (when gnus-use-scoring
7882         (gnus-possibly-score-headers))
7883       ;; Check whether to fill in the gaps in the threads.
7884       (when gnus-build-sparse-threads
7885         (gnus-build-sparse-threads))
7886       ;; Find the initial limit.
7887       (if gnus-show-threads
7888           (if show-all
7889               (let ((gnus-newsgroup-dormant nil))
7890                 (gnus-summary-initial-limit show-all))
7891             (gnus-summary-initial-limit show-all))
7892         (setq gnus-newsgroup-limit 
7893               (mapcar 
7894                (lambda (header) (mail-header-number header))
7895                gnus-newsgroup-headers)))
7896       ;; Generate the summary buffer.
7897       (unless no-display
7898         (gnus-summary-prepare))
7899       (when gnus-use-trees
7900         (gnus-tree-open group)
7901         (setq gnus-summary-highlight-line-function
7902               'gnus-tree-highlight-article))
7903       ;; If the summary buffer is empty, but there are some low-scored
7904       ;; articles or some excluded dormants, we include these in the
7905       ;; buffer.
7906       (when (and (zerop (buffer-size))
7907                  (not no-display))
7908         (cond (gnus-newsgroup-dormant
7909                (gnus-summary-limit-include-dormant))
7910               ((and gnus-newsgroup-scored show-all)
7911                (gnus-summary-limit-include-expunged t))))
7912       ;; Function `gnus-apply-kill-file' must be called in this hook.
7913       (run-hooks 'gnus-apply-kill-hook)
7914       (if (and (zerop (buffer-size))
7915                (not no-display))
7916           (progn
7917             ;; This newsgroup is empty.
7918             (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
7919             (gnus-message 6 "No unread news")
7920             (when kill-buffer
7921               (gnus-kill-or-deaden-summary kill-buffer))
7922             ;; Return nil from this function.
7923             nil)
7924         ;; Hide conversation thread subtrees.  We cannot do this in
7925         ;; gnus-summary-prepare-hook since kill processing may not
7926         ;; work with hidden articles.
7927         (and gnus-show-threads
7928              gnus-thread-hide-subtree
7929              (gnus-summary-hide-all-threads))
7930         ;; Show first unread article if requested.
7931         (if (and (not no-article)
7932                  (not no-display)
7933                  gnus-newsgroup-unreads
7934                  gnus-auto-select-first)
7935             (unless (if (eq gnus-auto-select-first 'best)
7936                         (gnus-summary-best-unread-article)
7937                       (gnus-summary-first-unread-article))
7938               (gnus-configure-windows 'summary))
7939           ;; Don't select any articles, just move point to the first
7940           ;; article in the group.
7941           (goto-char (point-min))
7942           (gnus-summary-position-point)
7943           (gnus-set-mode-line 'summary)
7944           (gnus-configure-windows 'summary 'force))
7945         ;; If we are in async mode, we send some info to the backend.
7946         (when gnus-newsgroup-async
7947           (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data))
7948         (when kill-buffer
7949           (gnus-kill-or-deaden-summary kill-buffer))
7950         (when (get-buffer-window gnus-group-buffer t)
7951           ;; Gotta use windows, because recenter does wierd stuff if
7952           ;; the current buffer ain't the displayed window.
7953           (let ((owin (selected-window)))
7954             (select-window (get-buffer-window gnus-group-buffer t))
7955             (when (gnus-group-goto-group group)
7956               (recenter))
7957             (select-window owin))))
7958       ;; Mark this buffer as "prepared".
7959       (setq gnus-newsgroup-prepared t)
7960       t))))
7961
7962 (defun gnus-summary-prepare ()
7963   "Generate the summary buffer."
7964   (let ((buffer-read-only nil))
7965     (erase-buffer)
7966     (setq gnus-newsgroup-data nil
7967           gnus-newsgroup-data-reverse nil)
7968     (run-hooks 'gnus-summary-generate-hook)
7969     ;; Generate the buffer, either with threads or without.
7970     (when gnus-newsgroup-headers
7971       (gnus-summary-prepare-threads
7972        (if gnus-show-threads
7973            (gnus-sort-gathered-threads
7974             (funcall gnus-summary-thread-gathering-function
7975                      (gnus-sort-threads
7976                       (gnus-cut-threads (gnus-make-threads)))))
7977          ;; Unthreaded display.
7978          (gnus-sort-articles gnus-newsgroup-headers))))
7979     (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
7980     ;; Call hooks for modifying summary buffer.
7981     (goto-char (point-min))
7982     (run-hooks 'gnus-summary-prepare-hook)))
7983
7984 (defun gnus-gather-threads-by-subject (threads)
7985   "Gather threads by looking at Subject headers."
7986   (if (not gnus-summary-make-false-root)
7987       threads
7988     (let ((hashtb (gnus-make-hashtable 1023))
7989           (prev threads)
7990           (result threads)
7991           subject hthread whole-subject)
7992       (while threads
7993         (setq whole-subject (mail-header-subject (caar threads)))
7994         (setq subject
7995               (cond
7996                ;; Truncate the subject.
7997                ((numberp gnus-summary-gather-subject-limit)
7998                 (setq subject (gnus-simplify-subject-re whole-subject))
7999                 (if (> (length subject) gnus-summary-gather-subject-limit)
8000                     (substring subject 0 gnus-summary-gather-subject-limit)
8001                   subject))
8002                ;; Fuzzily simplify it.
8003                ((eq 'fuzzy gnus-summary-gather-subject-limit)
8004                 (gnus-simplify-subject-fuzzy whole-subject))
8005                ;; Just remove the leading "Re:".
8006                (t
8007                 (gnus-simplify-subject-re whole-subject))))
8008
8009         (if (and gnus-summary-gather-exclude-subject
8010                  (string-match gnus-summary-gather-exclude-subject
8011                                subject))
8012             ()          ; We don't want to do anything with this article.
8013           ;; We simplify the subject before looking it up in the
8014           ;; hash table.
8015
8016           (if (setq hthread (gnus-gethash subject hashtb))
8017               (progn
8018                 ;; We enter a dummy root into the thread, if we
8019                 ;; haven't done that already.
8020                 (unless (stringp (caar hthread))
8021                   (setcar hthread (list whole-subject (car hthread))))
8022                 ;; We add this new gathered thread to this gathered
8023                 ;; thread.
8024                 (setcdr (car hthread)
8025                         (nconc (cdar hthread) (list (car threads))))
8026                 ;; Remove it from the list of threads.
8027                 (setcdr prev (cdr threads))
8028                 (setq threads prev))
8029             ;; Enter this thread into the hash table.
8030             (gnus-sethash subject threads hashtb)))
8031         (setq prev threads)
8032         (setq threads (cdr threads)))
8033       result)))
8034
8035 (defun gnus-gather-threads-by-references (threads)
8036   "Gather threads by looking at References headers."
8037   (let ((idhashtb (gnus-make-hashtable 1023))
8038         (thhashtb (gnus-make-hashtable 1023))
8039         (prev threads)
8040         (result threads)
8041         ids references id gthread gid entered)
8042     (while threads
8043       (when (setq references (mail-header-references (caar threads)))
8044         (setq id (mail-header-id (caar threads)))
8045         (setq ids (gnus-split-references references))
8046         (setq entered nil)
8047         (while ids
8048           (if (not (setq gid (gnus-gethash (car ids) idhashtb)))
8049               (progn
8050                 (gnus-sethash (car ids) id idhashtb)
8051                 (gnus-sethash id threads thhashtb))
8052             (setq gthread (gnus-gethash gid thhashtb))
8053             (unless entered
8054               ;; We enter a dummy root into the thread, if we
8055               ;; haven't done that already.
8056               (unless (stringp (caar gthread))
8057                 (setcar gthread (list (mail-header-subject (caar gthread))
8058                                       (car gthread))))
8059               ;; We add this new gathered thread to this gathered
8060               ;; thread.
8061               (setcdr (car gthread)
8062                       (nconc (cdar gthread) (list (car threads)))))
8063             ;; Add it into the thread hash table.
8064             (gnus-sethash id gthread thhashtb)
8065             (setq entered t)
8066             ;; Remove it from the list of threads.
8067             (setcdr prev (cdr threads))
8068             (setq threads prev))
8069           (setq ids (cdr ids))))
8070       (setq prev threads)
8071       (setq threads (cdr threads)))
8072     result))
8073
8074 (defun gnus-sort-gathered-threads (threads)
8075   "Sort subtreads inside each gathered thread by article number."
8076   (let ((result threads))
8077     (while threads
8078       (when (stringp (caar threads))
8079         (setcdr (car threads)
8080                 (sort (cdar threads) 'gnus-thread-sort-by-number)))
8081       (setq threads (cdr threads)))
8082     result))
8083
8084 (defun gnus-make-threads ()
8085   "Go through the dependency hashtb and find the roots.  Return all threads."
8086   (let (threads)
8087     (mapatoms
8088      (lambda (refs)
8089        (unless (car (symbol-value refs))
8090          ;; These threads do not refer back to any other articles,
8091          ;; so they're roots.
8092          (setq threads (append (cdr (symbol-value refs)) threads))))
8093      gnus-newsgroup-dependencies)
8094     threads))
8095
8096 (defun gnus-build-sparse-threads ()
8097   (let ((headers gnus-newsgroup-headers)
8098         (deps gnus-newsgroup-dependencies)
8099         header references generation relations 
8100         cthread subject child end pthread relation)
8101     ;; First we create an alist of generations/relations, where 
8102     ;; generations is how much we trust the ralation, and the relation
8103     ;; is parent/child.
8104     (gnus-message 7 "Making sparse threads...")
8105     (save-excursion
8106       (nnheader-set-temp-buffer " *gnus sparse threads*")
8107       (while (setq header (pop headers))
8108         (when (and (setq references (mail-header-references header))
8109                    (not (string= references "")))
8110           (insert references)
8111           (setq child (mail-header-id header)
8112                 subject (mail-header-subject header))
8113           (setq generation 0)
8114           (while (search-backward ">" nil t)
8115             (setq end (1+ (point)))
8116             (when (search-backward "<" nil t)
8117               (push (list (incf generation) 
8118                           child (setq child (buffer-substring (point) end))
8119                           subject)
8120                     relations)))
8121           (push (list (1+ generation) child nil subject) relations)
8122           (erase-buffer)))
8123       (kill-buffer (current-buffer)))
8124     ;; Sort over trustworthiness.
8125     (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2)))))
8126     (while (setq relation (pop relations))
8127       (when (if (boundp (setq cthread (intern (cadr relation) deps)))
8128                 (unless (car (symbol-value cthread))
8129                   ;; Make this article the parent of these threads.
8130                   (setcar (symbol-value cthread)
8131                           (vector gnus-reffed-article-number 
8132                                   (cadddr relation) 
8133                                   "" ""
8134                                   (cadr relation) 
8135                                   (or (caddr relation) "") 0 0 "")))
8136               (set cthread (list (vector gnus-reffed-article-number
8137                                          (cadddr relation) 
8138                                          "" "" (cadr relation) 
8139                                          (or (caddr relation) "") 0 0 ""))))
8140         (push gnus-reffed-article-number gnus-newsgroup-limit)
8141         (push gnus-reffed-article-number gnus-newsgroup-sparse)
8142         (push (cons gnus-reffed-article-number gnus-sparse-mark)
8143               gnus-newsgroup-reads)
8144         (decf gnus-reffed-article-number)
8145         ;; Make this new thread the child of its parent.
8146         (if (boundp (setq pthread (intern (or (caddr relation) "none") deps)))
8147             (setcdr (symbol-value pthread)
8148                     (nconc (cdr (symbol-value pthread))
8149                            (list (symbol-value cthread))))
8150           (set pthread (list nil (symbol-value cthread))))))
8151     (gnus-message 7 "Making sparse threads...done")))
8152
8153 (defun gnus-build-old-threads ()
8154   ;; Look at all the articles that refer back to old articles, and
8155   ;; fetch the headers for the articles that aren't there.  This will
8156   ;; build complete threads - if the roots haven't been expired by the
8157   ;; server, that is.
8158   (let (id heads)
8159     (mapatoms
8160      (lambda (refs)
8161        (when (not (car (symbol-value refs)))
8162          (setq heads (cdr (symbol-value refs)))
8163          (while heads
8164            (if (memq (mail-header-number (caar heads))
8165                      gnus-newsgroup-dormant)
8166                (setq heads (cdr heads))
8167              (setq id (symbol-name refs))
8168              (while (and (setq id (gnus-build-get-header id))
8169                          (not (car (gnus-gethash
8170                                     id gnus-newsgroup-dependencies)))))
8171              (setq heads nil)))))
8172      gnus-newsgroup-dependencies)))
8173
8174 (defun gnus-build-get-header (id)
8175   ;; Look through the buffer of NOV lines and find the header to
8176   ;; ID.  Enter this line into the dependencies hash table, and return
8177   ;; the id of the parent article (if any).
8178   (let ((deps gnus-newsgroup-dependencies)
8179         found header)
8180     (prog1
8181         (save-excursion
8182           (set-buffer nntp-server-buffer)
8183           (goto-char (point-min))
8184           (while (and (not found) (search-forward id nil t))
8185             (beginning-of-line)
8186             (setq found (looking-at
8187                          (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
8188                                  (regexp-quote id))))
8189             (or found (beginning-of-line 2)))
8190           (when found
8191             (beginning-of-line)
8192             (and
8193              (setq header (gnus-nov-parse-line
8194                            (read (current-buffer)) deps))
8195              (gnus-parent-id (mail-header-references header)))))
8196       (when header
8197         (let ((number (mail-header-number header)))
8198           (push number gnus-newsgroup-limit)
8199           (push header gnus-newsgroup-headers)
8200           (if (memq number gnus-newsgroup-unselected)
8201               (progn
8202                 (push number gnus-newsgroup-unreads)
8203                 (setq gnus-newsgroup-unselected
8204                       (delq number gnus-newsgroup-unselected)))
8205             (push number gnus-newsgroup-ancient)))))))
8206
8207 (defun gnus-summary-update-article (article &optional iheader)
8208   "Update ARTICLE in the summary buffer."
8209   (set-buffer gnus-summary-buffer)
8210   (let* ((header (or iheader (gnus-summary-article-header article)))
8211          (id (mail-header-id header))
8212          (data (gnus-data-find article))
8213          (thread (gnus-id-to-thread id))
8214          (references (mail-header-references header))
8215          (parent
8216           (gnus-id-to-thread
8217            (or (gnus-parent-id 
8218                 (if (and references
8219                          (not (equal "" references)))
8220                     references))
8221                "none")))
8222          (buffer-read-only nil)
8223          (old (car thread))
8224          (number (mail-header-number header))
8225          pos)
8226     (when thread
8227       ;; !!! Should this be in or not?
8228       (unless iheader
8229         (setcar thread nil))
8230       (when parent
8231         (delq thread parent))
8232       (if (gnus-summary-insert-subject id header iheader)
8233           ;; Set the (possibly) new article number in the data structure.
8234           (gnus-data-set-number data (gnus-id-to-article id))
8235         (setcar thread old)
8236         nil))))
8237
8238 (defun gnus-rebuild-thread (id)
8239   "Rebuild the thread containing ID."
8240   (let ((buffer-read-only nil)
8241         current thread data)
8242     (if (not gnus-show-threads)
8243         (setq thread (list (car (gnus-id-to-thread id))))
8244       ;; Get the thread this article is part of.
8245       (setq thread (gnus-remove-thread id)))
8246     (setq current (save-excursion
8247                     (and (zerop (forward-line -1))
8248                          (gnus-summary-article-number))))
8249     ;; If this is a gathered thread, we have to go some re-gathering.
8250     (when (stringp (car thread))
8251       (let ((subject (car thread))
8252             roots thr)
8253         (setq thread (cdr thread))
8254         (while thread
8255           (unless (memq (setq thr (gnus-id-to-thread
8256                                       (gnus-root-id
8257                                        (mail-header-id (caar thread)))))
8258                         roots)
8259             (push thr roots))
8260           (setq thread (cdr thread)))
8261         ;; We now have all (unique) roots.
8262         (if (= (length roots) 1)
8263             ;; All the loose roots are now one solid root.
8264             (setq thread (car roots))
8265           (setq thread (cons subject (gnus-sort-threads roots))))))
8266     (let (threads)
8267       ;; We then insert this thread into the summary buffer.
8268       (let (gnus-newsgroup-data gnus-newsgroup-threads)
8269         (gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
8270         (setq data (nreverse gnus-newsgroup-data))
8271         (setq threads gnus-newsgroup-threads))
8272       ;; We splice the new data into the data structure.
8273       (gnus-data-enter-list current data)
8274       (gnus-data-compute-positions)
8275       (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
8276
8277 (defun gnus-number-to-header (number)
8278   "Return the header for article NUMBER."
8279   (let ((headers gnus-newsgroup-headers))
8280     (while (and headers
8281                 (not (= number (mail-header-number (car headers)))))
8282       (pop headers))
8283     (when headers
8284       (car headers))))
8285
8286 (defun gnus-id-to-thread (id)
8287   "Return the (sub-)thread where ID appears."
8288   (gnus-gethash id gnus-newsgroup-dependencies))
8289
8290 (defun gnus-id-to-article (id)
8291   "Return the article number of ID."
8292   (let ((thread (gnus-id-to-thread id)))
8293     (when (and thread
8294                (car thread))
8295       (mail-header-number (car thread)))))
8296
8297 (defun gnus-id-to-header (id)
8298   "Return the article headers of ID."
8299   (car (gnus-id-to-thread id)))
8300
8301 (defun gnus-article-displayed-root-p (article)
8302   "Say whether ARTICLE is a root(ish) article."
8303   (let ((level (gnus-summary-thread-level article))
8304         (refs (mail-header-references  (gnus-summary-article-header article)))
8305         particle)
8306     (cond 
8307      ((null level) nil)
8308      ((zerop level) t)
8309      ((null refs) t)
8310      ((null (gnus-parent-id refs)) t)
8311      ((and (= 1 level)
8312            (null (setq particle (gnus-id-to-article
8313                                  (gnus-parent-id refs))))
8314            (null (gnus-summary-thread-level particle)))))))
8315
8316 (defun gnus-root-id (id)
8317   "Return the id of the root of the thread where ID appears."
8318   (let (last-id prev)
8319     (while (and id (setq prev (car (gnus-gethash 
8320                                     id gnus-newsgroup-dependencies))))
8321       (setq last-id id
8322             id (gnus-parent-id (mail-header-references prev))))
8323     last-id))
8324
8325 (defun gnus-remove-thread (id &optional dont-remove)
8326   "Remove the thread that has ID in it."
8327   (let ((dep gnus-newsgroup-dependencies)
8328         headers thread last-id)
8329     ;; First go up in this thread until we find the root.
8330     (setq last-id (gnus-root-id id))
8331     (setq headers (list (car (gnus-id-to-thread last-id))
8332                         (caadr (gnus-id-to-thread last-id))))
8333     ;; We have now found the real root of this thread.  It might have
8334     ;; been gathered into some loose thread, so we have to search
8335     ;; through the threads to find the thread we wanted.
8336     (let ((threads gnus-newsgroup-threads)
8337           sub)
8338       (while threads
8339         (setq sub (car threads))
8340         (if (stringp (car sub))
8341             ;; This is a gathered thread, so we look at the roots
8342             ;; below it to find whether this article is in this
8343             ;; gathered root.
8344             (progn
8345               (setq sub (cdr sub))
8346               (while sub
8347                 (when (member (caar sub) headers)
8348                   (setq thread (car threads)
8349                         threads nil
8350                         sub nil))
8351                 (setq sub (cdr sub))))
8352           ;; It's an ordinary thread, so we check it.
8353           (when (eq (car sub) (car headers))
8354             (setq thread sub
8355                   threads nil)))
8356         (setq threads (cdr threads)))
8357       ;; If this article is in no thread, then it's a root.
8358       (if thread
8359           (unless dont-remove
8360             (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
8361         (setq thread (gnus-gethash last-id dep)))
8362       (when thread
8363         (prog1
8364             thread ; We return this thread.
8365           (unless dont-remove
8366             (if (stringp (car thread))
8367                 (progn
8368                   ;; If we use dummy roots, then we have to remove the
8369                   ;; dummy root as well.
8370                   (when (eq gnus-summary-make-false-root 'dummy)
8371                     ;; Uhm.
8372                     )
8373                   (setq thread (cdr thread))
8374                   (while thread
8375                     (gnus-remove-thread-1 (car thread))
8376                     (setq thread (cdr thread))))
8377               (gnus-remove-thread-1 thread))))))))
8378
8379 (defun gnus-remove-thread-1 (thread)
8380   "Remove the thread THREAD recursively."
8381   (let ((number (mail-header-number (car thread)))
8382         pos)
8383     (when (setq pos (text-property-any
8384                      (point-min) (point-max) 'gnus-number number))
8385       (goto-char pos)
8386       (gnus-delete-line)
8387       (gnus-data-remove number))
8388     (setq thread (cdr thread))
8389     (while thread
8390       (gnus-remove-thread-1 (pop thread)))))
8391
8392 (defun gnus-sort-threads (threads)
8393   "Sort THREADS."
8394   (if (not gnus-thread-sort-functions)
8395       threads
8396     (let ((func (if (= 1 (length gnus-thread-sort-functions))
8397                     (car gnus-thread-sort-functions)
8398                   `(lambda (t1 t2)
8399                      ,(gnus-make-sort-function 
8400                        (reverse gnus-thread-sort-functions))))))
8401       (gnus-message 7 "Sorting threads...")
8402       (prog1
8403           (sort threads func)
8404         (gnus-message 7 "Sorting threads...done")))))
8405
8406 (defun gnus-sort-articles (articles)
8407   "Sort ARTICLES."
8408   (when gnus-article-sort-functions
8409     (let ((func (if (= 1 (length gnus-article-sort-functions))
8410                     (car gnus-article-sort-functions)
8411                   `(lambda (t1 t2)
8412                      ,(gnus-make-sort-function 
8413                        (reverse gnus-article-sort-functions))))))
8414       (gnus-message 7 "Sorting articles...")
8415       (prog1
8416           (setq gnus-newsgroup-headers (sort articles func))
8417         (gnus-message 7 "Sorting articles...done")))))
8418
8419 (defun gnus-make-sort-function (funs)
8420   "Return a composite sort condition based on the functions in FUNC."
8421   (if (cdr funs)
8422       `(or (,(car funs) t1 t2)
8423            (and (not (,(car funs) t2 t1))
8424                 ,(gnus-make-sort-function (cdr funs))))
8425     `(,(car funs) t1 t2)))
8426                  
8427 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
8428 (defmacro gnus-thread-header (thread)
8429   ;; Return header of first article in THREAD.
8430   ;; Note that THREAD must never, ever be anything else than a variable -
8431   ;; using some other form will lead to serious barfage.
8432   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
8433   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
8434   (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
8435         (vector thread) 2))
8436
8437 (defsubst gnus-article-sort-by-number (h1 h2)
8438   "Sort articles by article number."
8439   (< (mail-header-number h1)
8440      (mail-header-number h2)))
8441
8442 (defun gnus-thread-sort-by-number (h1 h2)
8443   "Sort threads by root article number."
8444   (gnus-article-sort-by-number
8445    (gnus-thread-header h1) (gnus-thread-header h2)))
8446
8447 (defsubst gnus-article-sort-by-author (h1 h2)
8448   "Sort articles by root author."
8449   (string-lessp
8450    (let ((extract (funcall
8451                    gnus-extract-address-components
8452                    (mail-header-from h1))))
8453      (or (car extract) (cdr extract)))
8454    (let ((extract (funcall
8455                    gnus-extract-address-components
8456                    (mail-header-from h2))))
8457      (or (car extract) (cdr extract)))))
8458
8459 (defun gnus-thread-sort-by-author (h1 h2)
8460   "Sort threads by root author."
8461   (gnus-article-sort-by-author
8462    (gnus-thread-header h1)  (gnus-thread-header h2)))
8463
8464 (defsubst gnus-article-sort-by-subject (h1 h2)
8465   "Sort articles by root subject."
8466   (string-lessp
8467    (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
8468    (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
8469
8470 (defun gnus-thread-sort-by-subject (h1 h2)
8471   "Sort threads by root subject."
8472   (gnus-article-sort-by-subject
8473    (gnus-thread-header h1) (gnus-thread-header h2)))
8474
8475 (defsubst gnus-article-sort-by-date (h1 h2)
8476   "Sort articles by root article date."
8477   (string-lessp
8478    (inline (gnus-sortable-date (mail-header-date h1)))
8479    (inline (gnus-sortable-date (mail-header-date h2)))))
8480
8481 (defun gnus-thread-sort-by-date (h1 h2)
8482   "Sort threads by root article date."
8483   (gnus-article-sort-by-date
8484    (gnus-thread-header h1) (gnus-thread-header h2)))
8485
8486 (defsubst gnus-article-sort-by-score (h1 h2)
8487   "Sort articles by root article score.
8488 Unscored articles will be counted as having a score of zero."
8489   (> (or (cdr (assq (mail-header-number h1)
8490                     gnus-newsgroup-scored))
8491          gnus-summary-default-score 0)
8492      (or (cdr (assq (mail-header-number h2)
8493                     gnus-newsgroup-scored))
8494          gnus-summary-default-score 0)))
8495
8496 (defun gnus-thread-sort-by-score (h1 h2)
8497   "Sort threads by root article score."
8498   (gnus-article-sort-by-score
8499    (gnus-thread-header h1) (gnus-thread-header h2)))
8500
8501 (defun gnus-thread-sort-by-total-score (h1 h2)
8502   "Sort threads by the sum of all scores in the thread.
8503 Unscored articles will be counted as having a score of zero."
8504   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
8505
8506 (defun gnus-thread-total-score (thread)
8507   ;;  This function find the total score of THREAD.
8508   (cond ((null thread)
8509          0)
8510         ((consp thread)
8511          (if (stringp (car thread))
8512              (apply gnus-thread-score-function 0
8513                     (mapcar 'gnus-thread-total-score-1 (cdr thread)))
8514            (gnus-thread-total-score-1 thread)))
8515         (t
8516          (gnus-thread-total-score-1 (list thread)))))
8517
8518 (defun gnus-thread-total-score-1 (root)
8519   ;; This function find the total score of the thread below ROOT.
8520   (setq root (car root))
8521   (apply gnus-thread-score-function
8522          (or (append
8523               (mapcar 'gnus-thread-total-score
8524                       (cdr (gnus-gethash (mail-header-id root)
8525                                          gnus-newsgroup-dependencies)))
8526                  (if (> (mail-header-number root) 0)
8527                      (list (or (cdr (assq (mail-header-number root) 
8528                                           gnus-newsgroup-scored))
8529                                gnus-summary-default-score 0))))
8530              (list gnus-summary-default-score)
8531              '(0))))
8532
8533 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
8534 (defvar gnus-tmp-prev-subject nil)
8535 (defvar gnus-tmp-false-parent nil)
8536 (defvar gnus-tmp-root-expunged nil)
8537 (defvar gnus-tmp-dummy-line nil)
8538
8539 (defun gnus-summary-prepare-threads (threads)
8540   "Prepare summary buffer from THREADS and indentation LEVEL.
8541 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
8542 or a straight list of headers."
8543   (gnus-message 7 "Generating summary...")
8544
8545   (setq gnus-newsgroup-threads threads)
8546   (beginning-of-line)
8547
8548   (let ((gnus-tmp-level 0)
8549         (default-score (or gnus-summary-default-score 0))
8550         (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
8551         thread number subject stack state gnus-tmp-gathered beg-match
8552         new-roots gnus-tmp-new-adopts thread-end
8553         gnus-tmp-header gnus-tmp-unread
8554         gnus-tmp-replied gnus-tmp-subject-or-nil
8555         gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
8556         gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
8557         gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
8558
8559     (setq gnus-tmp-prev-subject nil)
8560
8561     (if (vectorp (car threads))
8562         ;; If this is a straight (sic) list of headers, then a
8563         ;; threaded summary display isn't required, so we just create
8564         ;; an unthreaded one.
8565         (gnus-summary-prepare-unthreaded threads)
8566
8567       ;; Do the threaded display.
8568
8569       (while (or threads stack gnus-tmp-new-adopts new-roots)
8570
8571         (if (and (= gnus-tmp-level 0)
8572                  (not (setq gnus-tmp-dummy-line nil))
8573                  (or (not stack)
8574                      (= (caar stack) 0))
8575                  (not gnus-tmp-false-parent)
8576                  (or gnus-tmp-new-adopts new-roots))
8577             (if gnus-tmp-new-adopts
8578                 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
8579                       thread (list (car gnus-tmp-new-adopts))
8580                       gnus-tmp-header (caar thread)
8581                       gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
8582               (if new-roots
8583                   (setq thread (list (car new-roots))
8584                         gnus-tmp-header (caar thread)
8585                         new-roots (cdr new-roots))))
8586
8587           (if threads
8588               ;; If there are some threads, we do them before the
8589               ;; threads on the stack.
8590               (setq thread threads
8591                     gnus-tmp-header (caar thread))
8592             ;; There were no current threads, so we pop something off
8593             ;; the stack.
8594             (setq state (car stack)
8595                   gnus-tmp-level (car state)
8596                   thread (cdr state)
8597                   stack (cdr stack)
8598                   gnus-tmp-header (caar thread))))
8599
8600         (setq gnus-tmp-false-parent nil)
8601         (setq gnus-tmp-root-expunged nil)
8602         (setq thread-end nil)
8603
8604         (if (stringp gnus-tmp-header)
8605             ;; The header is a dummy root.
8606             (cond
8607              ((eq gnus-summary-make-false-root 'adopt)
8608               ;; We let the first article adopt the rest.
8609               (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
8610                                                (cddar thread)))
8611               (setq gnus-tmp-gathered
8612                     (nconc (mapcar
8613                             (lambda (h) (mail-header-number (car h)))
8614                             (cddar thread))
8615                            gnus-tmp-gathered))
8616               (setq thread (cons (list (caar thread)
8617                                        (cadar thread))
8618                                  (cdr thread)))
8619               (setq gnus-tmp-level -1
8620                     gnus-tmp-false-parent t))
8621              ((eq gnus-summary-make-false-root 'empty)
8622               ;; We print adopted articles with empty subject fields.
8623               (setq gnus-tmp-gathered
8624                     (nconc (mapcar
8625                             (lambda (h) (mail-header-number (car h)))
8626                             (cddar thread))
8627                            gnus-tmp-gathered))
8628               (setq gnus-tmp-level -1))
8629              ((eq gnus-summary-make-false-root 'dummy)
8630               ;; We remember that we probably want to output a dummy
8631               ;; root.
8632               (setq gnus-tmp-dummy-line gnus-tmp-header)
8633               (setq gnus-tmp-prev-subject gnus-tmp-header))
8634              (t
8635               ;; We do not make a root for the gathered
8636               ;; sub-threads at all.
8637               (setq gnus-tmp-level -1)))
8638
8639           (setq number (mail-header-number gnus-tmp-header)
8640                 subject (mail-header-subject gnus-tmp-header))
8641
8642           (cond
8643            ;; If the thread has changed subject, we might want to make
8644            ;; this subthread into a root.
8645            ((and (null gnus-thread-ignore-subject)
8646                  (not (zerop gnus-tmp-level))
8647                  gnus-tmp-prev-subject
8648                  (not (inline
8649                         (gnus-subject-equal gnus-tmp-prev-subject subject))))
8650             (setq new-roots (nconc new-roots (list (car thread)))
8651                   thread-end t
8652                   gnus-tmp-header nil))
8653            ;; If the article lies outside the current limit,
8654            ;; then we do not display it.
8655            ((and (not (memq number gnus-newsgroup-limit))
8656                  (not gnus-tmp-dummy-line))
8657             (setq gnus-tmp-gathered
8658                   (nconc (mapcar
8659                           (lambda (h) (mail-header-number (car h)))
8660                           (cdar thread))
8661                          gnus-tmp-gathered))
8662             (setq gnus-tmp-new-adopts (if (cdar thread)
8663                                           (append gnus-tmp-new-adopts
8664                                                   (cdar thread))
8665                                         gnus-tmp-new-adopts)
8666                   thread-end t
8667                   gnus-tmp-header nil)
8668             (when (zerop gnus-tmp-level)
8669               (setq gnus-tmp-root-expunged t)))
8670            ;; Perhaps this article is to be marked as read?
8671            ((and gnus-summary-mark-below
8672                  (< (or (cdr (assq number gnus-newsgroup-scored))
8673                         default-score)
8674                     gnus-summary-mark-below)
8675                  ;; Don't touch sparse articles.
8676                  (not (memq number gnus-newsgroup-sparse))
8677                  (not (memq number gnus-newsgroup-ancient)))
8678             (setq gnus-newsgroup-unreads
8679                   (delq number gnus-newsgroup-unreads))
8680             (if gnus-newsgroup-auto-expire
8681                 (push number gnus-newsgroup-expirable)
8682               (push (cons number gnus-low-score-mark)
8683                     gnus-newsgroup-reads))))
8684
8685           (when gnus-tmp-header
8686             ;; We may have an old dummy line to output before this
8687             ;; article.
8688             (when gnus-tmp-dummy-line
8689               (gnus-summary-insert-dummy-line
8690                gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
8691               (setq gnus-tmp-dummy-line nil))
8692
8693             ;; Compute the mark.
8694             (setq
8695              gnus-tmp-unread
8696              (cond
8697               ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8698               ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8699               ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8700               ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8701               (t (or (cdr (assq number gnus-newsgroup-reads))
8702                      gnus-ancient-mark))))
8703
8704             (push (gnus-data-make number gnus-tmp-unread (1+ (point))
8705                                   gnus-tmp-header gnus-tmp-level)
8706                   gnus-newsgroup-data)
8707
8708             ;; Actually insert the line.
8709             (setq
8710              gnus-tmp-subject-or-nil
8711              (cond
8712               ((and gnus-thread-ignore-subject
8713                     gnus-tmp-prev-subject
8714                     (not (inline (gnus-subject-equal
8715                                   gnus-tmp-prev-subject subject))))
8716                subject)
8717               ((zerop gnus-tmp-level)
8718                (if (and (eq gnus-summary-make-false-root 'empty)
8719                         (memq number gnus-tmp-gathered)
8720                         gnus-tmp-prev-subject
8721                         (inline (gnus-subject-equal
8722                                  gnus-tmp-prev-subject subject)))
8723                    gnus-summary-same-subject
8724                  subject))
8725               (t gnus-summary-same-subject)))
8726             (if (and (eq gnus-summary-make-false-root 'adopt)
8727                      (= gnus-tmp-level 1)
8728                      (memq number gnus-tmp-gathered))
8729                 (setq gnus-tmp-opening-bracket ?\<
8730                       gnus-tmp-closing-bracket ?\>)
8731               (setq gnus-tmp-opening-bracket ?\[
8732                     gnus-tmp-closing-bracket ?\]))
8733             (setq
8734              gnus-tmp-indentation
8735              (aref gnus-thread-indent-array gnus-tmp-level)
8736              gnus-tmp-lines (mail-header-lines gnus-tmp-header)
8737              gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
8738                                 gnus-summary-default-score 0)
8739              gnus-tmp-score-char
8740              (if (or (null gnus-summary-default-score)
8741                      (<= (abs (- gnus-tmp-score gnus-summary-default-score))
8742                          gnus-summary-zcore-fuzz)) ? 
8743                (if (< gnus-tmp-score gnus-summary-default-score)
8744                    gnus-score-below-mark gnus-score-over-mark))
8745              gnus-tmp-replied
8746              (cond ((memq number gnus-newsgroup-processable)
8747                     gnus-process-mark)
8748                    ((memq number gnus-newsgroup-cached)
8749                     gnus-cached-mark)
8750                    ((memq number gnus-newsgroup-replied)
8751                     gnus-replied-mark)
8752                    ((memq number gnus-newsgroup-saved)
8753                     gnus-saved-mark)
8754                    (t gnus-unread-mark))
8755              gnus-tmp-from (mail-header-from gnus-tmp-header)
8756              gnus-tmp-name
8757              (cond
8758               ((string-match "(.+)" gnus-tmp-from)
8759                (substring gnus-tmp-from
8760                           (1+ (match-beginning 0)) (1- (match-end 0))))
8761               ((string-match "<[^>]+> *$" gnus-tmp-from)
8762                (setq beg-match (match-beginning 0))
8763                (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
8764                         (substring gnus-tmp-from (1+ (match-beginning 0))
8765                                    (1- (match-end 0))))
8766                    (substring gnus-tmp-from 0 beg-match)))
8767               (t gnus-tmp-from)))
8768             (when (string= gnus-tmp-name "")
8769               (setq gnus-tmp-name gnus-tmp-from))
8770             (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
8771             (gnus-put-text-property
8772              (point)
8773              (progn (eval gnus-summary-line-format-spec) (point))
8774              'gnus-number number)
8775             (when gnus-visual-p
8776               (forward-line -1)
8777               (run-hooks 'gnus-summary-update-hook)
8778               (forward-line 1))
8779
8780             (setq gnus-tmp-prev-subject subject)))
8781
8782         (when (nth 1 thread)
8783           (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
8784         (incf gnus-tmp-level)
8785         (setq threads (if thread-end nil (cdar thread)))
8786         (unless threads
8787           (setq gnus-tmp-level 0)))))
8788   (gnus-message 7 "Generating summary...done"))
8789
8790 (defun gnus-summary-prepare-unthreaded (headers)
8791   "Generate an unthreaded summary buffer based on HEADERS."
8792   (let (header number mark)
8793
8794     (while headers
8795       ;; We may have to root out some bad articles...
8796       (when (memq (setq number (mail-header-number
8797                                 (setq header (pop headers))))
8798                   gnus-newsgroup-limit)
8799         ;; Mark article as read when it has a low score.
8800         (when (and gnus-summary-mark-below
8801                    (< (or (cdr (assq number gnus-newsgroup-scored))
8802                           gnus-summary-default-score 0)
8803                       gnus-summary-mark-below)
8804                    (not (memq number gnus-newsgroup-ancient)))
8805           (setq gnus-newsgroup-unreads
8806                 (delq number gnus-newsgroup-unreads))
8807           (if gnus-newsgroup-auto-expire
8808               (push number gnus-newsgroup-expirable)
8809             (push (cons number gnus-low-score-mark)
8810                   gnus-newsgroup-reads)))
8811
8812         (setq mark
8813               (cond
8814                ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8815                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8816                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8817                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8818                (t (or (cdr (assq number gnus-newsgroup-reads))
8819                       gnus-ancient-mark))))
8820         (setq gnus-newsgroup-data
8821               (cons (gnus-data-make number mark (1+ (point)) header 0)
8822                     gnus-newsgroup-data))
8823         (gnus-summary-insert-line
8824          header 0 nil mark (memq number gnus-newsgroup-replied)
8825          (memq number gnus-newsgroup-expirable)
8826          (mail-header-subject header) nil
8827          (cdr (assq number gnus-newsgroup-scored))
8828          (memq number gnus-newsgroup-processable))))))
8829
8830 (defun gnus-select-newsgroup (group &optional read-all)
8831   "Select newsgroup GROUP.
8832 If READ-ALL is non-nil, all articles in the group are selected."
8833   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
8834          (info (nth 2 entry))
8835          articles fetched-articles cached)
8836
8837     (or (gnus-check-server
8838          (setq gnus-current-select-method (gnus-find-method-for-group group)))
8839         (error "Couldn't open server"))
8840
8841     (or (and entry (not (eq (car entry) t))) ; Either it's active...
8842         (gnus-activate-group group)     ; Or we can activate it...
8843         (progn                          ; Or we bug out.
8844           (when (equal major-mode 'gnus-summary-mode)
8845             (kill-buffer (current-buffer)))
8846           (error "Couldn't request group %s: %s"
8847                  group (gnus-status-message group))))
8848
8849     (unless (gnus-request-group group t)
8850       (when (equal major-mode 'gnus-summary-mode)
8851         (kill-buffer (current-buffer)))
8852       (error "Couldn't request group %s: %s"
8853              group (gnus-status-message group)))      
8854
8855     (setq gnus-newsgroup-name group)
8856     (setq gnus-newsgroup-unselected nil)
8857     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
8858
8859     (and gnus-asynchronous
8860          (gnus-check-backend-function
8861           'request-asynchronous gnus-newsgroup-name)
8862          (setq gnus-newsgroup-async
8863                (gnus-request-asynchronous gnus-newsgroup-name)))
8864
8865     ;; Adjust and set lists of article marks.
8866     (when info
8867       (gnus-adjust-marked-articles info))
8868
8869     ;; Kludge to avoid having cached articles nixed out in virtual groups.
8870     (when (gnus-virtual-group-p group)
8871       (setq cached gnus-newsgroup-cached))
8872
8873     (setq gnus-newsgroup-unreads
8874           (gnus-set-difference
8875            (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
8876            gnus-newsgroup-dormant))
8877
8878     (setq gnus-newsgroup-processable nil)
8879
8880     (setq articles (gnus-articles-to-read group read-all))
8881
8882     (cond
8883      ((null articles)
8884       ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
8885       'quit)
8886      ((eq articles 0) nil)
8887      (t
8888       ;; Init the dependencies hash table.
8889       (setq gnus-newsgroup-dependencies
8890             (gnus-make-hashtable (length articles)))
8891       ;; Retrieve the headers and read them in.
8892       (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
8893       (setq gnus-newsgroup-headers
8894             (if (eq 'nov
8895                     (setq gnus-headers-retrieved-by
8896                           (gnus-retrieve-headers
8897                            articles gnus-newsgroup-name
8898                            ;; We might want to fetch old headers, but
8899                            ;; not if there is only 1 article.
8900                            (and gnus-fetch-old-headers
8901                                 (or (and
8902                                      (not (eq gnus-fetch-old-headers 'some))
8903                                      (not (numberp gnus-fetch-old-headers)))
8904                                     (> (length articles) 1))))))
8905                 (gnus-get-newsgroup-headers-xover articles)
8906               (gnus-get-newsgroup-headers)))
8907       (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
8908
8909       ;; Kludge to avoid having cached articles nixed out in virtual groups.
8910       (when cached
8911         (setq gnus-newsgroup-cached cached))
8912
8913       ;; Set the initial limit.
8914       (setq gnus-newsgroup-limit (copy-sequence articles))
8915       ;; Remove canceled articles from the list of unread articles.
8916       (setq gnus-newsgroup-unreads
8917             (gnus-set-sorted-intersection
8918              gnus-newsgroup-unreads
8919              (setq fetched-articles
8920                    (mapcar (lambda (headers) (mail-header-number headers))
8921                            gnus-newsgroup-headers))))
8922       ;; Removed marked articles that do not exist.
8923       (gnus-update-missing-marks
8924        (gnus-sorted-complement fetched-articles articles))
8925       ;; We might want to build some more threads first.
8926       (and gnus-fetch-old-headers
8927            (eq gnus-headers-retrieved-by 'nov)
8928            (gnus-build-old-threads))
8929       ;; Check whether auto-expire is to be done in this group.
8930       (setq gnus-newsgroup-auto-expire
8931             (gnus-group-auto-expirable-p group))
8932       ;; Set up the article buffer now, if necessary.
8933       (unless gnus-single-article-buffer
8934         (gnus-article-setup-buffer))
8935       ;; First and last article in this newsgroup.
8936       (when gnus-newsgroup-headers
8937         (setq gnus-newsgroup-begin
8938               (mail-header-number (car gnus-newsgroup-headers))
8939               gnus-newsgroup-end
8940               (mail-header-number
8941                (gnus-last-element gnus-newsgroup-headers))))
8942       ;; GROUP is successfully selected.
8943       (or gnus-newsgroup-headers t)))))
8944
8945 (defun gnus-articles-to-read (group read-all)
8946   ;; Find out what articles the user wants to read.
8947   (let* ((articles
8948           ;; Select all articles if `read-all' is non-nil, or if there
8949           ;; are no unread articles.
8950           (if (or read-all
8951                   (and (zerop (length gnus-newsgroup-marked))
8952                        (zerop (length gnus-newsgroup-unreads))))
8953               (gnus-uncompress-range (gnus-active group))
8954             (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
8955                           (copy-sequence gnus-newsgroup-unreads))
8956                   '<)))
8957          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
8958          (scored (length scored-list))
8959          (number (length articles))
8960          (marked (+ (length gnus-newsgroup-marked)
8961                     (length gnus-newsgroup-dormant)))
8962          (select
8963           (cond
8964            ((numberp read-all)
8965             read-all)
8966            (t
8967             (condition-case ()
8968                 (cond
8969                  ((and (or (<= scored marked) (= scored number))
8970                        (numberp gnus-large-newsgroup)
8971                        (> number gnus-large-newsgroup))
8972                   (let ((input
8973                          (read-string
8974                           (format
8975                            "How many articles from %s (default %d): "
8976                            gnus-newsgroup-name number))))
8977                     (if (string-match "^[ \t]*$" input) number input)))
8978                  ((and (> scored marked) (< scored number)
8979                        (> (- scored number) 20))
8980                   (let ((input
8981                          (read-string
8982                           (format "%s %s (%d scored, %d total): "
8983                                   "How many articles from"
8984                                   group scored number))))
8985                     (if (string-match "^[ \t]*$" input)
8986                         number input)))
8987                  (t number))
8988               (quit nil))))))
8989     (setq select (if (stringp select) (string-to-number select) select))
8990     (if (or (null select) (zerop select))
8991         select
8992       (if (and (not (zerop scored)) (<= (abs select) scored))
8993           (progn
8994             (setq articles (sort scored-list '<))
8995             (setq number (length articles)))
8996         (setq articles (copy-sequence articles)))
8997
8998       (if (< (abs select) number)
8999           (if (< select 0)
9000               ;; Select the N oldest articles.
9001               (setcdr (nthcdr (1- (abs select)) articles) nil)
9002             ;; Select the N most recent articles.
9003             (setq articles (nthcdr (- number select) articles))))
9004       (setq gnus-newsgroup-unselected
9005             (gnus-sorted-intersection
9006              gnus-newsgroup-unreads
9007              (gnus-sorted-complement gnus-newsgroup-unreads articles)))
9008       articles)))
9009
9010 (defun gnus-killed-articles (killed articles)
9011   (let (out)
9012     (while articles
9013       (if (inline (gnus-member-of-range (car articles) killed))
9014           (setq out (cons (car articles) out)))
9015       (setq articles (cdr articles)))
9016     out))
9017
9018 (defun gnus-uncompress-marks (marks)
9019   "Uncompress the mark ranges in MARKS."
9020   (let ((uncompressed '(score bookmark))
9021         out)
9022     (while marks
9023       (if (memq (caar marks) uncompressed)
9024           (push (car marks) out)
9025         (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
9026       (setq marks (cdr marks)))
9027     out))
9028
9029 (defun gnus-adjust-marked-articles (info)
9030   "Set all article lists and remove all marks that are no longer legal."
9031   (let* ((marked-lists (gnus-info-marks info))
9032          (active (gnus-active (gnus-info-group info)))
9033          (min (car active))
9034          (max (cdr active))
9035          (types gnus-article-mark-lists)
9036          (uncompressed '(score bookmark killed))
9037          marks var articles article mark)
9038
9039     (while marked-lists
9040       (setq marks (pop marked-lists))
9041       (set (setq var (intern (format "gnus-newsgroup-%s"
9042                                      (car (rassq (setq mark (car marks))
9043                                                  types)))))
9044            (if (memq (car marks) uncompressed) (cdr marks)
9045              (gnus-uncompress-range (cdr marks))))
9046
9047       (setq articles (symbol-value var))
9048
9049       ;; All articles have to be subsets of the active articles.
9050       (cond
9051        ;; Adjust "simple" lists.
9052        ((memq mark '(tick dormant expirable reply save))
9053         (while articles
9054           (when (or (< (setq article (pop articles)) min) (> article max))
9055             (set var (delq article (symbol-value var))))))
9056        ;; Adjust assocs.
9057        ((memq mark uncompressed)
9058         (while articles
9059           (when (or (not (consp (setq article (pop articles))))
9060                     (< (car article) min)
9061                     (> (car article) max))
9062             (set var (delq article (symbol-value var))))))))))
9063
9064 (defun gnus-update-missing-marks (missing)
9065   "Go through the list of MISSING articles and remove them mark lists."
9066   (when missing
9067     (let ((types gnus-article-mark-lists)
9068           var m)
9069       ;; Go through all types.
9070       (while types
9071         (setq var (intern (format "gnus-newsgroup-%s" (car (pop types)))))
9072         (when (symbol-value var)
9073           ;; This list has articles.  So we delete all missing articles
9074           ;; from it.
9075           (setq m missing)
9076           (while m
9077             (set var (delq (pop m) (symbol-value var)))))))))
9078
9079 (defun gnus-update-marks ()
9080   "Enter the various lists of marked articles into the newsgroup info list."
9081   (let ((types gnus-article-mark-lists)
9082         (info (gnus-get-info gnus-newsgroup-name))
9083         (uncompressed '(score bookmark killed))
9084         type list newmarked symbol)
9085     (when info
9086       ;; Add all marks lists that are non-nil to the list of marks lists.
9087       (while types
9088         (setq type (pop types))
9089         (when (setq list (symbol-value
9090                           (setq symbol
9091                                 (intern (format "gnus-newsgroup-%s"
9092                                                 (car type))))))
9093           (push (cons (cdr type)
9094                       (if (memq (cdr type) uncompressed) list
9095                         (gnus-compress-sequence 
9096                          (set symbol (sort list '<)) t)))
9097                 newmarked)))
9098
9099       ;; Enter these new marks into the info of the group.
9100       (if (nthcdr 3 info)
9101           (setcar (nthcdr 3 info) newmarked)
9102         ;; Add the marks lists to the end of the info.
9103         (when newmarked
9104           (setcdr (nthcdr 2 info) (list newmarked))))
9105
9106       ;; Cut off the end of the info if there's nothing else there.
9107       (let ((i 5))
9108         (while (and (> i 2)
9109                     (not (nth i info)))
9110           (when (nthcdr (decf i) info)
9111             (setcdr (nthcdr i info) nil)))))))
9112
9113 (defun gnus-add-marked-articles (group type articles &optional info force)
9114   ;; Add ARTICLES of TYPE to the info of GROUP.
9115   ;; If INFO is non-nil, use that info.  If FORCE is non-nil, don't
9116   ;; add, but replace marked articles of TYPE with ARTICLES.
9117   (let ((info (or info (gnus-get-info group)))
9118         (uncompressed '(score bookmark killed))
9119         marked m)
9120     (or (not info)
9121         (and (not (setq marked (nthcdr 3 info)))
9122              (or (null articles)
9123                  (setcdr (nthcdr 2 info)
9124                          (list (list (cons type (gnus-compress-sequence
9125                                                  articles t)))))))
9126         (and (not (setq m (assq type (car marked))))
9127              (or (null articles)
9128                  (setcar marked
9129                          (cons (cons type (gnus-compress-sequence articles t) )
9130                                (car marked)))))
9131         (if force
9132             (if (null articles)
9133                 (setcar (nthcdr 3 info)
9134                         (delq (assq type (car marked)) (car marked)))
9135               (setcdr m (gnus-compress-sequence articles t)))
9136           (setcdr m (gnus-compress-sequence
9137                      (sort (nconc (gnus-uncompress-range (cdr m))
9138                                   (copy-sequence articles)) '<) t))))))
9139
9140 (defun gnus-set-mode-line (where)
9141   "This function sets the mode line of the article or summary buffers.
9142 If WHERE is `summary', the summary mode line format will be used."
9143   ;; Is this mode line one we keep updated?
9144   (when (memq where gnus-updated-mode-lines)
9145     (let (mode-string)
9146       (save-excursion
9147         ;; We evaluate this in the summary buffer since these
9148         ;; variables are buffer-local to that buffer.
9149         (set-buffer gnus-summary-buffer)
9150         ;; We bind all these variables that are used in the `eval' form
9151         ;; below.
9152         (let* ((mformat (symbol-value
9153                          (intern
9154                           (format "gnus-%s-mode-line-format-spec" where))))
9155                (gnus-tmp-group-name gnus-newsgroup-name)
9156                (gnus-tmp-article-number (or gnus-current-article 0))
9157                (gnus-tmp-unread gnus-newsgroup-unreads)
9158                (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
9159                (gnus-tmp-unselected (length gnus-newsgroup-unselected))
9160                (gnus-tmp-unread-and-unselected
9161                 (cond ((and (zerop gnus-tmp-unread-and-unticked)
9162                             (zerop gnus-tmp-unselected)) "")
9163                       ((zerop gnus-tmp-unselected)
9164                        (format "{%d more}" gnus-tmp-unread-and-unticked))
9165                       (t (format "{%d(+%d) more}"
9166                                  gnus-tmp-unread-and-unticked
9167                                  gnus-tmp-unselected))))
9168                (gnus-tmp-subject
9169                 (if (and gnus-current-headers
9170                          (vectorp gnus-current-headers))
9171                     (gnus-mode-string-quote
9172                      (mail-header-subject gnus-current-headers)) ""))
9173                max-len
9174                gnus-tmp-header);; passed as argument to any user-format-funcs
9175           (setq mode-string (eval mformat))
9176           (setq max-len (max 4 (if gnus-mode-non-string-length
9177                                    (- (window-width)
9178                                       gnus-mode-non-string-length)
9179                                  (length mode-string))))
9180           ;; We might have to chop a bit of the string off...
9181           (when (> (length mode-string) max-len)
9182             (setq mode-string
9183                   (concat (gnus-truncate-string mode-string (- max-len 3))
9184                           "...")))
9185           ;; Pad the mode string a bit.
9186           (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
9187       ;; Update the mode line.
9188       (setq mode-line-buffer-identification 
9189             (gnus-mode-line-buffer-identification
9190              (list mode-string)))
9191       (set-buffer-modified-p t))))
9192
9193 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
9194   "Go through the HEADERS list and add all Xrefs to a hash table.
9195 The resulting hash table is returned, or nil if no Xrefs were found."
9196   (let* ((virtual (gnus-virtual-group-p from-newsgroup))
9197          (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
9198          (xref-hashtb (make-vector 63 0))
9199          start group entry number xrefs header)
9200     (while headers
9201       (setq header (pop headers))
9202       (when (and (setq xrefs (mail-header-xref header))
9203                  (not (memq (setq number (mail-header-number header))
9204                             unreads)))
9205         (setq start 0)
9206         (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
9207           (setq start (match-end 0))
9208           (setq group (if prefix
9209                           (concat prefix (substring xrefs (match-beginning 1)
9210                                                     (match-end 1)))
9211                         (substring xrefs (match-beginning 1) (match-end 1))))
9212           (setq number
9213                 (string-to-int (substring xrefs (match-beginning 2)
9214                                           (match-end 2))))
9215           (if (setq entry (gnus-gethash group xref-hashtb))
9216               (setcdr entry (cons number (cdr entry)))
9217             (gnus-sethash group (cons number nil) xref-hashtb)))))
9218     (and start xref-hashtb)))
9219
9220 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
9221   "Look through all the headers and mark the Xrefs as read."
9222   (let ((virtual (gnus-virtual-group-p from-newsgroup))
9223         name entry info xref-hashtb idlist method nth4)
9224     (save-excursion
9225       (set-buffer gnus-group-buffer)
9226       (when (setq xref-hashtb
9227                   (gnus-create-xref-hashtb from-newsgroup headers unreads))
9228         (mapatoms
9229          (lambda (group)
9230            (unless (string= from-newsgroup (setq name (symbol-name group)))
9231              (setq idlist (symbol-value group))
9232              ;; Dead groups are not updated.
9233              (and (prog1
9234                       (setq entry (gnus-gethash name gnus-newsrc-hashtb)
9235                             info (nth 2 entry))
9236                     (if (stringp (setq nth4 (gnus-info-method info)))
9237                         (setq nth4 (gnus-server-to-method nth4))))
9238                   ;; Only do the xrefs if the group has the same
9239                   ;; select method as the group we have just read.
9240                   (or (gnus-methods-equal-p
9241                        nth4 (gnus-find-method-for-group from-newsgroup))
9242                       virtual
9243                       (equal nth4 (setq method (gnus-find-method-for-group
9244                                                 from-newsgroup)))
9245                       (and (equal (car nth4) (car method))
9246                            (equal (nth 1 nth4) (nth 1 method))))
9247                   gnus-use-cross-reference
9248                   (or (not (eq gnus-use-cross-reference t))
9249                       virtual
9250                       ;; Only do cross-references on subscribed
9251                       ;; groups, if that is what is wanted.
9252                       (<= (gnus-info-level info) gnus-level-subscribed))
9253                   (gnus-group-make-articles-read name idlist))))
9254          xref-hashtb)))))
9255
9256 (defun gnus-group-make-articles-read (group articles)
9257   (let* ((num 0)
9258          (entry (gnus-gethash group gnus-newsrc-hashtb))
9259          (info (nth 2 entry))
9260          (active (gnus-active group))
9261          range)
9262     ;; First peel off all illegal article numbers.
9263     (if active
9264         (let ((ids articles)
9265               id first)
9266           (while ids
9267             (setq id (car ids))
9268             (if (and first (> id (cdr active)))
9269                 (progn
9270                   ;; We'll end up in this situation in one particular
9271                   ;; obscure situation.  If you re-scan a group and get
9272                   ;; a new article that is cross-posted to a different
9273                   ;; group that has not been re-scanned, you might get
9274                   ;; crossposted article that has a higher number than
9275                   ;; Gnus believes possible.  So we re-activate this
9276                   ;; group as well.  This might mean doing the
9277                   ;; crossposting thingy will *increase* the number
9278                   ;; of articles in some groups.  Tsk, tsk.
9279                   (setq active (or (gnus-activate-group group) active))))
9280             (if (or (> id (cdr active))
9281                     (< id (car active)))
9282                 (setq articles (delq id articles)))
9283             (setq ids (cdr ids)))))
9284     ;; If the read list is nil, we init it.
9285     (and active
9286          (null (gnus-info-read info))
9287          (> (car active) 1)
9288          (gnus-info-set-read info (cons 1 (1- (car active)))))
9289     ;; Then we add the read articles to the range.
9290     (gnus-info-set-read
9291      info
9292      (setq range
9293            (gnus-add-to-range
9294             (gnus-info-read info) (setq articles (sort articles '<)))))
9295     ;; Then we have to re-compute how many unread
9296     ;; articles there are in this group.
9297     (if active
9298         (progn
9299           (cond
9300            ((not range)
9301             (setq num (- (1+ (cdr active)) (car active))))
9302            ((not (listp (cdr range)))
9303             (setq num (- (cdr active) (- (1+ (cdr range))
9304                                          (car range)))))
9305            (t
9306             (while range
9307               (if (numberp (car range))
9308                   (setq num (1+ num))
9309                 (setq num (+ num (- (1+ (cdar range)) (caar range)))))
9310               (setq range (cdr range)))
9311             (setq num (- (cdr active) num))))
9312           ;; Update the number of unread articles.
9313           (setcar entry num)
9314           ;; Update the group buffer.
9315           (gnus-group-update-group group t)))))
9316
9317 (defun gnus-methods-equal-p (m1 m2)
9318   (let ((m1 (or m1 gnus-select-method))
9319         (m2 (or m2 gnus-select-method)))
9320     (or (equal m1 m2)
9321         (and (eq (car m1) (car m2))
9322              (or (not (memq 'address (assoc (symbol-name (car m1))
9323                                             gnus-valid-select-methods)))
9324                  (equal (nth 1 m1) (nth 1 m2)))))))
9325
9326 (defsubst gnus-header-value ()
9327   (buffer-substring (match-end 0) (gnus-point-at-eol)))
9328
9329 (defvar gnus-newsgroup-none-id 0)
9330
9331 (defun gnus-get-newsgroup-headers (&optional dependencies force-new)
9332   (let ((cur nntp-server-buffer)
9333         (dependencies
9334          (or dependencies
9335              (save-excursion (set-buffer gnus-summary-buffer)
9336                              gnus-newsgroup-dependencies)))
9337         headers id id-dep ref-dep end ref)
9338     (save-excursion
9339       (set-buffer nntp-server-buffer)
9340       (run-hooks 'gnus-parse-headers-hook)
9341       (let ((case-fold-search t)
9342             in-reply-to header p lines)
9343         (goto-char (point-min))
9344         ;; Search to the beginning of the next header.  Error messages
9345         ;; do not begin with 2 or 3.
9346         (while (re-search-forward "^[23][0-9]+ " nil t)
9347           (setq id nil
9348                 ref nil)
9349           ;; This implementation of this function, with nine
9350           ;; search-forwards instead of the one re-search-forward and
9351           ;; a case (which basically was the old function) is actually
9352           ;; about twice as fast, even though it looks messier.  You
9353           ;; can't have everything, I guess.  Speed and elegance
9354           ;; doesn't always go hand in hand.
9355           (setq
9356            header
9357            (vector
9358             ;; Number.
9359             (prog1
9360                 (read cur)
9361               (end-of-line)
9362               (setq p (point))
9363               (narrow-to-region (point)
9364                                 (or (and (search-forward "\n.\n" nil t)
9365                                          (- (point) 2))
9366                                     (point))))
9367             ;; Subject.
9368             (progn
9369               (goto-char p)
9370               (if (search-forward "\nsubject: " nil t)
9371                   (gnus-header-value) "(none)"))
9372             ;; From.
9373             (progn
9374               (goto-char p)
9375               (if (search-forward "\nfrom: " nil t)
9376                   (gnus-header-value) "(nobody)"))
9377             ;; Date.
9378             (progn
9379               (goto-char p)
9380               (if (search-forward "\ndate: " nil t)
9381                   (gnus-header-value) ""))
9382             ;; Message-ID.
9383             (progn
9384               (goto-char p)
9385               (if (search-forward "\nmessage-id: " nil t)
9386                   (setq id (gnus-header-value))
9387                 ;; If there was no message-id, we just fake one to make
9388                 ;; subsequent routines simpler.
9389                 (setq id (concat "none+"
9390                                  (int-to-string
9391                                   (setq gnus-newsgroup-none-id
9392                                         (1+ gnus-newsgroup-none-id)))))))
9393             ;; References.
9394             (progn
9395               (goto-char p)
9396               (if (search-forward "\nreferences: " nil t)
9397                   (progn
9398                     (setq end (point))
9399                     (prog1
9400                         (gnus-header-value)
9401                       (setq ref
9402                             (buffer-substring
9403                              (progn
9404                                (end-of-line)
9405                                (search-backward ">" end t)
9406                                (1+ (point)))
9407                              (progn
9408                                (search-backward "<" end t)
9409                                (point))))))
9410                 ;; Get the references from the in-reply-to header if there
9411                 ;; were no references and the in-reply-to header looks
9412                 ;; promising.
9413                 (if (and (search-forward "\nin-reply-to: " nil t)
9414                          (setq in-reply-to (gnus-header-value))
9415                          (string-match "<[^>]+>" in-reply-to))
9416                     (setq ref (substring in-reply-to (match-beginning 0)
9417                                          (match-end 0)))
9418                   (setq ref ""))))
9419             ;; Chars.
9420             0
9421             ;; Lines.
9422             (progn
9423               (goto-char p)
9424               (if (search-forward "\nlines: " nil t)
9425                   (if (numberp (setq lines (read cur)))
9426                       lines 0)
9427                 0))
9428             ;; Xref.
9429             (progn
9430               (goto-char p)
9431               (and (search-forward "\nxref: " nil t)
9432                    (gnus-header-value)))))
9433           ;; We do the threading while we read the headers.  The
9434           ;; message-id and the last reference are both entered into
9435           ;; the same hash table.  Some tippy-toeing around has to be
9436           ;; done in case an article has arrived before the article
9437           ;; which it refers to.
9438           (if (boundp (setq id-dep (intern id dependencies)))
9439               (if (and (car (symbol-value id-dep))
9440                        (not force-new))
9441                   ;; An article with this Message-ID has already
9442                   ;; been seen, so we ignore this one, except we add
9443                   ;; any additional Xrefs (in case the two articles
9444                   ;; came from different servers).
9445                   (progn
9446                     (mail-header-set-xref
9447                      (car (symbol-value id-dep))
9448                      (concat (or (mail-header-xref
9449                                   (car (symbol-value id-dep))) "")
9450                              (or (mail-header-xref header) "")))
9451                     (setq header nil))
9452                 (setcar (symbol-value id-dep) header))
9453             (set id-dep (list header)))
9454           (when header
9455             (if (boundp (setq ref-dep (intern ref dependencies)))
9456                 (setcdr (symbol-value ref-dep)
9457                         (nconc (cdr (symbol-value ref-dep))
9458                                (list (symbol-value id-dep))))
9459               (set ref-dep (list nil (symbol-value id-dep))))
9460             (setq headers (cons header headers)))
9461           (goto-char (point-max))
9462           (widen))
9463         (nreverse headers)))))
9464
9465 ;; The following macros and functions were written by Felix Lee
9466 ;; <flee@cse.psu.edu>.
9467
9468 (defmacro gnus-nov-read-integer ()
9469   '(prog1
9470        (if (= (following-char) ?\t)
9471            0
9472          (let ((num (condition-case nil (read buffer) (error nil))))
9473            (if (numberp num) num 0)))
9474      (or (eobp) (forward-char 1))))
9475
9476 (defmacro gnus-nov-skip-field ()
9477   '(search-forward "\t" eol 'move))
9478
9479 (defmacro gnus-nov-field ()
9480   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
9481
9482 ;; Goes through the xover lines and returns a list of vectors
9483 (defun gnus-get-newsgroup-headers-xover (sequence &optional 
9484                                                   force-new dependencies)
9485   "Parse the news overview data in the server buffer, and return a
9486 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
9487   ;; Get the Xref when the users reads the articles since most/some
9488   ;; NNTP servers do not include Xrefs when using XOVER.
9489   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
9490   (let ((cur nntp-server-buffer)
9491         (dependencies (or dependencies gnus-newsgroup-dependencies))
9492         number headers header)
9493     (save-excursion
9494       (set-buffer nntp-server-buffer)
9495       ;; Allow the user to mangle the headers before parsing them.
9496       (run-hooks 'gnus-parse-headers-hook)
9497       (goto-char (point-min))
9498       (while (and sequence (not (eobp)))
9499         (setq number (read cur))
9500         (while (and sequence (< (car sequence) number))
9501           (setq sequence (cdr sequence)))
9502         (and sequence
9503              (eq number (car sequence))
9504              (progn
9505                (setq sequence (cdr sequence))
9506                (if (setq header
9507                          (inline (gnus-nov-parse-line
9508                                   number dependencies force-new)))
9509                    (setq headers (cons header headers)))))
9510         (forward-line 1))
9511       (setq headers (nreverse headers)))
9512     headers))
9513
9514 ;; This function has to be called with point after the article number
9515 ;; on the beginning of the line.
9516 (defun gnus-nov-parse-line (number dependencies &optional force-new)
9517   (let ((none 0)
9518         (eol (gnus-point-at-eol))
9519         (buffer (current-buffer))
9520         header ref id id-dep ref-dep)
9521
9522     ;; overview: [num subject from date id refs chars lines misc]
9523     (narrow-to-region (point) eol)
9524     (or (eobp) (forward-char))
9525
9526     (condition-case nil
9527         (setq header
9528               (vector
9529                number                   ; number
9530                (gnus-nov-field)         ; subject
9531                (gnus-nov-field)         ; from
9532                (gnus-nov-field)         ; date
9533                (setq id (or (gnus-nov-field)
9534                             (concat "none+"
9535                                     (int-to-string
9536                                      (setq none (1+ none)))))) ; id
9537                (progn
9538                  (save-excursion
9539                    (let ((beg (point)))
9540                      (search-forward "\t" eol)
9541                      (if (search-backward ">" beg t)
9542                          (setq ref
9543                                (buffer-substring
9544                                 (1+ (point))
9545                                 (search-backward "<" beg t)))
9546                        (setq ref nil))))
9547                  (gnus-nov-field))      ; refs
9548                (gnus-nov-read-integer)  ; chars
9549                (gnus-nov-read-integer)  ; lines
9550                (if (= (following-char) ?\n)
9551                    nil
9552                  (gnus-nov-field))      ; misc
9553                ))
9554       (error (progn
9555                (gnus-error 4 "Strange nov line")
9556                (setq header nil)
9557                (goto-char eol))))
9558
9559     (widen)
9560
9561     ;; We build the thread tree.
9562     (when header
9563       (if (boundp (setq id-dep (intern id dependencies)))
9564           (if (and (car (symbol-value id-dep))
9565                    (not force-new))
9566               ;; An article with this Message-ID has already been seen,
9567               ;; so we ignore this one, except we add any additional
9568               ;; Xrefs (in case the two articles came from different
9569               ;; servers.
9570               (progn
9571                 (mail-header-set-xref
9572                  (car (symbol-value id-dep))
9573                  (concat (or (mail-header-xref
9574                               (car (symbol-value id-dep))) "")
9575                          (or (mail-header-xref header) "")))
9576                 (setq header nil))
9577             (setcar (symbol-value id-dep) header))
9578         (set id-dep (list header))))
9579     (when header
9580       (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
9581           (setcdr (symbol-value ref-dep)
9582                   (nconc (cdr (symbol-value ref-dep))
9583                          (list (symbol-value id-dep))))
9584         (set ref-dep (list nil (symbol-value id-dep)))))
9585     header))
9586
9587 (defun gnus-article-get-xrefs ()
9588   "Fill in the Xref value in `gnus-current-headers', if necessary.
9589 This is meant to be called in `gnus-article-internal-prepare-hook'."
9590   (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
9591                                  gnus-current-headers)))
9592     (or (not gnus-use-cross-reference)
9593         (not headers)
9594         (and (mail-header-xref headers)
9595              (not (string= (mail-header-xref headers) "")))
9596         (let ((case-fold-search t)
9597               xref)
9598           (save-restriction
9599             (nnheader-narrow-to-headers)
9600             (goto-char (point-min))
9601             (if (or (and (eq (downcase (following-char)) ?x)
9602                          (looking-at "Xref:"))
9603                     (search-forward "\nXref:" nil t))
9604                 (progn
9605                   (goto-char (1+ (match-end 0)))
9606                   (setq xref (buffer-substring (point)
9607                                                (progn (end-of-line) (point))))
9608                   (mail-header-set-xref headers xref))))))))
9609
9610 (defun gnus-summary-insert-subject (id &optional old-header use-old-header)
9611   "Find article ID and insert the summary line for that article."
9612   (let ((header (if (and old-header use-old-header)
9613                     old-header (gnus-read-header id)))
9614         (number (and (numberp id) id))
9615         pos)
9616     (when header
9617       ;; Rebuild the thread that this article is part of and go to the
9618       ;; article we have fetched.
9619       (when (and (not gnus-show-threads)
9620                  old-header)
9621         (when (setq pos (text-property-any
9622                          (point-min) (point-max) 'gnus-number 
9623                          (mail-header-number old-header)))
9624           (goto-char pos)
9625           (gnus-delete-line)
9626           (gnus-data-remove (mail-header-number old-header))))
9627       (when old-header
9628         (mail-header-set-number header (mail-header-number old-header)))
9629       (setq gnus-newsgroup-sparse
9630             (delq (setq number (mail-header-number header)) 
9631                   gnus-newsgroup-sparse))
9632       (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
9633       (gnus-rebuild-thread (mail-header-id header))
9634       (gnus-summary-goto-subject number nil t))
9635     (when (and (numberp number)
9636                (> number 0))
9637       ;; We have to update the boundaries even if we can't fetch the
9638       ;; article if ID is a number -- so that the next `P' or `N'
9639       ;; command will fetch the previous (or next) article even
9640       ;; if the one we tried to fetch this time has been canceled.
9641       (and (> number gnus-newsgroup-end)
9642            (setq gnus-newsgroup-end number))
9643       (and (< number gnus-newsgroup-begin)
9644            (setq gnus-newsgroup-begin number))
9645       (setq gnus-newsgroup-unselected
9646             (delq number gnus-newsgroup-unselected)))
9647     ;; Report back a success?
9648     (and header (mail-header-number header))))
9649
9650 (defun gnus-summary-work-articles (n)
9651   "Return a list of articles to be worked upon.  The prefix argument,
9652 the list of process marked articles, and the current article will be
9653 taken into consideration."
9654   (cond
9655    (n
9656     ;; A numerical prefix has been given.
9657     (let ((backward (< n 0))
9658           (n (abs (prefix-numeric-value n)))
9659           articles article)
9660       (save-excursion
9661         (while
9662             (and (> n 0)
9663                  (push (setq article (gnus-summary-article-number))
9664                        articles)
9665                  (if backward
9666                      (gnus-summary-find-prev nil article)
9667                    (gnus-summary-find-next nil article)))
9668           (decf n)))
9669       (nreverse articles)))
9670    ((and (boundp 'transient-mark-mode)
9671          transient-mark-mode
9672          mark-active)
9673     ;; Work on the region between point and mark.
9674     (let ((max (max (point) (mark)))
9675           articles article)
9676       (save-excursion
9677         (goto-char (min (point) (mark)))
9678         (while
9679             (and
9680              (push (setq article (gnus-summary-article-number)) articles)
9681              (gnus-summary-find-next nil article)
9682              (< (point) max)))
9683         (nreverse articles))))
9684    (gnus-newsgroup-processable
9685     ;; There are process-marked articles present.
9686     (reverse gnus-newsgroup-processable))
9687    (t
9688     ;; Just return the current article.
9689     (list (gnus-summary-article-number)))))
9690
9691 (defun gnus-summary-search-group (&optional backward use-level)
9692   "Search for next unread newsgroup.
9693 If optional argument BACKWARD is non-nil, search backward instead."
9694   (save-excursion
9695     (set-buffer gnus-group-buffer)
9696     (if (gnus-group-search-forward
9697          backward nil (if use-level (gnus-group-group-level) nil))
9698         (gnus-group-group-name))))
9699
9700 (defun gnus-summary-best-group (&optional exclude-group)
9701   "Find the name of the best unread group.
9702 If EXCLUDE-GROUP, do not go to this group."
9703   (save-excursion
9704     (set-buffer gnus-group-buffer)
9705     (save-excursion
9706       (gnus-group-best-unread-group exclude-group))))
9707
9708 (defun gnus-summary-find-next (&optional unread article backward)
9709   (if backward (gnus-summary-find-prev)
9710     (let* ((dummy (gnus-summary-article-intangible-p))
9711            (article (or article (gnus-summary-article-number)))
9712            (arts (gnus-data-find-list article))
9713            result)
9714       (when (and (not dummy)
9715                  (or (not gnus-summary-check-current)
9716                      (not unread)
9717                      (not (gnus-data-unread-p (car arts)))))
9718         (setq arts (cdr arts)))
9719       (when (setq result
9720                   (if unread
9721                       (progn
9722                         (while arts
9723                           (when (gnus-data-unread-p (car arts))
9724                             (setq result (car arts)
9725                                   arts nil))
9726                           (setq arts (cdr arts)))
9727                         result)
9728                     (car arts)))
9729         (goto-char (gnus-data-pos result))
9730         (gnus-data-number result)))))
9731
9732 (defun gnus-summary-find-prev (&optional unread article)
9733   (let* ((eobp (eobp))
9734          (article (or article (gnus-summary-article-number)))
9735          (arts (gnus-data-find-list article (gnus-data-list 'rev)))
9736          result)
9737     (when (and (not eobp)
9738                (or (not gnus-summary-check-current)
9739                    (not unread)
9740                    (not (gnus-data-unread-p (car arts)))))
9741       (setq arts (cdr arts)))
9742     (if (setq result
9743               (if unread
9744                   (progn
9745                     (while arts
9746                       (and (gnus-data-unread-p (car arts))
9747                            (setq result (car arts)
9748                                  arts nil))
9749                       (setq arts (cdr arts)))
9750                     result)
9751                 (car arts)))
9752         (progn
9753           (goto-char (gnus-data-pos result))
9754           (gnus-data-number result)))))
9755
9756 (defun gnus-summary-find-subject (subject &optional unread backward article)
9757   (let* ((simp-subject (gnus-simplify-subject-fully subject))
9758          (article (or article (gnus-summary-article-number)))
9759          (articles (gnus-data-list backward))
9760          (arts (gnus-data-find-list article articles))
9761          result)
9762     (when (or (not gnus-summary-check-current)
9763               (not unread)
9764               (not (gnus-data-unread-p (car arts))))
9765       (setq arts (cdr arts)))
9766     (while arts
9767       (and (or (not unread)
9768                (gnus-data-unread-p (car arts)))
9769            (vectorp (gnus-data-header (car arts)))
9770            (gnus-subject-equal
9771             simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
9772            (setq result (car arts)
9773                  arts nil))
9774       (setq arts (cdr arts)))
9775     (and result
9776          (goto-char (gnus-data-pos result))
9777          (gnus-data-number result))))
9778
9779 (defun gnus-summary-search-forward (&optional unread subject backward)
9780   "Search forward for an article.
9781 If UNREAD, look for unread articles.  If SUBJECT, look for
9782 articles with that subject.  If BACKWARD, search backward instead."
9783   (cond (subject (gnus-summary-find-subject subject unread backward))
9784         (backward (gnus-summary-find-prev unread))
9785         (t (gnus-summary-find-next unread))))
9786
9787 (defun gnus-recenter (&optional n)
9788   "Center point in window and redisplay frame.
9789 Also do horizontal recentering."
9790   (interactive "P")
9791   (when (and gnus-auto-center-summary
9792              (not (eq gnus-auto-center-summary 'vertical)))
9793     (gnus-horizontal-recenter))
9794   (recenter n))
9795
9796 (defun gnus-summary-recenter ()
9797   "Center point in the summary window.
9798 If `gnus-auto-center-summary' is nil, or the article buffer isn't
9799 displayed, no centering will be performed."
9800   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
9801   ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
9802   (let* ((top (cond ((< (window-height) 4) 0)
9803                     ((< (window-height) 7) 1)
9804                     (t 2)))
9805          (height (1- (window-height)))
9806          (bottom (save-excursion (goto-char (point-max))
9807                                  (forward-line (- height))
9808                                  (point)))
9809          (window (get-buffer-window (current-buffer))))
9810     ;; The user has to want it.
9811     (when gnus-auto-center-summary
9812       (when (get-buffer-window gnus-article-buffer)
9813        ;; Only do recentering when the article buffer is displayed,
9814        ;; Set the window start to either `bottom', which is the biggest
9815        ;; possible valid number, or the second line from the top,
9816        ;; whichever is the least.
9817        (set-window-start
9818         window (min bottom (save-excursion 
9819                              (forward-line (- top)) (point)))))
9820       ;; Do horizontal recentering while we're at it.
9821       (when (and (get-buffer-window (current-buffer) t)
9822                  (not (eq gnus-auto-center-summary 'vertical)))
9823         (let ((selected (selected-window)))
9824           (select-window (get-buffer-window (current-buffer) t))
9825           (gnus-summary-position-point)
9826           (gnus-horizontal-recenter)
9827           (select-window selected))))))
9828
9829 (defun gnus-horizontal-recenter ()
9830   "Recenter the current buffer horizontally."
9831   (if (< (current-column) (/ (window-width) 2))
9832       (set-window-hscroll (get-buffer-window (current-buffer) t) 0)
9833     (let* ((orig (point))
9834            (end (window-end (get-buffer-window (current-buffer) t)))
9835            (max 0))
9836       ;; Find the longest line currently displayed in the window.
9837       (goto-char (window-start))
9838       (while (and (not (eobp)) 
9839                   (< (point) end))
9840         (end-of-line)
9841         (setq max (max max (current-column)))
9842         (forward-line 1))
9843       (goto-char orig)
9844       ;; Scroll horizontally to center (sort of) the point.
9845       (if (> max (window-width))
9846           (set-window-hscroll 
9847            (get-buffer-window (current-buffer) t)
9848            (min (- (current-column) (/ (window-width) 3))
9849                 (+ 2 (- max (window-width)))))
9850         (set-window-hscroll (get-buffer-window (current-buffer) t) 0))
9851       max)))
9852
9853 ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
9854 (defun gnus-short-group-name (group &optional levels)
9855   "Collapse GROUP name LEVELS."
9856   (let* ((name "") 
9857          (foreign "")
9858          (depth 0) 
9859          (skip 1)
9860          (levels (or levels
9861                      (progn
9862                        (while (string-match "\\." group skip)
9863                          (setq skip (match-end 0)
9864                                depth (+ depth 1)))
9865                        depth))))
9866     (if (string-match ":" group)
9867         (setq foreign (substring group 0 (match-end 0))
9868               group (substring group (match-end 0))))
9869     (while group
9870       (if (and (string-match "\\." group)
9871                (> levels (- gnus-group-uncollapsed-levels 1)))
9872           (setq name (concat name (substring group 0 1))
9873                 group (substring group (match-end 0))
9874                 levels (- levels 1)
9875                 name (concat name "."))
9876         (setq name (concat foreign name group)
9877               group nil)))
9878     name))
9879
9880 (defun gnus-summary-jump-to-group (newsgroup)
9881   "Move point to NEWSGROUP in group mode buffer."
9882   ;; Keep update point of group mode buffer if visible.
9883   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
9884       (save-window-excursion
9885         ;; Take care of tree window mode.
9886         (if (get-buffer-window gnus-group-buffer)
9887             (pop-to-buffer gnus-group-buffer))
9888         (gnus-group-jump-to-group newsgroup))
9889     (save-excursion
9890       ;; Take care of tree window mode.
9891       (if (get-buffer-window gnus-group-buffer)
9892           (pop-to-buffer gnus-group-buffer)
9893         (set-buffer gnus-group-buffer))
9894       (gnus-group-jump-to-group newsgroup))))
9895
9896 ;; This function returns a list of article numbers based on the
9897 ;; difference between the ranges of read articles in this group and
9898 ;; the range of active articles.
9899 (defun gnus-list-of-unread-articles (group)
9900   (let* ((read (gnus-info-read (gnus-get-info group)))
9901          (active (gnus-active group))
9902          (last (cdr active))
9903          first nlast unread)
9904     ;; If none are read, then all are unread.
9905     (if (not read)
9906         (setq first (car active))
9907       ;; If the range of read articles is a single range, then the
9908       ;; first unread article is the article after the last read
9909       ;; article.  Sounds logical, doesn't it?
9910       (if (not (listp (cdr read)))
9911           (setq first (1+ (cdr read)))
9912         ;; `read' is a list of ranges.
9913         (if (/= (setq nlast (or (and (numberp (car read)) (car read))
9914                                 (caar read))) 1)
9915             (setq first 1))
9916         (while read
9917           (if first
9918               (while (< first nlast)
9919                 (setq unread (cons first unread))
9920                 (setq first (1+ first))))
9921           (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
9922           (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
9923           (setq read (cdr read)))))
9924     ;; And add the last unread articles.
9925     (while (<= first last)
9926       (setq unread (cons first unread))
9927       (setq first (1+ first)))
9928     ;; Return the list of unread articles.
9929     (nreverse unread)))
9930
9931 (defun gnus-list-of-read-articles (group)
9932   "Return a list of unread, unticked and non-dormant articles."
9933   (let* ((info (gnus-get-info group))
9934          (marked (gnus-info-marks info))
9935          (active (gnus-active group)))
9936     (and info active
9937          (gnus-set-difference
9938           (gnus-sorted-complement
9939            (gnus-uncompress-range active)
9940            (gnus-list-of-unread-articles group))
9941           (append
9942            (gnus-uncompress-range (cdr (assq 'dormant marked)))
9943            (gnus-uncompress-range (cdr (assq 'tick marked))))))))
9944
9945 ;; Various summary commands
9946
9947 (defun gnus-summary-universal-argument (arg)
9948   "Perform any operation on all articles that are process/prefixed."
9949   (interactive "P")
9950   (gnus-set-global-variables)
9951   (let ((articles (gnus-summary-work-articles arg))
9952         func article)
9953     (if (eq
9954          (setq
9955           func
9956           (key-binding
9957            (read-key-sequence
9958             (substitute-command-keys
9959              "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
9960              ))))
9961          'undefined)
9962         (gnus-error 1 "Undefined key")
9963       (save-excursion
9964         (while articles
9965           (gnus-summary-goto-subject (setq article (pop articles)))
9966           (command-execute func)
9967           (gnus-summary-remove-process-mark article)))))
9968   (gnus-summary-position-point))
9969
9970 (defun gnus-summary-toggle-truncation (&optional arg)
9971   "Toggle truncation of summary lines.
9972 With arg, turn line truncation on iff arg is positive."
9973   (interactive "P")
9974   (setq truncate-lines
9975         (if (null arg) (not truncate-lines)
9976           (> (prefix-numeric-value arg) 0)))
9977   (redraw-display))
9978
9979 (defun gnus-summary-reselect-current-group (&optional all rescan)
9980   "Exit and then reselect the current newsgroup.
9981 The prefix argument ALL means to select all articles."
9982   (interactive "P")
9983   (gnus-set-global-variables)
9984   (when (gnus-ephemeral-group-p gnus-newsgroup-name)
9985     (error "Ephemeral groups can't be reselected"))
9986   (let ((current-subject (gnus-summary-article-number))
9987         (group gnus-newsgroup-name))
9988     (setq gnus-newsgroup-begin nil)
9989     (gnus-summary-exit)
9990     ;; We have to adjust the point of group mode buffer because the
9991     ;; current point was moved to the next unread newsgroup by
9992     ;; exiting.
9993     (gnus-summary-jump-to-group group)
9994     (when rescan
9995       (save-excursion
9996         (gnus-group-get-new-news-this-group 1)))
9997     (gnus-group-read-group all t)
9998     (gnus-summary-goto-subject current-subject nil t)))
9999
10000 (defun gnus-summary-rescan-group (&optional all)
10001   "Exit the newsgroup, ask for new articles, and select the newsgroup."
10002   (interactive "P")
10003   (gnus-summary-reselect-current-group all t))
10004
10005 (defun gnus-summary-update-info ()
10006   (let* ((group gnus-newsgroup-name))
10007     (when gnus-newsgroup-kill-headers
10008       (setq gnus-newsgroup-killed
10009             (gnus-compress-sequence
10010              (nconc
10011               (gnus-set-sorted-intersection
10012                (gnus-uncompress-range gnus-newsgroup-killed)
10013                (setq gnus-newsgroup-unselected
10014                      (sort gnus-newsgroup-unselected '<)))
10015               (setq gnus-newsgroup-unreads
10016                     (sort gnus-newsgroup-unreads '<))) t)))
10017     (unless (listp (cdr gnus-newsgroup-killed))
10018       (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
10019     (let ((headers gnus-newsgroup-headers))
10020       (run-hooks 'gnus-exit-group-hook)
10021       (unless gnus-save-score
10022         (setq gnus-newsgroup-scored nil))
10023       ;; Set the new ranges of read articles.
10024       (gnus-update-read-articles
10025        group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
10026       ;; Set the current article marks.
10027       (gnus-update-marks)
10028       ;; Do the cross-ref thing.
10029       (when gnus-use-cross-reference
10030         (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
10031       ;; Do adaptive scoring, and possibly save score files.
10032       (when gnus-newsgroup-adaptive
10033         (gnus-score-adaptive))
10034       (when gnus-use-scoring
10035         (gnus-score-save))
10036       ;; Do not switch windows but change the buffer to work.
10037       (set-buffer gnus-group-buffer)
10038       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
10039           (gnus-group-update-group group)))))
10040
10041 (defun gnus-summary-exit (&optional temporary)
10042   "Exit reading current newsgroup, and then return to group selection mode.
10043 gnus-exit-group-hook is called with no arguments if that value is non-nil."
10044   (interactive)
10045   (gnus-set-global-variables)
10046   (gnus-kill-save-kill-buffer)
10047   (let* ((group gnus-newsgroup-name)
10048          (quit-config (gnus-group-quit-config gnus-newsgroup-name))
10049          (mode major-mode)
10050          (buf (current-buffer)))
10051     (run-hooks 'gnus-summary-prepare-exit-hook)
10052     ;; If we have several article buffers, we kill them at exit.
10053     (unless gnus-single-article-buffer
10054       (gnus-kill-buffer gnus-original-article-buffer)
10055       (setq gnus-article-current nil))
10056     (when gnus-use-cache
10057       (gnus-cache-possibly-remove-articles)
10058       (gnus-cache-save-buffers))
10059     (when gnus-use-trees
10060       (gnus-tree-close group))
10061     ;; Make all changes in this group permanent.
10062     (unless quit-config
10063       (gnus-summary-update-info))
10064     (gnus-close-group group)
10065     ;; Make sure where I was, and go to next newsgroup.
10066     (set-buffer gnus-group-buffer)
10067     (unless quit-config
10068       (gnus-group-jump-to-group group))
10069     (run-hooks 'gnus-summary-exit-hook)
10070     (unless quit-config
10071       (gnus-group-next-unread-group 1))
10072     (if temporary
10073         nil                             ;Nothing to do.
10074       ;; If we have several article buffers, we kill them at exit.
10075       (unless gnus-single-article-buffer
10076         (gnus-kill-buffer gnus-article-buffer)
10077         (gnus-kill-buffer gnus-original-article-buffer)
10078         (setq gnus-article-current nil))
10079       (set-buffer buf)
10080       (if (not gnus-kill-summary-on-exit)
10081           (gnus-deaden-summary)
10082         ;; We set all buffer-local variables to nil.  It is unclear why
10083         ;; this is needed, but if we don't, buffer-local variables are
10084         ;; not garbage-collected, it seems.  This would the lead to en
10085         ;; ever-growing Emacs.
10086         (gnus-summary-clear-local-variables)
10087         (when (get-buffer gnus-article-buffer)
10088           (bury-buffer gnus-article-buffer))
10089         ;; We clear the global counterparts of the buffer-local
10090         ;; variables as well, just to be on the safe side.
10091         (gnus-configure-windows 'group 'force)
10092         (gnus-summary-clear-local-variables)
10093         ;; Return to group mode buffer.
10094         (if (eq mode 'gnus-summary-mode)
10095             (gnus-kill-buffer buf)))
10096       (setq gnus-current-select-method gnus-select-method)
10097       (pop-to-buffer gnus-group-buffer)
10098       ;; Clear the current group name.
10099       (if (not quit-config)
10100           (progn
10101             (gnus-group-jump-to-group group)
10102             (gnus-group-next-unread-group 1)
10103             (gnus-configure-windows 'group 'force))
10104         (if (not (buffer-name (car quit-config)))
10105             (gnus-configure-windows 'group 'force)
10106           (set-buffer (car quit-config))
10107           (and (eq major-mode 'gnus-summary-mode)
10108                (gnus-set-global-variables))
10109           (gnus-configure-windows (cdr quit-config))))
10110       (unless quit-config
10111         (setq gnus-newsgroup-name nil)))))
10112
10113 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
10114 (defun gnus-summary-exit-no-update (&optional no-questions)
10115   "Quit reading current newsgroup without updating read article info."
10116   (interactive)
10117   (gnus-set-global-variables)
10118   (let* ((group gnus-newsgroup-name)
10119          (quit-config (gnus-group-quit-config group)))
10120     (when (or no-questions
10121               gnus-expert-user
10122               (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
10123       ;; If we have several article buffers, we kill them at exit.
10124       (unless gnus-single-article-buffer
10125         (gnus-kill-buffer gnus-article-buffer)
10126         (gnus-kill-buffer gnus-original-article-buffer)
10127         (setq gnus-article-current nil))
10128       (if (not gnus-kill-summary-on-exit)
10129           (gnus-deaden-summary)
10130         (gnus-close-group group)
10131         (gnus-summary-clear-local-variables)
10132         (set-buffer gnus-group-buffer)
10133         (gnus-summary-clear-local-variables)
10134         (when (get-buffer gnus-summary-buffer)
10135           (kill-buffer gnus-summary-buffer)))
10136       (unless gnus-single-article-buffer
10137         (setq gnus-article-current nil))
10138       (when gnus-use-trees
10139         (gnus-tree-close group))
10140       (when (get-buffer gnus-article-buffer)
10141         (bury-buffer gnus-article-buffer))
10142       ;; Return to the group buffer.
10143       (gnus-configure-windows 'group 'force)
10144       ;; Clear the current group name.
10145       (setq gnus-newsgroup-name nil)
10146       (when (equal (gnus-group-group-name) group)
10147         (gnus-group-next-unread-group 1))
10148       (when quit-config
10149         (if (not (buffer-name (car quit-config)))
10150             (gnus-configure-windows 'group 'force)
10151           (set-buffer (car quit-config))
10152           (when (eq major-mode 'gnus-summary-mode)
10153             (gnus-set-global-variables))
10154           (gnus-configure-windows (cdr quit-config)))))))
10155
10156 ;;; Dead summaries.
10157
10158 (defvar gnus-dead-summary-mode-map nil)
10159
10160 (if gnus-dead-summary-mode-map
10161     nil
10162   (setq gnus-dead-summary-mode-map (make-keymap))
10163   (suppress-keymap gnus-dead-summary-mode-map)
10164   (substitute-key-definition
10165    'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
10166   (let ((keys '("\C-d" "\r" "\177")))
10167     (while keys
10168       (define-key gnus-dead-summary-mode-map
10169         (pop keys) 'gnus-summary-wake-up-the-dead))))
10170
10171 (defvar gnus-dead-summary-mode nil
10172   "Minor mode for Gnus summary buffers.")
10173
10174 (defun gnus-dead-summary-mode (&optional arg)
10175   "Minor mode for Gnus summary buffers."
10176   (interactive "P")
10177   (when (eq major-mode 'gnus-summary-mode)
10178     (make-local-variable 'gnus-dead-summary-mode)
10179     (setq gnus-dead-summary-mode
10180           (if (null arg) (not gnus-dead-summary-mode)
10181             (> (prefix-numeric-value arg) 0)))
10182     (when gnus-dead-summary-mode
10183       (unless (assq 'gnus-dead-summary-mode minor-mode-alist)
10184         (push '(gnus-dead-summary-mode " Dead") minor-mode-alist))
10185       (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist)
10186         (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map)
10187               minor-mode-map-alist)))))
10188
10189 (defun gnus-deaden-summary ()
10190   "Make the current summary buffer into a dead summary buffer."
10191   ;; Kill any previous dead summary buffer.
10192   (when (and gnus-dead-summary
10193              (buffer-name gnus-dead-summary))
10194     (save-excursion
10195       (set-buffer gnus-dead-summary)
10196       (when gnus-dead-summary-mode
10197         (kill-buffer (current-buffer)))))
10198   ;; Make this the current dead summary.
10199   (setq gnus-dead-summary (current-buffer))
10200   (gnus-dead-summary-mode 1)
10201   (let ((name (buffer-name)))
10202     (when (string-match "Summary" name)
10203       (rename-buffer
10204        (concat (substring name 0 (match-beginning 0)) "Dead "
10205                (substring name (match-beginning 0))) t))))
10206
10207 (defun gnus-kill-or-deaden-summary (buffer)
10208   "Kill or deaden the summary BUFFER."
10209   (when (and (buffer-name buffer)
10210              (not gnus-single-article-buffer))
10211     (save-excursion
10212       (set-buffer buffer)
10213       (gnus-kill-buffer gnus-article-buffer)
10214       (gnus-kill-buffer gnus-original-article-buffer)))
10215   (cond (gnus-kill-summary-on-exit
10216          (when (and gnus-use-trees
10217                     (and (get-buffer buffer)
10218                          (buffer-name (get-buffer buffer))))
10219            (save-excursion
10220              (set-buffer (get-buffer buffer))
10221              (gnus-tree-close gnus-newsgroup-name)))
10222          (gnus-kill-buffer buffer))
10223         ((and (get-buffer buffer)
10224               (buffer-name (get-buffer buffer)))
10225          (save-excursion
10226            (set-buffer buffer)
10227            (gnus-deaden-summary)))))
10228
10229 (defun gnus-summary-wake-up-the-dead (&rest args)
10230   "Wake up the dead summary buffer."
10231   (interactive)
10232   (gnus-dead-summary-mode -1)
10233   (let ((name (buffer-name)))
10234     (when (string-match "Dead " name)
10235       (rename-buffer
10236        (concat (substring name 0 (match-beginning 0))
10237                (substring name (match-end 0))) t)))
10238   (gnus-message 3 "This dead summary is now alive again"))
10239
10240 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
10241 (defun gnus-summary-fetch-faq (&optional faq-dir)
10242   "Fetch the FAQ for the current group.
10243 If FAQ-DIR (the prefix), prompt for a directory to search for the faq
10244 in."
10245   (interactive
10246    (list
10247     (if current-prefix-arg
10248         (completing-read
10249          "Faq dir: " (and (listp gnus-group-faq-directory)
10250                           gnus-group-faq-directory)))))
10251   (let (gnus-faq-buffer)
10252     (and (setq gnus-faq-buffer
10253                (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
10254          (gnus-configure-windows 'summary-faq))))
10255
10256 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
10257 (defun gnus-summary-describe-group (&optional force)
10258   "Describe the current newsgroup."
10259   (interactive "P")
10260   (gnus-group-describe-group force gnus-newsgroup-name))
10261
10262 (defun gnus-summary-describe-briefly ()
10263   "Describe summary mode commands briefly."
10264   (interactive)
10265   (gnus-message 6
10266                 (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")))
10267
10268 ;; Walking around group mode buffer from summary mode.
10269
10270 (defun gnus-summary-next-group (&optional no-article target-group backward)
10271   "Exit current newsgroup and then select next unread newsgroup.
10272 If prefix argument NO-ARTICLE is non-nil, no article is selected
10273 initially.  If NEXT-GROUP, go to this group.  If BACKWARD, go to
10274 previous group instead."
10275   (interactive "P")
10276   (gnus-set-global-variables)
10277   (let ((current-group gnus-newsgroup-name)
10278         (current-buffer (current-buffer))
10279         entered)
10280     ;; First we semi-exit this group to update Xrefs and all variables.
10281     ;; We can't do a real exit, because the window conf must remain
10282     ;; the same in case the user is prompted for info, and we don't
10283     ;; want the window conf to change before that...
10284     (gnus-summary-exit t)
10285     (while (not entered)
10286       ;; Then we find what group we are supposed to enter.
10287       (set-buffer gnus-group-buffer)
10288       (gnus-group-jump-to-group current-group)
10289       (setq target-group
10290             (or target-group
10291                 (if (eq gnus-keep-same-level 'best)
10292                     (gnus-summary-best-group gnus-newsgroup-name)
10293                   (gnus-summary-search-group backward gnus-keep-same-level))))
10294       (if (not target-group)
10295           ;; There are no further groups, so we return to the group
10296           ;; buffer.
10297           (progn
10298             (gnus-message 5 "Returning to the group buffer")
10299             (setq entered t)
10300             (set-buffer current-buffer)
10301             (gnus-summary-exit))
10302         ;; We try to enter the target group.
10303         (gnus-group-jump-to-group target-group)
10304         (let ((unreads (gnus-group-group-unread)))
10305           (if (and (or (eq t unreads)
10306                        (and unreads (not (zerop unreads))))
10307                    (gnus-summary-read-group
10308                     target-group nil no-article current-buffer))
10309               (setq entered t)
10310             (setq current-group target-group
10311                   target-group nil)))))))
10312
10313 (defun gnus-summary-prev-group (&optional no-article)
10314   "Exit current newsgroup and then select previous unread newsgroup.
10315 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
10316   (interactive "P")
10317   (gnus-summary-next-group no-article nil t))
10318
10319 ;; Walking around summary lines.
10320
10321 (defun gnus-summary-first-subject (&optional unread)
10322   "Go to the first unread subject.
10323 If UNREAD is non-nil, go to the first unread article.
10324 Returns the article selected or nil if there are no unread articles."
10325   (interactive "P")
10326   (prog1
10327       (cond
10328        ;; Empty summary.
10329        ((null gnus-newsgroup-data)
10330         (gnus-message 3 "No articles in the group")
10331         nil)
10332        ;; Pick the first article.
10333        ((not unread)
10334         (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
10335         (gnus-data-number (car gnus-newsgroup-data)))
10336        ;; No unread articles.
10337        ((null gnus-newsgroup-unreads)
10338         (gnus-message 3 "No more unread articles")
10339         nil)
10340        ;; Find the first unread article.
10341        (t
10342         (let ((data gnus-newsgroup-data))
10343           (while (and data
10344                       (not (gnus-data-unread-p (car data))))
10345             (setq data (cdr data)))
10346           (if data
10347               (progn
10348                 (goto-char (gnus-data-pos (car data)))
10349                 (gnus-data-number (car data)))))))
10350     (gnus-summary-position-point)))
10351
10352 (defun gnus-summary-next-subject (n &optional unread dont-display)
10353   "Go to next N'th summary line.
10354 If N is negative, go to the previous N'th subject line.
10355 If UNREAD is non-nil, only unread articles are selected.
10356 The difference between N and the actual number of steps taken is
10357 returned."
10358   (interactive "p")
10359   (let ((backward (< n 0))
10360         (n (abs n)))
10361     (while (and (> n 0)
10362                 (if backward
10363                     (gnus-summary-find-prev unread)
10364                   (gnus-summary-find-next unread)))
10365       (setq n (1- n)))
10366     (if (/= 0 n) (gnus-message 7 "No more%s articles"
10367                                (if unread " unread" "")))
10368     (unless dont-display
10369       (gnus-summary-recenter)
10370       (gnus-summary-position-point))
10371     n))
10372
10373 (defun gnus-summary-next-unread-subject (n)
10374   "Go to next N'th unread summary line."
10375   (interactive "p")
10376   (gnus-summary-next-subject n t))
10377
10378 (defun gnus-summary-prev-subject (n &optional unread)
10379   "Go to previous N'th summary line.
10380 If optional argument UNREAD is non-nil, only unread article is selected."
10381   (interactive "p")
10382   (gnus-summary-next-subject (- n) unread))
10383
10384 (defun gnus-summary-prev-unread-subject (n)
10385   "Go to previous N'th unread summary line."
10386   (interactive "p")
10387   (gnus-summary-next-subject (- n) t))
10388
10389 (defun gnus-summary-goto-subject (article &optional force silent)
10390   "Go the subject line of ARTICLE.
10391 If FORCE, also allow jumping to articles not currently shown."
10392   (let ((b (point))
10393         (data (gnus-data-find article)))
10394     ;; We read in the article if we have to.
10395     (and (not data)
10396          force
10397          (gnus-summary-insert-subject article (and (vectorp force) force) t)
10398          (setq data (gnus-data-find article)))
10399     (goto-char b)
10400     (if (not data)
10401         (progn
10402           (unless silent
10403             (gnus-message 3 "Can't find article %d" article))
10404           nil)
10405       (goto-char (gnus-data-pos data))
10406       article)))
10407
10408 ;; Walking around summary lines with displaying articles.
10409
10410 (defun gnus-summary-expand-window (&optional arg)
10411   "Make the summary buffer take up the entire Emacs frame.
10412 Given a prefix, will force an `article' buffer configuration."
10413   (interactive "P")
10414   (gnus-set-global-variables)
10415   (if arg
10416       (gnus-configure-windows 'article 'force)
10417     (gnus-configure-windows 'summary 'force)))
10418
10419 (defun gnus-summary-display-article (article &optional all-header)
10420   "Display ARTICLE in article buffer."
10421   (gnus-set-global-variables)
10422   (if (null article)
10423       nil
10424     (prog1
10425         (if gnus-summary-display-article-function
10426             (funcall gnus-summary-display-article-function article all-header)
10427           (gnus-article-prepare article all-header))
10428       (run-hooks 'gnus-select-article-hook)
10429       (unless (zerop gnus-current-article)
10430         (gnus-summary-goto-subject gnus-current-article))
10431       (gnus-summary-recenter)
10432       (when gnus-use-trees
10433         (gnus-possibly-generate-tree article)
10434         (gnus-highlight-selected-tree article))
10435       ;; Successfully display article.
10436       (gnus-article-set-window-start
10437        (cdr (assq article gnus-newsgroup-bookmarks))))))
10438
10439 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
10440   "Select the current article.
10441 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
10442 non-nil, the article will be re-fetched even if it already present in
10443 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
10444 be displayed."
10445   ;; Make sure we are in the summary buffer to work around bbdb bug.
10446   (unless (eq major-mode 'gnus-summary-mode)
10447     (set-buffer gnus-summary-buffer))
10448   (let ((article (or article (gnus-summary-article-number)))
10449         (all-headers (not (not all-headers))) ;Must be T or NIL.
10450         gnus-summary-display-article-function
10451         did)
10452     (and (not pseudo)
10453          (gnus-summary-article-pseudo-p article)
10454          (error "This is a pseudo-article."))
10455     (prog1
10456         (save-excursion
10457           (set-buffer gnus-summary-buffer)
10458           (if (or (and gnus-single-article-buffer
10459                        (or (null gnus-current-article)
10460                            (null gnus-article-current)
10461                            (null (get-buffer gnus-article-buffer))
10462                            (not (eq article (cdr gnus-article-current)))
10463                            (not (equal (car gnus-article-current)
10464                                        gnus-newsgroup-name))))
10465                   (and (not gnus-single-article-buffer)
10466                        (or (null gnus-current-article)
10467                            (not (eq gnus-current-article article))))
10468                   force)
10469               ;; The requested article is different from the current article.
10470               (prog1
10471                   (gnus-summary-display-article article all-headers)
10472                 (setq did article))
10473             (if (or all-headers gnus-show-all-headers)
10474                 (gnus-article-show-all-headers))
10475             'old))
10476       (if did
10477           (gnus-article-set-window-start
10478            (cdr (assq article gnus-newsgroup-bookmarks)))))))
10479
10480 (defun gnus-summary-set-current-mark (&optional current-mark)
10481   "Obsolete function."
10482   nil)
10483
10484 (defun gnus-summary-next-article (&optional unread subject backward push)
10485   "Select the next article.
10486 If UNREAD, only unread articles are selected.
10487 If SUBJECT, only articles with SUBJECT are selected.
10488 If BACKWARD, the previous article is selected instead of the next."
10489   (interactive "P")
10490   (gnus-set-global-variables)
10491   (cond
10492    ;; Is there such an article?
10493    ((and (gnus-summary-search-forward unread subject backward)
10494          (or (gnus-summary-display-article (gnus-summary-article-number))
10495              (eq (gnus-summary-article-mark) gnus-canceled-mark)))
10496     (gnus-summary-position-point))
10497    ;; If not, we try the first unread, if that is wanted.
10498    ((and subject
10499          gnus-auto-select-same
10500          (gnus-summary-first-unread-article))
10501     (gnus-summary-position-point)
10502     (gnus-message 6 "Wrapped"))
10503    ;; Try to get next/previous article not displayed in this group.
10504    ((and gnus-auto-extend-newsgroup
10505          (not unread) (not subject))
10506     (gnus-summary-goto-article
10507      (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
10508      nil t))
10509    ;; Go to next/previous group.
10510    (t
10511     (or (gnus-ephemeral-group-p gnus-newsgroup-name)
10512         (gnus-summary-jump-to-group gnus-newsgroup-name))
10513     (let ((cmd last-command-char)
10514           (group
10515            (if (eq gnus-keep-same-level 'best)
10516                (gnus-summary-best-group gnus-newsgroup-name)
10517              (gnus-summary-search-group backward gnus-keep-same-level))))
10518       ;; For some reason, the group window gets selected.  We change
10519       ;; it back.
10520       (select-window (get-buffer-window (current-buffer)))
10521       ;; Select next unread newsgroup automagically.
10522       (cond
10523        ((or (not gnus-auto-select-next)
10524             (not cmd))
10525         (gnus-message 7 "No more%s articles" (if unread " unread" "")))
10526        ((or (eq gnus-auto-select-next 'quietly)
10527             (and (eq gnus-auto-select-next 'slightly-quietly)
10528                  push)
10529             (and (eq gnus-auto-select-next 'almost-quietly)
10530                  (gnus-summary-last-article-p)))
10531         ;; Select quietly.
10532         (if (gnus-ephemeral-group-p gnus-newsgroup-name)
10533             (gnus-summary-exit)
10534           (gnus-message 7 "No more%s articles (%s)..."
10535                         (if unread " unread" "")
10536                         (if group (concat "selecting " group)
10537                           "exiting"))
10538           (gnus-summary-next-group nil group backward)))
10539        (t
10540         (gnus-summary-walk-group-buffer
10541          gnus-newsgroup-name cmd unread backward)))))))
10542
10543 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
10544   (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
10545                       (?\C-p (gnus-group-prev-unread-group 1))))
10546         keve key group ended)
10547     (save-excursion
10548       (set-buffer gnus-group-buffer)
10549       (gnus-summary-jump-to-group from-group)
10550       (setq group
10551             (if (eq gnus-keep-same-level 'best)
10552                 (gnus-summary-best-group gnus-newsgroup-name)
10553               (gnus-summary-search-group backward gnus-keep-same-level))))
10554     (while (not ended)
10555       (gnus-message
10556        5 "No more%s articles%s" (if unread " unread" "")
10557        (if (and group
10558                 (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
10559            (format " (Type %s for %s [%s])"
10560                    (single-key-description cmd) group
10561                    (car (gnus-gethash group gnus-newsrc-hashtb)))
10562          (format " (Type %s to exit %s)"
10563                  (single-key-description cmd)
10564                  gnus-newsgroup-name)))
10565       ;; Confirm auto selection.
10566       (setq key (car (setq keve (gnus-read-event-char))))
10567       (setq ended t)
10568       (cond
10569        ((assq key keystrokes)
10570         (let ((obuf (current-buffer)))
10571           (switch-to-buffer gnus-group-buffer)
10572           (and group
10573                (gnus-group-jump-to-group group))
10574           (eval (cadr (assq key keystrokes)))
10575           (setq group (gnus-group-group-name))
10576           (switch-to-buffer obuf))
10577         (setq ended nil))
10578        ((equal key cmd)
10579         (if (or (not group)
10580                 (gnus-ephemeral-group-p gnus-newsgroup-name))
10581             (gnus-summary-exit)
10582           (gnus-summary-next-group nil group backward)))
10583        (t
10584         (push (cdr keve) unread-command-events))))))
10585
10586 (defun gnus-read-event-char ()
10587   "Get the next event."
10588   (let ((event (read-event)))
10589     (cons (and (numberp event) event) event)))
10590
10591 (defun gnus-summary-next-unread-article ()
10592   "Select unread article after current one."
10593   (interactive)
10594   (gnus-summary-next-article t (and gnus-auto-select-same
10595                                     (gnus-summary-article-subject))))
10596
10597 (defun gnus-summary-prev-article (&optional unread subject)
10598   "Select the article after the current one.
10599 If UNREAD is non-nil, only unread articles are selected."
10600   (interactive "P")
10601   (gnus-summary-next-article unread subject t))
10602
10603 (defun gnus-summary-prev-unread-article ()
10604   "Select unred article before current one."
10605   (interactive)
10606   (gnus-summary-prev-article t (and gnus-auto-select-same
10607                                     (gnus-summary-article-subject))))
10608
10609 (defun gnus-summary-next-page (&optional lines circular)
10610   "Show next page of the selected article.
10611 If at the end of the current article, select the next article.
10612 LINES says how many lines should be scrolled up.
10613
10614 If CIRCULAR is non-nil, go to the start of the article instead of
10615 selecting the next article when reaching the end of the current
10616 article."
10617   (interactive "P")
10618   (setq gnus-summary-buffer (current-buffer))
10619   (gnus-set-global-variables)
10620   (let ((article (gnus-summary-article-number))
10621         (endp nil))
10622     (gnus-configure-windows 'article)
10623     (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark)
10624         (if (and (eq gnus-summary-goto-unread 'never)
10625                  (not (gnus-summary-last-article-p article)))
10626             (gnus-summary-next-article)
10627           (gnus-summary-next-unread-article))
10628       (if (or (null gnus-current-article)
10629               (null gnus-article-current)
10630               (/= article (cdr gnus-article-current))
10631               (not (equal (car gnus-article-current) gnus-newsgroup-name)))
10632           ;; Selected subject is different from current article's.
10633           (gnus-summary-display-article article)
10634         (gnus-eval-in-buffer-window gnus-article-buffer
10635           (setq endp (gnus-article-next-page lines)))
10636         (if endp
10637             (cond (circular
10638                    (gnus-summary-beginning-of-article))
10639                   (lines
10640                    (gnus-message 3 "End of message"))
10641                   ((null lines)
10642                    (if (and (eq gnus-summary-goto-unread 'never)
10643                             (not (gnus-summary-last-article-p article)))
10644                        (gnus-summary-next-article)
10645                      (gnus-summary-next-unread-article)))))))
10646     (gnus-summary-recenter)
10647     (gnus-summary-position-point)))
10648
10649 (defun gnus-summary-prev-page (&optional lines)
10650   "Show previous page of selected article.
10651 Argument LINES specifies lines to be scrolled down."
10652   (interactive "P")
10653   (gnus-set-global-variables)
10654   (let ((article (gnus-summary-article-number)))
10655     (gnus-configure-windows 'article)
10656     (if (or (null gnus-current-article)
10657             (null gnus-article-current)
10658             (/= article (cdr gnus-article-current))
10659             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
10660         ;; Selected subject is different from current article's.
10661         (gnus-summary-display-article article)
10662       (gnus-summary-recenter)
10663       (gnus-eval-in-buffer-window gnus-article-buffer
10664         (gnus-article-prev-page lines))))
10665   (gnus-summary-position-point))
10666
10667 (defun gnus-summary-scroll-up (lines)
10668   "Scroll up (or down) one line current article.
10669 Argument LINES specifies lines to be scrolled up (or down if negative)."
10670   (interactive "p")
10671   (gnus-set-global-variables)
10672   (gnus-configure-windows 'article)
10673   (gnus-summary-show-thread)
10674   (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
10675     (gnus-eval-in-buffer-window gnus-article-buffer
10676       (cond ((> lines 0)
10677              (if (gnus-article-next-page lines)
10678                  (gnus-message 3 "End of message")))
10679             ((< lines 0)
10680              (gnus-article-prev-page (- lines))))))
10681   (gnus-summary-recenter)
10682   (gnus-summary-position-point))
10683
10684 (defun gnus-summary-next-same-subject ()
10685   "Select next article which has the same subject as current one."
10686   (interactive)
10687   (gnus-set-global-variables)
10688   (gnus-summary-next-article nil (gnus-summary-article-subject)))
10689
10690 (defun gnus-summary-prev-same-subject ()
10691   "Select previous article which has the same subject as current one."
10692   (interactive)
10693   (gnus-set-global-variables)
10694   (gnus-summary-prev-article nil (gnus-summary-article-subject)))
10695
10696 (defun gnus-summary-next-unread-same-subject ()
10697   "Select next unread article which has the same subject as current one."
10698   (interactive)
10699   (gnus-set-global-variables)
10700   (gnus-summary-next-article t (gnus-summary-article-subject)))
10701
10702 (defun gnus-summary-prev-unread-same-subject ()
10703   "Select previous unread article which has the same subject as current one."
10704   (interactive)
10705   (gnus-set-global-variables)
10706   (gnus-summary-prev-article t (gnus-summary-article-subject)))
10707
10708 (defun gnus-summary-first-unread-article ()
10709   "Select the first unread article.
10710 Return nil if there are no unread articles."
10711   (interactive)
10712   (gnus-set-global-variables)
10713   (prog1
10714       (if (gnus-summary-first-subject t)
10715           (progn
10716             (gnus-summary-show-thread)
10717             (gnus-summary-first-subject t)
10718             (gnus-summary-display-article (gnus-summary-article-number))))
10719     (gnus-summary-position-point)))
10720
10721 (defun gnus-summary-best-unread-article ()
10722   "Select the unread article with the highest score."
10723   (interactive)
10724   (gnus-set-global-variables)
10725   (let ((best -1000000)
10726         (data gnus-newsgroup-data)
10727         article score)
10728     (while data
10729       (and (gnus-data-unread-p (car data))
10730            (> (setq score
10731                     (gnus-summary-article-score (gnus-data-number (car data))))
10732               best)
10733            (setq best score
10734                  article (gnus-data-number (car data))))
10735       (setq data (cdr data)))
10736     (prog1
10737         (if article
10738             (gnus-summary-goto-article article)
10739           (error "No unread articles"))
10740       (gnus-summary-position-point))))
10741
10742 (defun gnus-summary-last-subject ()
10743   "Go to the last displayed subject line in the group."
10744   (let ((article (gnus-data-number (car (gnus-data-list t)))))
10745     (when article
10746       (gnus-summary-goto-subject article))))
10747
10748 (defun gnus-summary-goto-article (article &optional all-headers force)
10749   "Fetch ARTICLE and display it if it exists.
10750 If ALL-HEADERS is non-nil, no header lines are hidden."
10751   (interactive
10752    (list
10753     (string-to-int
10754      (completing-read
10755       "Article number: "
10756       (mapcar (lambda (number) (list (int-to-string number)))
10757               gnus-newsgroup-limit)))
10758     current-prefix-arg
10759     t))
10760   (prog1
10761       (if (gnus-summary-goto-subject article force)
10762           (gnus-summary-display-article article all-headers)
10763         (gnus-message 4 "Couldn't go to article %s" article) nil)
10764     (gnus-summary-position-point)))
10765
10766 (defun gnus-summary-goto-last-article ()
10767   "Go to the previously read article."
10768   (interactive)
10769   (prog1
10770       (and gnus-last-article
10771            (gnus-summary-goto-article gnus-last-article))
10772     (gnus-summary-position-point)))
10773
10774 (defun gnus-summary-pop-article (number)
10775   "Pop one article off the history and go to the previous.
10776 NUMBER articles will be popped off."
10777   (interactive "p")
10778   (let (to)
10779     (setq gnus-newsgroup-history
10780           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
10781     (if to
10782         (gnus-summary-goto-article (car to))
10783       (error "Article history empty")))
10784   (gnus-summary-position-point))
10785
10786 ;; Summary commands and functions for limiting the summary buffer.
10787
10788 (defun gnus-summary-limit-to-articles (n)
10789   "Limit the summary buffer to the next N articles.
10790 If not given a prefix, use the process marked articles instead."
10791   (interactive "P")
10792   (gnus-set-global-variables)
10793   (prog1
10794       (let ((articles (gnus-summary-work-articles n)))
10795         (setq gnus-newsgroup-processable nil)
10796         (gnus-summary-limit articles))
10797     (gnus-summary-position-point)))
10798
10799 (defun gnus-summary-pop-limit (&optional total)
10800   "Restore the previous limit.
10801 If given a prefix, remove all limits."
10802   (interactive "P")
10803   (gnus-set-global-variables)
10804   (when total 
10805     (setq gnus-newsgroup-limits
10806           (list (mapcar (lambda (h) (mail-header-number h))
10807                         gnus-newsgroup-headers))))
10808   (unless gnus-newsgroup-limits
10809     (error "No limit to pop"))
10810   (prog1
10811       (gnus-summary-limit nil 'pop)
10812     (gnus-summary-position-point)))
10813
10814 (defun gnus-summary-limit-to-subject (subject &optional header)
10815   "Limit the summary buffer to articles that have subjects that match a regexp."
10816   (interactive "sRegexp: ")
10817   (unless header
10818     (setq header "subject"))
10819   (when (not (equal "" subject))
10820     (prog1
10821         (let ((articles (gnus-summary-find-matching
10822                          (or header "subject") subject 'all)))
10823           (or articles (error "Found no matches for \"%s\"" subject))
10824           (gnus-summary-limit articles))
10825       (gnus-summary-position-point))))
10826
10827 (defun gnus-summary-limit-to-author (from)
10828   "Limit the summary buffer to articles that have authors that match a regexp."
10829   (interactive "sRegexp: ")
10830   (gnus-summary-limit-to-subject from "from"))
10831
10832 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10833 (make-obsolete
10834  'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10835
10836 (defun gnus-summary-limit-to-unread (&optional all)
10837   "Limit the summary buffer to articles that are not marked as read.
10838 If ALL is non-nil, limit strictly to unread articles."
10839   (interactive "P")
10840   (if all
10841       (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
10842     (gnus-summary-limit-to-marks
10843      ;; Concat all the marks that say that an article is read and have
10844      ;; those removed.
10845      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
10846            gnus-killed-mark gnus-kill-file-mark
10847            gnus-low-score-mark gnus-expirable-mark
10848            gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark)
10849      'reverse)))
10850
10851 (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10852 (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10853
10854 (defun gnus-summary-limit-to-marks (marks &optional reverse)
10855   "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
10856 If REVERSE, limit the summary buffer to articles that are not marked
10857 with MARKS.  MARKS can either be a string of marks or a list of marks.
10858 Returns how many articles were removed."
10859   (interactive "sMarks: ")
10860   (gnus-set-global-variables)
10861   (prog1
10862       (let ((data gnus-newsgroup-data)
10863             (marks (if (listp marks) marks
10864                      (append marks nil))) ; Transform to list.
10865             articles)
10866         (while data
10867           (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
10868                  (memq (gnus-data-mark (car data)) marks))
10869                (setq articles (cons (gnus-data-number (car data)) articles)))
10870           (setq data (cdr data)))
10871         (gnus-summary-limit articles))
10872     (gnus-summary-position-point)))
10873
10874 (defun gnus-summary-limit-to-score (&optional score)
10875   "Limit to articles with score at or above SCORE."
10876   (interactive "P")
10877   (gnus-set-global-variables)
10878   (setq score (if score
10879                   (prefix-numeric-value score)
10880                 (or gnus-summary-default-score 0)))
10881   (let ((data gnus-newsgroup-data)
10882         articles)
10883     (while data
10884       (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
10885                 score)
10886         (push (gnus-data-number (car data)) articles))
10887       (setq data (cdr data)))
10888     (prog1
10889         (gnus-summary-limit articles)
10890       (gnus-summary-position-point))))
10891
10892 (defun gnus-summary-limit-include-dormant ()
10893   "Display all the hidden articles that are marked as dormant."
10894   (interactive)
10895   (gnus-set-global-variables)
10896   (or gnus-newsgroup-dormant
10897       (error "There are no dormant articles in this group"))
10898   (prog1
10899       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
10900     (gnus-summary-position-point)))
10901
10902 (defun gnus-summary-limit-exclude-dormant ()
10903   "Hide all dormant articles."
10904   (interactive)
10905   (gnus-set-global-variables)
10906   (prog1
10907       (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
10908     (gnus-summary-position-point)))
10909
10910 (defun gnus-summary-limit-exclude-childless-dormant ()
10911   "Hide all dormant articles that have no children."
10912   (interactive)
10913   (gnus-set-global-variables)
10914   (let ((data (gnus-data-list t))
10915         articles d children)
10916     ;; Find all articles that are either not dormant or have
10917     ;; children.
10918     (while (setq d (pop data))
10919       (when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
10920                 (and (setq children 
10921                            (gnus-article-children (gnus-data-number d)))
10922                      (let (found)
10923                        (while children
10924                          (when (memq (car children) articles)
10925                            (setq children nil
10926                                  found t))
10927                          (pop children))
10928                        found)))
10929         (push (gnus-data-number d) articles)))
10930     ;; Do the limiting.
10931     (prog1
10932         (gnus-summary-limit articles)
10933       (gnus-summary-position-point))))
10934
10935 (defun gnus-summary-limit-mark-excluded-as-read (&optional all)
10936   "Mark all unread excluded articles as read.
10937 If ALL, mark even excluded ticked and dormants as read."
10938   (interactive "P")
10939   (let ((articles (gnus-sorted-complement
10940                    (sort
10941                     (mapcar (lambda (h) (mail-header-number h))
10942                             gnus-newsgroup-headers)
10943                     '<)
10944                    (sort gnus-newsgroup-limit '<)))
10945         article)
10946     (setq gnus-newsgroup-unreads nil)
10947     (if all
10948         (setq gnus-newsgroup-dormant nil
10949               gnus-newsgroup-marked nil
10950               gnus-newsgroup-reads
10951               (nconc
10952                (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
10953                gnus-newsgroup-reads))
10954       (while (setq article (pop articles))
10955         (unless (or (memq article gnus-newsgroup-dormant)
10956                     (memq article gnus-newsgroup-marked))
10957           (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
10958
10959 (defun gnus-summary-limit (articles &optional pop)
10960   (if pop
10961       ;; We pop the previous limit off the stack and use that.
10962       (setq articles (car gnus-newsgroup-limits)
10963             gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
10964     ;; We use the new limit, so we push the old limit on the stack.
10965     (setq gnus-newsgroup-limits
10966           (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
10967   ;; Set the limit.
10968   (setq gnus-newsgroup-limit articles)
10969   (let ((total (length gnus-newsgroup-data))
10970         (data (gnus-data-find-list (gnus-summary-article-number)))
10971         (gnus-summary-mark-below nil)   ; Inhibit this.
10972         found)
10973     ;; This will do all the work of generating the new summary buffer
10974     ;; according to the new limit.
10975     (gnus-summary-prepare)
10976     ;; Hide any threads, possibly.
10977     (and gnus-show-threads
10978          gnus-thread-hide-subtree
10979          (gnus-summary-hide-all-threads))
10980     ;; Try to return to the article you were at, or one in the
10981     ;; neighborhood.
10982     (if data
10983         ;; We try to find some article after the current one.
10984         (while data
10985           (and (gnus-summary-goto-subject
10986                 (gnus-data-number (car data)) nil t)
10987                (setq data nil
10988                      found t))
10989           (setq data (cdr data))))
10990     (or found
10991         ;; If there is no data, that means that we were after the last
10992         ;; article.  The same goes when we can't find any articles
10993         ;; after the current one.
10994         (progn
10995           (goto-char (point-max))
10996           (gnus-summary-find-prev)))
10997     ;; We return how many articles were removed from the summary
10998     ;; buffer as a result of the new limit.
10999     (- total (length gnus-newsgroup-data))))
11000
11001 (defsubst gnus-invisible-cut-children (threads)
11002   (let ((num 0))
11003     (while threads
11004       (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit)
11005         (incf num))
11006       (pop threads))
11007     (< num 2)))
11008
11009 (defsubst gnus-cut-thread (thread)
11010   "Go forwards in the thread until we find an article that we want to display."
11011   (when (or (eq gnus-fetch-old-headers 'some)
11012             (eq gnus-build-sparse-threads 'some)
11013             (eq gnus-build-sparse-threads 'more))
11014     ;; Deal with old-fetched headers and sparse threads.
11015     (while (and
11016             thread
11017             (or
11018              (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
11019              (memq (mail-header-number (car thread)) gnus-newsgroup-ancient))
11020             (or (<= (length (cdr thread)) 1)
11021                 (gnus-invisible-cut-children (cdr thread))))
11022       (setq thread (cadr thread))))
11023   thread)
11024
11025 (defun gnus-cut-threads (threads)
11026   "Cut off all uninteresting articles from the beginning of threads."
11027   (when (or (eq gnus-fetch-old-headers 'some)
11028             (eq gnus-build-sparse-threads 'some)
11029             (eq gnus-build-sparse-threads 'more))
11030     (let ((th threads))
11031       (while th
11032         (setcar th (gnus-cut-thread (car th)))
11033         (setq th (cdr th)))))
11034   ;; Remove nixed out threads.
11035   (delq nil threads))
11036
11037 (defun gnus-summary-initial-limit (&optional show-if-empty)
11038   "Figure out what the initial limit is supposed to be on group entry.
11039 This entails weeding out unwanted dormants, low-scored articles,
11040 fetch-old-headers verbiage, and so on."
11041   ;; Most groups have nothing to remove.
11042   (if (or gnus-inhibit-limiting
11043           (and (null gnus-newsgroup-dormant)
11044                (not (eq gnus-fetch-old-headers 'some))
11045                (null gnus-summary-expunge-below)
11046                (not (eq gnus-build-sparse-threads 'some))
11047                (not (eq gnus-build-sparse-threads 'more))
11048                (null gnus-thread-expunge-below)
11049                (not gnus-use-nocem)))
11050       () ; Do nothing.
11051     (push gnus-newsgroup-limit gnus-newsgroup-limits)
11052     (setq gnus-newsgroup-limit nil)
11053     (mapatoms
11054      (lambda (node)
11055        (unless (car (symbol-value node))
11056          ;; These threads have no parents -- they are roots.
11057          (let ((nodes (cdr (symbol-value node)))
11058                thread)
11059            (while nodes
11060              (if (and gnus-thread-expunge-below
11061                       (< (gnus-thread-total-score (car nodes))
11062                          gnus-thread-expunge-below))
11063                  (gnus-expunge-thread (pop nodes))
11064                (setq thread (pop nodes))
11065                (gnus-summary-limit-children thread))))))
11066      gnus-newsgroup-dependencies)
11067     ;; If this limitation resulted in an empty group, we might
11068     ;; pop the previous limit and use it instead.
11069     (when (and (not gnus-newsgroup-limit)
11070                show-if-empty)
11071       (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
11072     gnus-newsgroup-limit))
11073
11074 (defun gnus-summary-limit-children (thread)
11075   "Return 1 if this subthread is visible and 0 if it is not."
11076   ;; First we get the number of visible children to this thread.  This
11077   ;; is done by recursing down the thread using this function, so this
11078   ;; will really go down to a leaf article first, before slowly
11079   ;; working its way up towards the root.
11080   (when thread
11081     (let ((children
11082            (if (cdr thread)
11083                (apply '+ (mapcar 'gnus-summary-limit-children
11084                                  (cdr thread)))
11085              0))
11086           (number (mail-header-number (car thread)))
11087           score)
11088       (if (or
11089            ;; If this article is dormant and has absolutely no visible
11090            ;; children, then this article isn't visible.
11091            (and (memq number gnus-newsgroup-dormant)
11092                 (= children 0))
11093            ;; If this is "fetch-old-headered" and there is only one
11094            ;; visible child (or less), then we don't want this article.
11095            (and (eq gnus-fetch-old-headers 'some)
11096                 (memq number gnus-newsgroup-ancient)
11097                 (zerop children))
11098            ;; If this is a sparsely inserted article with no children,
11099            ;; we don't want it.
11100            (and (eq gnus-build-sparse-threads 'some)
11101                 (memq number gnus-newsgroup-sparse)
11102                 (zerop children))
11103            ;; If we use expunging, and this article is really
11104            ;; low-scored, then we don't want this article.
11105            (when (and gnus-summary-expunge-below
11106                       (< (setq score
11107                                (or (cdr (assq number gnus-newsgroup-scored))
11108                                    gnus-summary-default-score))
11109                          gnus-summary-expunge-below))
11110              ;; We increase the expunge-tally here, but that has
11111              ;; nothing to do with the limits, really.
11112              (incf gnus-newsgroup-expunged-tally)
11113              ;; We also mark as read here, if that's wanted.
11114              (when (and gnus-summary-mark-below
11115                         (< score gnus-summary-mark-below))
11116                (setq gnus-newsgroup-unreads
11117                      (delq number gnus-newsgroup-unreads))
11118                (if gnus-newsgroup-auto-expire
11119                    (push number gnus-newsgroup-expirable)
11120                  (push (cons number gnus-low-score-mark)
11121                        gnus-newsgroup-reads)))
11122              t)
11123            (and gnus-use-nocem
11124                 (gnus-nocem-unwanted-article-p (mail-header-id (car thread)))))
11125           ;; Nope, invisible article.
11126           0
11127         ;; Ok, this article is to be visible, so we add it to the limit
11128         ;; and return 1.
11129         (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
11130         1))))
11131
11132 (defun gnus-expunge-thread (thread)
11133   "Mark all articles in THREAD as read."
11134   (let* ((number (mail-header-number (car thread))))
11135     (incf gnus-newsgroup-expunged-tally)
11136     ;; We also mark as read here, if that's wanted.
11137     (setq gnus-newsgroup-unreads
11138           (delq number gnus-newsgroup-unreads))
11139     (if gnus-newsgroup-auto-expire
11140         (push number gnus-newsgroup-expirable)
11141       (push (cons number gnus-low-score-mark)
11142             gnus-newsgroup-reads)))
11143   ;; Go recursively through all subthreads.
11144   (mapcar 'gnus-expunge-thread (cdr thread)))
11145
11146 ;; Summary article oriented commands
11147
11148 (defun gnus-summary-refer-parent-article (n)
11149   "Refer parent article N times.
11150 The difference between N and the number of articles fetched is returned."
11151   (interactive "p")
11152   (gnus-set-global-variables)
11153   (while
11154       (and
11155        (> n 0)
11156        (let* ((header (gnus-summary-article-header))
11157               (ref
11158                ;; If we try to find the parent of the currently
11159                ;; displayed article, then we take a look at the actual
11160                ;; References header, since this is slightly more
11161                ;; reliable than the References field we got from the
11162                ;; server.
11163                (if (and (eq (mail-header-number header)
11164                             (cdr gnus-article-current))
11165                         (equal gnus-newsgroup-name
11166                                (car gnus-article-current)))
11167                    (save-excursion
11168                      (set-buffer gnus-original-article-buffer)
11169                      (nnheader-narrow-to-headers)
11170                      (prog1
11171                          (message-fetch-field "references")
11172                        (widen)))
11173                  ;; It's not the current article, so we take a bet on
11174                  ;; the value we got from the server.
11175                  (mail-header-references header))))
11176          (if (setq ref (or ref (mail-header-references header)))
11177              (or (gnus-summary-refer-article (gnus-parent-id ref))
11178                  (gnus-message 1 "Couldn't find parent"))
11179            (gnus-message 1 "No references in article %d"
11180                          (gnus-summary-article-number))
11181            nil)))
11182     (setq n (1- n)))
11183   (gnus-summary-position-point)
11184   n)
11185
11186 (defun gnus-summary-refer-references ()
11187   "Fetch all articles mentioned in the References header.
11188 Return how many articles were fetched."
11189   (interactive)
11190   (gnus-set-global-variables)
11191   (let ((ref (mail-header-references (gnus-summary-article-header)))
11192         (current (gnus-summary-article-number))
11193         (n 0))
11194     ;; For each Message-ID in the References header...
11195     (while (string-match "<[^>]*>" ref)
11196       (incf n)
11197       ;; ... fetch that article.
11198       (gnus-summary-refer-article
11199        (prog1 (match-string 0 ref)
11200          (setq ref (substring ref (match-end 0))))))
11201     (gnus-summary-goto-subject current)
11202     (gnus-summary-position-point)
11203     n))
11204
11205 (defun gnus-summary-refer-article (message-id)
11206   "Fetch an article specified by MESSAGE-ID."
11207   (interactive "sMessage-ID: ")
11208   (when (and (stringp message-id)
11209              (not (zerop (length message-id))))
11210     ;; Construct the correct Message-ID if necessary.
11211     ;; Suggested by tale@pawl.rpi.edu.
11212     (unless (string-match "^<" message-id)
11213       (setq message-id (concat "<" message-id)))
11214     (unless (string-match ">$" message-id)
11215       (setq message-id (concat message-id ">")))
11216     (let* ((header (gnus-id-to-header message-id))
11217            (sparse (and header
11218                         (memq (mail-header-number header)
11219                               gnus-newsgroup-sparse))))
11220       (if header
11221           (prog1
11222               ;; The article is present in the buffer, to we just go to it.
11223               (gnus-summary-goto-article 
11224                (mail-header-number header) nil header)
11225             (when sparse
11226               (gnus-summary-update-article (mail-header-number header))))
11227         ;; We fetch the article
11228         (let ((gnus-override-method 
11229                (and (gnus-news-group-p gnus-newsgroup-name)
11230                     gnus-refer-article-method))
11231               number)
11232           ;; Start the special refer-article method, if necessary.
11233           (when (and gnus-refer-article-method
11234                      (gnus-news-group-p gnus-newsgroup-name))
11235             (gnus-check-server gnus-refer-article-method))
11236           ;; Fetch the header, and display the article.
11237           (if (setq number (gnus-summary-insert-subject message-id))
11238               (gnus-summary-select-article nil nil nil number)
11239             (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
11240
11241 (defun gnus-summary-enter-digest-group (&optional force)
11242   "Enter a digest group based on the current article."
11243   (interactive "P")
11244   (gnus-set-global-variables)
11245   (gnus-summary-select-article)
11246   (let ((name (format "%s-%d"
11247                       (gnus-group-prefixed-name
11248                        gnus-newsgroup-name (list 'nndoc ""))
11249                       gnus-current-article))
11250         (ogroup gnus-newsgroup-name)
11251         (case-fold-search t)
11252         (buf (current-buffer))
11253         dig)
11254     (save-excursion
11255       (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
11256       (insert-buffer-substring gnus-original-article-buffer)
11257       (narrow-to-region
11258        (goto-char (point-min))
11259        (or (search-forward "\n\n" nil t) (point)))
11260       (goto-char (point-min))
11261       (delete-matching-lines "^\\(Path\\):\\|^From ")
11262       (widen))
11263     (unwind-protect
11264         (if (gnus-group-read-ephemeral-group
11265              name `(nndoc ,name (nndoc-address
11266                                  ,(get-buffer dig))
11267                           (nndoc-article-type ,(if force 'digest 'guess))) t)
11268             ;; Make all postings to this group go to the parent group.
11269             (nconc (gnus-info-params (gnus-get-info name))
11270                    (list (cons 'to-group ogroup)))
11271           ;; Couldn't select this doc group.
11272           (switch-to-buffer buf)
11273           (gnus-set-global-variables)
11274           (gnus-configure-windows 'summary)
11275           (gnus-message 3 "Article couldn't be entered?"))
11276       (kill-buffer dig))))
11277
11278 (defun gnus-summary-isearch-article (&optional regexp-p)
11279   "Do incremental search forward on the current article.
11280 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
11281   (interactive "P")
11282   (gnus-set-global-variables)
11283   (gnus-summary-select-article)
11284   (gnus-configure-windows 'article)
11285   (gnus-eval-in-buffer-window gnus-article-buffer
11286     ;;(goto-char (point-min))
11287     (isearch-forward regexp-p)))
11288
11289 (defun gnus-summary-search-article-forward (regexp &optional backward)
11290   "Search for an article containing REGEXP forward.
11291 If BACKWARD, search backward instead."
11292   (interactive
11293    (list (read-string
11294           (format "Search article %s (regexp%s): "
11295                   (if current-prefix-arg "backward" "forward")
11296                   (if gnus-last-search-regexp
11297                       (concat ", default " gnus-last-search-regexp)
11298                     "")))
11299          current-prefix-arg))
11300   (gnus-set-global-variables)
11301   (if (string-equal regexp "")
11302       (setq regexp (or gnus-last-search-regexp ""))
11303     (setq gnus-last-search-regexp regexp))
11304   (unless (gnus-summary-search-article regexp backward)
11305     (error "Search failed: \"%s\"" regexp)))
11306
11307 (defun gnus-summary-search-article-backward (regexp)
11308   "Search for an article containing REGEXP backward."
11309   (interactive
11310    (list (read-string
11311           (format "Search article backward (regexp%s): "
11312                   (if gnus-last-search-regexp
11313                       (concat ", default " gnus-last-search-regexp)
11314                     "")))))
11315   (gnus-summary-search-article-forward regexp 'backward))
11316
11317 (defun gnus-summary-search-article (regexp &optional backward)
11318   "Search for an article containing REGEXP.
11319 Optional argument BACKWARD means do search for backward.
11320 `gnus-select-article-hook' is not called during the search."
11321   (let ((gnus-select-article-hook nil)  ;Disable hook.
11322         (gnus-article-display-hook nil)
11323         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
11324         (re-search
11325          (if backward
11326              're-search-backward 're-search-forward))
11327         (sum (current-buffer))
11328         (found nil))
11329     (gnus-save-hidden-threads
11330       (gnus-summary-select-article)
11331       (set-buffer gnus-article-buffer)
11332       (when backward
11333         (forward-line -1))
11334       (while (not found)
11335         (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current))
11336         (if (if backward
11337                 (re-search-backward regexp nil t)
11338               (re-search-forward regexp nil t))
11339             ;; We found the regexp.
11340             (progn
11341               (setq found 'found)
11342               (beginning-of-line)
11343               (set-window-start
11344                (get-buffer-window (current-buffer))
11345                (point))
11346               (forward-line 1)
11347               (set-buffer sum))
11348           ;; We didn't find it, so we go to the next article.
11349           (set-buffer sum)
11350           (if (not (if backward (gnus-summary-find-prev)
11351                      (gnus-summary-find-next)))
11352               ;; No more articles.
11353               (setq found t)
11354             ;; Select the next article and adjust point.
11355             (gnus-summary-select-article)
11356             (set-buffer gnus-article-buffer)
11357             (widen)
11358             (goto-char (if backward (point-max) (point-min))))))
11359       (gnus-message 7 ""))
11360     ;; Return whether we found the regexp.
11361     (when (eq found 'found)
11362       (gnus-summary-show-thread)
11363       (gnus-summary-goto-subject gnus-current-article)
11364       (gnus-summary-position-point)
11365       t)))
11366
11367 (defun gnus-summary-find-matching (header regexp &optional backward unread
11368                                           not-case-fold)
11369   "Return a list of all articles that match REGEXP on HEADER.
11370 The search stars on the current article and goes forwards unless
11371 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
11372 If UNREAD is non-nil, only unread articles will
11373 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
11374 in the comparisons."
11375   (let ((data (if (eq backward 'all) gnus-newsgroup-data
11376                 (gnus-data-find-list
11377                  (gnus-summary-article-number) (gnus-data-list backward))))
11378         (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
11379         (case-fold-search (not not-case-fold))
11380         articles d)
11381     (or (fboundp (intern (concat "mail-header-" header)))
11382         (error "%s is not a valid header" header))
11383     (while data
11384       (setq d (car data))
11385       (and (or (not unread)             ; We want all articles...
11386                (gnus-data-unread-p d))  ; Or just unreads.
11387            (vectorp (gnus-data-header d)) ; It's not a pseudo.
11388            (string-match regexp (funcall func (gnus-data-header d))) ; Match.
11389            (setq articles (cons (gnus-data-number d) articles))) ; Success!
11390       (setq data (cdr data)))
11391     (nreverse articles)))
11392
11393 (defun gnus-summary-execute-command (header regexp command &optional backward)
11394   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
11395 If HEADER is an empty string (or nil), the match is done on the entire
11396 article.  If BACKWARD (the prefix) is non-nil, search backward instead."
11397   (interactive
11398    (list (let ((completion-ignore-case t))
11399            (completing-read
11400             "Header name: "
11401             (mapcar (lambda (string) (list string))
11402                     '("Number" "Subject" "From" "Lines" "Date"
11403                       "Message-ID" "Xref" "References" "Body"))
11404             nil 'require-match))
11405          (read-string "Regexp: ")
11406          (read-key-sequence "Command: ")
11407          current-prefix-arg))
11408   (when (equal header "Body")
11409     (setq header ""))
11410   (gnus-set-global-variables)
11411   ;; Hidden thread subtrees must be searched as well.
11412   (gnus-summary-show-all-threads)
11413   ;; We don't want to change current point nor window configuration.
11414   (save-excursion
11415     (save-window-excursion
11416       (gnus-message 6 "Executing %s..." (key-description command))
11417       ;; We'd like to execute COMMAND interactively so as to give arguments.
11418       (gnus-execute header regexp
11419                     `(lambda () (call-interactively ',(key-binding command)))
11420                     backward)
11421       (gnus-message 6 "Executing %s...done" (key-description command)))))
11422
11423 (defun gnus-summary-beginning-of-article ()
11424   "Scroll the article back to the beginning."
11425   (interactive)
11426   (gnus-set-global-variables)
11427   (gnus-summary-select-article)
11428   (gnus-configure-windows 'article)
11429   (gnus-eval-in-buffer-window gnus-article-buffer
11430     (widen)
11431     (goto-char (point-min))
11432     (and gnus-break-pages (gnus-narrow-to-page))))
11433
11434 (defun gnus-summary-end-of-article ()
11435   "Scroll to the end of the article."
11436   (interactive)
11437   (gnus-set-global-variables)
11438   (gnus-summary-select-article)
11439   (gnus-configure-windows 'article)
11440   (gnus-eval-in-buffer-window gnus-article-buffer
11441     (widen)
11442     (goto-char (point-max))
11443     (recenter -3)
11444     (and gnus-break-pages (gnus-narrow-to-page))))
11445
11446 (defun gnus-summary-show-article (&optional arg)
11447   "Force re-fetching of the current article.
11448 If ARG (the prefix) is non-nil, show the raw article without any
11449 article massaging functions being run."
11450   (interactive "P")
11451   (gnus-set-global-variables)
11452   (if (not arg)
11453       ;; Select the article the normal way.
11454       (gnus-summary-select-article nil 'force)
11455     ;; Bind the article treatment functions to nil.
11456     (let ((gnus-have-all-headers t)
11457           gnus-article-display-hook
11458           gnus-article-prepare-hook
11459           gnus-break-pages
11460           gnus-visual)
11461       (gnus-summary-select-article nil 'force)))
11462   (gnus-summary-goto-subject gnus-current-article)
11463 ;  (gnus-configure-windows 'article)
11464   (gnus-summary-position-point))
11465
11466 (defun gnus-summary-verbose-headers (&optional arg)
11467   "Toggle permanent full header display.
11468 If ARG is a positive number, turn header display on.
11469 If ARG is a negative number, turn header display off."
11470   (interactive "P")
11471   (gnus-set-global-variables)
11472   (gnus-summary-toggle-header arg)
11473   (setq gnus-show-all-headers
11474         (cond ((or (not (numberp arg))
11475                    (zerop arg))
11476                (not gnus-show-all-headers))
11477               ((natnump arg)
11478                t))))
11479
11480 (defun gnus-summary-toggle-header (&optional arg)
11481   "Show the headers if they are hidden, or hide them if they are shown.
11482 If ARG is a positive number, show the entire header.
11483 If ARG is a negative number, hide the unwanted header lines."
11484   (interactive "P")
11485   (gnus-set-global-variables)
11486   (save-excursion
11487     (set-buffer gnus-article-buffer)
11488     (let* ((buffer-read-only nil)
11489            (inhibit-point-motion-hooks t)
11490            (hidden (text-property-any
11491                     (goto-char (point-min)) (search-forward "\n\n")
11492                     'invisible t))
11493            e)
11494       (goto-char (point-min))
11495       (when (search-forward "\n\n" nil t)
11496         (delete-region (point-min) (1- (point))))
11497       (goto-char (point-min))
11498       (save-excursion
11499         (set-buffer gnus-original-article-buffer)
11500         (goto-char (point-min))
11501         (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
11502       (insert-buffer-substring gnus-original-article-buffer 1 e)
11503       (let ((gnus-inhibit-hiding t))
11504         (run-hooks 'gnus-article-display-hook))
11505       (if (or (not hidden) (and (numberp arg) (< arg 0)))
11506           (gnus-article-hide-headers)))))
11507
11508 (defun gnus-summary-show-all-headers ()
11509   "Make all header lines visible."
11510   (interactive)
11511   (gnus-set-global-variables)
11512   (gnus-article-show-all-headers))
11513
11514 (defun gnus-summary-toggle-mime (&optional arg)
11515   "Toggle MIME processing.
11516 If ARG is a positive number, turn MIME processing on."
11517   (interactive "P")
11518   (gnus-set-global-variables)
11519   (setq gnus-show-mime
11520         (if (null arg) (not gnus-show-mime)
11521           (> (prefix-numeric-value arg) 0)))
11522   (gnus-summary-select-article t 'force))
11523
11524 (defun gnus-summary-caesar-message (&optional arg)
11525   "Caesar rotate the current article by 13.
11526 The numerical prefix specifies how manu places to rotate each letter
11527 forward."
11528   (interactive "P")
11529   (gnus-set-global-variables)
11530   (gnus-summary-select-article)
11531   (let ((mail-header-separator ""))
11532     (gnus-eval-in-buffer-window gnus-article-buffer
11533       (save-restriction
11534         (widen)
11535         (let ((start (window-start))
11536               buffer-read-only)
11537           (message-caesar-buffer-body arg)
11538           (set-window-start (get-buffer-window (current-buffer)) start))))))
11539
11540 (defun gnus-summary-stop-page-breaking ()
11541   "Stop page breaking in the current article."
11542   (interactive)
11543   (gnus-set-global-variables)
11544   (gnus-summary-select-article)
11545   (gnus-eval-in-buffer-window gnus-article-buffer
11546     (widen)))
11547
11548 (defun gnus-summary-move-article (&optional n to-newsgroup select-method action)
11549   "Move the current article to a different newsgroup.
11550 If N is a positive number, move the N next articles.
11551 If N is a negative number, move the N previous articles.
11552 If N is nil and any articles have been marked with the process mark,
11553 move those articles instead.
11554 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
11555 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
11556 re-spool using this method.
11557
11558 For this function to work, both the current newsgroup and the
11559 newsgroup that you want to move to have to support the `request-move'
11560 and `request-accept' functions."
11561   (interactive "P")
11562   (unless action (setq action 'move))
11563   (gnus-set-global-variables)
11564   ;; Check whether the source group supports the required functions.
11565   (cond ((and (eq action 'move)
11566               (not (gnus-check-backend-function
11567                     'request-move-article gnus-newsgroup-name)))
11568          (error "The current group does not support article moving"))
11569         ((and (eq action 'crosspost)
11570               (not (gnus-check-backend-function
11571                     'request-replace-article gnus-newsgroup-name)))
11572          (error "The current group does not support article editing")))
11573   (let ((articles (gnus-summary-work-articles n))
11574         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
11575         (names '((move "Move" "Moving")
11576                  (copy "Copy" "Copying")
11577                  (crosspost "Crosspost" "Crossposting")))
11578         (copy-buf (save-excursion
11579                     (nnheader-set-temp-buffer " *copy article*")))
11580         art-group to-method new-xref article to-groups)
11581     (unless (assq action names)
11582       (error "Unknown action %s" action))
11583     ;; Read the newsgroup name.
11584     (when (and (not to-newsgroup)
11585                (not select-method))
11586       (setq to-newsgroup
11587             (gnus-read-move-group-name
11588              (cadr (assq action names))
11589              (symbol-value (intern (format "gnus-current-%s-group" action)))
11590              articles prefix))
11591       (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
11592     (setq to-method (or select-method 
11593                         (gnus-group-name-to-method to-newsgroup)))
11594     ;; Check the method we are to move this article to...
11595     (or (gnus-check-backend-function 'request-accept-article (car to-method))
11596         (error "%s does not support article copying" (car to-method)))
11597     (or (gnus-check-server to-method)
11598         (error "Can't open server %s" (car to-method)))
11599     (gnus-message 6 "%s to %s: %s..."
11600                   (caddr (assq action names))
11601                   (or (car select-method) to-newsgroup) articles)
11602     (while articles
11603       (setq article (pop articles))
11604       (setq
11605        art-group
11606        (cond
11607         ;; Move the article.
11608         ((eq action 'move)
11609          (gnus-request-move-article
11610           article                       ; Article to move
11611           gnus-newsgroup-name           ; From newsgrouo
11612           (nth 1 (gnus-find-method-for-group
11613                   gnus-newsgroup-name)) ; Server
11614           (list 'gnus-request-accept-article
11615                 to-newsgroup (list 'quote select-method)
11616                 (not articles))         ; Accept form
11617           (not articles)))              ; Only save nov last time
11618         ;; Copy the article.
11619         ((eq action 'copy)
11620          (save-excursion
11621            (set-buffer copy-buf)
11622            (gnus-request-article-this-buffer article gnus-newsgroup-name)
11623            (gnus-request-accept-article
11624             to-newsgroup select-method (not articles))))
11625         ;; Crosspost the article.
11626         ((eq action 'crosspost)
11627          (let ((xref (mail-header-xref (gnus-summary-article-header article))))
11628            (setq new-xref (concat gnus-newsgroup-name ":" article))
11629            (if (and xref (not (string= xref "")))
11630                (progn
11631                  (when (string-match "^Xref: " xref)
11632                    (setq xref (substring xref (match-end 0))))
11633                  (setq new-xref (concat xref " " new-xref)))
11634              (setq new-xref (concat (system-name) " " new-xref)))
11635            (save-excursion
11636              (set-buffer copy-buf)
11637              (gnus-request-article-this-buffer article gnus-newsgroup-name)
11638              (nnheader-replace-header "xref" new-xref)
11639              (gnus-request-accept-article
11640               to-newsgroup select-method (not articles)))))))
11641       (if (not art-group)
11642           (gnus-message 1 "Couldn't %s article %s"
11643                         (cadr (assq action names)) article)
11644         (let* ((entry
11645                 (or
11646                  (gnus-gethash (car art-group) gnus-newsrc-hashtb)
11647                  (gnus-gethash
11648                   (gnus-group-prefixed-name
11649                    (car art-group)
11650                    (or select-method 
11651                        (gnus-find-method-for-group to-newsgroup)))
11652                   gnus-newsrc-hashtb)))
11653                (info (nth 2 entry))
11654                (to-group (gnus-info-group info)))
11655           ;; Update the group that has been moved to.
11656           (when (and info
11657                      (memq action '(move copy)))
11658             (unless (member to-group to-groups)
11659               (push to-group to-groups))
11660
11661             (unless (memq article gnus-newsgroup-unreads)
11662               (gnus-info-set-read
11663                info (gnus-add-to-range (gnus-info-read info)
11664                                        (list (cdr art-group)))))
11665
11666             ;; Copy any marks over to the new group.
11667             (let ((marks gnus-article-mark-lists)
11668                   (to-article (cdr art-group)))
11669
11670               ;; See whether the article is to be put in the cache.
11671               (when gnus-use-cache
11672                 (gnus-cache-possibly-enter-article
11673                  to-group to-article
11674                  (let ((header (copy-sequence
11675                                 (gnus-summary-article-header article))))
11676                    (mail-header-set-number header to-article)
11677                    header)
11678                  (memq article gnus-newsgroup-marked)
11679                  (memq article gnus-newsgroup-dormant)
11680                  (memq article gnus-newsgroup-unreads)))
11681
11682               (while marks
11683                 (when (memq article (symbol-value
11684                                      (intern (format "gnus-newsgroup-%s"
11685                                                      (caar marks)))))
11686                   ;; If the other group is the same as this group,
11687                   ;; then we have to add the mark to the list.
11688                   (when (equal to-group gnus-newsgroup-name)
11689                     (set (intern (format "gnus-newsgroup-%s" (caar marks)))
11690                          (cons to-article
11691                                (symbol-value
11692                                 (intern (format "gnus-newsgroup-%s"
11693                                                 (caar marks)))))))
11694                   ;; Copy mark to other group.
11695                   (gnus-add-marked-articles
11696                    to-group (cdar marks) (list to-article) info))
11697                 (setq marks (cdr marks)))))
11698
11699           ;; Update the Xref header in this article to point to
11700           ;; the new crossposted article we have just created.
11701           (when (eq action 'crosspost)
11702             (save-excursion
11703               (set-buffer copy-buf)
11704               (gnus-request-article-this-buffer article gnus-newsgroup-name)
11705               (nnheader-replace-header
11706                "xref" (concat new-xref " " (gnus-group-prefixed-name
11707                                             (car art-group) to-method)
11708                               ":" (cdr art-group)))
11709               (gnus-request-replace-article
11710                article gnus-newsgroup-name (current-buffer)))))
11711
11712         (gnus-summary-goto-subject article)
11713         (when (eq action 'move)
11714           (gnus-summary-mark-article article gnus-canceled-mark)))
11715       (gnus-summary-remove-process-mark article))
11716     ;; Re-activate all groups that have been moved to.
11717     (while to-groups
11718       (gnus-activate-group (pop to-groups)))
11719     
11720     (gnus-kill-buffer copy-buf)
11721     (gnus-summary-position-point)
11722     (gnus-set-mode-line 'summary)))
11723
11724 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
11725   "Move the current article to a different newsgroup.
11726 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
11727 If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
11728 re-spool using this method."
11729   (interactive "P")
11730   (gnus-summary-move-article n nil select-method 'copy))
11731
11732 (defun gnus-summary-crosspost-article (&optional n)
11733   "Crosspost the current article to some other group."
11734   (interactive "P")
11735   (gnus-summary-move-article n nil nil 'crosspost))
11736
11737 (defvar gnus-summary-respool-default-method nil
11738   "Default method for respooling an article.  
11739 If nil, use to the current newsgroup method.")
11740
11741 (defun gnus-summary-respool-article (&optional n method)
11742   "Respool the current article.
11743 The article will be squeezed through the mail spooling process again,
11744 which means that it will be put in some mail newsgroup or other
11745 depending on `nnmail-split-methods'.
11746 If N is a positive number, respool the N next articles.
11747 If N is a negative number, respool the N previous articles.
11748 If N is nil and any articles have been marked with the process mark,
11749 respool those articles instead.
11750
11751 Respooling can be done both from mail groups and \"real\" newsgroups.
11752 In the former case, the articles in question will be moved from the
11753 current group into whatever groups they are destined to.  In the
11754 latter case, they will be copied into the relevant groups."
11755   (interactive 
11756    (list current-prefix-arg
11757          (let* ((methods (gnus-methods-using 'respool))
11758                 (methname
11759                  (symbol-name (or gnus-summary-respool-default-method
11760                                   (car (gnus-find-method-for-group
11761                                         gnus-newsgroup-name)))))
11762                 (method
11763                  (gnus-completing-read 
11764                   methname "What backend do you want to use when respooling?"
11765                   methods nil t nil 'gnus-method-history))
11766                 ms)
11767            (cond
11768             ((zerop (length (setq ms (gnus-servers-using-backend method))))
11769              (list (intern method) ""))
11770             ((= 1 (length ms))
11771              (car ms))
11772             (t
11773              (cdr (completing-read 
11774                    "Server name: "
11775                    (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t)))))))
11776   (gnus-set-global-variables)
11777   (unless method
11778     (error "No method given for respooling"))
11779   (if (assoc (symbol-name
11780               (car (gnus-find-method-for-group gnus-newsgroup-name)))
11781              (gnus-methods-using 'respool))
11782       (gnus-summary-move-article n nil method)
11783     (gnus-summary-copy-article n nil method)))
11784
11785 (defun gnus-summary-import-article (file)
11786   "Import a random file into a mail newsgroup."
11787   (interactive "fImport file: ")
11788   (gnus-set-global-variables)
11789   (let ((group gnus-newsgroup-name)
11790         (now (current-time))
11791         atts lines)
11792     (or (gnus-check-backend-function 'request-accept-article group)
11793         (error "%s does not support article importing" group))
11794     (or (file-readable-p file)
11795         (not (file-regular-p file))
11796         (error "Can't read %s" file))
11797     (save-excursion
11798       (set-buffer (get-buffer-create " *import file*"))
11799       (buffer-disable-undo (current-buffer))
11800       (erase-buffer)
11801       (insert-file-contents file)
11802       (goto-char (point-min))
11803       (unless (nnheader-article-p)
11804         ;; This doesn't look like an article, so we fudge some headers.
11805         (setq atts (file-attributes file)
11806               lines (count-lines (point-min) (point-max)))
11807         (insert "From: " (read-string "From: ") "\n"
11808                 "Subject: " (read-string "Subject: ") "\n"
11809                 "Date: " (timezone-make-date-arpa-standard
11810                           (current-time-string (nth 5 atts))
11811                           (current-time-zone now)
11812                           (current-time-zone now)) "\n"
11813                 "Message-ID: " (message-make-message-id) "\n"
11814                 "Lines: " (int-to-string lines) "\n"
11815                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
11816       (gnus-request-accept-article group nil t)
11817       (kill-buffer (current-buffer)))))
11818
11819 (defun gnus-summary-expire-articles (&optional now)
11820   "Expire all articles that are marked as expirable in the current group."
11821   (interactive)
11822   (gnus-set-global-variables)
11823   (when (gnus-check-backend-function
11824          'request-expire-articles gnus-newsgroup-name)
11825     ;; This backend supports expiry.
11826     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
11827            (expirable (if total
11828                           (gnus-list-of-read-articles gnus-newsgroup-name)
11829                         (setq gnus-newsgroup-expirable
11830                               (sort gnus-newsgroup-expirable '<))))
11831            (expiry-wait (if now 'immediate
11832                           (gnus-group-get-parameter
11833                            gnus-newsgroup-name 'expiry-wait)))
11834            es)
11835       (when expirable
11836         ;; There are expirable articles in this group, so we run them
11837         ;; through the expiry process.
11838         (gnus-message 6 "Expiring articles...")
11839         ;; The list of articles that weren't expired is returned.
11840         (if expiry-wait
11841             (let ((nnmail-expiry-wait-function nil)
11842                   (nnmail-expiry-wait expiry-wait))
11843               (setq es (gnus-request-expire-articles
11844                         expirable gnus-newsgroup-name)))
11845           (setq es (gnus-request-expire-articles
11846                     expirable gnus-newsgroup-name)))
11847         (or total (setq gnus-newsgroup-expirable es))
11848         ;; We go through the old list of expirable, and mark all
11849         ;; really expired articles as nonexistent.
11850         (unless (eq es expirable)       ;If nothing was expired, we don't mark.
11851           (let ((gnus-use-cache nil))
11852             (while expirable
11853               (unless (memq (car expirable) es)
11854                 (when (gnus-data-find (car expirable))
11855                   (gnus-summary-mark-article
11856                    (car expirable) gnus-canceled-mark)))
11857               (setq expirable (cdr expirable)))))
11858         (gnus-message 6 "Expiring articles...done")))))
11859
11860 (defun gnus-summary-expire-articles-now ()
11861   "Expunge all expirable articles in the current group.
11862 This means that *all* articles that are marked as expirable will be
11863 deleted forever, right now."
11864   (interactive)
11865   (gnus-set-global-variables)
11866   (or gnus-expert-user
11867       (gnus-y-or-n-p
11868        "Are you really, really, really sure you want to delete all these messages? ")
11869       (error "Phew!"))
11870   (gnus-summary-expire-articles t))
11871
11872 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
11873 (defun gnus-summary-delete-article (&optional n)
11874   "Delete the N next (mail) articles.
11875 This command actually deletes articles.  This is not a marking
11876 command.  The article will disappear forever from your life, never to
11877 return.
11878 If N is negative, delete backwards.
11879 If N is nil and articles have been marked with the process mark,
11880 delete these instead."
11881   (interactive "P")
11882   (gnus-set-global-variables)
11883   (or (gnus-check-backend-function 'request-expire-articles
11884                                    gnus-newsgroup-name)
11885       (error "The current newsgroup does not support article deletion."))
11886   ;; Compute the list of articles to delete.
11887   (let ((articles (gnus-summary-work-articles n))
11888         not-deleted)
11889     (if (and gnus-novice-user
11890              (not (gnus-y-or-n-p
11891                    (format "Do you really want to delete %s forever? "
11892                            (if (> (length articles) 1) 
11893                                (format "these %s articles" (length articles))
11894                              "this article")))))
11895         ()
11896       ;; Delete the articles.
11897       (setq not-deleted (gnus-request-expire-articles
11898                          articles gnus-newsgroup-name 'force))
11899       (while articles
11900         (gnus-summary-remove-process-mark (car articles))
11901         ;; The backend might not have been able to delete the article
11902         ;; after all.
11903         (or (memq (car articles) not-deleted)
11904             (gnus-summary-mark-article (car articles) gnus-canceled-mark))
11905         (setq articles (cdr articles))))
11906     (gnus-summary-position-point)
11907     (gnus-set-mode-line 'summary)
11908     not-deleted))
11909
11910 (defun gnus-summary-edit-article (&optional force)
11911   "Enter into a buffer and edit the current article.
11912 This will have permanent effect only in mail groups.
11913 If FORCE is non-nil, allow editing of articles even in read-only
11914 groups."
11915   (interactive "P")
11916   (save-excursion
11917     (set-buffer gnus-summary-buffer)
11918     (gnus-set-global-variables)
11919     (when (and (not force)
11920                (gnus-group-read-only-p))
11921       (error "The current newsgroup does not support article editing."))
11922     (gnus-summary-select-article t nil t)
11923     (gnus-configure-windows 'article)
11924     (select-window (get-buffer-window gnus-article-buffer))
11925     (gnus-message 6 "C-c C-c to end edits")
11926     (setq buffer-read-only nil)
11927     (text-mode)
11928     (use-local-map (copy-keymap (current-local-map)))
11929     (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
11930     (buffer-enable-undo)
11931     (widen)
11932     (goto-char (point-min))
11933     (search-forward "\n\n" nil t)))
11934
11935 (defun gnus-summary-edit-article-done ()
11936   "Make edits to the current article permanent."
11937   (interactive)
11938   (if (gnus-group-read-only-p)
11939       (progn
11940         (let ((beep (not (eq major-mode 'text-mode))))
11941           (gnus-summary-edit-article-postpone)
11942           (when beep
11943             (gnus-error
11944              3 "The current newsgroup does not support article editing."))))
11945     (let ((buf (format "%s" (buffer-string))))
11946       (erase-buffer)
11947       (insert buf)
11948       (if (not (gnus-request-replace-article
11949                 (cdr gnus-article-current) (car gnus-article-current)
11950                 (current-buffer)))
11951           (error "Couldn't replace article.")
11952         (gnus-article-mode)
11953         (use-local-map gnus-article-mode-map)
11954         (setq buffer-read-only t)
11955         (buffer-disable-undo (current-buffer))
11956         (gnus-configure-windows 'summary)
11957         (gnus-summary-update-article (cdr gnus-article-current))
11958         (when gnus-use-cache
11959           (gnus-cache-update-article    
11960            (car gnus-article-current) (cdr gnus-article-current)))
11961         (when gnus-keep-backlog
11962           (gnus-backlog-remove-article 
11963            (car gnus-article-current) (cdr gnus-article-current))))
11964       (save-excursion
11965         (when (get-buffer gnus-original-article-buffer)
11966           (set-buffer gnus-original-article-buffer)
11967           (setq gnus-original-article nil)))
11968       (setq gnus-article-current nil
11969             gnus-current-article nil)
11970       (run-hooks 'gnus-article-display-hook)
11971       (and (gnus-visual-p 'summary-highlight 'highlight)
11972            (run-hooks 'gnus-visual-mark-article-hook)))))
11973
11974 (defun gnus-summary-edit-article-postpone ()
11975   "Postpone changes to the current article."
11976   (interactive)
11977   (gnus-article-mode)
11978   (use-local-map gnus-article-mode-map)
11979   (setq buffer-read-only t)
11980   (buffer-disable-undo (current-buffer))
11981   (gnus-configure-windows 'summary)
11982   (and (gnus-visual-p 'summary-highlight 'highlight)
11983        (run-hooks 'gnus-visual-mark-article-hook)))
11984
11985 (defun gnus-summary-respool-query ()
11986   "Query where the respool algorithm would put this article."
11987   (interactive)
11988   (gnus-set-global-variables)
11989   (gnus-summary-select-article)
11990   (save-excursion
11991     (set-buffer gnus-article-buffer)
11992     (save-restriction
11993       (goto-char (point-min))
11994       (search-forward "\n\n")
11995       (narrow-to-region (point-min) (point))
11996       (pp-eval-expression
11997        (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
11998
11999 ;; Summary marking commands.
12000
12001 (defun gnus-summary-kill-same-subject-and-select (&optional unmark)
12002   "Mark articles which has the same subject as read, and then select the next.
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     ;; Select next unread article.  If auto-select-same mode, should
12013     ;; select the first unread article.
12014     (gnus-summary-next-article t (and gnus-auto-select-same
12015                                       (gnus-summary-article-subject)))
12016     (gnus-message 7 "%d article%s marked as %s"
12017                   count (if (= count 1) " is" "s are")
12018                   (if unmark "unread" "read"))))
12019
12020 (defun gnus-summary-kill-same-subject (&optional unmark)
12021   "Mark articles which has the same subject as read.
12022 If UNMARK is positive, remove any kind of mark.
12023 If UNMARK is negative, tick articles."
12024   (interactive "P")
12025   (gnus-set-global-variables)
12026   (if unmark
12027       (setq unmark (prefix-numeric-value unmark)))
12028   (let ((count
12029          (gnus-summary-mark-same-subject
12030           (gnus-summary-article-subject) unmark)))
12031     ;; If marked as read, go to next unread subject.
12032     (if (null unmark)
12033         ;; Go to next unread subject.
12034         (gnus-summary-next-subject 1 t))
12035     (gnus-message 7 "%d articles are marked as %s"
12036                   count (if unmark "unread" "read"))))
12037
12038 (defun gnus-summary-mark-same-subject (subject &optional unmark)
12039   "Mark articles with same SUBJECT as read, and return marked number.
12040 If optional argument UNMARK is positive, remove any kinds of marks.
12041 If optional argument UNMARK is negative, mark articles as unread instead."
12042   (let ((count 1))
12043     (save-excursion
12044       (cond
12045        ((null unmark)                   ; Mark as read.
12046         (while (and
12047                 (progn
12048                   (gnus-summary-mark-article-as-read gnus-killed-mark)
12049                   (gnus-summary-show-thread) t)
12050                 (gnus-summary-find-subject subject))
12051           (setq count (1+ count))))
12052        ((> unmark 0)                    ; Tick.
12053         (while (and
12054                 (progn
12055                   (gnus-summary-mark-article-as-unread gnus-ticked-mark)
12056                   (gnus-summary-show-thread) t)
12057                 (gnus-summary-find-subject subject))
12058           (setq count (1+ count))))
12059        (t                               ; Mark as unread.
12060         (while (and
12061                 (progn
12062                   (gnus-summary-mark-article-as-unread gnus-unread-mark)
12063                   (gnus-summary-show-thread) t)
12064                 (gnus-summary-find-subject subject))
12065           (setq count (1+ count)))))
12066       (gnus-set-mode-line 'summary)
12067       ;; Return the number of marked articles.
12068       count)))
12069
12070 (defun gnus-summary-mark-as-processable (n &optional unmark)
12071   "Set the process mark on the next N articles.
12072 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
12073 the process mark instead.  The difference between N and the actual
12074 number of articles marked is returned."
12075   (interactive "p")
12076   (gnus-set-global-variables)
12077   (let ((backward (< n 0))
12078         (n (abs n)))
12079     (while (and
12080             (> n 0)
12081             (if unmark
12082                 (gnus-summary-remove-process-mark
12083                  (gnus-summary-article-number))
12084               (gnus-summary-set-process-mark (gnus-summary-article-number)))
12085             (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
12086       (setq n (1- n)))
12087     (if (/= 0 n) (gnus-message 7 "No more articles"))
12088     (gnus-summary-recenter)
12089     (gnus-summary-position-point)
12090     n))
12091
12092 (defun gnus-summary-unmark-as-processable (n)
12093   "Remove the process mark from the next N articles.
12094 If N is negative, mark backward instead.  The difference between N and
12095 the actual number of articles marked is returned."
12096   (interactive "p")
12097   (gnus-set-global-variables)
12098   (gnus-summary-mark-as-processable n t))
12099
12100 (defun gnus-summary-unmark-all-processable ()
12101   "Remove the process mark from all articles."
12102   (interactive)
12103   (gnus-set-global-variables)
12104   (save-excursion
12105     (while gnus-newsgroup-processable
12106       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
12107   (gnus-summary-position-point))
12108
12109 (defun gnus-summary-mark-as-expirable (n)
12110   "Mark N articles forward as expirable.
12111 If N is negative, mark backward instead.  The difference between N and
12112 the actual number of articles marked is returned."
12113   (interactive "p")
12114   (gnus-set-global-variables)
12115   (gnus-summary-mark-forward n gnus-expirable-mark))
12116
12117 (defun gnus-summary-mark-article-as-replied (article)
12118   "Mark ARTICLE replied and update the summary line."
12119   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
12120   (let ((buffer-read-only nil))
12121     (when (gnus-summary-goto-subject article)
12122       (gnus-summary-update-secondary-mark article))))
12123
12124 (defun gnus-summary-set-bookmark (article)
12125   "Set a bookmark in current article."
12126   (interactive (list (gnus-summary-article-number)))
12127   (gnus-set-global-variables)
12128   (if (or (not (get-buffer gnus-article-buffer))
12129           (not gnus-current-article)
12130           (not gnus-article-current)
12131           (not (equal gnus-newsgroup-name (car gnus-article-current))))
12132       (error "No current article selected"))
12133   ;; Remove old bookmark, if one exists.
12134   (let ((old (assq article gnus-newsgroup-bookmarks)))
12135     (if old (setq gnus-newsgroup-bookmarks
12136                   (delq old gnus-newsgroup-bookmarks))))
12137   ;; Set the new bookmark, which is on the form
12138   ;; (article-number . line-number-in-body).
12139   (setq gnus-newsgroup-bookmarks
12140         (cons
12141          (cons article
12142                (save-excursion
12143                  (set-buffer gnus-article-buffer)
12144                  (count-lines
12145                   (min (point)
12146                        (save-excursion
12147                          (goto-char (point-min))
12148                          (search-forward "\n\n" nil t)
12149                          (point)))
12150                   (point))))
12151          gnus-newsgroup-bookmarks))
12152   (gnus-message 6 "A bookmark has been added to the current article."))
12153
12154 (defun gnus-summary-remove-bookmark (article)
12155   "Remove the bookmark from the current article."
12156   (interactive (list (gnus-summary-article-number)))
12157   (gnus-set-global-variables)
12158   ;; Remove old bookmark, if one exists.
12159   (let ((old (assq article gnus-newsgroup-bookmarks)))
12160     (if old
12161         (progn
12162           (setq gnus-newsgroup-bookmarks
12163                 (delq old gnus-newsgroup-bookmarks))
12164           (gnus-message 6 "Removed bookmark."))
12165       (gnus-message 6 "No bookmark in current article."))))
12166
12167 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
12168 (defun gnus-summary-mark-as-dormant (n)
12169   "Mark N articles forward as dormant.
12170 If N is negative, mark backward instead.  The difference between N and
12171 the actual number of articles marked is returned."
12172   (interactive "p")
12173   (gnus-set-global-variables)
12174   (gnus-summary-mark-forward n gnus-dormant-mark))
12175
12176 (defun gnus-summary-set-process-mark (article)
12177   "Set the process mark on ARTICLE and update the summary line."
12178   (setq gnus-newsgroup-processable
12179         (cons article
12180               (delq article gnus-newsgroup-processable)))
12181   (when (gnus-summary-goto-subject article)
12182     (gnus-summary-show-thread)
12183     (gnus-summary-update-secondary-mark article)))
12184
12185 (defun gnus-summary-remove-process-mark (article)
12186   "Remove the process mark from ARTICLE and update the summary line."
12187   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
12188   (when (gnus-summary-goto-subject article)
12189     (gnus-summary-show-thread)
12190     (gnus-summary-update-secondary-mark article)))
12191
12192 (defun gnus-summary-set-saved-mark (article)
12193   "Set the process mark on ARTICLE and update the summary line."
12194   (push article gnus-newsgroup-saved)
12195   (when (gnus-summary-goto-subject article)
12196     (gnus-summary-update-secondary-mark article)))
12197
12198 (defun gnus-summary-mark-forward (n &optional mark no-expire)
12199   "Mark N articles as read forwards.
12200 If N is negative, mark backwards instead.  Mark with MARK, ?r by default.
12201 The difference between N and the actual number of articles marked is
12202 returned."
12203   (interactive "p")
12204   (gnus-set-global-variables)
12205   (let ((backward (< n 0))
12206         (gnus-summary-goto-unread
12207          (and gnus-summary-goto-unread
12208               (not (eq gnus-summary-goto-unread 'never))
12209               (not (memq mark (list gnus-unread-mark
12210                                     gnus-ticked-mark gnus-dormant-mark)))))
12211         (n (abs n))
12212         (mark (or mark gnus-del-mark)))
12213     (while (and (> n 0)
12214                 (gnus-summary-mark-article nil mark no-expire)
12215                 (zerop (gnus-summary-next-subject
12216                         (if backward -1 1)
12217                         (and gnus-summary-goto-unread
12218                              (not (eq gnus-summary-goto-unread 'never)))
12219                         t)))
12220       (setq n (1- n)))
12221     (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
12222     (gnus-summary-recenter)
12223     (gnus-summary-position-point)
12224     (gnus-set-mode-line 'summary)
12225     n))
12226
12227 (defun gnus-summary-mark-article-as-read (mark)
12228   "Mark the current article quickly as read with MARK."
12229   (let ((article (gnus-summary-article-number)))
12230     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
12231     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
12232     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
12233     (setq gnus-newsgroup-reads
12234           (cons (cons article mark) gnus-newsgroup-reads))
12235     ;; Possibly remove from cache, if that is used.
12236     (and gnus-use-cache (gnus-cache-enter-remove-article article))
12237     ;; Allow the backend to change the mark.
12238     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
12239     ;; Check for auto-expiry.
12240     (when (and gnus-newsgroup-auto-expire
12241                (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
12242                    (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
12243                    (= mark gnus-ancient-mark)
12244                    (= mark gnus-read-mark) (= mark gnus-souped-mark)))
12245       (setq mark gnus-expirable-mark)
12246       (push article gnus-newsgroup-expirable))
12247     ;; Set the mark in the buffer.
12248     (gnus-summary-update-mark mark 'unread)
12249     t))
12250
12251 (defun gnus-summary-mark-article-as-unread (mark)
12252   "Mark the current article quickly as unread with MARK."
12253   (let ((article (gnus-summary-article-number)))
12254     (if (< article 0)
12255         (gnus-error 1 "Unmarkable article")
12256       (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
12257       (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
12258       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
12259       (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
12260       (cond ((= mark gnus-ticked-mark)
12261              (push article gnus-newsgroup-marked))
12262             ((= mark gnus-dormant-mark)
12263              (push article gnus-newsgroup-dormant))
12264             (t
12265              (push article gnus-newsgroup-unreads)))
12266       (setq gnus-newsgroup-reads
12267             (delq (assq article gnus-newsgroup-reads)
12268                   gnus-newsgroup-reads))
12269
12270       ;; See whether the article is to be put in the cache.
12271       (and gnus-use-cache
12272            (vectorp (gnus-summary-article-header article))
12273            (save-excursion
12274              (gnus-cache-possibly-enter-article
12275               gnus-newsgroup-name article
12276               (gnus-summary-article-header article)
12277               (= mark gnus-ticked-mark)
12278               (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
12279
12280       ;; Fix the mark.
12281       (gnus-summary-update-mark mark 'unread))
12282     t))
12283
12284 (defun gnus-summary-mark-article (&optional article mark no-expire)
12285   "Mark ARTICLE with MARK.  MARK can be any character.
12286 Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
12287 `??' (dormant) and `?E' (expirable).
12288 If MARK is nil, then the default character `?D' is used.
12289 If ARTICLE is nil, then the article on the current line will be
12290 marked."
12291   ;; The mark might be a string.
12292   (and (stringp mark)
12293        (setq mark (aref mark 0)))
12294   ;; If no mark is given, then we check auto-expiring.
12295   (and (not no-expire)
12296        gnus-newsgroup-auto-expire
12297        (or (not mark)
12298            (and (numberp mark)
12299                 (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
12300                     (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
12301                     (= mark gnus-read-mark) (= mark gnus-souped-mark))))
12302        (setq mark gnus-expirable-mark))
12303   (let* ((mark (or mark gnus-del-mark))
12304          (article (or article (gnus-summary-article-number))))
12305     (or article (error "No article on current line"))
12306     (if (or (= mark gnus-unread-mark)
12307             (= mark gnus-ticked-mark)
12308             (= mark gnus-dormant-mark))
12309         (gnus-mark-article-as-unread article mark)
12310       (gnus-mark-article-as-read article mark))
12311
12312     ;; See whether the article is to be put in the cache.
12313     (and gnus-use-cache
12314          (not (= mark gnus-canceled-mark))
12315          (vectorp (gnus-summary-article-header article))
12316          (save-excursion
12317            (gnus-cache-possibly-enter-article
12318             gnus-newsgroup-name article
12319             (gnus-summary-article-header article)
12320             (= mark gnus-ticked-mark)
12321             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
12322
12323     (if (gnus-summary-goto-subject article nil t)
12324         (let ((buffer-read-only nil))
12325           (gnus-summary-show-thread)
12326           ;; Fix the mark.
12327           (gnus-summary-update-mark mark 'unread)
12328           t))))
12329
12330 (defun gnus-summary-update-secondary-mark (article)
12331   "Update the secondary (read, process, cache) mark."
12332   (gnus-summary-update-mark
12333    (cond ((memq article gnus-newsgroup-processable)
12334           gnus-process-mark)
12335          ((memq article gnus-newsgroup-cached)
12336           gnus-cached-mark)
12337          ((memq article gnus-newsgroup-replied)
12338           gnus-replied-mark)
12339          ((memq article gnus-newsgroup-saved)
12340           gnus-saved-mark)
12341          (t gnus-unread-mark))
12342    'replied)
12343   (when (gnus-visual-p 'summary-highlight 'highlight)
12344     (run-hooks 'gnus-summary-update-hook))
12345   t)
12346
12347 (defun gnus-summary-update-mark (mark type)
12348   (beginning-of-line)
12349   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
12350         (buffer-read-only nil))
12351     (when (and forward
12352                (<= (+ forward (point)) (point-max)))
12353       ;; Go to the right position on the line.
12354       (goto-char (+ forward (point)))
12355       ;; Replace the old mark with the new mark.
12356       (subst-char-in-region (point) (1+ (point)) (following-char) mark)
12357       ;; Optionally update the marks by some user rule.
12358       (when (eq type 'unread)
12359         (gnus-data-set-mark
12360          (gnus-data-find (gnus-summary-article-number)) mark)
12361         (gnus-summary-update-line (eq mark gnus-unread-mark))))))
12362
12363 (defun gnus-mark-article-as-read (article &optional mark)
12364   "Enter ARTICLE in the pertinent lists and remove it from others."
12365   ;; Make the article expirable.
12366   (let ((mark (or mark gnus-del-mark)))
12367     (if (= mark gnus-expirable-mark)
12368         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
12369       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
12370     ;; Remove from unread and marked lists.
12371     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
12372     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
12373     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
12374     (push (cons article mark) gnus-newsgroup-reads)
12375     ;; Possibly remove from cache, if that is used.
12376     (when gnus-use-cache
12377       (gnus-cache-enter-remove-article article))))
12378
12379 (defun gnus-mark-article-as-unread (article &optional mark)
12380   "Enter ARTICLE in the pertinent lists and remove it from others."
12381   (let ((mark (or mark gnus-ticked-mark)))
12382     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
12383     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
12384     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
12385     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
12386     (cond ((= mark gnus-ticked-mark)
12387            (push article gnus-newsgroup-marked))
12388           ((= mark gnus-dormant-mark)
12389            (push article gnus-newsgroup-dormant))
12390           (t
12391            (push article gnus-newsgroup-unreads)))
12392     (setq gnus-newsgroup-reads
12393           (delq (assq article gnus-newsgroup-reads)
12394                 gnus-newsgroup-reads))))
12395
12396 (defalias 'gnus-summary-mark-as-unread-forward
12397   'gnus-summary-tick-article-forward)
12398 (make-obsolete 'gnus-summary-mark-as-unread-forward
12399                'gnus-summary-tick-article-forward)
12400 (defun gnus-summary-tick-article-forward (n)
12401   "Tick N articles forwards.
12402 If N is negative, tick backwards instead.
12403 The difference between N and the number of articles ticked is returned."
12404   (interactive "p")
12405   (gnus-summary-mark-forward n gnus-ticked-mark))
12406
12407 (defalias 'gnus-summary-mark-as-unread-backward
12408   'gnus-summary-tick-article-backward)
12409 (make-obsolete 'gnus-summary-mark-as-unread-backward
12410                'gnus-summary-tick-article-backward)
12411 (defun gnus-summary-tick-article-backward (n)
12412   "Tick N articles backwards.
12413 The difference between N and the number of articles ticked is returned."
12414   (interactive "p")
12415   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
12416
12417 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
12418 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
12419 (defun gnus-summary-tick-article (&optional article clear-mark)
12420   "Mark current article as unread.
12421 Optional 1st argument ARTICLE specifies article number to be marked as unread.
12422 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
12423   (interactive)
12424   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
12425                                        gnus-ticked-mark)))
12426
12427 (defun gnus-summary-mark-as-read-forward (n)
12428   "Mark N articles as read forwards.
12429 If N is negative, mark backwards instead.
12430 The difference between N and the actual number of articles marked is
12431 returned."
12432   (interactive "p")
12433   (gnus-summary-mark-forward n gnus-del-mark t))
12434
12435 (defun gnus-summary-mark-as-read-backward (n)
12436   "Mark the N articles as read backwards.
12437 The difference between N and the actual number of articles marked is
12438 returned."
12439   (interactive "p")
12440   (gnus-summary-mark-forward (- n) gnus-del-mark t))
12441
12442 (defun gnus-summary-mark-as-read (&optional article mark)
12443   "Mark current article as read.
12444 ARTICLE specifies the article to be marked as read.
12445 MARK specifies a string to be inserted at the beginning of the line."
12446   (gnus-summary-mark-article article mark))
12447
12448 (defun gnus-summary-clear-mark-forward (n)
12449   "Clear marks from N articles forward.
12450 If N is negative, clear backward instead.
12451 The difference between N and the number of marks cleared is returned."
12452   (interactive "p")
12453   (gnus-summary-mark-forward n gnus-unread-mark))
12454
12455 (defun gnus-summary-clear-mark-backward (n)
12456   "Clear marks from N articles backward.
12457 The difference between N and the number of marks cleared is returned."
12458   (interactive "p")
12459   (gnus-summary-mark-forward (- n) gnus-unread-mark))
12460
12461 (defun gnus-summary-mark-unread-as-read ()
12462   "Intended to be used by `gnus-summary-mark-article-hook'."
12463   (when (memq gnus-current-article gnus-newsgroup-unreads)
12464     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
12465
12466 (defun gnus-summary-mark-read-and-unread-as-read ()
12467   "Intended to be used by `gnus-summary-mark-article-hook'."
12468   (let ((mark (gnus-summary-article-mark)))
12469     (when (or (gnus-unread-mark-p mark)
12470               (gnus-read-mark-p mark))
12471       (gnus-summary-mark-article gnus-current-article gnus-read-mark))))
12472
12473 (defun gnus-summary-mark-region-as-read (point mark all)
12474   "Mark all unread articles between point and mark as read.
12475 If given a prefix, mark all articles between point and mark as read,
12476 even ticked and dormant ones."
12477   (interactive "r\nP")
12478   (save-excursion
12479     (let (article)
12480       (goto-char point)
12481       (beginning-of-line)
12482       (while (and
12483               (< (point) mark)
12484               (progn
12485                 (when (or all
12486                           (memq (setq article (gnus-summary-article-number))
12487                                 gnus-newsgroup-unreads))
12488                   (gnus-summary-mark-article article gnus-del-mark))
12489                 t)
12490               (gnus-summary-find-next))))))
12491
12492 (defun gnus-summary-mark-below (score mark)
12493   "Mark articles with score less than SCORE with MARK."
12494   (interactive "P\ncMark: ")
12495   (gnus-set-global-variables)
12496   (setq score (if score
12497                   (prefix-numeric-value score)
12498                 (or gnus-summary-default-score 0)))
12499   (save-excursion
12500     (set-buffer gnus-summary-buffer)
12501     (goto-char (point-min))
12502     (while 
12503         (progn
12504           (and (< (gnus-summary-article-score) score)
12505                (gnus-summary-mark-article nil mark))
12506           (gnus-summary-find-next)))))
12507
12508 (defun gnus-summary-kill-below (&optional score)
12509   "Mark articles with score below SCORE as read."
12510   (interactive "P")
12511   (gnus-set-global-variables)
12512   (gnus-summary-mark-below score gnus-killed-mark))
12513
12514 (defun gnus-summary-clear-above (&optional score)
12515   "Clear all marks from articles with score above SCORE."
12516   (interactive "P")
12517   (gnus-set-global-variables)
12518   (gnus-summary-mark-above score gnus-unread-mark))
12519
12520 (defun gnus-summary-tick-above (&optional score)
12521   "Tick all articles with score above SCORE."
12522   (interactive "P")
12523   (gnus-set-global-variables)
12524   (gnus-summary-mark-above score gnus-ticked-mark))
12525
12526 (defun gnus-summary-mark-above (score mark)
12527   "Mark articles with score over SCORE with MARK."
12528   (interactive "P\ncMark: ")
12529   (gnus-set-global-variables)
12530   (setq score (if score
12531                   (prefix-numeric-value score)
12532                 (or gnus-summary-default-score 0)))
12533   (save-excursion
12534     (set-buffer gnus-summary-buffer)
12535     (goto-char (point-min))
12536     (while (and (progn
12537                   (if (> (gnus-summary-article-score) score)
12538                       (gnus-summary-mark-article nil mark))
12539                   t)
12540                 (gnus-summary-find-next)))))
12541
12542 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
12543 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
12544 (defun gnus-summary-limit-include-expunged (&optional no-error)
12545   "Display all the hidden articles that were expunged for low scores."
12546   (interactive)
12547   (gnus-set-global-variables)
12548   (let ((buffer-read-only nil))
12549     (let ((scored gnus-newsgroup-scored)
12550           headers h)
12551       (while scored
12552         (or (gnus-summary-goto-subject (caar scored))
12553             (and (setq h (gnus-summary-article-header (caar scored)))
12554                  (< (cdar scored) gnus-summary-expunge-below)
12555                  (setq headers (cons h headers))))
12556         (setq scored (cdr scored)))
12557       (if (not headers)
12558           (when (not no-error)
12559             (error "No expunged articles hidden."))
12560         (goto-char (point-min))
12561         (gnus-summary-prepare-unthreaded (nreverse headers))
12562         (goto-char (point-min))
12563         (gnus-summary-position-point)
12564         t))))
12565
12566 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
12567   "Mark all articles not marked as unread in this newsgroup as read.
12568 If prefix argument ALL is non-nil, all articles are marked as read.
12569 If QUIETLY is non-nil, no questions will be asked.
12570 If TO-HERE is non-nil, it should be a point in the buffer.  All
12571 articles before this point will be marked as read.
12572 The number of articles marked as read is returned."
12573   (interactive "P")
12574   (gnus-set-global-variables)
12575   (prog1
12576       (if (or quietly
12577               (not gnus-interactive-catchup) ;Without confirmation?
12578               gnus-expert-user
12579               (gnus-y-or-n-p
12580                (if all
12581                    "Mark absolutely all articles as read? "
12582                  "Mark all unread articles as read? ")))
12583           (if (and not-mark
12584                    (not gnus-newsgroup-adaptive)
12585                    (not gnus-newsgroup-auto-expire))
12586               (progn
12587                 (when all
12588                   (setq gnus-newsgroup-marked nil
12589                         gnus-newsgroup-dormant nil))
12590                 (setq gnus-newsgroup-unreads nil))
12591             ;; We actually mark all articles as canceled, which we
12592             ;; have to do when using auto-expiry or adaptive scoring.
12593             (gnus-summary-show-all-threads)
12594             (if (gnus-summary-first-subject (not all))
12595                 (while (and
12596                         (if to-here (< (point) to-here) t)
12597                         (gnus-summary-mark-article-as-read gnus-catchup-mark)
12598                         (gnus-summary-find-next (not all)))))
12599             (unless to-here
12600               (setq gnus-newsgroup-unreads nil))
12601             (gnus-set-mode-line 'summary)))
12602     (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
12603       (if (and (not to-here) (eq 'nnvirtual (car method)))
12604           (nnvirtual-catchup-group
12605            (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
12606     (gnus-summary-position-point)))
12607
12608 (defun gnus-summary-catchup-to-here (&optional all)
12609   "Mark all unticked articles before the current one as read.
12610 If ALL is non-nil, also mark ticked and dormant articles as read."
12611   (interactive "P")
12612   (gnus-set-global-variables)
12613   (save-excursion
12614     (gnus-save-hidden-threads
12615       (let ((beg (point)))
12616         ;; We check that there are unread articles.
12617         (when (or all (gnus-summary-find-prev))
12618           (gnus-summary-catchup all t beg)))))
12619   (gnus-summary-position-point))
12620
12621 (defun gnus-summary-catchup-all (&optional quietly)
12622   "Mark all articles in this newsgroup as read."
12623   (interactive "P")
12624   (gnus-set-global-variables)
12625   (gnus-summary-catchup t quietly))
12626
12627 (defun gnus-summary-catchup-and-exit (&optional all quietly)
12628   "Mark all articles not marked as unread in this newsgroup as read, then exit.
12629 If prefix argument ALL is non-nil, all articles are marked as read."
12630   (interactive "P")
12631   (gnus-set-global-variables)
12632   (gnus-summary-catchup all quietly nil 'fast)
12633   ;; Select next newsgroup or exit.
12634   (if (eq gnus-auto-select-next 'quietly)
12635       (gnus-summary-next-group nil)
12636     (gnus-summary-exit)))
12637
12638 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
12639   "Mark all articles in this newsgroup as read, and then exit."
12640   (interactive "P")
12641   (gnus-set-global-variables)
12642   (gnus-summary-catchup-and-exit t quietly))
12643
12644 ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
12645 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
12646   "Mark all articles in this group as read and select the next group.
12647 If given a prefix, mark all articles, unread as well as ticked, as
12648 read."
12649   (interactive "P")
12650   (gnus-set-global-variables)
12651   (save-excursion
12652     (gnus-summary-catchup all))
12653   (gnus-summary-next-article t nil nil t))
12654
12655 ;; Thread-based commands.
12656
12657 (defun gnus-summary-articles-in-thread (&optional article)
12658   "Return a list of all articles in the current thread.
12659 If ARTICLE is non-nil, return all articles in the thread that starts
12660 with that article."
12661   (let* ((article (or article (gnus-summary-article-number)))
12662          (data (gnus-data-find-list article))
12663          (top-level (gnus-data-level (car data)))
12664          (top-subject
12665           (cond ((null gnus-thread-operation-ignore-subject)
12666                  (gnus-simplify-subject-re
12667                   (mail-header-subject (gnus-data-header (car data)))))
12668                 ((eq gnus-thread-operation-ignore-subject 'fuzzy)
12669                  (gnus-simplify-subject-fuzzy
12670                   (mail-header-subject (gnus-data-header (car data)))))
12671                 (t nil)))
12672          (end-point (save-excursion
12673                       (if (gnus-summary-go-to-next-thread) 
12674                           (point) (point-max))))
12675          articles)
12676     (while (and data
12677                 (< (gnus-data-pos (car data)) end-point))
12678       (when (or (not top-subject)
12679                 (string= top-subject
12680                          (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
12681                              (gnus-simplify-subject-fuzzy
12682                               (mail-header-subject
12683                                (gnus-data-header (car data))))
12684                            (gnus-simplify-subject-re
12685                             (mail-header-subject
12686                              (gnus-data-header (car data)))))))
12687         (push (gnus-data-number (car data)) articles))
12688       (unless (and (setq data (cdr data))
12689                    (> (gnus-data-level (car data)) top-level))
12690         (setq data nil)))
12691     ;; Return the list of articles.
12692     (nreverse articles)))
12693
12694 (defun gnus-summary-rethread-current ()
12695   "Rethread the thread the current article is part of."
12696   (interactive)
12697   (gnus-set-global-variables)
12698   (let* ((gnus-show-threads t)
12699          (article (gnus-summary-article-number))
12700          (id (mail-header-id (gnus-summary-article-header)))
12701          (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id)))))
12702     (unless id
12703       (error "No article on the current line"))
12704     (gnus-rebuild-thread id)
12705     (gnus-summary-goto-subject article)))
12706
12707 (defun gnus-summary-reparent-thread ()
12708   "Make current article child of the marked (or previous) article.
12709
12710 Note that the re-threading will only work if `gnus-thread-ignore-subject'
12711 is non-nil or the Subject: of both articles are the same."
12712   (interactive)
12713   (or (not (gnus-group-read-only-p))
12714       (error "The current newsgroup does not support article editing."))
12715   (or (<= (length gnus-newsgroup-processable) 1)
12716       (error "No more than one article may be marked."))
12717   (save-window-excursion
12718     (let ((gnus-article-buffer " *reparent*")
12719           (current-article (gnus-summary-article-number))
12720           ; first grab the marked article, otherwise one line up.
12721           (parent-article (if (not (null gnus-newsgroup-processable))
12722                               (car gnus-newsgroup-processable)
12723                             (save-excursion
12724                               (if (eq (forward-line -1) 0)
12725                                   (gnus-summary-article-number)
12726                                 (error "Beginning of summary buffer."))))))
12727       (or (not (eq current-article parent-article))
12728           (error "An article may not be self-referential."))
12729       (let ((message-id (mail-header-id 
12730                          (gnus-summary-article-header parent-article))))
12731         (or (and message-id (not (equal message-id "")))
12732             (error "No message-id in desired parent."))
12733         (gnus-summary-select-article t t nil current-article)
12734         (set-buffer gnus-article-buffer)
12735         (setq buffer-read-only nil)
12736         (let ((buf (format "%s" (buffer-string))))
12737           (erase-buffer)
12738           (insert buf))
12739         (goto-char (point-min))
12740         (if (search-forward-regexp "^References: " nil t)
12741             (insert message-id " " )
12742           (insert "References: " message-id "\n"))
12743         (or (gnus-request-replace-article current-article
12744                                           (car gnus-article-current)
12745                                           gnus-article-buffer)
12746             (error "Couldn't replace article."))
12747         (set-buffer gnus-summary-buffer)
12748         (gnus-summary-unmark-all-processable)
12749         (gnus-summary-rethread-current)
12750         (gnus-message 3 "Article %d is now the child of article %d."
12751                       current-article parent-article)))))
12752
12753 (defun gnus-summary-toggle-threads (&optional arg)
12754   "Toggle showing conversation threads.
12755 If ARG is positive number, turn showing conversation threads on."
12756   (interactive "P")
12757   (gnus-set-global-variables)
12758   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
12759     (setq gnus-show-threads
12760           (if (null arg) (not gnus-show-threads)
12761             (> (prefix-numeric-value arg) 0)))
12762     (gnus-summary-prepare)
12763     (gnus-summary-goto-subject current)
12764     (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off"))
12765     (gnus-summary-position-point)))
12766
12767 (defun gnus-summary-show-all-threads ()
12768   "Show all threads."
12769   (interactive)
12770   (gnus-set-global-variables)
12771   (save-excursion
12772     (let ((buffer-read-only nil))
12773       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
12774   (gnus-summary-position-point))
12775
12776 (defun gnus-summary-show-thread ()
12777   "Show thread subtrees.
12778 Returns nil if no thread was there to be shown."
12779   (interactive)
12780   (gnus-set-global-variables)
12781   (let ((buffer-read-only nil)
12782         (orig (point))
12783         ;; first goto end then to beg, to have point at beg after let
12784         (end (progn (end-of-line) (point)))
12785         (beg (progn (beginning-of-line) (point))))
12786     (prog1
12787         ;; Any hidden lines here?
12788         (search-forward "\r" end t)
12789       (subst-char-in-region beg end ?\^M ?\n t)
12790       (goto-char orig)
12791       (gnus-summary-position-point))))
12792
12793 (defun gnus-summary-hide-all-threads ()
12794   "Hide all thread subtrees."
12795   (interactive)
12796   (gnus-set-global-variables)
12797   (save-excursion
12798     (goto-char (point-min))
12799     (gnus-summary-hide-thread)
12800     (while (zerop (gnus-summary-next-thread 1 t))
12801       (gnus-summary-hide-thread)))
12802   (gnus-summary-position-point))
12803
12804 (defun gnus-summary-hide-thread ()
12805   "Hide thread subtrees.
12806 Returns nil if no threads were there to be hidden."
12807   (interactive)
12808   (gnus-set-global-variables)
12809   (let ((buffer-read-only nil)
12810         (start (point))
12811         (article (gnus-summary-article-number)))
12812     (goto-char start)
12813     ;; Go forward until either the buffer ends or the subthread
12814     ;; ends.
12815     (when (and (not (eobp))
12816                (or (zerop (gnus-summary-next-thread 1 t))
12817                    (goto-char (point-max))))
12818       (prog1
12819           (if (and (> (point) start)
12820                    (search-backward "\n" start t))
12821               (progn
12822                 (subst-char-in-region start (point) ?\n ?\^M)
12823                 (gnus-summary-goto-subject article))
12824             (goto-char start)
12825             nil)
12826         ;;(gnus-summary-position-point)
12827         ))))
12828
12829 (defun gnus-summary-go-to-next-thread (&optional previous)
12830   "Go to the same level (or less) next thread.
12831 If PREVIOUS is non-nil, go to previous thread instead.
12832 Return the article number moved to, or nil if moving was impossible."
12833   (let ((level (gnus-summary-thread-level))
12834         (way (if previous -1 1))
12835         (beg (point)))
12836     (forward-line way)
12837     (while (and (not (eobp))
12838                 (< level (gnus-summary-thread-level)))
12839       (forward-line way))
12840     (if (eobp)
12841         (progn
12842           (goto-char beg)
12843           nil)
12844       (setq beg (point))
12845       (prog1
12846           (gnus-summary-article-number)
12847         (goto-char beg)))))
12848
12849 (defun gnus-summary-go-to-next-thread-old (&optional previous)
12850   "Go to the same level (or less) next thread.
12851 If PREVIOUS is non-nil, go to previous thread instead.
12852 Return the article number moved to, or nil if moving was impossible."
12853   (if (and (eq gnus-summary-make-false-root 'dummy)
12854            (gnus-summary-article-intangible-p))
12855       (let ((beg (point)))
12856         (while (and (zerop (forward-line 1))
12857                     (not (gnus-summary-article-intangible-p))
12858                     (not (zerop (save-excursion 
12859                                   (gnus-summary-thread-level))))))
12860         (if (eobp)
12861             (progn
12862               (goto-char beg)
12863               nil)
12864           (point)))
12865     (let* ((level (gnus-summary-thread-level))
12866            (article (gnus-summary-article-number))
12867            (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
12868            oart)
12869       (while data
12870         (if (<= (gnus-data-level (car data)) level)
12871             (setq oart (gnus-data-number (car data))
12872                   data nil)
12873           (setq data (cdr data))))
12874       (and oart
12875            (gnus-summary-goto-subject oart)))))
12876
12877 (defun gnus-summary-next-thread (n &optional silent)
12878   "Go to the same level next N'th thread.
12879 If N is negative, search backward instead.
12880 Returns the difference between N and the number of skips actually
12881 done.
12882
12883 If SILENT, don't output messages."
12884   (interactive "p")
12885   (gnus-set-global-variables)
12886   (let ((backward (< n 0))
12887         (n (abs n))
12888         old dum int)
12889     (while (and (> n 0)
12890                 (gnus-summary-go-to-next-thread backward))
12891       (decf n))
12892     (unless silent 
12893       (gnus-summary-position-point))
12894     (when (and (not silent) (/= 0 n))
12895       (gnus-message 7 "No more threads"))
12896     n))
12897
12898 (defun gnus-summary-prev-thread (n)
12899   "Go to the same level previous N'th thread.
12900 Returns the difference between N and the number of skips actually
12901 done."
12902   (interactive "p")
12903   (gnus-set-global-variables)
12904   (gnus-summary-next-thread (- n)))
12905
12906 (defun gnus-summary-go-down-thread ()
12907   "Go down one level in the current thread."
12908   (let ((children (gnus-summary-article-children)))
12909     (and children
12910          (gnus-summary-goto-subject (car children)))))
12911
12912 (defun gnus-summary-go-up-thread ()
12913   "Go up one level in the current thread."
12914   (let ((parent (gnus-summary-article-parent)))
12915     (and parent
12916          (gnus-summary-goto-subject parent))))
12917
12918 (defun gnus-summary-down-thread (n)
12919   "Go down thread N steps.
12920 If N is negative, go up instead.
12921 Returns the difference between N and how many steps down that were
12922 taken."
12923   (interactive "p")
12924   (gnus-set-global-variables)
12925   (let ((up (< n 0))
12926         (n (abs n)))
12927     (while (and (> n 0)
12928                 (if up (gnus-summary-go-up-thread)
12929                   (gnus-summary-go-down-thread)))
12930       (setq n (1- n)))
12931     (gnus-summary-position-point)
12932     (if (/= 0 n) (gnus-message 7 "Can't go further"))
12933     n))
12934
12935 (defun gnus-summary-up-thread (n)
12936   "Go up thread N steps.
12937 If N is negative, go up instead.
12938 Returns the difference between N and how many steps down that were
12939 taken."
12940   (interactive "p")
12941   (gnus-set-global-variables)
12942   (gnus-summary-down-thread (- n)))
12943
12944 (defun gnus-summary-top-thread ()
12945   "Go to the top of the thread."
12946   (interactive)
12947   (gnus-set-global-variables)
12948   (while (gnus-summary-go-up-thread))
12949   (gnus-summary-article-number))
12950
12951 (defun gnus-summary-kill-thread (&optional unmark)
12952   "Mark articles under current thread as read.
12953 If the prefix argument is positive, remove any kinds of marks.
12954 If the prefix argument is negative, tick articles instead."
12955   (interactive "P")
12956   (gnus-set-global-variables)
12957   (when unmark
12958     (setq unmark (prefix-numeric-value unmark)))
12959   (let ((articles (gnus-summary-articles-in-thread)))
12960     (save-excursion
12961       ;; Expand the thread.
12962       (gnus-summary-show-thread)
12963       ;; Mark all the articles.
12964       (while articles
12965         (gnus-summary-goto-subject (car articles))
12966         (cond ((null unmark)
12967                (gnus-summary-mark-article-as-read gnus-killed-mark))
12968               ((> unmark 0)
12969                (gnus-summary-mark-article-as-unread gnus-unread-mark))
12970               (t
12971                (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
12972         (setq articles (cdr articles))))
12973     ;; Hide killed subtrees.
12974     (and (null unmark)
12975          gnus-thread-hide-killed
12976          (gnus-summary-hide-thread))
12977     ;; If marked as read, go to next unread subject.
12978     (if (null unmark)
12979         ;; Go to next unread subject.
12980         (gnus-summary-next-subject 1 t)))
12981   (gnus-set-mode-line 'summary))
12982
12983 ;; Summary sorting commands
12984
12985 (defun gnus-summary-sort-by-number (&optional reverse)
12986   "Sort summary buffer by article number.
12987 Argument REVERSE means reverse order."
12988   (interactive "P")
12989   (gnus-summary-sort 'number reverse))
12990
12991 (defun gnus-summary-sort-by-author (&optional reverse)
12992   "Sort summary buffer by author name alphabetically.
12993 If case-fold-search is non-nil, case of letters is ignored.
12994 Argument REVERSE means reverse order."
12995   (interactive "P")
12996   (gnus-summary-sort 'author reverse))
12997
12998 (defun gnus-summary-sort-by-subject (&optional reverse)
12999   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
13000 If case-fold-search is non-nil, case of letters is ignored.
13001 Argument REVERSE means reverse order."
13002   (interactive "P")
13003   (gnus-summary-sort 'subject reverse))
13004
13005 (defun gnus-summary-sort-by-date (&optional reverse)
13006   "Sort summary buffer by date.
13007 Argument REVERSE means reverse order."
13008   (interactive "P")
13009   (gnus-summary-sort 'date reverse))
13010
13011 (defun gnus-summary-sort-by-score (&optional reverse)
13012   "Sort summary buffer by score.
13013 Argument REVERSE means reverse order."
13014   (interactive "P")
13015   (gnus-summary-sort 'score reverse))
13016
13017 (defun gnus-summary-sort (predicate reverse)
13018   "Sort summary buffer by PREDICATE.  REVERSE means reverse order."
13019   (gnus-set-global-variables)
13020   (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
13021          (article (intern (format "gnus-article-sort-by-%s" predicate)))
13022          (gnus-thread-sort-functions
13023           (list
13024            (if (not reverse)
13025                thread
13026              `(lambda (t1 t2)
13027                 (,thread t2 t1)))))
13028          (gnus-article-sort-functions
13029           (list
13030            (if (not reverse)
13031                article
13032              `(lambda (t1 t2)
13033                 (,article t2 t1)))))
13034          (buffer-read-only)
13035          (gnus-summary-prepare-hook nil))
13036     ;; We do the sorting by regenerating the threads.
13037     (gnus-summary-prepare)
13038     ;; Hide subthreads if needed.
13039     (when (and gnus-show-threads gnus-thread-hide-subtree)
13040       (gnus-summary-hide-all-threads)))
13041   ;; If in async mode, we send some info to the backend.
13042   (when gnus-newsgroup-async
13043     (gnus-request-asynchronous
13044      gnus-newsgroup-name gnus-newsgroup-data)))
13045
13046 (defun gnus-sortable-date (date)
13047   "Make sortable string by string-lessp from DATE.
13048 Timezone package is used."
13049   (condition-case ()
13050       (progn
13051         (setq date (inline (timezone-fix-time 
13052                             date nil 
13053                             (aref (inline (timezone-parse-date date)) 4))))
13054         (inline
13055           (timezone-make-sortable-date
13056            (aref date 0) (aref date 1) (aref date 2)
13057            (inline
13058              (timezone-make-time-string
13059               (aref date 3) (aref date 4) (aref date 5))))))
13060     (error "")))
13061   
13062 ;; Summary saving commands.
13063
13064 (defun gnus-summary-save-article (&optional n not-saved)
13065   "Save the current article using the default saver function.
13066 If N is a positive number, save the N next articles.
13067 If N is a negative number, save the N previous articles.
13068 If N is nil and any articles have been marked with the process mark,
13069 save those articles instead.
13070 The variable `gnus-default-article-saver' specifies the saver function."
13071   (interactive "P")
13072   (gnus-set-global-variables)
13073   (let ((articles (gnus-summary-work-articles n))
13074         (save-buffer (save-excursion 
13075                        (nnheader-set-temp-buffer " *Gnus Save*")))
13076         file header article)
13077     (while articles
13078       (setq header (gnus-summary-article-header
13079                     (setq article (pop articles))))
13080       (if (not (vectorp header))
13081           ;; This is a pseudo-article.
13082           (if (assq 'name header)
13083               (gnus-copy-file (cdr (assq 'name header)))
13084             (gnus-message 1 "Article %d is unsaveable" article))
13085         ;; This is a real article.
13086         (save-window-excursion
13087           (gnus-summary-select-article t nil nil article))
13088         (save-excursion
13089           (set-buffer save-buffer)
13090           (erase-buffer)
13091           (insert-buffer-substring gnus-original-article-buffer))
13092         (unless gnus-save-all-headers
13093           ;; Remove headers accoring to `gnus-saved-headers'.
13094           (let ((gnus-visible-headers
13095                  (or gnus-saved-headers gnus-visible-headers))
13096                 (gnus-article-buffer save-buffer))
13097             (gnus-article-hide-headers 1 t)))
13098         (save-window-excursion
13099           (if (not gnus-default-article-saver)
13100               (error "No default saver is defined.")
13101             ;; !!! Magic!  The saving functions all save
13102             ;; `gnus-original-article-buffer' (or so they think),
13103             ;; but we bind that variable to our save-buffer.
13104             (set-buffer gnus-article-buffer)
13105             (let ((gnus-original-article-buffer save-buffer))
13106               (set-buffer gnus-summary-buffer)
13107               (setq file (funcall
13108                           gnus-default-article-saver
13109                           (cond
13110                            ((not gnus-prompt-before-saving)
13111                             'default)
13112                            ((eq gnus-prompt-before-saving 'always)
13113                             nil)
13114                            (t file)))))))
13115         (gnus-summary-remove-process-mark article)
13116         (unless not-saved
13117           (gnus-summary-set-saved-mark article))))
13118     (gnus-kill-buffer save-buffer)
13119     (gnus-summary-position-point)
13120     n))
13121
13122 (defun gnus-summary-pipe-output (&optional arg)
13123   "Pipe the current article to a subprocess.
13124 If N is a positive number, pipe the N next articles.
13125 If N is a negative number, pipe the N previous articles.
13126 If N is nil and any articles have been marked with the process mark,
13127 pipe those articles instead."
13128   (interactive "P")
13129   (gnus-set-global-variables)
13130   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
13131     (gnus-summary-save-article arg t))
13132   (gnus-configure-windows 'pipe))
13133
13134 (defun gnus-summary-save-article-mail (&optional arg)
13135   "Append the current article to an mail file.
13136 If N is a positive number, save the N next articles.
13137 If N is a negative number, save the N previous articles.
13138 If N is nil and any articles have been marked with the process mark,
13139 save those articles instead."
13140   (interactive "P")
13141   (gnus-set-global-variables)
13142   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
13143     (gnus-summary-save-article arg)))
13144
13145 (defun gnus-summary-save-article-rmail (&optional arg)
13146   "Append the current article to an rmail file.
13147 If N is a positive number, save the N next articles.
13148 If N is a negative number, save the N previous articles.
13149 If N is nil and any articles have been marked with the process mark,
13150 save those articles instead."
13151   (interactive "P")
13152   (gnus-set-global-variables)
13153   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
13154     (gnus-summary-save-article arg)))
13155
13156 (defun gnus-summary-save-article-file (&optional arg)
13157   "Append the current article to a file.
13158 If N is a positive number, save the N next articles.
13159 If N is a negative number, save the N previous articles.
13160 If N is nil and any articles have been marked with the process mark,
13161 save those articles instead."
13162   (interactive "P")
13163   (gnus-set-global-variables)
13164   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
13165     (gnus-summary-save-article arg)))
13166
13167 (defun gnus-summary-save-article-body-file (&optional arg)
13168   "Append the current article body to a file.
13169 If N is a positive number, save the N next articles.
13170 If N is a negative number, save the N previous articles.
13171 If N is nil and any articles have been marked with the process mark,
13172 save those articles instead."
13173   (interactive "P")
13174   (gnus-set-global-variables)
13175   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
13176     (gnus-summary-save-article arg)))
13177
13178 (defun gnus-get-split-value (methods)
13179   "Return a value based on the split METHODS."
13180   (let (split-name method result match)
13181     (when methods
13182       (save-excursion
13183         (set-buffer gnus-original-article-buffer)
13184         (save-restriction
13185           (nnheader-narrow-to-headers)
13186           (while methods
13187             (goto-char (point-min))
13188             (setq method (pop methods))
13189             (setq match (car method))
13190             (when (cond
13191                    ((stringp match)
13192                     ;; Regular expression.
13193                     (condition-case ()
13194                         (re-search-forward match nil t)
13195                       (error nil)))
13196                    ((gnus-functionp match)
13197                     ;; Function.
13198                     (save-restriction
13199                       (widen)
13200                       (setq result (funcall match gnus-newsgroup-name))))
13201                    ((consp match)
13202                     ;; Form.
13203                     (save-restriction
13204                       (widen)
13205                       (setq result (eval match)))))
13206               (setq split-name (append (cdr method) split-name))
13207               (cond ((stringp result)
13208                      (push result split-name))
13209                     ((consp result)
13210                      (setq split-name (append result split-name)))))))))
13211     split-name))
13212
13213 (defun gnus-read-move-group-name (prompt default articles prefix)
13214   "Read a group name."
13215   (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
13216          (minibuffer-confirm-incomplete nil) ; XEmacs
13217          group-map
13218          (dum (mapatoms
13219                (lambda (g) 
13220                  (and (boundp g)
13221                       (symbol-name g)
13222                       (memq 'respool
13223                             (assoc (symbol-name
13224                                     (car (gnus-find-method-for-group
13225                                           (symbol-name g))))
13226                                    gnus-valid-select-methods))
13227                       (push (list (symbol-name g)) group-map)))
13228                gnus-active-hashtb))
13229          (prom
13230           (format "%s %s to:"
13231                   prompt
13232                   (if (> (length articles) 1)
13233                       (format "these %d articles" (length articles))
13234                     "this article")))
13235          (to-newsgroup
13236           (cond
13237            ((null split-name)
13238             (gnus-completing-read default prom
13239                                   group-map nil nil prefix
13240                                   'gnus-group-history))
13241            ((= 1 (length split-name))
13242             (gnus-completing-read (car split-name) prom group-map
13243                                   nil nil nil
13244                                   'gnus-group-history))
13245            (t
13246             (gnus-completing-read nil prom 
13247                                   (mapcar (lambda (el) (list el))
13248                                           (nreverse split-name))
13249                                   nil nil nil
13250                                   'gnus-group-history)))))
13251     (when to-newsgroup
13252       (if (or (string= to-newsgroup "")
13253               (string= to-newsgroup prefix))
13254           (setq to-newsgroup (or default "")))
13255       (or (gnus-active to-newsgroup)
13256           (gnus-activate-group to-newsgroup)
13257           (if (gnus-y-or-n-p (format "No such group: %s.  Create it? "
13258                                      to-newsgroup))
13259               (or (and (gnus-request-create-group 
13260                         to-newsgroup (gnus-group-name-to-method to-newsgroup))
13261                        (gnus-activate-group to-newsgroup nil nil
13262                                             (gnus-group-name-to-method
13263                                              to-newsgroup)))
13264                   (error "Couldn't create group %s" to-newsgroup)))
13265           (error "No such group: %s" to-newsgroup)))
13266     to-newsgroup))
13267
13268 (defun gnus-read-save-file-name (prompt default-name)
13269   (let* ((split-name (gnus-get-split-value gnus-split-methods))
13270          (file
13271           ;; Let the split methods have their say.
13272           (cond
13273            ;; No split name was found.
13274            ((null split-name)
13275             (read-file-name
13276              (concat prompt " (default "
13277                      (file-name-nondirectory default-name) ") ")
13278              (file-name-directory default-name)
13279              default-name))
13280            ;; A single split name was found
13281            ((= 1 (length split-name))
13282             (let* ((name (car split-name))
13283                    (dir (cond ((file-directory-p name)
13284                                (file-name-as-directory name))
13285                               ((file-exists-p name) name)
13286                               (t gnus-article-save-directory))))
13287               (read-file-name
13288                (concat prompt " (default " name ") ")
13289                dir name)))
13290            ;; A list of splits was found.
13291            (t
13292             (setq split-name (nreverse split-name))
13293             (let (result)
13294               (let ((file-name-history (nconc split-name file-name-history)))
13295                 (setq result
13296                       (read-file-name
13297                        (concat prompt " (`M-p' for defaults) ")
13298                        gnus-article-save-directory
13299                        (car split-name))))
13300               (car (push result file-name-history)))))))
13301     ;; If we have read a directory, we append the default file name.
13302     (when (file-directory-p file)
13303       (setq file (concat (file-name-as-directory file)
13304                          (file-name-nondirectory default-name))))
13305     ;; Possibly translate some charaters.
13306     (nnheader-translate-file-chars file)))
13307
13308 (defun gnus-article-archive-name (group)
13309   "Return the first instance of an \"Archive-name\" in the current buffer."
13310   (let ((case-fold-search t))
13311     (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
13312       (match-string 1))))
13313
13314 (defun gnus-summary-save-in-rmail (&optional filename)
13315   "Append this article to Rmail file.
13316 Optional argument FILENAME specifies file name.
13317 Directory to save to is default to `gnus-article-save-directory'."
13318   (interactive)
13319   (gnus-set-global-variables)
13320   (let ((default-name
13321           (funcall gnus-rmail-save-name gnus-newsgroup-name
13322                    gnus-current-headers gnus-newsgroup-last-rmail)))
13323     (setq filename
13324           (cond ((eq filename 'default)
13325                  default-name)
13326                 (filename filename)
13327                 (t (gnus-read-save-file-name
13328                     "Save in rmail file:" default-name))))
13329     (gnus-make-directory (file-name-directory filename))
13330     (gnus-eval-in-buffer-window gnus-original-article-buffer
13331       (save-excursion
13332         (save-restriction
13333           (widen)
13334           (gnus-output-to-rmail filename))))
13335     ;; Remember the directory name to save articles
13336     (setq gnus-newsgroup-last-rmail filename)))
13337
13338 (defun gnus-summary-save-in-mail (&optional filename)
13339   "Append this article to Unix mail file.
13340 Optional argument FILENAME specifies file name.
13341 Directory to save to is default to `gnus-article-save-directory'."
13342   (interactive)
13343   (gnus-set-global-variables)
13344   (let ((default-name
13345           (funcall gnus-mail-save-name gnus-newsgroup-name
13346                    gnus-current-headers gnus-newsgroup-last-mail)))
13347     (setq filename
13348           (cond ((eq filename 'default)
13349                  default-name)
13350                 (filename filename)
13351                 (t (gnus-read-save-file-name
13352                     "Save in Unix mail file:" default-name))))
13353     (setq filename
13354           (expand-file-name filename
13355                             (and default-name
13356                                  (file-name-directory default-name))))
13357     (gnus-make-directory (file-name-directory filename))
13358     (gnus-eval-in-buffer-window gnus-original-article-buffer
13359       (save-excursion
13360         (save-restriction
13361           (widen)
13362           (if (and (file-readable-p filename) (mail-file-babyl-p filename))
13363               (gnus-output-to-rmail filename)
13364             (let ((mail-use-rfc822 t))
13365               (rmail-output filename 1 t t))))))
13366     ;; Remember the directory name to save articles.
13367     (setq gnus-newsgroup-last-mail filename)))
13368
13369 (defun gnus-summary-save-in-file (&optional filename)
13370   "Append this article to file.
13371 Optional argument FILENAME specifies file name.
13372 Directory to save to is default to `gnus-article-save-directory'."
13373   (interactive)
13374   (gnus-set-global-variables)
13375   (let ((default-name
13376           (funcall gnus-file-save-name gnus-newsgroup-name
13377                    gnus-current-headers gnus-newsgroup-last-file)))
13378     (setq filename
13379           (cond ((eq filename 'default)
13380                  default-name)
13381                 (filename filename)
13382                 (t (gnus-read-save-file-name
13383                     "Save in file:" default-name))))
13384     (gnus-make-directory (file-name-directory filename))
13385     (gnus-eval-in-buffer-window gnus-original-article-buffer
13386       (save-excursion
13387         (save-restriction
13388           (widen)
13389           (gnus-output-to-file filename))))
13390     ;; Remember the directory name to save articles.
13391     (setq gnus-newsgroup-last-file filename)))
13392
13393 (defun gnus-summary-save-body-in-file (&optional filename)
13394   "Append this article body to a file.
13395 Optional argument FILENAME specifies file name.
13396 The directory to save in defaults to `gnus-article-save-directory'."
13397   (interactive)
13398   (gnus-set-global-variables)
13399   (let ((default-name
13400           (funcall gnus-file-save-name gnus-newsgroup-name
13401                    gnus-current-headers gnus-newsgroup-last-file)))
13402     (setq filename
13403           (cond ((eq filename 'default)
13404                  default-name)
13405                 (filename filename)
13406                 (t (gnus-read-save-file-name
13407                     "Save body in file:" default-name))))
13408     (gnus-make-directory (file-name-directory filename))
13409     (gnus-eval-in-buffer-window gnus-original-article-buffer
13410       (save-excursion
13411         (save-restriction
13412           (widen)
13413           (goto-char (point-min))
13414           (and (search-forward "\n\n" nil t)
13415                (narrow-to-region (point) (point-max)))
13416           (gnus-output-to-file filename))))
13417     ;; Remember the directory name to save articles.
13418     (setq gnus-newsgroup-last-file filename)))
13419
13420 (defun gnus-summary-save-in-pipe (&optional command)
13421   "Pipe this article to subprocess."
13422   (interactive)
13423   (gnus-set-global-variables)
13424   (setq command
13425         (cond ((eq command 'default)
13426                gnus-last-shell-command)
13427               (command command)
13428               (t (read-string "Shell command on article: "
13429                               gnus-last-shell-command))))
13430   (if (string-equal command "")
13431       (setq command gnus-last-shell-command))
13432   (gnus-eval-in-buffer-window gnus-article-buffer
13433     (save-restriction
13434       (widen)
13435       (shell-command-on-region (point-min) (point-max) command nil)))
13436   (setq gnus-last-shell-command command))
13437
13438 ;; Summary extract commands
13439
13440 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
13441   (let ((buffer-read-only nil)
13442         (article (gnus-summary-article-number))
13443         after-article b e)
13444     (or (gnus-summary-goto-subject article)
13445         (error (format "No such article: %d" article)))
13446     (gnus-summary-position-point)
13447     ;; If all commands are to be bunched up on one line, we collect
13448     ;; them here.
13449     (if gnus-view-pseudos-separately
13450         ()
13451       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
13452             files action)
13453         (while ps
13454           (setq action (cdr (assq 'action (car ps))))
13455           (setq files (list (cdr (assq 'name (car ps)))))
13456           (while (and ps (cdr ps)
13457                       (string= (or action "1")
13458                                (or (cdr (assq 'action (cadr ps))) "2")))
13459             (setq files (cons (cdr (assq 'name (cadr ps))) files))
13460             (setcdr ps (cddr ps)))
13461           (if (not files)
13462               ()
13463             (if (not (string-match "%s" action))
13464                 (setq files (cons " " files)))
13465             (setq files (cons " " files))
13466             (and (assq 'execute (car ps))
13467                  (setcdr (assq 'execute (car ps))
13468                          (funcall (if (string-match "%s" action)
13469                                       'format 'concat)
13470                                   action
13471                                   (mapconcat (lambda (f) f) files " ")))))
13472           (setq ps (cdr ps)))))
13473     (if (and gnus-view-pseudos (not not-view))
13474         (while pslist
13475           (and (assq 'execute (car pslist))
13476                (gnus-execute-command (cdr (assq 'execute (car pslist)))
13477                                      (eq gnus-view-pseudos 'not-confirm)))
13478           (setq pslist (cdr pslist)))
13479       (save-excursion
13480         (while pslist
13481           (setq after-article (or (cdr (assq 'article (car pslist)))
13482                                   (gnus-summary-article-number)))
13483           (gnus-summary-goto-subject after-article)
13484           (forward-line 1)
13485           (setq b (point))
13486           (insert "    " (file-name-nondirectory
13487                                 (cdr (assq 'name (car pslist))))
13488                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
13489           (setq e (point))
13490           (forward-line -1)             ; back to `b'
13491           (gnus-add-text-properties
13492            b (1- e) (list 'gnus-number gnus-reffed-article-number
13493                           gnus-mouse-face-prop gnus-mouse-face))
13494           (gnus-data-enter
13495            after-article gnus-reffed-article-number
13496            gnus-unread-mark b (car pslist) 0 (- e b))
13497           (push gnus-reffed-article-number gnus-newsgroup-unreads)
13498           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
13499           (setq pslist (cdr pslist)))))))
13500
13501 (defun gnus-pseudos< (p1 p2)
13502   (let ((c1 (cdr (assq 'action p1)))
13503         (c2 (cdr (assq 'action p2))))
13504     (and c1 c2 (string< c1 c2))))
13505
13506 (defun gnus-request-pseudo-article (props)
13507   (cond ((assq 'execute props)
13508          (gnus-execute-command (cdr (assq 'execute props)))))
13509   (let ((gnus-current-article (gnus-summary-article-number)))
13510     (run-hooks 'gnus-mark-article-hook)))
13511
13512 (defun gnus-execute-command (command &optional automatic)
13513   (save-excursion
13514     (gnus-article-setup-buffer)
13515     (set-buffer gnus-article-buffer)
13516     (setq buffer-read-only nil)
13517     (let ((command (if automatic command (read-string "Command: " command)))
13518           ;; Just binding this here doesn't help, because there might
13519           ;; be output from the process after exiting the scope of 
13520           ;; this `let'.
13521           ;; (buffer-read-only nil)
13522           )
13523       (erase-buffer)
13524       (insert "$ " command "\n\n")
13525       (if gnus-view-pseudo-asynchronously
13526           (start-process "gnus-execute" nil shell-file-name
13527                          shell-command-switch command)
13528         (call-process shell-file-name nil t nil
13529                       shell-command-switch command)))))
13530
13531 (defun gnus-copy-file (file &optional to)
13532   "Copy FILE to TO."
13533   (interactive
13534    (list (read-file-name "Copy file: " default-directory)
13535          (read-file-name "Copy file to: " default-directory)))
13536   (gnus-set-global-variables)
13537   (or to (setq to (read-file-name "Copy file to: " default-directory)))
13538   (and (file-directory-p to)
13539        (setq to (concat (file-name-as-directory to)
13540                         (file-name-nondirectory file))))
13541   (copy-file file to))
13542
13543 ;; Summary kill commands.
13544
13545 (defun gnus-summary-edit-global-kill (article)
13546   "Edit the \"global\" kill file."
13547   (interactive (list (gnus-summary-article-number)))
13548   (gnus-set-global-variables)
13549   (gnus-group-edit-global-kill article))
13550
13551 (defun gnus-summary-edit-local-kill ()
13552   "Edit a local kill file applied to the current newsgroup."
13553   (interactive)
13554   (gnus-set-global-variables)
13555   (setq gnus-current-headers (gnus-summary-article-header))
13556   (gnus-set-global-variables)
13557   (gnus-group-edit-local-kill
13558    (gnus-summary-article-number) gnus-newsgroup-name))
13559
13560 \f
13561 ;;;
13562 ;;; Gnus article mode
13563 ;;;
13564
13565 (put 'gnus-article-mode 'mode-class 'special)
13566
13567 (if gnus-article-mode-map
13568     nil
13569   (setq gnus-article-mode-map (make-keymap))
13570   (suppress-keymap gnus-article-mode-map)
13571
13572   (gnus-define-keys gnus-article-mode-map
13573     " " gnus-article-goto-next-page
13574     "\177" gnus-article-goto-prev-page
13575     [delete] gnus-article-goto-prev-page
13576     "\C-c^" gnus-article-refer-article
13577     "h" gnus-article-show-summary
13578     "s" gnus-article-show-summary
13579     "\C-c\C-m" gnus-article-mail
13580     "?" gnus-article-describe-briefly
13581     gnus-mouse-2 gnus-article-push-button
13582     "\r" gnus-article-press-button
13583     "\t" gnus-article-next-button
13584     "\M-\t" gnus-article-prev-button
13585     "<" beginning-of-buffer
13586     ">" end-of-buffer
13587     "\C-c\C-i" gnus-info-find-node
13588     "\C-c\C-b" gnus-bug)
13589
13590   (substitute-key-definition
13591    'undefined 'gnus-article-read-summary-keys gnus-article-mode-map))
13592
13593 (defun gnus-article-mode ()
13594   "Major mode for displaying an article.
13595
13596 All normal editing commands are switched off.
13597
13598 The following commands are available:
13599
13600 \\<gnus-article-mode-map>
13601 \\[gnus-article-next-page]\t Scroll the article one page forwards
13602 \\[gnus-article-prev-page]\t Scroll the article one page backwards
13603 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
13604 \\[gnus-article-show-summary]\t Display the summary buffer
13605 \\[gnus-article-mail]\t Send a reply to the address near point
13606 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
13607 \\[gnus-info-find-node]\t Go to the Gnus info node"
13608   (interactive)
13609   (when (and menu-bar-mode
13610              (gnus-visual-p 'article-menu 'menu))
13611     (gnus-article-make-menu-bar))
13612   (kill-all-local-variables)
13613   (gnus-simplify-mode-line)
13614   (setq mode-name "Article")
13615   (setq major-mode 'gnus-article-mode)
13616   (make-local-variable 'minor-mode-alist)
13617   (or (assq 'gnus-show-mime minor-mode-alist)
13618       (setq minor-mode-alist
13619             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
13620   (use-local-map gnus-article-mode-map)
13621   (make-local-variable 'page-delimiter)
13622   (setq page-delimiter gnus-page-delimiter)
13623   (buffer-disable-undo (current-buffer))
13624   (setq buffer-read-only t)             ;Disable modification
13625   (run-hooks 'gnus-article-mode-hook))
13626
13627 (defun gnus-article-setup-buffer ()
13628   "Initialize the article buffer."
13629   (let* ((name (if gnus-single-article-buffer "*Article*"
13630                  (concat "*Article " gnus-newsgroup-name "*")))
13631          (original
13632           (progn (string-match "\\*Article" name)
13633                  (concat " *Original Article"
13634                          (substring name (match-end 0))))))
13635     (setq gnus-article-buffer name)
13636     (setq gnus-original-article-buffer original)
13637     ;; This might be a variable local to the summary buffer.
13638     (unless gnus-single-article-buffer
13639       (save-excursion
13640         (set-buffer gnus-summary-buffer)
13641         (setq gnus-article-buffer name)
13642         (setq gnus-original-article-buffer original)
13643         (gnus-set-global-variables))
13644       (make-local-variable 'gnus-summary-buffer))
13645     ;; Init original article buffer.
13646     (save-excursion
13647       (set-buffer (get-buffer-create gnus-original-article-buffer))
13648       (buffer-disable-undo (current-buffer))
13649       (setq major-mode 'gnus-original-article-mode)
13650       (gnus-add-current-to-buffer-list)
13651       (make-local-variable 'gnus-original-article))
13652     (if (get-buffer name)
13653         (save-excursion
13654           (set-buffer name)
13655           (buffer-disable-undo (current-buffer))
13656           (setq buffer-read-only t)
13657           (gnus-add-current-to-buffer-list)
13658           (or (eq major-mode 'gnus-article-mode)
13659               (gnus-article-mode))
13660           (current-buffer))
13661       (save-excursion
13662         (set-buffer (get-buffer-create name))
13663         (gnus-add-current-to-buffer-list)
13664         (gnus-article-mode)
13665         (current-buffer)))))
13666
13667 ;; Set article window start at LINE, where LINE is the number of lines
13668 ;; from the head of the article.
13669 (defun gnus-article-set-window-start (&optional line)
13670   (set-window-start
13671    (get-buffer-window gnus-article-buffer t)
13672    (save-excursion
13673      (set-buffer gnus-article-buffer)
13674      (goto-char (point-min))
13675      (if (not line)
13676          (point-min)
13677        (gnus-message 6 "Moved to bookmark")
13678        (search-forward "\n\n" nil t)
13679        (forward-line line)
13680        (point)))))
13681
13682 (defun gnus-kill-all-overlays ()
13683   "Delete all overlays in the current buffer."
13684   (when (fboundp 'overlay-lists)
13685     (let* ((overlayss (overlay-lists))
13686            (buffer-read-only nil)
13687            (overlays (nconc (car overlayss) (cdr overlayss))))
13688       (while overlays
13689         (delete-overlay (pop overlays))))))
13690
13691 (defun gnus-request-article-this-buffer (article group)
13692   "Get an article and insert it into this buffer."
13693   (let (do-update-line)
13694     (prog1
13695         (save-excursion
13696           (erase-buffer)
13697           (gnus-kill-all-overlays)
13698           (setq group (or group gnus-newsgroup-name))
13699
13700           ;; Open server if it has closed.
13701           (gnus-check-server (gnus-find-method-for-group group))
13702
13703           ;; Using `gnus-request-article' directly will insert the article into
13704           ;; `nntp-server-buffer' - so we'll save some time by not having to
13705           ;; copy it from the server buffer into the article buffer.
13706
13707           ;; We only request an article by message-id when we do not have the
13708           ;; headers for it, so we'll have to get those.
13709           (when (stringp article)
13710             (let ((gnus-override-method gnus-refer-article-method))
13711               (gnus-read-header article)))
13712
13713           ;; If the article number is negative, that means that this article
13714           ;; doesn't belong in this newsgroup (possibly), so we find its
13715           ;; message-id and request it by id instead of number.
13716           (when (and (numberp article)
13717                      gnus-summary-buffer
13718                      (get-buffer gnus-summary-buffer)
13719                      (buffer-name (get-buffer gnus-summary-buffer)))
13720             (save-excursion
13721               (set-buffer gnus-summary-buffer)
13722               (let ((header (gnus-summary-article-header article)))
13723                 (if (< article 0)
13724                     (cond 
13725                      ((memq article gnus-newsgroup-sparse)
13726                       ;; This is a sparse gap article.
13727                       (setq do-update-line article)
13728                       (setq article (mail-header-id header))
13729                       (let ((gnus-override-method gnus-refer-article-method))
13730                         (gnus-read-header article))
13731                       (setq gnus-newsgroup-sparse
13732                             (delq article gnus-newsgroup-sparse)))
13733                      ((vectorp header)
13734                       ;; It's a real article.
13735                       (setq article (mail-header-id header)))
13736                      (t
13737                       ;; It is an extracted pseudo-article.
13738                       (setq article 'pseudo)
13739                       (gnus-request-pseudo-article header))))
13740                 
13741                 (let ((method (gnus-find-method-for-group 
13742                                gnus-newsgroup-name)))
13743                   (if (not (eq (car method) 'nneething))
13744                       ()
13745                     (let ((dir (concat (file-name-as-directory (nth 1 method))
13746                                        (mail-header-subject header))))
13747                       (if (file-directory-p dir)
13748                           (progn
13749                             (setq article 'nneething)
13750                             (gnus-group-enter-directory dir)))))))))
13751
13752           (cond
13753            ;; Refuse to select canceled articles.
13754            ((and (numberp article)
13755                  gnus-summary-buffer
13756                  (get-buffer gnus-summary-buffer)
13757                  (buffer-name (get-buffer gnus-summary-buffer))
13758                  (eq (cdr (save-excursion
13759                             (set-buffer gnus-summary-buffer)
13760                             (assq article gnus-newsgroup-reads)))
13761                      gnus-canceled-mark))
13762             nil)
13763            ;; We first check `gnus-original-article-buffer'.
13764            ((and (get-buffer gnus-original-article-buffer)
13765                  (numberp article)
13766                  (save-excursion
13767                    (set-buffer gnus-original-article-buffer)
13768                    (and (equal (car gnus-original-article) group)
13769                         (eq (cdr gnus-original-article) article))))
13770             (insert-buffer-substring gnus-original-article-buffer)
13771             'article)
13772            ;; Check the backlog.
13773            ((and gnus-keep-backlog
13774                  (gnus-backlog-request-article group article (current-buffer)))
13775             'article)
13776            ;; Check the cache.
13777            ((and gnus-use-cache
13778                  (numberp article)
13779                  (gnus-cache-request-article article group))
13780             'article)
13781            ;; Get the article and put into the article buffer.
13782            ((or (stringp article) (numberp article))
13783             (let ((gnus-override-method
13784                    (and (stringp article) gnus-refer-article-method))
13785                   (buffer-read-only nil))
13786               (erase-buffer)
13787               (gnus-kill-all-overlays)
13788               (if (gnus-request-article article group (current-buffer))
13789                   (progn
13790                     (and gnus-keep-backlog
13791                          (numberp article)
13792                          (gnus-backlog-enter-article
13793                           group article (current-buffer)))
13794                     'article))))
13795            ;; It was a pseudo.
13796            (t article)))
13797
13798       ;; Take the article from the original article buffer
13799       ;; and place it in the buffer it's supposed to be in.
13800       (when (and (get-buffer gnus-article-buffer)
13801                  ;;(numberp article)
13802                  (equal (buffer-name (current-buffer))
13803                         (buffer-name (get-buffer gnus-article-buffer))))
13804         (save-excursion
13805           (if (get-buffer gnus-original-article-buffer)
13806               (set-buffer (get-buffer gnus-original-article-buffer))
13807             (set-buffer (get-buffer-create gnus-original-article-buffer))
13808             (buffer-disable-undo (current-buffer))
13809             (setq major-mode 'gnus-original-article-mode)
13810             (setq buffer-read-only t)
13811             (gnus-add-current-to-buffer-list))
13812           (let (buffer-read-only)
13813             (erase-buffer)
13814             (insert-buffer-substring gnus-article-buffer))
13815           (setq gnus-original-article (cons group article))))
13816     
13817       ;; Update sparse articles.
13818       (when (and do-update-line
13819                  (or (numberp article)
13820                      (stringp article)))
13821         (let ((buf (current-buffer)))
13822           (set-buffer gnus-summary-buffer)
13823           (gnus-summary-update-article do-update-line)
13824           (gnus-summary-goto-subject do-update-line nil t)
13825           (set-window-point (get-buffer-window (current-buffer) t)
13826                             (point))
13827           (set-buffer buf))))))
13828
13829 (defun gnus-read-header (id &optional header)
13830   "Read the headers of article ID and enter them into the Gnus system."
13831   (let ((group gnus-newsgroup-name)
13832         (gnus-override-method 
13833          (and (gnus-news-group-p gnus-newsgroup-name)
13834               gnus-refer-article-method))       
13835         where)
13836     ;; First we check to see whether the header in question is already
13837     ;; fetched.
13838     (if (stringp id)
13839         ;; This is a Message-ID.
13840         (setq header (or header (gnus-id-to-header id)))
13841       ;; This is an article number.
13842       (setq header (or header (gnus-summary-article-header id))))
13843     (if (and header
13844              (not (memq (mail-header-number header) gnus-newsgroup-sparse)))
13845         ;; We have found the header.
13846         header
13847       ;; We have to really fetch the header to this article.
13848       (when (setq where (gnus-request-head id group))
13849         (save-excursion
13850           (set-buffer nntp-server-buffer)
13851           (goto-char (point-max))
13852           (insert ".\n")
13853           (goto-char (point-min))
13854           (insert "211 ")
13855           (princ (cond
13856                   ((numberp id) id)
13857                   ((cdr where) (cdr where))
13858                   (header (mail-header-number header))
13859                   (t gnus-reffed-article-number))
13860                  (current-buffer))
13861           (insert " Article retrieved.\n"))
13862         ;(when (and header
13863         ;          (memq (mail-header-number header) gnus-newsgroup-sparse))
13864         ;  (setcar (gnus-id-to-thread id) nil))
13865         (if (not (setq header (car (gnus-get-newsgroup-headers))))
13866             ()                          ; Malformed head.
13867           (unless (memq (mail-header-number header) gnus-newsgroup-sparse)
13868             (if (and (stringp id)
13869                      (not (string= (gnus-group-real-name group)
13870                                    (car where))))
13871                 ;; If we fetched by Message-ID and the article came
13872                 ;; from a different group, we fudge some bogus article
13873                 ;; numbers for this article.
13874                 (mail-header-set-number header gnus-reffed-article-number))
13875             (decf gnus-reffed-article-number)
13876             (gnus-remove-header (mail-header-number header))
13877             (push header gnus-newsgroup-headers)
13878             (setq gnus-current-headers header)
13879             (push (mail-header-number header) gnus-newsgroup-limit))
13880           header)))))
13881
13882 (defun gnus-remove-header (number)
13883   "Remove header NUMBER from `gnus-newsgroup-headers'."
13884   (if (and gnus-newsgroup-headers
13885            (= number (mail-header-number (car gnus-newsgroup-headers))))
13886       (pop gnus-newsgroup-headers)
13887     (let ((headers gnus-newsgroup-headers))
13888       (while (and (cdr headers)
13889                   (not (= number (mail-header-number (cadr headers)))))
13890         (pop headers))
13891       (when (cdr headers)
13892         (setcdr headers (cddr headers))))))
13893
13894 (defun gnus-article-prepare (article &optional all-headers header)
13895   "Prepare ARTICLE in article mode buffer.
13896 ARTICLE should either be an article number or a Message-ID.
13897 If ARTICLE is an id, HEADER should be the article headers.
13898 If ALL-HEADERS is non-nil, no headers are hidden."
13899   (save-excursion
13900     ;; Make sure we start in a summary buffer.
13901     (unless (eq major-mode 'gnus-summary-mode)
13902       (set-buffer gnus-summary-buffer))
13903     (setq gnus-summary-buffer (current-buffer))
13904     ;; Make sure the connection to the server is alive.
13905     (unless (gnus-server-opened
13906              (gnus-find-method-for-group gnus-newsgroup-name))
13907       (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
13908       (gnus-request-group gnus-newsgroup-name t))
13909     (let* ((article (if header (mail-header-number header) article))
13910            (summary-buffer (current-buffer))
13911            (internal-hook gnus-article-internal-prepare-hook)
13912            (group gnus-newsgroup-name)
13913            result)
13914       (save-excursion
13915         (gnus-article-setup-buffer)
13916         (set-buffer gnus-article-buffer)
13917         ;; Deactivate active regions.
13918         (when (and (boundp 'transient-mark-mode)
13919                    transient-mark-mode)
13920           (setq mark-active nil))
13921         (if (not (setq result (let ((buffer-read-only nil))
13922                                 (gnus-request-article-this-buffer
13923                                  article group))))
13924             ;; There is no such article.
13925             (save-excursion
13926               (when (and (numberp article)
13927                          (not (memq article gnus-newsgroup-sparse)))
13928                 (setq gnus-article-current
13929                       (cons gnus-newsgroup-name article))
13930                 (set-buffer gnus-summary-buffer)
13931                 (setq gnus-current-article article)
13932                 (gnus-summary-mark-article article gnus-canceled-mark))
13933               (unless (memq article gnus-newsgroup-sparse)
13934                 (gnus-error
13935                  1 "No such article (may have expired or been canceled)")))
13936           (if (or (eq result 'pseudo) (eq result 'nneething))
13937               (progn
13938                 (save-excursion
13939                   (set-buffer summary-buffer)
13940                   (setq gnus-last-article gnus-current-article
13941                         gnus-newsgroup-history (cons gnus-current-article
13942                                                      gnus-newsgroup-history)
13943                         gnus-current-article 0
13944                         gnus-current-headers nil
13945                         gnus-article-current nil)
13946                   (if (eq result 'nneething)
13947                       (gnus-configure-windows 'summary)
13948                     (gnus-configure-windows 'article))
13949                   (gnus-set-global-variables))
13950                 (gnus-set-mode-line 'article))
13951             ;; The result from the `request' was an actual article -
13952             ;; or at least some text that is now displayed in the
13953             ;; article buffer.
13954             (if (and (numberp article)
13955                      (not (eq article gnus-current-article)))
13956                 ;; Seems like a new article has been selected.
13957                 ;; `gnus-current-article' must be an article number.
13958                 (save-excursion
13959                   (set-buffer summary-buffer)
13960                   (setq gnus-last-article gnus-current-article
13961                         gnus-newsgroup-history (cons gnus-current-article
13962                                                      gnus-newsgroup-history)
13963                         gnus-current-article article
13964                         gnus-current-headers
13965                         (gnus-summary-article-header gnus-current-article)
13966                         gnus-article-current
13967                         (cons gnus-newsgroup-name gnus-current-article))
13968                   (unless (vectorp gnus-current-headers)
13969                     (setq gnus-current-headers nil))
13970                   (gnus-summary-show-thread)
13971                   (run-hooks 'gnus-mark-article-hook)
13972                   (gnus-set-mode-line 'summary)
13973                   (and (gnus-visual-p 'article-highlight 'highlight)
13974                        (run-hooks 'gnus-visual-mark-article-hook))
13975                   ;; Set the global newsgroup variables here.
13976                   ;; Suggested by Jim Sisolak
13977                   ;; <sisolak@trans4.neep.wisc.edu>.
13978                   (gnus-set-global-variables)
13979                   (setq gnus-have-all-headers
13980                         (or all-headers gnus-show-all-headers))
13981                   (and gnus-use-cache
13982                        (vectorp (gnus-summary-article-header article))
13983                        (gnus-cache-possibly-enter-article
13984                         group article
13985                         (gnus-summary-article-header article)
13986                         (memq article gnus-newsgroup-marked)
13987                         (memq article gnus-newsgroup-dormant)
13988                         (memq article gnus-newsgroup-unreads)))))
13989             (when (or (numberp article)
13990                       (stringp article))
13991               ;; Hooks for getting information from the article.
13992               ;; This hook must be called before being narrowed.
13993               (let (buffer-read-only)
13994                 (run-hooks 'internal-hook)
13995                 (run-hooks 'gnus-article-prepare-hook)
13996                 ;; Decode MIME message.
13997                 (if gnus-show-mime
13998                     (if (or (not gnus-strict-mime)
13999                             (gnus-fetch-field "Mime-Version"))
14000                         (funcall gnus-show-mime-method)
14001                       (funcall gnus-decode-encoded-word-method)))
14002                 ;; Perform the article display hooks.
14003                 (run-hooks 'gnus-article-display-hook))
14004               ;; Do page break.
14005               (goto-char (point-min))
14006               (and gnus-break-pages (gnus-narrow-to-page)))
14007             (gnus-set-mode-line 'article)
14008             (gnus-configure-windows 'article)
14009             (goto-char (point-min))
14010             t))))))
14011
14012 (defun gnus-article-show-all-headers ()
14013   "Show all article headers in article mode buffer."
14014   (save-excursion
14015     (gnus-article-setup-buffer)
14016     (set-buffer gnus-article-buffer)
14017     (let ((buffer-read-only nil))
14018       (gnus-unhide-text (point-min) (point-max)))))
14019
14020 (defun gnus-article-hide-headers-if-wanted ()
14021   "Hide unwanted headers if `gnus-have-all-headers' is nil.
14022 Provided for backwards compatibility."
14023   (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
14024       gnus-inhibit-hiding
14025       (gnus-article-hide-headers)))
14026
14027 (defsubst gnus-article-header-rank ()
14028   "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
14029   (let ((list gnus-sorted-header-list)
14030         (i 0))
14031     (while list
14032       (when (looking-at (car list))
14033         (setq list nil))
14034       (setq list (cdr list))
14035       (incf i))
14036     i))
14037
14038 (defun gnus-article-hide-headers (&optional arg delete)
14039   "Toggle whether to hide unwanted headers and possibly sort them as well.
14040 If given a negative prefix, always show; if given a positive prefix,
14041 always hide."
14042   (interactive (gnus-hidden-arg))
14043   (if (gnus-article-check-hidden-text 'headers arg)
14044       ;; Show boring headers as well.
14045       (gnus-article-show-hidden-text 'boring-headers)
14046     ;; This function might be inhibited.
14047     (unless gnus-inhibit-hiding
14048       (save-excursion
14049         (set-buffer gnus-article-buffer)
14050         (save-restriction
14051           (let ((buffer-read-only nil)
14052                 (props (nconc (list 'gnus-type 'headers)
14053                               gnus-hidden-properties))
14054                 (max (1+ (length gnus-sorted-header-list)))
14055                 (ignored (when (not (stringp gnus-visible-headers))
14056                            (cond ((stringp gnus-ignored-headers)
14057                                   gnus-ignored-headers)
14058                                  ((listp gnus-ignored-headers)
14059                                   (mapconcat 'identity gnus-ignored-headers
14060                                              "\\|")))))
14061                 (visible
14062                  (cond ((stringp gnus-visible-headers)
14063                         gnus-visible-headers)
14064                        ((and gnus-visible-headers
14065                              (listp gnus-visible-headers))
14066                         (mapconcat 'identity gnus-visible-headers "\\|"))))
14067                 (inhibit-point-motion-hooks t)
14068                 want-list beg)
14069             ;; First we narrow to just the headers.
14070             (widen)
14071             (goto-char (point-min))
14072             ;; Hide any "From " lines at the beginning of (mail) articles.
14073             (while (looking-at "From ")
14074               (forward-line 1))
14075             (unless (bobp)
14076               (if delete
14077                   (delete-region (point-min) (point))
14078                 (gnus-hide-text (point-min) (point) props)))
14079             ;; Then treat the rest of the header lines.
14080             (narrow-to-region
14081              (point)
14082              (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
14083             ;; Then we use the two regular expressions
14084             ;; `gnus-ignored-headers' and `gnus-visible-headers' to
14085             ;; select which header lines is to remain visible in the
14086             ;; article buffer.
14087             (goto-char (point-min))
14088             (while (re-search-forward "^[^ \t]*:" nil t)
14089               (beginning-of-line)
14090               ;; We add the headers we want to keep to a list and delete
14091               ;; them from the buffer.
14092               (gnus-put-text-property 
14093                (point) (1+ (point)) 'message-rank
14094                (if (or (and visible (looking-at visible))
14095                        (and ignored
14096                             (not (looking-at ignored))))
14097                    (gnus-article-header-rank) 
14098                  (+ 2 max)))
14099               (forward-line 1))
14100             (message-sort-headers-1)
14101             (when (setq beg (text-property-any 
14102                              (point-min) (point-max) 'message-rank (+ 2 max)))
14103               ;; We make the unwanted headers invisible.
14104               (if delete
14105                   (delete-region beg (point-max))
14106                 ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
14107                 (gnus-hide-text-type beg (point-max) 'headers))
14108               ;; Work around XEmacs lossage.
14109               (gnus-put-text-property (point-min) beg 'invisible nil))))))))
14110
14111 (defun gnus-article-hide-boring-headers (&optional arg)
14112   "Toggle hiding of headers that aren't very interesting.
14113 If given a negative prefix, always show; if given a positive prefix,
14114 always hide."
14115   (interactive (gnus-hidden-arg))
14116   (unless (gnus-article-check-hidden-text 'boring-headers arg)
14117     (save-excursion
14118       (set-buffer gnus-article-buffer)
14119       (save-restriction
14120         (let ((buffer-read-only nil)
14121               (list gnus-boring-article-headers)
14122               (inhibit-point-motion-hooks t)
14123               elem)
14124           (nnheader-narrow-to-headers)
14125           (while list
14126             (setq elem (pop list))
14127             (goto-char (point-min))
14128             (cond
14129              ;; Hide empty headers.
14130              ((eq elem 'empty)
14131               (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t)
14132                 (forward-line -1)
14133                 (gnus-hide-text-type
14134                  (progn (beginning-of-line) (point))
14135                  (progn 
14136                    (end-of-line)
14137                    (if (re-search-forward "^[^ \t]" nil t)
14138                        (match-beginning 0)
14139                      (point-max)))
14140                  'boring-headers)))
14141              ;; Hide boring Newsgroups header.
14142              ((eq elem 'newsgroups)
14143               (when (equal (message-fetch-field "newsgroups")
14144                            (gnus-group-real-name gnus-newsgroup-name))
14145                 (gnus-article-hide-header "newsgroups")))
14146              ((eq elem 'followup-to)
14147               (when (equal (message-fetch-field "followup-to")
14148                            (message-fetch-field "newsgroups"))
14149                 (gnus-article-hide-header "followup-to")))
14150              ((eq elem 'reply-to)
14151               (let ((from (message-fetch-field "from"))
14152                     (reply-to (message-fetch-field "reply-to")))
14153                 (when (and
14154                        from reply-to
14155                        (equal 
14156                         (nth 1 (funcall gnus-extract-address-components from))
14157                         (nth 1 (funcall gnus-extract-address-components
14158                                         reply-to))))
14159                   (gnus-article-hide-header "reply-to"))))
14160              ((eq elem 'date)
14161               (let ((date (message-fetch-field "date")))
14162                 (when (and date
14163                            (< (gnus-days-between date (current-time-string))
14164                               4))
14165                   (gnus-article-hide-header "date")))))))))))
14166
14167 (defun gnus-article-hide-header (header)
14168   (save-excursion
14169     (goto-char (point-min))
14170     (when (re-search-forward (concat "^" header ":") nil t)
14171       (gnus-hide-text-type
14172        (progn (beginning-of-line) (point))
14173        (progn 
14174          (end-of-line)
14175          (if (re-search-forward "^[^ \t]" nil t)
14176              (match-beginning 0)
14177            (point-max)))
14178        'boring-headers))))
14179
14180 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
14181 (defun gnus-article-treat-overstrike ()
14182   "Translate overstrikes into bold text."
14183   (interactive)
14184   (save-excursion
14185     (set-buffer gnus-article-buffer)
14186     (let ((buffer-read-only nil))
14187       (while (search-forward "\b" nil t)
14188         (let ((next (following-char))
14189               (previous (char-after (- (point) 2))))
14190           (cond 
14191            ((eq next previous)
14192             (gnus-put-text-property (- (point) 2) (point) 'invisible t)
14193             (gnus-put-text-property (point) (1+ (point)) 'face 'bold))
14194            ((eq next ?_)
14195             (gnus-put-text-property (1- (point)) (1+ (point)) 'invisible t)
14196             (gnus-put-text-property
14197              (- (point) 2) (1- (point)) 'face 'underline))
14198            ((eq previous ?_)
14199             (gnus-put-text-property (- (point) 2) (point) 'invisible t)
14200             (gnus-put-text-property
14201              (point) (1+ (point))       'face 'underline))))))))
14202
14203 (defun gnus-article-word-wrap ()
14204   "Format too long lines."
14205   (interactive)
14206   (save-excursion
14207     (set-buffer gnus-article-buffer)
14208     (let ((buffer-read-only nil))
14209       (widen)
14210       (goto-char (point-min))
14211       (search-forward "\n\n" nil t)
14212       (end-of-line 1)
14213       (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
14214             (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
14215             (adaptive-fill-mode t))
14216         (while (not (eobp))
14217           (and (>= (current-column) (min fill-column (window-width)))
14218                (/= (preceding-char) ?:)
14219                (fill-paragraph nil))
14220           (end-of-line 2))))))
14221
14222 (defun gnus-article-remove-cr ()
14223   "Remove carriage returns from an article."
14224   (interactive)
14225   (save-excursion
14226     (set-buffer gnus-article-buffer)
14227     (let ((buffer-read-only nil))
14228       (goto-char (point-min))
14229       (while (search-forward "\r" nil t)
14230         (replace-match "" t t)))))
14231
14232 (defun gnus-article-remove-trailing-blank-lines ()
14233   "Remove all trailing blank lines from the article."
14234   (interactive)
14235   (save-excursion
14236     (set-buffer gnus-article-buffer)
14237     (let ((buffer-read-only nil))
14238       (goto-char (point-max))
14239       (delete-region
14240        (point)
14241        (progn
14242          (while (looking-at "^[ \t]*$")
14243            (forward-line -1))
14244          (forward-line 1)
14245          (point))))))
14246
14247 (defun gnus-article-display-x-face (&optional force)
14248   "Look for an X-Face header and display it if present."
14249   (interactive (list 'force))
14250   (save-excursion
14251     (set-buffer gnus-article-buffer)
14252     ;; Delete the old process, if any.
14253     (when (process-status "gnus-x-face")
14254       (delete-process "gnus-x-face"))
14255     (let ((inhibit-point-motion-hooks t)
14256           (case-fold-search nil)
14257           from)
14258       (save-restriction
14259         (nnheader-narrow-to-headers)
14260         (setq from (message-fetch-field "from"))
14261         (goto-char (point-min))
14262         (when (and gnus-article-x-face-command
14263                    (or force
14264                        ;; Check whether this face is censored.
14265                        (not gnus-article-x-face-too-ugly)
14266                        (and gnus-article-x-face-too-ugly from
14267                             (not (string-match gnus-article-x-face-too-ugly
14268                                                from))))
14269                    ;; Has to be present.
14270                    (re-search-forward "^X-Face: " nil t))
14271           ;; We now have the area of the buffer where the X-Face is stored.
14272           (let ((beg (point))
14273                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
14274             ;; We display the face.
14275             (if (symbolp gnus-article-x-face-command)
14276                 ;; The command is a lisp function, so we call it.
14277                 (if (gnus-functionp gnus-article-x-face-command)
14278                     (funcall gnus-article-x-face-command beg end)
14279                   (error "%s is not a function" gnus-article-x-face-command))
14280               ;; The command is a string, so we interpret the command
14281               ;; as a, well, command, and fork it off.
14282               (let ((process-connection-type nil))
14283                 (process-kill-without-query
14284                  (start-process
14285                   "gnus-x-face" nil shell-file-name shell-command-switch
14286                   gnus-article-x-face-command))
14287                 (process-send-region "gnus-x-face" beg end)
14288                 (process-send-eof "gnus-x-face")))))))))
14289
14290 (defalias 'gnus-headers-decode-quoted-printable 'gnus-decode-rfc1522)
14291 (defun gnus-decode-rfc1522 ()
14292   "Hack to remove QP encoding from headers."
14293   (let ((case-fold-search t)
14294         (inhibit-point-motion-hooks t)
14295         (buffer-read-only nil)
14296         string)
14297     (save-restriction
14298       (narrow-to-region
14299        (goto-char (point-min))
14300        (or (search-forward "\n\n" nil t) (point-max)))
14301
14302       (goto-char (point-min))
14303       (while (re-search-forward 
14304               "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
14305         (setq string (match-string 1))
14306         (narrow-to-region (match-beginning 0) (match-end 0))
14307         (delete-region (point-min) (point-max))
14308         (insert string)
14309         (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
14310         (subst-char-in-region (point-min) (point-max) ?_ ? )
14311         (widen)
14312         (goto-char (point-min))))))
14313
14314 (defun gnus-article-de-quoted-unreadable (&optional force)
14315   "Do a naive translation of a quoted-printable-encoded article.
14316 This is in no way, shape or form meant as a replacement for real MIME
14317 processing, but is simply a stop-gap measure until MIME support is
14318 written.
14319 If FORCE, decode the article whether it is marked as quoted-printable
14320 or not."
14321   (interactive (list 'force))
14322   (save-excursion
14323     (set-buffer gnus-article-buffer)
14324     (let ((case-fold-search t)
14325           (buffer-read-only nil)
14326           (type (gnus-fetch-field "content-transfer-encoding")))
14327       (gnus-decode-rfc1522)
14328       (when (or force
14329                 (and type (string-match "quoted-printable" (downcase type))))
14330         (goto-char (point-min))
14331         (search-forward "\n\n" nil 'move)
14332         (gnus-mime-decode-quoted-printable (point) (point-max))))))
14333
14334 (defun gnus-mime-decode-quoted-printable (from to)
14335   "Decode Quoted-Printable in the region between FROM and TO."
14336   (interactive "r")
14337   (goto-char from)
14338   (while (search-forward "=" to t)
14339     (cond ((eq (following-char) ?\n)
14340            (delete-char -1)
14341            (delete-char 1))
14342           ((looking-at "[0-9A-F][0-9A-F]")
14343            (subst-char-in-region
14344             (1- (point)) (point) ?=
14345             (hexl-hex-string-to-integer
14346              (buffer-substring (point) (+ 2 (point)))))
14347            (delete-char 2))
14348           ((looking-at "=")
14349            (delete-char 1))
14350           ((gnus-message 3 "Malformed MIME quoted-printable message")))))
14351
14352 (defun gnus-article-hide-pgp (&optional arg)
14353   "Toggle hiding of any PGP headers and signatures in the current article.
14354 If given a negative prefix, always show; if given a positive prefix,
14355 always hide."
14356   (interactive (gnus-hidden-arg))
14357   (unless (gnus-article-check-hidden-text 'pgp arg)
14358     (save-excursion
14359       (set-buffer gnus-article-buffer)
14360       (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties))
14361             buffer-read-only beg end)
14362         (widen)
14363         (goto-char (point-min))
14364         ;; Hide the "header".
14365         (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
14366              (gnus-hide-text (match-beginning 0) (match-end 0) props))
14367         (setq beg (point))
14368         ;; Hide the actual signature.
14369         (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
14370              (setq end (1+ (match-beginning 0)))
14371              (gnus-hide-text
14372               end
14373               (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
14374                   (match-end 0)
14375                 ;; Perhaps we shouldn't hide to the end of the buffer
14376                 ;; if there is no end to the signature?
14377                 (point-max))
14378               props))
14379         ;; Hide "- " PGP quotation markers.
14380         (when (and beg end)
14381           (narrow-to-region beg end)
14382           (goto-char (point-min))
14383           (while (re-search-forward "^- " nil t)
14384             (gnus-hide-text (match-beginning 0) (match-end 0) props))
14385           (widen))))))
14386
14387 (defun gnus-article-hide-pem (&optional arg)
14388   "Toggle hiding of any PEM headers and signatures in the current article.
14389 If given a negative prefix, always show; if given a positive prefix,
14390 always hide."
14391   (interactive (gnus-hidden-arg))
14392   (unless (gnus-article-check-hidden-text 'pem arg)
14393     (save-excursion
14394       (set-buffer gnus-article-buffer)
14395       (let ((props (nconc (list 'gnus-type 'pem) gnus-hidden-properties))
14396             buffer-read-only end)
14397         (widen)
14398         (goto-char (point-min))
14399         ;; hide the horrendously ugly "header".
14400         (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n"
14401                              nil
14402                              t)
14403              (setq end (1+ (match-beginning 0)))
14404              (gnus-hide-text
14405               end
14406               (if (search-forward "\n\n" nil t)
14407                   (match-end 0)
14408                 (point-max))
14409               props))
14410         ;; hide the trailer as well
14411         (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n"
14412                              nil
14413                              t)
14414              (gnus-hide-text (match-beginning 0) (match-end 0) props))))))
14415
14416 (defun gnus-article-hide-signature (&optional arg)
14417   "Hide the signature in the current article.
14418 If given a negative prefix, always show; if given a positive prefix,
14419 always hide."
14420   (interactive (gnus-hidden-arg))
14421   (unless (gnus-article-check-hidden-text 'signature arg)
14422     (save-excursion
14423       (set-buffer gnus-article-buffer)
14424       (save-restriction
14425         (let ((buffer-read-only nil))
14426           (when (gnus-narrow-to-signature)
14427             (gnus-hide-text-type (point-min) (point-max) 'signature)))))))
14428
14429 (defun gnus-article-strip-leading-blank-lines ()
14430   "Remove all blank lines from the beginning of the article."
14431   (interactive)
14432   (save-excursion
14433     (set-buffer gnus-article-buffer)
14434     (let (buffer-read-only)
14435       (goto-char (point-min))
14436       (when (search-forward "\n\n" nil t)
14437         (while (looking-at "[ \t]$")
14438           (gnus-delete-line))))))
14439
14440 (defvar mime::preview/content-list)
14441 (defvar mime::preview-content-info/point-min)
14442 (defun gnus-narrow-to-signature ()
14443   "Narrow to the signature."
14444   (widen)
14445   (if (and (boundp 'mime::preview/content-list)
14446            mime::preview/content-list)
14447       (let ((pcinfo (car (last mime::preview/content-list))))
14448         (condition-case ()
14449             (narrow-to-region
14450              (funcall (intern "mime::preview-content-info/point-min") pcinfo)
14451              (point-max))
14452           (error nil))))
14453   (goto-char (point-max))
14454   (when (re-search-backward gnus-signature-separator nil t)
14455     (forward-line 1)
14456     (when (or (null gnus-signature-limit)
14457               (and (numberp gnus-signature-limit)
14458                    (< (- (point-max) (point)) gnus-signature-limit))
14459               (and (gnus-functionp gnus-signature-limit)
14460                    (funcall gnus-signature-limit))
14461               (and (stringp gnus-signature-limit)
14462                    (not (re-search-forward gnus-signature-limit nil t))))
14463       (narrow-to-region (point) (point-max))
14464       t)))
14465
14466 (defun gnus-hidden-arg ()
14467   "Return the current prefix arg as a number, or 0 if no prefix."
14468   (list (if current-prefix-arg
14469             (prefix-numeric-value current-prefix-arg)
14470           0)))
14471
14472 (defun gnus-article-check-hidden-text (type arg)
14473   "Return nil if hiding is necessary.
14474 Arg can be nil or a number.  Nil and positive means hide, negative
14475 means show, 0 means toggle."
14476   (save-excursion
14477     (set-buffer gnus-article-buffer)
14478     (let ((hide (gnus-article-hidden-text-p type)))
14479       (cond
14480        ((or (null arg)
14481             (> arg 0))
14482         nil)
14483        ((< arg 0)
14484         (gnus-article-show-hidden-text type))
14485        (t
14486         (if (eq hide 'hidden)
14487             (gnus-article-show-hidden-text type)
14488           nil))))))
14489
14490 (defun gnus-article-hidden-text-p (type)
14491   "Say whether the current buffer contains hidden text of type TYPE."
14492   (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type)))
14493     (when pos
14494       (if (get-text-property pos 'invisible)
14495           'hidden
14496         'shown))))
14497
14498 (defun gnus-article-hide (&optional arg force)
14499   "Hide all the gruft in the current article.
14500 This means that PGP stuff, signatures, cited text and (some)
14501 headers will be hidden.
14502 If given a prefix, show the hidden text instead."
14503   (interactive (list current-prefix-arg 'force))
14504   (gnus-article-hide-headers arg)
14505   (gnus-article-hide-pgp arg)
14506   (gnus-article-hide-citation-maybe arg force)
14507   (gnus-article-hide-signature arg))
14508
14509 (defun gnus-article-show-hidden-text (type &optional hide)
14510   "Show all hidden text of type TYPE.
14511 If HIDE, hide the text instead."
14512   (save-excursion
14513     (set-buffer gnus-article-buffer)
14514     (let ((buffer-read-only nil)
14515           (inhibit-point-motion-hooks t)
14516           (beg (point-min)))
14517       (while (gnus-goto-char (text-property-any
14518                               beg (point-max) 'gnus-type type))
14519         (setq beg (point))
14520         (forward-char)
14521         (if hide
14522             (gnus-hide-text beg (point) gnus-hidden-properties)
14523           (gnus-unhide-text beg (point)))
14524         (setq beg (point)))
14525       t)))
14526
14527 (defvar gnus-article-time-units
14528   `((year . ,(* 365.25 24 60 60))
14529     (week . ,(* 7 24 60 60))
14530     (day . ,(* 24 60 60))
14531     (hour . ,(* 60 60))
14532     (minute . 60)
14533     (second . 1))
14534   "Mapping from time units to seconds.")
14535
14536 (defun gnus-article-date-ut (&optional type highlight)
14537   "Convert DATE date to universal time in the current article.
14538 If TYPE is `local', convert to local time; if it is `lapsed', output
14539 how much time has lapsed since DATE."
14540   (interactive (list 'ut t))
14541   (let* ((header (or gnus-current-headers
14542                      (gnus-summary-article-header) ""))
14543          (date (and (vectorp header) (mail-header-date header)))
14544          (date-regexp "^Date: \\|^X-Sent: ")
14545          (now (current-time))
14546          (inhibit-point-motion-hooks t)
14547          bface eface)
14548     (when (and date (not (string= date "")))
14549       (save-excursion
14550         (set-buffer gnus-article-buffer)
14551         (save-restriction
14552           (nnheader-narrow-to-headers)
14553           (let ((buffer-read-only nil))
14554             ;; Delete any old Date headers.
14555             (if (re-search-forward date-regexp nil t)
14556                 (progn
14557                   (setq bface (get-text-property (gnus-point-at-bol) 'face)
14558                         eface (get-text-property (1- (gnus-point-at-eol))
14559                                                  'face))
14560                   (message-remove-header date-regexp t)
14561                   (beginning-of-line))
14562               (goto-char (point-max)))
14563             (insert (gnus-make-date-line date type))
14564             ;; Do highlighting.
14565             (forward-line -1)
14566             (when (and (gnus-visual-p 'article-highlight 'highlight)
14567                        (looking-at "\\([^:]+\\): *\\(.*\\)$"))
14568               (gnus-put-text-property (match-beginning 1) (match-end 1)
14569                                  'face bface)
14570               (gnus-put-text-property (match-beginning 2) (match-end 2)
14571                                  'face eface))))))))
14572
14573 (defun gnus-make-date-line (date type)
14574   "Return a DATE line of TYPE."
14575   (cond
14576    ;; Convert to the local timezone.  We have to slap a
14577    ;; `condition-case' round the calls to the timezone
14578    ;; functions since they aren't particularly resistant to
14579    ;; buggy dates.
14580    ((eq type 'local)
14581     (concat "Date: " (condition-case ()
14582                          (timezone-make-date-arpa-standard date)
14583                        (error date))
14584             "\n"))
14585    ;; Convert to Universal Time.
14586    ((eq type 'ut)
14587     (concat "Date: "
14588             (condition-case ()
14589                 (timezone-make-date-arpa-standard date nil "UT")
14590               (error date))
14591             "\n"))
14592    ;; Get the original date from the article.
14593    ((eq type 'original)
14594     (concat "Date: " date "\n"))
14595    ;; Do an X-Sent lapsed format.
14596    ((eq type 'lapsed)
14597     ;; If the date is seriously mangled, the timezone
14598     ;; functions are liable to bug out, so we condition-case
14599     ;; the entire thing.
14600     (let* ((now (current-time))
14601            (real-time
14602             (condition-case ()
14603                 (gnus-time-minus
14604                  (gnus-encode-date
14605                   (timezone-make-date-arpa-standard
14606                    (current-time-string now)
14607                    (current-time-zone now) "UT"))
14608                  (gnus-encode-date
14609                   (timezone-make-date-arpa-standard
14610                    date nil "UT")))
14611               (error '(0 0))))
14612            (real-sec (+ (* (float (car real-time)) 65536)
14613                         (cadr real-time)))
14614            (sec (abs real-sec))
14615            num prev)
14616       (cond
14617        ((equal real-time '(0 0))
14618         "X-Sent: Unknown\n")
14619        ((zerop sec)
14620         "X-Sent: Now\n")
14621        (t
14622         (concat
14623          "X-Sent: "
14624          ;; This is a bit convoluted, but basically we go
14625          ;; through the time units for years, weeks, etc,
14626          ;; and divide things to see whether that results
14627          ;; in positive answers.
14628          (mapconcat
14629           (lambda (unit)
14630             (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
14631                 ;; The (remaining) seconds are too few to
14632                 ;; be divided into this time unit.
14633                 ""
14634               ;; It's big enough, so we output it.
14635               (setq sec (- sec (* num (cdr unit))))
14636               (prog1
14637                   (concat (if prev ", " "") (int-to-string
14638                                              (floor num))
14639                           " " (symbol-name (car unit)) 
14640                           (if (> num 1) "s" ""))
14641                 (setq prev t))))
14642           gnus-article-time-units "")
14643          ;; If dates are odd, then it might appear like the
14644          ;; article was sent in the future.
14645          (if (> real-sec 0)
14646              " ago\n"
14647            " in the future\n"))))))
14648    (t
14649     (error "Unknown conversion type: %s" type))))
14650
14651 (defun gnus-article-date-local (&optional highlight)
14652   "Convert the current article date to the local timezone."
14653   (interactive (list t))
14654   (gnus-article-date-ut 'local highlight))
14655
14656 (defun gnus-article-date-original (&optional highlight)
14657   "Convert the current article date to what it was originally.
14658 This is only useful if you have used some other date conversion
14659 function and want to see what the date was before converting."
14660   (interactive (list t))
14661   (gnus-article-date-ut 'original highlight))
14662
14663 (defun gnus-article-date-lapsed (&optional highlight)
14664   "Convert the current article date to time lapsed since it was sent."
14665   (interactive (list t))
14666   (gnus-article-date-ut 'lapsed highlight))
14667
14668 (defun gnus-article-maybe-highlight ()
14669   "Do some article highlighting if `gnus-visual' is non-nil."
14670   (if (gnus-visual-p 'article-highlight 'highlight)
14671       (gnus-article-highlight-some)))
14672
14673 ;;; Article savers.
14674
14675 (defun gnus-output-to-rmail (file-name)
14676   "Append the current article to an Rmail file named FILE-NAME."
14677   (require 'rmail)
14678   ;; Most of these codes are borrowed from rmailout.el.
14679   (setq file-name (expand-file-name file-name))
14680   (setq rmail-default-rmail-file file-name)
14681   (let ((artbuf (current-buffer))
14682         (tmpbuf (get-buffer-create " *Gnus-output*")))
14683     (save-excursion
14684       (or (get-file-buffer file-name)
14685           (file-exists-p file-name)
14686           (if (gnus-yes-or-no-p
14687                (concat "\"" file-name "\" does not exist, create it? "))
14688               (let ((file-buffer (create-file-buffer file-name)))
14689                 (save-excursion
14690                   (set-buffer file-buffer)
14691                   (rmail-insert-rmail-file-header)
14692                   (let ((require-final-newline nil))
14693                     (write-region (point-min) (point-max) file-name t 1)))
14694                 (kill-buffer file-buffer))
14695             (error "Output file does not exist")))
14696       (set-buffer tmpbuf)
14697       (buffer-disable-undo (current-buffer))
14698       (erase-buffer)
14699       (insert-buffer-substring artbuf)
14700       (gnus-convert-article-to-rmail)
14701       ;; Decide whether to append to a file or to an Emacs buffer.
14702       (let ((outbuf (get-file-buffer file-name)))
14703         (if (not outbuf)
14704             (append-to-file (point-min) (point-max) file-name)
14705           ;; File has been visited, in buffer OUTBUF.
14706           (set-buffer outbuf)
14707           (let ((buffer-read-only nil)
14708                 (msg (and (boundp 'rmail-current-message)
14709                           (symbol-value 'rmail-current-message))))
14710             ;; If MSG is non-nil, buffer is in RMAIL mode.
14711             (if msg
14712                 (progn (widen)
14713                        (narrow-to-region (point-max) (point-max))))
14714             (insert-buffer-substring tmpbuf)
14715             (if msg
14716                 (progn
14717                   (goto-char (point-min))
14718                   (widen)
14719                   (search-backward "\^_")
14720                   (narrow-to-region (point) (point-max))
14721                   (goto-char (1+ (point-min)))
14722                   (rmail-count-new-messages t)
14723                   (rmail-show-message msg)))))))
14724     (kill-buffer tmpbuf)))
14725
14726 (defun gnus-output-to-file (file-name)
14727   "Append the current article to a file named FILE-NAME."
14728   (let ((artbuf (current-buffer)))
14729     (nnheader-temp-write nil
14730       (insert-buffer-substring artbuf)
14731       ;; Append newline at end of the buffer as separator, and then
14732       ;; save it to file.
14733       (goto-char (point-max))
14734       (insert "\n")
14735       (append-to-file (point-min) (point-max) file-name))))
14736
14737 (defun gnus-convert-article-to-rmail ()
14738   "Convert article in current buffer to Rmail message format."
14739   (let ((buffer-read-only nil))
14740     ;; Convert article directly into Babyl format.
14741     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
14742     (goto-char (point-min))
14743     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
14744     (while (search-forward "\n\^_" nil t) ;single char
14745       (replace-match "\n^_" t t))       ;2 chars: "^" and "_"
14746     (goto-char (point-max))
14747     (insert "\^_")))
14748
14749 (defun gnus-narrow-to-page (&optional arg)
14750   "Narrow the article buffer to a page.
14751 If given a numerical ARG, move forward ARG pages."
14752   (interactive "P")
14753   (setq arg (if arg (prefix-numeric-value arg) 0))
14754   (save-excursion
14755     (set-buffer gnus-article-buffer)
14756     (goto-char (point-min))
14757     (widen)
14758     (when (gnus-visual-p 'page-marker)
14759       (let ((buffer-read-only nil))
14760         (gnus-remove-text-with-property 'gnus-prev)
14761         (gnus-remove-text-with-property 'gnus-next)))
14762     (when
14763         (cond ((< arg 0)
14764                (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
14765               ((> arg 0)
14766                (re-search-forward page-delimiter nil 'move arg)))
14767       (goto-char (match-end 0)))
14768     (narrow-to-region
14769      (point)
14770      (if (re-search-forward page-delimiter nil 'move)
14771          (match-beginning 0)
14772        (point)))
14773     (when (and (gnus-visual-p 'page-marker)
14774                (not (= (point-min) 1)))
14775       (save-excursion
14776         (goto-char (point-min))
14777         (gnus-insert-prev-page-button)))
14778     (when (and (gnus-visual-p 'page-marker)
14779                (not (= (1- (point-max)) (buffer-size))))
14780       (save-excursion
14781         (goto-char (point-max))
14782         (gnus-insert-next-page-button)))))
14783
14784 ;; Article mode commands
14785
14786 (defun gnus-article-goto-next-page ()
14787   "Show the next page of the article."
14788   (interactive)
14789   (when (gnus-article-next-page)
14790     (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
14791
14792 (defun gnus-article-goto-prev-page ()
14793   "Show the next page of the article."
14794   (interactive)
14795   (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))
14796     (gnus-article-prev-page nil)))
14797
14798 (defun gnus-article-next-page (&optional lines)
14799   "Show the next page of the current article.
14800 If end of article, return non-nil.  Otherwise return nil.
14801 Argument LINES specifies lines to be scrolled up."
14802   (interactive "p")
14803   (move-to-window-line -1)
14804   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
14805   (if (save-excursion
14806         (end-of-line)
14807         (and (pos-visible-in-window-p)  ;Not continuation line.
14808              (eobp)))
14809       ;; Nothing in this page.
14810       (if (or (not gnus-break-pages)
14811               (save-excursion
14812                 (save-restriction
14813                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
14814           t                             ;Nothing more.
14815         (gnus-narrow-to-page 1)         ;Go to next page.
14816         nil)
14817     ;; More in this page.
14818     (condition-case ()
14819         (scroll-up lines)
14820       (end-of-buffer
14821        ;; Long lines may cause an end-of-buffer error.
14822        (goto-char (point-max))))
14823     (move-to-window-line 0)
14824     nil))
14825
14826 (defun gnus-article-prev-page (&optional lines)
14827   "Show previous page of current article.
14828 Argument LINES specifies lines to be scrolled down."
14829   (interactive "p")
14830   (move-to-window-line 0)
14831   (if (and gnus-break-pages
14832            (bobp)
14833            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
14834       (progn
14835         (gnus-narrow-to-page -1)        ;Go to previous page.
14836         (goto-char (point-max))
14837         (recenter -1))
14838     (prog1
14839         (condition-case ()
14840             (scroll-down lines)
14841           (error nil))
14842       (move-to-window-line 0))))
14843
14844 (defun gnus-article-refer-article ()
14845   "Read article specified by message-id around point."
14846   (interactive)
14847   (let ((point (point)))
14848     (search-forward ">" nil t)          ;Move point to end of "<....>".
14849     (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
14850         (let ((message-id (match-string 1)))
14851           (goto-char point)
14852           (set-buffer gnus-summary-buffer)
14853           (gnus-summary-refer-article message-id))
14854       (goto-char (point))
14855       (error "No references around point"))))
14856
14857 (defun gnus-article-show-summary ()
14858   "Reconfigure windows to show summary buffer."
14859   (interactive)
14860   (gnus-configure-windows 'article)
14861   (gnus-summary-goto-subject gnus-current-article))
14862
14863 (defun gnus-article-describe-briefly ()
14864   "Describe article mode commands briefly."
14865   (interactive)
14866   (gnus-message 6
14867                 (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")))
14868
14869 (defun gnus-article-summary-command ()
14870   "Execute the last keystroke in the summary buffer."
14871   (interactive)
14872   (let ((obuf (current-buffer))
14873         (owin (current-window-configuration))
14874         func)
14875     (switch-to-buffer gnus-summary-buffer 'norecord)
14876     (setq func (lookup-key (current-local-map) (this-command-keys)))
14877     (call-interactively func)
14878     (set-buffer obuf)
14879     (set-window-configuration owin)
14880     (set-window-point (get-buffer-window (current-buffer)) (point))))
14881
14882 (defun gnus-article-summary-command-nosave ()
14883   "Execute the last keystroke in the summary buffer."
14884   (interactive)
14885   (let (func)
14886     (pop-to-buffer gnus-summary-buffer 'norecord)
14887     (setq func (lookup-key (current-local-map) (this-command-keys)))
14888     (call-interactively func)))
14889
14890 (defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
14891   "Read a summary buffer key sequence and execute it from the article buffer."
14892   (interactive "P")
14893   (let ((nosaves
14894          '("q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F"
14895            "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
14896            "=" "^" "\M-^" "|"))
14897         (nosave-but-article
14898          '("A\r"))
14899         keys)
14900     (save-excursion
14901       (set-buffer gnus-summary-buffer)
14902       (push (or key last-command-event) unread-command-events)
14903       (setq keys (read-key-sequence nil)))
14904     (message "")
14905
14906     (if (or (member keys nosaves)
14907             (member keys nosave-but-article))
14908         (let (func)
14909           (save-window-excursion
14910             (pop-to-buffer gnus-summary-buffer 'norecord)
14911             (setq func (lookup-key (current-local-map) keys)))
14912           (if (not func)
14913               (ding)
14914             (set-buffer gnus-summary-buffer)
14915             (call-interactively func))
14916           (when (member keys nosave-but-article)
14917             (pop-to-buffer gnus-article-buffer 'norecord)))
14918       (let ((obuf (current-buffer))
14919             (owin (current-window-configuration))
14920             (opoint (point))
14921             func in-buffer)
14922         (if not-restore-window
14923             (pop-to-buffer gnus-summary-buffer 'norecord)
14924           (switch-to-buffer gnus-summary-buffer 'norecord))
14925         (setq in-buffer (current-buffer))
14926         (if (setq func (lookup-key (current-local-map) keys))
14927             (call-interactively func)
14928           (ding))
14929         (when (eq in-buffer (current-buffer))
14930           (set-buffer obuf)
14931           (unless not-restore-window
14932             (set-window-configuration owin))
14933           (set-window-point (get-buffer-window (current-buffer)) opoint))))))
14934
14935 \f
14936 ;;;
14937 ;;; Kill file handling.
14938 ;;;
14939
14940 ;;;###autoload
14941 (defalias 'gnus-batch-kill 'gnus-batch-score)
14942 ;;;###autoload
14943 (defun gnus-batch-score ()
14944   "Run batched scoring.
14945 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
14946 Newsgroups is a list of strings in Bnews format.  If you want to score
14947 the comp hierarchy, you'd say \"comp.all\".  If you would not like to
14948 score the alt hierarchy, you'd say \"!alt.all\"."
14949   (interactive)
14950   (let* ((yes-and-no
14951           (gnus-newsrc-parse-options
14952            (apply (function concat)
14953                   (mapcar (lambda (g) (concat g " "))
14954                           command-line-args-left))))
14955          (gnus-expert-user t)
14956          (nnmail-spool-file nil)
14957          (gnus-use-dribble-file nil)
14958          (yes (car yes-and-no))
14959          (no (cdr yes-and-no))
14960          group newsrc entry
14961          ;; Disable verbose message.
14962          gnus-novice-user gnus-large-newsgroup)
14963     ;; Eat all arguments.
14964     (setq command-line-args-left nil)
14965     ;; Start Gnus.
14966     (gnus)
14967     ;; Apply kills to specified newsgroups in command line arguments.
14968     (setq newsrc (cdr gnus-newsrc-alist))
14969     (while newsrc
14970       (setq group (caar newsrc))
14971       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
14972       (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
14973                (and (car entry)
14974                     (or (eq (car entry) t)
14975                         (not (zerop (car entry)))))
14976                (if yes (string-match yes group) t)
14977                (or (null no) (not (string-match no group))))
14978           (progn
14979             (gnus-summary-read-group group nil t nil t)
14980             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
14981                  (gnus-summary-exit))))
14982       (setq newsrc (cdr newsrc)))
14983     ;; Exit Emacs.
14984     (switch-to-buffer gnus-group-buffer)
14985     (gnus-group-save-newsrc)))
14986
14987 (defun gnus-apply-kill-file ()
14988   "Apply a kill file to the current newsgroup.
14989 Returns the number of articles marked as read."
14990   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
14991           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
14992       (gnus-apply-kill-file-internal)
14993     0))
14994
14995 (defun gnus-kill-save-kill-buffer ()
14996   (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
14997     (when (get-file-buffer file)
14998       (save-excursion
14999         (set-buffer (get-file-buffer file))
15000         (and (buffer-modified-p) (save-buffer))
15001         (kill-buffer (current-buffer))))))
15002
15003 (defvar gnus-kill-file-name "KILL"
15004   "Suffix of the kill files.")
15005
15006 (defun gnus-newsgroup-kill-file (newsgroup)
15007   "Return the name of a kill file name for NEWSGROUP.
15008 If NEWSGROUP is nil, return the global kill file name instead."
15009   (cond 
15010    ;; The global KILL file is placed at top of the directory.
15011    ((or (null newsgroup)
15012         (string-equal newsgroup ""))
15013     (expand-file-name gnus-kill-file-name
15014                       gnus-kill-files-directory))
15015    ;; Append ".KILL" to newsgroup name.
15016    ((gnus-use-long-file-name 'not-kill)
15017     (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
15018                               "." gnus-kill-file-name)
15019                       gnus-kill-files-directory))
15020    ;; Place "KILL" under the hierarchical directory.
15021    (t
15022     (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
15023                               "/" gnus-kill-file-name)
15024                       gnus-kill-files-directory))))
15025
15026 \f
15027 ;;;
15028 ;;; Dribble file
15029 ;;;
15030
15031 (defvar gnus-dribble-ignore nil)
15032 (defvar gnus-dribble-eval-file nil)
15033
15034 (defun gnus-dribble-file-name ()
15035   "Return the dribble file for the current .newsrc."
15036   (concat
15037    (if gnus-dribble-directory
15038        (concat (file-name-as-directory gnus-dribble-directory)
15039                (file-name-nondirectory gnus-current-startup-file))
15040      gnus-current-startup-file)
15041    "-dribble"))
15042
15043 (defun gnus-dribble-enter (string)
15044   "Enter STRING into the dribble buffer."
15045   (if (and (not gnus-dribble-ignore)
15046            gnus-dribble-buffer
15047            (buffer-name gnus-dribble-buffer))
15048       (let ((obuf (current-buffer)))
15049         (set-buffer gnus-dribble-buffer)
15050         (insert string "\n")
15051         (set-window-point (get-buffer-window (current-buffer)) (point-max))
15052         (bury-buffer gnus-dribble-buffer)
15053         (set-buffer obuf))))
15054
15055 (defun gnus-dribble-read-file ()
15056   "Read the dribble file from disk."
15057   (let ((dribble-file (gnus-dribble-file-name)))
15058     (save-excursion
15059       (set-buffer (setq gnus-dribble-buffer
15060                         (get-buffer-create
15061                          (file-name-nondirectory dribble-file))))
15062       (gnus-add-current-to-buffer-list)
15063       (erase-buffer)
15064       (setq buffer-file-name dribble-file)
15065       (auto-save-mode t)
15066       (buffer-disable-undo (current-buffer))
15067       (bury-buffer (current-buffer))
15068       (set-buffer-modified-p nil)
15069       (let ((auto (make-auto-save-file-name))
15070             (gnus-dribble-ignore t)
15071             modes)
15072         (when (or (file-exists-p auto) (file-exists-p dribble-file))
15073           ;; Load whichever file is newest -- the auto save file
15074           ;; or the "real" file.
15075           (if (file-newer-than-file-p auto dribble-file)
15076               (insert-file-contents auto)
15077             (insert-file-contents dribble-file))
15078           (unless (zerop (buffer-size))
15079             (set-buffer-modified-p t))
15080           ;; Set the file modes to reflect the .newsrc file modes.
15081           (save-buffer)
15082           (when (and (file-exists-p gnus-current-startup-file)
15083                      (setq modes (file-modes gnus-current-startup-file)))
15084             (set-file-modes dribble-file modes))
15085           ;; Possibly eval the file later.
15086           (when (gnus-y-or-n-p
15087                  "Auto-save file exists.  Do you want to read it? ")
15088             (setq gnus-dribble-eval-file t)))))))
15089
15090 (defun gnus-dribble-eval-file ()
15091   (when gnus-dribble-eval-file
15092     (setq gnus-dribble-eval-file nil)
15093     (save-excursion
15094       (let ((gnus-dribble-ignore t))
15095         (set-buffer gnus-dribble-buffer)
15096         (eval-buffer (current-buffer))))))
15097
15098 (defun gnus-dribble-delete-file ()
15099   (when (file-exists-p (gnus-dribble-file-name))
15100     (delete-file (gnus-dribble-file-name)))
15101   (when gnus-dribble-buffer
15102     (save-excursion
15103       (set-buffer gnus-dribble-buffer)
15104       (let ((auto (make-auto-save-file-name)))
15105         (if (file-exists-p auto)
15106             (delete-file auto))
15107         (erase-buffer)
15108         (set-buffer-modified-p nil)))))
15109
15110 (defun gnus-dribble-save ()
15111   (when (and gnus-dribble-buffer
15112              (buffer-name gnus-dribble-buffer))
15113     (save-excursion
15114       (set-buffer gnus-dribble-buffer)
15115       (save-buffer))))
15116
15117 (defun gnus-dribble-clear ()
15118   (when (gnus-buffer-exists-p gnus-dribble-buffer)
15119     (save-excursion
15120       (set-buffer gnus-dribble-buffer)
15121       (erase-buffer)
15122       (set-buffer-modified-p nil)
15123       (setq buffer-saved-size (buffer-size)))))
15124
15125 \f
15126 ;;;
15127 ;;; Server Communication
15128 ;;;
15129
15130 (defun gnus-start-news-server (&optional confirm)
15131   "Open a method for getting news.
15132 If CONFIRM is non-nil, the user will be asked for an NNTP server."
15133   (let (how)
15134     (if gnus-current-select-method
15135         ;; Stream is already opened.
15136         nil
15137       ;; Open NNTP server.
15138       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
15139       (if confirm
15140           (progn
15141             ;; Read server name with completion.
15142             (setq gnus-nntp-server
15143                   (completing-read "NNTP server: "
15144                                    (mapcar (lambda (server) (list server))
15145                                            (cons (list gnus-nntp-server)
15146                                                  gnus-secondary-servers))
15147                                    nil nil gnus-nntp-server))))
15148
15149       (if (and gnus-nntp-server
15150                (stringp gnus-nntp-server)
15151                (not (string= gnus-nntp-server "")))
15152           (setq gnus-select-method
15153                 (cond ((or (string= gnus-nntp-server "")
15154                            (string= gnus-nntp-server "::"))
15155                        (list 'nnspool (system-name)))
15156                       ((string-match "^:" gnus-nntp-server)
15157                        (list 'nnmh gnus-nntp-server
15158                              (list 'nnmh-directory
15159                                    (file-name-as-directory
15160                                     (expand-file-name
15161                                      (concat "~/" (substring
15162                                                    gnus-nntp-server 1)))))
15163                              (list 'nnmh-get-new-mail nil)))
15164                       (t
15165                        (list 'nntp gnus-nntp-server)))))
15166
15167       (setq how (car gnus-select-method))
15168       (cond ((eq how 'nnspool)
15169              (require 'nnspool)
15170              (gnus-message 5 "Looking up local news spool..."))
15171             ((eq how 'nnmh)
15172              (require 'nnmh)
15173              (gnus-message 5 "Looking up mh spool..."))
15174             (t
15175              (require 'nntp)))
15176       (setq gnus-current-select-method gnus-select-method)
15177       (run-hooks 'gnus-open-server-hook)
15178       (or
15179        ;; gnus-open-server-hook might have opened it
15180        (gnus-server-opened gnus-select-method)
15181        (gnus-open-server gnus-select-method)
15182        (gnus-y-or-n-p
15183         (format
15184          "%s (%s) open error: '%s'.     Continue? "
15185          (car gnus-select-method) (cadr gnus-select-method)
15186          (gnus-status-message gnus-select-method)))
15187        (gnus-error 1 "Couldn't open server on %s"
15188                    (nth 1 gnus-select-method))))))
15189
15190 (defun gnus-check-group (group)
15191   "Try to make sure that the server where GROUP exists is alive."
15192   (let ((method (gnus-find-method-for-group group)))
15193     (or (gnus-server-opened method)
15194         (gnus-open-server method))))
15195
15196 (defun gnus-check-server (&optional method silent)
15197   "Check whether the connection to METHOD is down.
15198 If METHOD is nil, use `gnus-select-method'.
15199 If it is down, start it up (again)."
15200   (let ((method (or method gnus-select-method)))
15201     ;; Transform virtual server names into select methods.
15202     (when (stringp method)
15203       (setq method (gnus-server-to-method method)))
15204     (if (gnus-server-opened method)
15205         ;; The stream is already opened.
15206         t
15207       ;; Open the server.
15208       (unless silent
15209         (gnus-message 5 "Opening %s server%s..." (car method)
15210                       (if (equal (nth 1 method) "") ""
15211                         (format " on %s" (nth 1 method)))))
15212       (run-hooks 'gnus-open-server-hook)
15213       (prog1
15214           (gnus-open-server method)
15215         (unless silent
15216           (message ""))))))
15217
15218 (defun gnus-get-function (method function &optional noerror)
15219   "Return a function symbol based on METHOD and FUNCTION."
15220   ;; Translate server names into methods.
15221   (unless method
15222     (error "Attempted use of a nil select method"))
15223   (when (stringp method)
15224     (setq method (gnus-server-to-method method)))
15225   (let ((func (intern (format "%s-%s" (car method) function))))
15226     ;; If the functions isn't bound, we require the backend in
15227     ;; question.
15228     (unless (fboundp func)
15229       (require (car method))
15230       (when (and (not (fboundp func))
15231                  (not noerror))
15232         ;; This backend doesn't implement this function.
15233         (error "No such function: %s" func)))
15234     func))
15235
15236 \f
15237 ;;;
15238 ;;; Interface functions to the backends.
15239 ;;;
15240
15241 (defun gnus-open-server (method)
15242   "Open a connection to METHOD."
15243   (when (stringp method)
15244     (setq method (gnus-server-to-method method)))
15245   (let ((elem (assoc method gnus-opened-servers)))
15246     ;; If this method was previously denied, we just return nil.
15247     (if (eq (nth 1 elem) 'denied)
15248         (progn
15249           (gnus-message 1 "Denied server")
15250           nil)
15251       ;; Open the server.
15252       (let ((result
15253              (funcall (gnus-get-function method 'open-server)
15254                       (nth 1 method) (nthcdr 2 method))))
15255         ;; If this hasn't been opened before, we add it to the list.
15256         (unless elem
15257           (setq elem (list method nil)
15258                 gnus-opened-servers (cons elem gnus-opened-servers)))
15259         ;; Set the status of this server.
15260         (setcar (cdr elem) (if result 'ok 'denied))
15261         ;; Return the result from the "open" call.
15262         result))))
15263
15264 (defun gnus-close-server (method)
15265   "Close the connection to METHOD."
15266   (when (stringp method)
15267     (setq method (gnus-server-to-method method)))
15268   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
15269
15270 (defun gnus-request-list (method)
15271   "Request the active file from METHOD."
15272   (when (stringp method)
15273     (setq method (gnus-server-to-method method)))
15274   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
15275
15276 (defun gnus-request-list-newsgroups (method)
15277   "Request the newsgroups file from METHOD."
15278   (when (stringp method)
15279     (setq method (gnus-server-to-method method)))
15280   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
15281
15282 (defun gnus-request-newgroups (date method)
15283   "Request all new groups since DATE from METHOD."
15284   (when (stringp method)
15285     (setq method (gnus-server-to-method method)))
15286   (funcall (gnus-get-function method 'request-newgroups)
15287            date (nth 1 method)))
15288
15289 (defun gnus-server-opened (method)
15290   "Check whether a connection to METHOD has been opened."
15291   (when (stringp method)
15292     (setq method (gnus-server-to-method method)))
15293   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
15294
15295 (defun gnus-status-message (method)
15296   "Return the status message from METHOD.
15297 If METHOD is a string, it is interpreted as a group name.   The method
15298 this group uses will be queried."
15299   (let ((method (if (stringp method) (gnus-find-method-for-group method)
15300                   method)))
15301     (funcall (gnus-get-function method 'status-message) (nth 1 method))))
15302
15303 (defun gnus-request-group (group &optional dont-check method)
15304   "Request GROUP.  If DONT-CHECK, no information is required."
15305   (let ((method (or method (gnus-find-method-for-group group))))
15306     (when (stringp method)
15307       (setq method (gnus-server-to-method method)))
15308     (funcall (gnus-get-function method 'request-group)
15309              (gnus-group-real-name group) (nth 1 method) dont-check)))
15310
15311 (defun gnus-request-asynchronous (group &optional articles)
15312   "Request that GROUP behave asynchronously.
15313 ARTICLES is the `data' of the group."
15314   (let ((method (gnus-find-method-for-group group)))
15315     (funcall (gnus-get-function method 'request-asynchronous)
15316              (gnus-group-real-name group) (nth 1 method) articles)))
15317
15318 (defun gnus-list-active-group (group)
15319   "Request active information on GROUP."
15320   (let ((method (gnus-find-method-for-group group))
15321         (func 'list-active-group))
15322     (when (gnus-check-backend-function func group)
15323       (funcall (gnus-get-function method func)
15324                (gnus-group-real-name group) (nth 1 method)))))
15325
15326 (defun gnus-request-group-description (group)
15327   "Request a description of GROUP."
15328   (let ((method (gnus-find-method-for-group group))
15329         (func 'request-group-description))
15330     (when (gnus-check-backend-function func group)
15331       (funcall (gnus-get-function method func)
15332                (gnus-group-real-name group) (nth 1 method)))))
15333
15334 (defun gnus-close-group (group)
15335   "Request the GROUP be closed."
15336   (let ((method (gnus-find-method-for-group group)))
15337     (funcall (gnus-get-function method 'close-group)
15338              (gnus-group-real-name group) (nth 1 method))))
15339
15340 (defun gnus-retrieve-headers (articles group &optional fetch-old)
15341   "Request headers for ARTICLES in GROUP.
15342 If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
15343   (let ((method (gnus-find-method-for-group group)))
15344     (if (and gnus-use-cache (numberp (car articles)))
15345         (gnus-cache-retrieve-headers articles group fetch-old)
15346       (funcall (gnus-get-function method 'retrieve-headers)
15347                articles (gnus-group-real-name group) (nth 1 method)
15348                fetch-old))))
15349
15350 (defun gnus-retrieve-groups (groups method)
15351   "Request active information on GROUPS from METHOD."
15352   (when (stringp method)
15353     (setq method (gnus-server-to-method method)))
15354   (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
15355
15356 (defun gnus-request-type (group &optional article)
15357   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
15358   (let ((method (gnus-find-method-for-group group)))
15359     (if (not (gnus-check-backend-function 'request-type (car method)))
15360         'unknown
15361       (funcall (gnus-get-function method 'request-type)
15362                (gnus-group-real-name group) article))))
15363
15364 (defun gnus-request-update-mark (group article mark)
15365   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
15366   (let ((method (gnus-find-method-for-group group)))
15367     (if (not (gnus-check-backend-function 'request-update-mark (car method)))
15368         mark
15369       (funcall (gnus-get-function method 'request-update-mark)
15370                (gnus-group-real-name group) article mark))))
15371
15372 (defun gnus-request-article (article group &optional buffer)
15373   "Request the ARTICLE in GROUP.
15374 ARTICLE can either be an article number or an article Message-ID.
15375 If BUFFER, insert the article in that group."
15376   (let ((method (gnus-find-method-for-group group)))
15377     (funcall (gnus-get-function method 'request-article)
15378              article (gnus-group-real-name group) (nth 1 method) buffer)))
15379
15380 (defun gnus-request-head (article group)
15381   "Request the head of ARTICLE in GROUP."
15382   (let* ((method (gnus-find-method-for-group group))
15383          (head (gnus-get-function method 'request-head t)))
15384     (if (fboundp head)
15385         (funcall head article (gnus-group-real-name group) (nth 1 method))
15386       (let ((res (gnus-request-article article group)))
15387         (when res
15388           (save-excursion
15389             (set-buffer nntp-server-buffer)
15390             (goto-char (point-min))
15391             (when (search-forward "\n\n" nil t)
15392               (delete-region (1- (point)) (point-max)))
15393             (nnheader-fold-continuation-lines)))
15394         res))))
15395
15396 (defun gnus-request-body (article group)
15397   "Request the body of ARTICLE in GROUP."
15398   (let ((method (gnus-find-method-for-group group)))
15399     (funcall (gnus-get-function method 'request-body)
15400              article (gnus-group-real-name group) (nth 1 method))))
15401
15402 (defun gnus-request-post (method)
15403   "Post the current buffer using METHOD."
15404   (when (stringp method)
15405     (setq method (gnus-server-to-method method)))
15406   (funcall (gnus-get-function method 'request-post) (nth 1 method)))
15407
15408 (defun gnus-request-scan (group method)
15409   "Request a SCAN being performed in GROUP from METHOD.
15410 If GROUP is nil, all groups on METHOD are scanned."
15411   (let ((method (if group (gnus-find-method-for-group group) method)))
15412     (funcall (gnus-get-function method 'request-scan)
15413              (and group (gnus-group-real-name group)) (nth 1 method))))
15414
15415 (defsubst gnus-request-update-info (info method)
15416   "Request that METHOD update INFO."
15417   (when (stringp method)
15418     (setq method (gnus-server-to-method method)))
15419   (when (gnus-check-backend-function 'request-update-info (car method))
15420     (funcall (gnus-get-function method 'request-update-info)
15421              (gnus-group-real-name (gnus-info-group info))
15422              info (nth 1 method))))
15423
15424 (defun gnus-request-expire-articles (articles group &optional force)
15425   (let ((method (gnus-find-method-for-group group)))
15426     (funcall (gnus-get-function method 'request-expire-articles)
15427              articles (gnus-group-real-name group) (nth 1 method)
15428              force)))
15429
15430 (defun gnus-request-move-article
15431   (article group server accept-function &optional last)
15432   (let ((method (gnus-find-method-for-group group)))
15433     (funcall (gnus-get-function method 'request-move-article)
15434              article (gnus-group-real-name group)
15435              (nth 1 method) accept-function last)))
15436
15437 (defun gnus-request-accept-article (group method &optional last)
15438   ;; Make sure there's a newline at the end of the article.
15439   (when (stringp method)
15440     (setq method (gnus-server-to-method method)))
15441   (when (and (not method)
15442              (stringp group))
15443     (setq method (gnus-group-name-to-method group)))
15444   (goto-char (point-max))
15445   (unless (bolp)
15446     (insert "\n"))
15447   (let ((func (car (or method (gnus-find-method-for-group group)))))
15448     (funcall (intern (format "%s-request-accept-article" func))
15449              (if (stringp group) (gnus-group-real-name group) group)
15450              (cadr method)
15451              last)))
15452
15453 (defun gnus-request-replace-article (article group buffer)
15454   (let ((func (car (gnus-find-method-for-group group))))
15455     (funcall (intern (format "%s-request-replace-article" func))
15456              article (gnus-group-real-name group) buffer)))
15457
15458 (defun gnus-request-associate-buffer (group)
15459   (let ((method (gnus-find-method-for-group group)))
15460     (funcall (gnus-get-function method 'request-associate-buffer)
15461              (gnus-group-real-name group))))
15462
15463 (defun gnus-request-restore-buffer (article group)
15464   "Request a new buffer restored to the state of ARTICLE."
15465   (let ((method (gnus-find-method-for-group group)))
15466     (funcall (gnus-get-function method 'request-restore-buffer)
15467              article (gnus-group-real-name group) (nth 1 method))))
15468
15469 (defun gnus-request-create-group (group &optional method)
15470   (when (stringp method)
15471     (setq method (gnus-server-to-method method)))
15472   (let ((method (or method (gnus-find-method-for-group group))))
15473     (funcall (gnus-get-function method 'request-create-group)
15474              (gnus-group-real-name group) (nth 1 method))))
15475
15476 (defun gnus-request-delete-group (group &optional force)
15477   (let ((method (gnus-find-method-for-group group)))
15478     (funcall (gnus-get-function method 'request-delete-group)
15479              (gnus-group-real-name group) force (nth 1 method))))
15480
15481 (defun gnus-request-rename-group (group new-name)
15482   (let ((method (gnus-find-method-for-group group)))
15483     (funcall (gnus-get-function method 'request-rename-group)
15484              (gnus-group-real-name group)
15485              (gnus-group-real-name new-name) (nth 1 method))))
15486
15487 (defun gnus-member-of-valid (symbol group)
15488   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
15489   (memq symbol (assoc
15490                 (symbol-name (car (gnus-find-method-for-group group)))
15491                 gnus-valid-select-methods)))
15492
15493 (defun gnus-method-option-p (method option)
15494   "Return non-nil if select METHOD has OPTION as a parameter."
15495   (when (stringp method)
15496     (setq method (gnus-server-to-method method)))
15497   (memq option (assoc (format "%s" (car method))
15498                       gnus-valid-select-methods)))
15499
15500 (defun gnus-server-extend-method (group method)
15501   ;; This function "extends" a virtual server.  If the server is
15502   ;; "hello", and the select method is ("hello" (my-var "something"))
15503   ;; in the group "alt.alt", this will result in a new virtual server
15504   ;; called "hello+alt.alt".
15505   (let ((entry
15506          (gnus-copy-sequence
15507           (if (equal (car method) "native") gnus-select-method
15508             (cdr (assoc (car method) gnus-server-alist))))))
15509     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
15510     (nconc entry (cdr method))))
15511
15512 (defun gnus-server-status (method)
15513   "Return the status of METHOD."
15514   (nth 1 (assoc method gnus-opened-servers)))
15515
15516 (defun gnus-group-name-to-method (group)
15517   "Return a select method suitable for GROUP."
15518   (if (string-match ":" group)
15519       (let ((server (substring group 0 (match-beginning 0))))
15520         (if (string-match "\\+" server)
15521             (list (intern (substring server 0 (match-beginning 0)))
15522                   (substring server (match-end 0)))
15523           (list (intern server) "")))
15524     gnus-select-method))
15525
15526 (defun gnus-find-method-for-group (group &optional info)
15527   "Find the select method that GROUP uses."
15528   (or gnus-override-method
15529       (and (not group)
15530            gnus-select-method)
15531       (let ((info (or info (gnus-get-info group)))
15532             method)
15533         (if (or (not info)
15534                 (not (setq method (gnus-info-method info)))
15535                 (equal method "native"))
15536             gnus-select-method
15537           (setq method
15538                 (cond ((stringp method)
15539                        (gnus-server-to-method method))
15540                       ((stringp (car method))
15541                        (gnus-server-extend-method group method))
15542                       (t
15543                        method)))
15544           (cond ((equal (cadr method) "")
15545                  method)
15546                 ((null (cadr method))
15547                  (list (car method) ""))
15548                 (t
15549                  (gnus-server-add-address method)))))))
15550
15551 (defun gnus-check-backend-function (func group)
15552   "Check whether GROUP supports function FUNC."
15553   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
15554                   group)))
15555     (fboundp (intern (format "%s-%s" method func)))))
15556
15557 (defun gnus-methods-using (feature)
15558   "Find all methods that have FEATURE."
15559   (let ((valids gnus-valid-select-methods)
15560         outs)
15561     (while valids
15562       (if (memq feature (car valids))
15563           (setq outs (cons (car valids) outs)))
15564       (setq valids (cdr valids)))
15565     outs))
15566
15567 \f
15568 ;;;
15569 ;;; Active & Newsrc File Handling
15570 ;;;
15571
15572 (defun gnus-setup-news (&optional rawfile level dont-connect)
15573   "Setup news information.
15574 If RAWFILE is non-nil, the .newsrc file will also be read.
15575 If LEVEL is non-nil, the news will be set up at level LEVEL."
15576   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
15577
15578     (when init 
15579       ;; Clear some variables to re-initialize news information.
15580       (setq gnus-newsrc-alist nil
15581             gnus-active-hashtb nil)
15582       ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
15583       (gnus-read-newsrc-file rawfile))
15584
15585     (when (and (not (assoc "archive" gnus-server-alist))
15586                (gnus-archive-server-wanted-p))
15587       (push (cons "archive" gnus-message-archive-method)
15588             gnus-server-alist))
15589
15590     ;; If we don't read the complete active file, we fill in the
15591     ;; hashtb here.
15592     (if (or (null gnus-read-active-file)
15593             (eq gnus-read-active-file 'some))
15594         (gnus-update-active-hashtb-from-killed))
15595
15596     ;; Read the active file and create `gnus-active-hashtb'.
15597     ;; If `gnus-read-active-file' is nil, then we just create an empty
15598     ;; hash table.  The partial filling out of the hash table will be
15599     ;; done in `gnus-get-unread-articles'.
15600     (and gnus-read-active-file
15601          (not level)
15602          (gnus-read-active-file))
15603
15604     (or gnus-active-hashtb
15605         (setq gnus-active-hashtb (make-vector 4095 0)))
15606
15607     ;; Initialize the cache.
15608     (when gnus-use-cache
15609       (gnus-cache-open))
15610
15611     ;; Possibly eval the dribble file.
15612     (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
15613
15614     ;; Slave Gnusii should then clear the dribble buffer.
15615     (when (and init gnus-slave)
15616       (gnus-dribble-clear))
15617
15618     (gnus-update-format-specifications)
15619
15620     ;; See whether we need to read the description file.
15621     (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
15622              (not gnus-description-hashtb)
15623              (not dont-connect)
15624              gnus-read-active-file)
15625         (gnus-read-all-descriptions-files))
15626
15627     ;; Find new newsgroups and treat them.
15628     (if (and init gnus-check-new-newsgroups (not level)
15629              (gnus-check-server gnus-select-method))
15630         (gnus-find-new-newsgroups))
15631
15632     ;; We might read in new NoCeM messages here.
15633     (when (and gnus-use-nocem 
15634                (not level)
15635                (not dont-connect))
15636       (gnus-nocem-scan-groups))
15637
15638     ;; Find the number of unread articles in each non-dead group.
15639     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
15640       (gnus-get-unread-articles level))
15641
15642     (if (and init gnus-check-bogus-newsgroups
15643              gnus-read-active-file (not level)
15644              (gnus-server-opened gnus-select-method))
15645         (gnus-check-bogus-newsgroups))))
15646
15647 (defun gnus-find-new-newsgroups (&optional arg)
15648   "Search for new newsgroups and add them.
15649 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
15650 The `-n' option line from .newsrc is respected.
15651 If ARG (the prefix), use the `ask-server' method to query
15652 the server for new groups."
15653   (interactive "P")
15654   (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups)))
15655                        (null gnus-read-active-file)
15656                        (eq gnus-read-active-file 'some))
15657                    'ask-server gnus-check-new-newsgroups)))
15658     (unless (gnus-check-first-time-used)
15659       (if (or (consp check)
15660               (eq check 'ask-server))
15661           ;; Ask the server for new groups.
15662           (gnus-ask-server-for-new-groups)
15663         ;; Go through the active hashtb and look for new groups.
15664         (let ((groups 0)
15665               group new-newsgroups)
15666           (gnus-message 5 "Looking for new newsgroups...")
15667           (unless gnus-have-read-active-file
15668             (gnus-read-active-file))
15669           (setq gnus-newsrc-last-checked-date (current-time-string))
15670           (unless gnus-killed-hashtb
15671             (gnus-make-hashtable-from-killed))
15672           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
15673           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
15674           (mapatoms
15675            (lambda (sym)
15676              (if (or (null (setq group (symbol-name sym)))
15677                      (not (boundp sym))
15678                      (null (symbol-value sym))
15679                      (gnus-gethash group gnus-killed-hashtb)
15680                      (gnus-gethash group gnus-newsrc-hashtb))
15681                  ()
15682                (let ((do-sub (gnus-matches-options-n group)))
15683                  (cond
15684                   ((eq do-sub 'subscribe)
15685                    (setq groups (1+ groups))
15686                    (gnus-sethash group group gnus-killed-hashtb)
15687                    (funcall gnus-subscribe-options-newsgroup-method group))
15688                   ((eq do-sub 'ignore)
15689                    nil)
15690                   (t
15691                    (setq groups (1+ groups))
15692                    (gnus-sethash group group gnus-killed-hashtb)
15693                    (if gnus-subscribe-hierarchical-interactive
15694                        (setq new-newsgroups (cons group new-newsgroups))
15695                      (funcall gnus-subscribe-newsgroup-method group)))))))
15696            gnus-active-hashtb)
15697           (when new-newsgroups
15698             (gnus-subscribe-hierarchical-interactive new-newsgroups))
15699           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
15700           (if (> groups 0)
15701               (gnus-message 6 "%d new newsgroup%s arrived."
15702                             groups (if (> groups 1) "s have" " has"))
15703             (gnus-message 6 "No new newsgroups.")))))))
15704
15705 (defun gnus-matches-options-n (group)
15706   ;; Returns `subscribe' if the group is to be unconditionally
15707   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
15708   ;; no match for the group.
15709
15710   ;; First we check the two user variables.
15711   (cond
15712    ((and gnus-options-subscribe
15713          (string-match gnus-options-subscribe group))
15714     'subscribe)
15715    ((and gnus-auto-subscribed-groups
15716          (string-match gnus-auto-subscribed-groups group))
15717     'subscribe)
15718    ((and gnus-options-not-subscribe
15719          (string-match gnus-options-not-subscribe group))
15720     'ignore)
15721    ;; Then we go through the list that was retrieved from the .newsrc
15722    ;; file.  This list has elements on the form
15723    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
15724    ;; is in the reverse order of the options line) is returned.
15725    (t
15726     (let ((regs gnus-newsrc-options-n))
15727       (while (and regs
15728                   (not (string-match (caar regs) group)))
15729         (setq regs (cdr regs)))
15730       (and regs (cdar regs))))))
15731
15732 (defun gnus-ask-server-for-new-groups ()
15733   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
15734          (methods (cons gnus-select-method
15735                         (nconc
15736                          (when (gnus-archive-server-wanted-p)
15737                            (list "archive"))
15738                          (append
15739                           (and (consp gnus-check-new-newsgroups)
15740                                gnus-check-new-newsgroups)
15741                           gnus-secondary-select-methods))))
15742          (groups 0)
15743          (new-date (current-time-string))
15744          group new-newsgroups got-new method hashtb
15745          gnus-override-subscribe-method)
15746     ;; Go through both primary and secondary select methods and
15747     ;; request new newsgroups.
15748     (while (setq method (gnus-server-get-method nil (pop methods)))
15749       (setq new-newsgroups nil)
15750       (setq gnus-override-subscribe-method method)
15751       (when (and (gnus-check-server method)
15752                  (gnus-request-newgroups date method))
15753         (save-excursion
15754           (setq got-new t)
15755           (setq hashtb (gnus-make-hashtable 100))
15756           (set-buffer nntp-server-buffer)
15757           ;; Enter all the new groups into a hashtable.
15758           (gnus-active-to-gnus-format method hashtb 'ignore))
15759         ;; Now all new groups from `method' are in `hashtb'.
15760         (mapatoms
15761          (lambda (group-sym)
15762            (if (or (null (setq group (symbol-name group-sym)))
15763                    (not (boundp group-sym))
15764                    (null (symbol-value group-sym))
15765                    (gnus-gethash group gnus-newsrc-hashtb)
15766                    (member group gnus-zombie-list)
15767                    (member group gnus-killed-list))
15768                ;; The group is already known.
15769                ()
15770              ;; Make this group active.
15771              (when (symbol-value group-sym)
15772                (gnus-set-active group (symbol-value group-sym)))
15773              ;; Check whether we want it or not.
15774              (let ((do-sub (gnus-matches-options-n group)))
15775                (cond
15776                 ((eq do-sub 'subscribe)
15777                  (incf groups)
15778                  (gnus-sethash group group gnus-killed-hashtb)
15779                  (funcall gnus-subscribe-options-newsgroup-method group))
15780                 ((eq do-sub 'ignore)
15781                  nil)
15782                 (t
15783                  (incf groups)
15784                  (gnus-sethash group group gnus-killed-hashtb)
15785                  (if gnus-subscribe-hierarchical-interactive
15786                      (push group new-newsgroups)
15787                    (funcall gnus-subscribe-newsgroup-method group)))))))
15788          hashtb))
15789       (when new-newsgroups
15790         (gnus-subscribe-hierarchical-interactive new-newsgroups)))
15791     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
15792     (when (> groups 0)
15793       (gnus-message 6 "%d new newsgroup%s arrived."
15794                     groups (if (> groups 1) "s have" " has")))
15795     (and got-new (setq gnus-newsrc-last-checked-date new-date))
15796     got-new))
15797
15798 (defun gnus-check-first-time-used ()
15799   (if (or (> (length gnus-newsrc-alist) 1)
15800           (file-exists-p gnus-startup-file)
15801           (file-exists-p (concat gnus-startup-file ".el"))
15802           (file-exists-p (concat gnus-startup-file ".eld")))
15803       nil
15804     (gnus-message 6 "First time user; subscribing you to default groups")
15805     (unless (gnus-read-active-file-p)
15806       (gnus-read-active-file))
15807     (setq gnus-newsrc-last-checked-date (current-time-string))
15808     (let ((groups gnus-default-subscribed-newsgroups)
15809           group)
15810       (if (eq groups t)
15811           nil
15812         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
15813         (mapatoms
15814          (lambda (sym)
15815            (if (null (setq group (symbol-name sym)))
15816                ()
15817              (let ((do-sub (gnus-matches-options-n group)))
15818                (cond
15819                 ((eq do-sub 'subscribe)
15820                  (gnus-sethash group group gnus-killed-hashtb)
15821                  (funcall gnus-subscribe-options-newsgroup-method group))
15822                 ((eq do-sub 'ignore)
15823                  nil)
15824                 (t
15825                  (setq gnus-killed-list (cons group gnus-killed-list)))))))
15826          gnus-active-hashtb)
15827         (while groups
15828           (if (gnus-active (car groups))
15829               (gnus-group-change-level
15830                (car groups) gnus-level-default-subscribed gnus-level-killed))
15831           (setq groups (cdr groups)))
15832         (gnus-group-make-help-group)
15833         (and gnus-novice-user
15834              (gnus-message 7 "`A k' to list killed groups"))))))
15835
15836 (defun gnus-subscribe-group (group previous &optional method)
15837   (gnus-group-change-level
15838    (if method
15839        (list t group gnus-level-default-subscribed nil nil method)
15840      group)
15841    gnus-level-default-subscribed gnus-level-killed previous t))
15842
15843 ;; `gnus-group-change-level' is the fundamental function for changing
15844 ;; subscription levels of newsgroups.  This might mean just changing
15845 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
15846 ;; again, which subscribes/unsubscribes a group, which is equally
15847 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
15848 ;; from 8-9 to 1-7 means that you remove the group from the list of
15849 ;; killed (or zombie) groups and add them to the (kinda) subscribed
15850 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
15851 ;; which is trivial.
15852 ;; ENTRY can either be a string (newsgroup name) or a list (if
15853 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
15854 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
15855 ;; entries.
15856 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
15857 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
15858 ;; after.
15859 (defun gnus-group-change-level (entry level &optional oldlevel
15860                                       previous fromkilled)
15861   (let (group info active num)
15862     ;; Glean what info we can from the arguments
15863     (if (consp entry)
15864         (if fromkilled (setq group (nth 1 entry))
15865           (setq group (car (nth 2 entry))))
15866       (setq group entry))
15867     (if (and (stringp entry)
15868              oldlevel
15869              (< oldlevel gnus-level-zombie))
15870         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
15871     (if (and (not oldlevel)
15872              (consp entry))
15873         (setq oldlevel (gnus-info-level (nth 2 entry)))
15874       (setq oldlevel (or oldlevel 9)))
15875     (if (stringp previous)
15876         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
15877
15878     (if (and (>= oldlevel gnus-level-zombie)
15879              (gnus-gethash group gnus-newsrc-hashtb))
15880         ;; We are trying to subscribe a group that is already
15881         ;; subscribed.
15882         ()                              ; Do nothing.
15883
15884       (or (gnus-ephemeral-group-p group)
15885           (gnus-dribble-enter
15886            (format "(gnus-group-change-level %S %S %S %S %S)"
15887                    group level oldlevel (car (nth 2 previous)) fromkilled)))
15888
15889       ;; Then we remove the newgroup from any old structures, if needed.
15890       ;; If the group was killed, we remove it from the killed or zombie
15891       ;; list.  If not, and it is in fact going to be killed, we remove
15892       ;; it from the newsrc hash table and assoc.
15893       (cond
15894        ((>= oldlevel gnus-level-zombie)
15895         (if (= oldlevel gnus-level-zombie)
15896             (setq gnus-zombie-list (delete group gnus-zombie-list))
15897           (setq gnus-killed-list (delete group gnus-killed-list))))
15898        (t
15899         (if (and (>= level gnus-level-zombie)
15900                  entry)
15901             (progn
15902               (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
15903               (if (nth 3 entry)
15904                   (setcdr (gnus-gethash (car (nth 3 entry))
15905                                         gnus-newsrc-hashtb)
15906                           (cdr entry)))
15907               (setcdr (cdr entry) (cdddr entry))))))
15908
15909       ;; Finally we enter (if needed) the list where it is supposed to
15910       ;; go, and change the subscription level.  If it is to be killed,
15911       ;; we enter it into the killed or zombie list.
15912       (cond 
15913        ((>= level gnus-level-zombie)
15914         ;; Remove from the hash table.
15915         (gnus-sethash group nil gnus-newsrc-hashtb)
15916         ;; We do not enter foreign groups into the list of dead
15917         ;; groups.
15918         (unless (gnus-group-foreign-p group)
15919           (if (= level gnus-level-zombie)
15920               (setq gnus-zombie-list (cons group gnus-zombie-list))
15921             (setq gnus-killed-list (cons group gnus-killed-list)))))
15922        (t
15923         ;; If the list is to be entered into the newsrc assoc, and
15924         ;; it was killed, we have to create an entry in the newsrc
15925         ;; hashtb format and fix the pointers in the newsrc assoc.
15926         (if (< oldlevel gnus-level-zombie)
15927             ;; It was alive, and it is going to stay alive, so we
15928             ;; just change the level and don't change any pointers or
15929             ;; hash table entries.
15930             (setcar (cdaddr entry) level)
15931           (if (listp entry)
15932               (setq info (cdr entry)
15933                     num (car entry))
15934             (setq active (gnus-active group))
15935             (setq num
15936                   (if active (- (1+ (cdr active)) (car active)) t))
15937             ;; Check whether the group is foreign.  If so, the
15938             ;; foreign select method has to be entered into the
15939             ;; info.
15940             (let ((method (or gnus-override-subscribe-method
15941                               (gnus-group-method group))))
15942               (if (eq method gnus-select-method)
15943                   (setq info (list group level nil))
15944                 (setq info (list group level nil nil method)))))
15945           (unless previous
15946             (setq previous
15947                   (let ((p gnus-newsrc-alist))
15948                     (while (cddr p)
15949                       (setq p (cdr p)))
15950                     p)))
15951           (setq entry (cons info (cddr previous)))
15952           (if (cdr previous)
15953               (progn
15954                 (setcdr (cdr previous) entry)
15955                 (gnus-sethash group (cons num (cdr previous))
15956                               gnus-newsrc-hashtb))
15957             (setcdr previous entry)
15958             (gnus-sethash group (cons num previous)
15959                           gnus-newsrc-hashtb))
15960           (when (cdr entry)
15961             (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)))))
15962       (when gnus-group-change-level-function
15963         (funcall gnus-group-change-level-function group level oldlevel)))))
15964
15965 (defun gnus-kill-newsgroup (newsgroup)
15966   "Obsolete function.  Kills a newsgroup."
15967   (gnus-group-change-level
15968    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
15969
15970 (defun gnus-check-bogus-newsgroups (&optional confirm)
15971   "Remove bogus newsgroups.
15972 If CONFIRM is non-nil, the user has to confirm the deletion of every
15973 newsgroup."
15974   (let ((newsrc (cdr gnus-newsrc-alist))
15975         bogus group entry info)
15976     (gnus-message 5 "Checking bogus newsgroups...")
15977     (unless (gnus-read-active-file-p)
15978       (gnus-read-active-file))
15979     (when (gnus-read-active-file-p)
15980       ;; Find all bogus newsgroup that are subscribed.
15981       (while newsrc
15982         (setq info (pop newsrc)
15983               group (gnus-info-group info))
15984         (unless (or (gnus-active group) ; Active
15985                     (gnus-info-method info) ; Foreign
15986                     (and confirm
15987                          (not (gnus-y-or-n-p
15988                                (format "Remove bogus newsgroup: %s " group)))))
15989           ;; Found a bogus newsgroup.
15990           (push group bogus)))
15991       ;; Remove all bogus subscribed groups by first killing them, and
15992       ;; then removing them from the list of killed groups.
15993       (while bogus
15994         (when (setq entry (gnus-gethash (setq group (pop bogus))
15995                                         gnus-newsrc-hashtb))
15996           (gnus-group-change-level entry gnus-level-killed)
15997           (setq gnus-killed-list (delete group gnus-killed-list))))
15998       ;; Then we remove all bogus groups from the list of killed and
15999       ;; zombie groups.  They are removed without confirmation.
16000       (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
16001             killed)
16002         (while dead-lists
16003           (setq killed (symbol-value (car dead-lists)))
16004           (while killed
16005             (unless (gnus-active (setq group (pop killed)))
16006               ;; The group is bogus.
16007               ;; !!!Slow as hell.
16008               (set (car dead-lists)
16009                    (delete group (symbol-value (car dead-lists))))))
16010           (setq dead-lists (cdr dead-lists))))
16011       (run-hooks 'gnus-check-bogus-groups-hook)
16012       (gnus-message 5 "Checking bogus newsgroups...done"))))
16013
16014 (defun gnus-check-duplicate-killed-groups ()
16015   "Remove duplicates from the list of killed groups."
16016   (interactive)
16017   (let ((killed gnus-killed-list))
16018     (while killed
16019       (gnus-message 9 "%d" (length killed))
16020       (setcdr killed (delete (car killed) (cdr killed)))
16021       (setq killed (cdr killed)))))
16022
16023 ;; We want to inline a function from gnus-cache, so we cheat here:
16024 (eval-when-compile
16025   (provide 'gnus)
16026   (setq gnus-directory (or (getenv "SAVEDIR") "~/News/"))
16027   (require 'gnus-cache))
16028
16029 (defun gnus-get-unread-articles-in-group (info active &optional update)
16030   (when active
16031     ;; Allow the backend to update the info in the group.
16032     (when (and update 
16033                (gnus-request-update-info
16034                 info (gnus-find-method-for-group (gnus-info-group info))))
16035       (gnus-activate-group (gnus-info-group info) nil t))
16036     (let* ((range (gnus-info-read info))
16037            (num 0))
16038       ;; If a cache is present, we may have to alter the active info.
16039       (when (and gnus-use-cache info)
16040         (inline (gnus-cache-possibly-alter-active 
16041                  (gnus-info-group info) active)))
16042       ;; Modify the list of read articles according to what articles
16043       ;; are available; then tally the unread articles and add the
16044       ;; number to the group hash table entry.
16045       (cond
16046        ((zerop (cdr active))
16047         (setq num 0))
16048        ((not range)
16049         (setq num (- (1+ (cdr active)) (car active))))
16050        ((not (listp (cdr range)))
16051         ;; Fix a single (num . num) range according to the
16052         ;; active hash table.
16053         ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
16054         (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
16055         (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
16056         ;; Compute number of unread articles.
16057         (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
16058        (t
16059         ;; The read list is a list of ranges.  Fix them according to
16060         ;; the active hash table.
16061         ;; First peel off any elements that are below the lower
16062         ;; active limit.
16063         (while (and (cdr range)
16064                     (>= (car active)
16065                         (or (and (atom (cadr range)) (cadr range))
16066                             (caadr range))))
16067           (if (numberp (car range))
16068               (setcar range
16069                       (cons (car range)
16070                             (or (and (numberp (cadr range))
16071                                      (cadr range))
16072                                 (cdadr range))))
16073             (setcdr (car range)
16074                     (or (and (numberp (nth 1 range)) (nth 1 range))
16075                         (cdadr range))))
16076           (setcdr range (cddr range)))
16077         ;; Adjust the first element to be the same as the lower limit.
16078         (if (and (not (atom (car range)))
16079                  (< (cdar range) (car active)))
16080             (setcdr (car range) (1- (car active))))
16081         ;; Then we want to peel off any elements that are higher
16082         ;; than the upper active limit.
16083         (let ((srange range))
16084           ;; Go past all legal elements.
16085           (while (and (cdr srange)
16086                       (<= (or (and (atom (cadr srange))
16087                                    (cadr srange))
16088                               (caadr srange)) (cdr active)))
16089             (setq srange (cdr srange)))
16090           (if (cdr srange)
16091               ;; Nuke all remaining illegal elements.
16092               (setcdr srange nil))
16093
16094           ;; Adjust the final element.
16095           (if (and (not (atom (car srange)))
16096                    (> (cdar srange) (cdr active)))
16097               (setcdr (car srange) (cdr active))))
16098         ;; Compute the number of unread articles.
16099         (while range
16100           (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
16101                                       (cdar range)))
16102                               (or (and (atom (car range)) (car range))
16103                                   (caar range)))))
16104           (setq range (cdr range)))
16105         (setq num (max 0 (- (cdr active) num)))))
16106       ;; Set the number of unread articles.
16107       (when info
16108         (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
16109       num)))
16110
16111 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
16112 ;; and compute how many unread articles there are in each group.
16113 (defun gnus-get-unread-articles (&optional level)
16114   (let* ((newsrc (cdr gnus-newsrc-alist))
16115          (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
16116          (foreign-level
16117           (min
16118            (cond ((and gnus-activate-foreign-newsgroups
16119                        (not (numberp gnus-activate-foreign-newsgroups)))
16120                   (1+ gnus-level-subscribed))
16121                  ((numberp gnus-activate-foreign-newsgroups)
16122                   gnus-activate-foreign-newsgroups)
16123                  (t 0))
16124            level))
16125          info group active method)
16126     (gnus-message 5 "Checking new news...")
16127
16128     (while newsrc
16129       (setq active (gnus-active (setq group (gnus-info-group
16130                                              (setq info (pop newsrc))))))
16131
16132       ;; Check newsgroups.  If the user doesn't want to check them, or
16133       ;; they can't be checked (for instance, if the news server can't
16134       ;; be reached) we just set the number of unread articles in this
16135       ;; newsgroup to t.  This means that Gnus thinks that there are
16136       ;; unread articles, but it has no idea how many.
16137       (if (and (setq method (gnus-info-method info))
16138                (not (gnus-server-equal
16139                      gnus-select-method
16140                      (setq method (gnus-server-get-method nil method))))
16141                (not (gnus-secondary-method-p method)))
16142           ;; These groups are foreign.  Check the level.
16143           (when (<= (gnus-info-level info) foreign-level)
16144             (setq active (gnus-activate-group group 'scan))
16145             (unless (inline (gnus-virtual-group-p group))
16146               (inline (gnus-close-group group)))
16147             (when (fboundp (intern (concat (symbol-name (car method))
16148                                            "-request-update-info")))
16149               (inline (gnus-request-update-info info method))))
16150         ;; These groups are native or secondary.
16151         (when (and (<= (gnus-info-level info) level)
16152                    (not gnus-read-active-file))
16153           (setq active (gnus-activate-group group 'scan))
16154           (inline (gnus-close-group group))))
16155
16156       ;; Get the number of unread articles in the group.
16157       (if active
16158           (inline (gnus-get-unread-articles-in-group info active))
16159         ;; The group couldn't be reached, so we nix out the number of
16160         ;; unread articles and stuff.
16161         (gnus-set-active group nil)
16162         (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
16163
16164     (gnus-message 5 "Checking new news...done")))
16165
16166 ;; Create a hash table out of the newsrc alist.  The `car's of the
16167 ;; alist elements are used as keys.
16168 (defun gnus-make-hashtable-from-newsrc-alist ()
16169   (let ((alist gnus-newsrc-alist)
16170         (ohashtb gnus-newsrc-hashtb)
16171         prev)
16172     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
16173     (setq alist
16174           (setq prev (setq gnus-newsrc-alist
16175                            (if (equal (caar gnus-newsrc-alist)
16176                                       "dummy.group")
16177                                gnus-newsrc-alist
16178                              (cons (list "dummy.group" 0 nil) alist)))))
16179     (while alist
16180       (gnus-sethash
16181        (caar alist)
16182        (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
16183              prev)
16184        gnus-newsrc-hashtb)
16185       (setq prev alist
16186             alist (cdr alist)))))
16187
16188 (defun gnus-make-hashtable-from-killed ()
16189   "Create a hash table from the killed and zombie lists."
16190   (let ((lists '(gnus-killed-list gnus-zombie-list))
16191         list)
16192     (setq gnus-killed-hashtb
16193           (gnus-make-hashtable
16194            (+ (length gnus-killed-list) (length gnus-zombie-list))))
16195     (while (setq list (pop lists))
16196       (setq list (symbol-value list))
16197       (while list
16198         (gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
16199
16200 (defun gnus-activate-group (group &optional scan dont-check method)
16201   ;; Check whether a group has been activated or not.
16202   ;; If SCAN, request a scan of that group as well.
16203   (let ((method (or method (gnus-find-method-for-group group)))
16204         active)
16205     (and (gnus-check-server method)
16206          ;; We escape all bugs and quit here to make it possible to
16207          ;; continue if a group is so out-there that it reports bugs
16208          ;; and stuff.
16209          (progn
16210            (and scan
16211                 (gnus-check-backend-function 'request-scan (car method))
16212                 (gnus-request-scan group method))
16213            t)
16214          (condition-case ()
16215              (gnus-request-group group dont-check method)
16216         ;   (error nil)
16217            (quit nil))
16218          (save-excursion
16219            (set-buffer nntp-server-buffer)
16220            (goto-char (point-min))
16221            ;; Parse the result we got from `gnus-request-group'.
16222            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
16223                 (progn
16224                   (goto-char (match-beginning 1))
16225                   (gnus-set-active
16226                    group (setq active (cons (read (current-buffer))
16227                                             (read (current-buffer)))))
16228                   ;; Return the new active info.
16229                   active))))))
16230
16231 (defun gnus-update-read-articles (group unread)
16232   "Update the list of read and ticked articles in GROUP using the
16233 UNREAD and TICKED lists.
16234 Note: UNSELECTED has to be sorted over `<'.
16235 Returns whether the updating was successful."
16236   (let* ((active (or gnus-newsgroup-active (gnus-active group)))
16237          (entry (gnus-gethash group gnus-newsrc-hashtb))
16238          (info (nth 2 entry))
16239          (prev 1)
16240          (unread (sort (copy-sequence unread) '<))
16241          read)
16242     (if (or (not info) (not active))
16243         ;; There is no info on this group if it was, in fact,
16244         ;; killed.  Gnus stores no information on killed groups, so
16245         ;; there's nothing to be done.
16246         ;; One could store the information somewhere temporarily,
16247         ;; perhaps...  Hmmm...
16248         ()
16249       ;; Remove any negative articles numbers.
16250       (while (and unread (< (car unread) 0))
16251         (setq unread (cdr unread)))
16252       ;; Remove any expired article numbers
16253       (while (and unread (< (car unread) (car active)))
16254         (setq unread (cdr unread)))
16255       ;; Compute the ranges of read articles by looking at the list of
16256       ;; unread articles.
16257       (while unread
16258         (if (/= (car unread) prev)
16259             (setq read (cons (if (= prev (1- (car unread))) prev
16260                                (cons prev (1- (car unread)))) read)))
16261         (setq prev (1+ (car unread)))
16262         (setq unread (cdr unread)))
16263       (when (<= prev (cdr active))
16264         (setq read (cons (cons prev (cdr active)) read)))
16265       ;; Enter this list into the group info.
16266       (gnus-info-set-read
16267        info (if (> (length read) 1) (nreverse read) read))
16268       ;; Set the number of unread articles in gnus-newsrc-hashtb.
16269       (gnus-get-unread-articles-in-group info (gnus-active group))
16270       t)))
16271
16272 (defun gnus-make-articles-unread (group articles)
16273   "Mark ARTICLES in GROUP as unread."
16274   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
16275                           (gnus-gethash (gnus-group-real-name group)
16276                                         gnus-newsrc-hashtb))))
16277          (ranges (gnus-info-read info))
16278          news article)
16279     (while articles
16280       (when (gnus-member-of-range
16281              (setq article (pop articles)) ranges)
16282         (setq news (cons article news))))
16283     (when news
16284       (gnus-info-set-read
16285        info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
16286       (gnus-group-update-group group t))))
16287
16288 ;; Enter all dead groups into the hashtb.
16289 (defun gnus-update-active-hashtb-from-killed ()
16290   (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
16291         (lists (list gnus-killed-list gnus-zombie-list))
16292         killed)
16293     (while lists
16294       (setq killed (car lists))
16295       (while killed
16296         (gnus-sethash (car killed) nil hashtb)
16297         (setq killed (cdr killed)))
16298       (setq lists (cdr lists)))))
16299
16300 (defun gnus-get-killed-groups ()
16301   "Go through the active hashtb and mark all unknown groups as killed."
16302   ;; First make sure active file has been read.
16303   (unless (gnus-read-active-file-p)
16304     (let ((gnus-read-active-file t))
16305       (gnus-read-active-file)))
16306   (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
16307   ;; Go through all newsgroups that are known to Gnus - enlarge kill list.
16308   (mapatoms
16309    (lambda (sym)
16310      (let ((groups 0)
16311            (group (symbol-name sym)))
16312        (if (or (null group)
16313                (gnus-gethash group gnus-killed-hashtb)
16314                (gnus-gethash group gnus-newsrc-hashtb))
16315            ()
16316          (let ((do-sub (gnus-matches-options-n group)))
16317            (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
16318                ()
16319              (setq groups (1+ groups))
16320              (setq gnus-killed-list
16321                    (cons group gnus-killed-list))
16322              (gnus-sethash group group gnus-killed-hashtb))))))
16323    gnus-active-hashtb))
16324
16325 ;; Get the active file(s) from the backend(s).
16326 (defun gnus-read-active-file ()
16327   (gnus-group-set-mode-line)
16328   (let ((methods 
16329          (append
16330           (if (gnus-check-server gnus-select-method)
16331               ;; The native server is available.
16332               (cons gnus-select-method gnus-secondary-select-methods)
16333             ;; The native server is down, so we just do the
16334             ;; secondary ones.
16335             gnus-secondary-select-methods)
16336           ;; Also read from the archive server.
16337           (when (gnus-archive-server-wanted-p)
16338             (list "archive"))))
16339         list-type)
16340     (setq gnus-have-read-active-file nil)
16341     (save-excursion
16342       (set-buffer nntp-server-buffer)
16343       (while methods
16344         (let* ((method (if (stringp (car methods))
16345                            (gnus-server-get-method nil (car methods))
16346                          (car methods)))
16347                (where (nth 1 method))
16348                (mesg (format "Reading active file%s via %s..."
16349                              (if (and where (not (zerop (length where))))
16350                                  (concat " from " where) "")
16351                              (car method))))
16352           (gnus-message 5 mesg)
16353           (when (gnus-check-server method)
16354             ;; Request that the backend scan its incoming messages.
16355             (and (gnus-check-backend-function 'request-scan (car method))
16356                  (gnus-request-scan nil method))
16357             (cond
16358              ((and (eq gnus-read-active-file 'some)
16359                    (gnus-check-backend-function 'retrieve-groups (car method)))
16360               (let ((newsrc (cdr gnus-newsrc-alist))
16361                     (gmethod (gnus-server-get-method nil method))
16362                     groups info)
16363                 (while (setq info (pop newsrc))
16364                   (when (gnus-server-equal
16365                          (gnus-find-method-for-group 
16366                           (gnus-info-group info) info)
16367                          gmethod)
16368                     (push (gnus-group-real-name (gnus-info-group info)) 
16369                           groups)))
16370                 (when groups
16371                   (gnus-check-server method)
16372                   (setq list-type (gnus-retrieve-groups groups method))
16373                   (cond
16374                    ((not list-type)
16375                     (gnus-error
16376                      1.2 "Cannot read partial active file from %s server."
16377                      (car method)))
16378                    ((eq list-type 'active)
16379                     (gnus-active-to-gnus-format method gnus-active-hashtb))
16380                    (t
16381                     (gnus-groups-to-gnus-format method gnus-active-hashtb))))))
16382              (t
16383               (if (not (gnus-request-list method))
16384                   (unless (equal method gnus-message-archive-method)
16385                     (gnus-error 1 "Cannot read active file from %s server."
16386                                 (car method)))
16387                 (gnus-message 5 mesg)
16388                 (gnus-active-to-gnus-format method gnus-active-hashtb)
16389                 ;; We mark this active file as read.
16390                 (push method gnus-have-read-active-file)
16391                 (gnus-message 5 "%sdone" mesg))))))
16392         (setq methods (cdr methods))))))
16393
16394 ;; Read an active file and place the results in `gnus-active-hashtb'.
16395 (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors)
16396   (unless method
16397     (setq method gnus-select-method))
16398   (let ((cur (current-buffer))
16399         (hashtb (or hashtb
16400                     (if (and gnus-active-hashtb
16401                              (not (equal method gnus-select-method)))
16402                         gnus-active-hashtb
16403                       (setq gnus-active-hashtb
16404                             (if (equal method gnus-select-method)
16405                                 (gnus-make-hashtable
16406                                  (count-lines (point-min) (point-max)))
16407                               (gnus-make-hashtable 4096)))))))
16408     ;; Delete unnecessary lines.
16409     (goto-char (point-min))
16410     (while (search-forward "\nto." nil t)
16411       (delete-region (1+ (match-beginning 0))
16412                      (progn (forward-line 1) (point))))
16413     (or (string= gnus-ignored-newsgroups "")
16414         (progn
16415           (goto-char (point-min))
16416           (delete-matching-lines gnus-ignored-newsgroups)))
16417     ;; Make the group names readable as a lisp expression even if they
16418     ;; contain special characters.
16419     ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
16420     (goto-char (point-max))
16421     (while (re-search-backward "[][';?()#]" nil t)
16422       (insert ?\\))
16423     ;; If these are groups from a foreign select method, we insert the
16424     ;; group prefix in front of the group names.
16425     (and method (not (gnus-server-equal
16426                       (gnus-server-get-method nil method)
16427                       (gnus-server-get-method nil gnus-select-method)))
16428          (let ((prefix (gnus-group-prefixed-name "" method)))
16429            (goto-char (point-min))
16430            (while (and (not (eobp))
16431                        (progn (insert prefix)
16432                               (zerop (forward-line 1)))))))
16433     ;; Store the active file in a hash table.
16434     (goto-char (point-min))
16435     (if (string-match "%[oO]" gnus-group-line-format)
16436         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
16437         ;; If we want information on moderated groups, we use this
16438         ;; loop...
16439         (let* ((mod-hashtb (make-vector 7 0))
16440                (m (intern "m" mod-hashtb))
16441                group max min)
16442           (while (not (eobp))
16443             (condition-case nil
16444                 (progn
16445                   (narrow-to-region (point) (gnus-point-at-eol))
16446                   (setq group (let ((obarray hashtb)) (read cur)))
16447                   (if (and (numberp (setq max (read cur)))
16448                            (numberp (setq min (read cur)))
16449                            (progn
16450                              (skip-chars-forward " \t")
16451                              (not
16452                               (or (= (following-char) ?=)
16453                                   (= (following-char) ?x)
16454                                   (= (following-char) ?j)))))
16455                       (set group (cons min max))
16456                     (set group nil))
16457                   ;; Enter moderated groups into a list.
16458                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
16459                       (setq gnus-moderated-list
16460                             (cons (symbol-name group) gnus-moderated-list))))
16461               (error
16462                (and group
16463                     (symbolp group)
16464                     (set group nil))))
16465             (widen)
16466             (forward-line 1)))
16467       ;; And if we do not care about moderation, we use this loop,
16468       ;; which is faster.
16469       (let (group max min)
16470         (while (not (eobp))
16471           (condition-case ()
16472               (progn
16473                 (narrow-to-region (point) (gnus-point-at-eol))
16474                 ;; group gets set to a symbol interned in the hash table
16475                 ;; (what a hack!!) - jwz
16476                 (setq group (let ((obarray hashtb)) (read cur)))
16477                 (if (and (numberp (setq max (read cur)))
16478                          (numberp (setq min (read cur)))
16479                          (progn
16480                            (skip-chars-forward " \t")
16481                            (not
16482                             (or (= (following-char) ?=)
16483                                 (= (following-char) ?x)
16484                                 (= (following-char) ?j)))))
16485                     (set group (cons min max))
16486                   (set group nil)))
16487             (error
16488              (progn
16489                (and group
16490                     (symbolp group)
16491                     (set group nil))
16492                (or ignore-errors
16493                    (gnus-message 3 "Warning - illegal active: %s"
16494                                  (buffer-substring
16495                                   (gnus-point-at-bol) (gnus-point-at-eol)))))))
16496           (widen)
16497           (forward-line 1))))))
16498
16499 (defun gnus-groups-to-gnus-format (method &optional hashtb)
16500   ;; Parse a "groups" active file.
16501   (let ((cur (current-buffer))
16502         (hashtb (or hashtb
16503                     (if (and method gnus-active-hashtb)
16504                         gnus-active-hashtb
16505                       (setq gnus-active-hashtb
16506                             (gnus-make-hashtable
16507                              (count-lines (point-min) (point-max)))))))
16508         (prefix (and method
16509                      (not (gnus-server-equal
16510                            (gnus-server-get-method nil method)
16511                            (gnus-server-get-method nil gnus-select-method)))
16512                      (gnus-group-prefixed-name "" method))))
16513
16514     (goto-char (point-min))
16515     ;; We split this into to separate loops, one with the prefix
16516     ;; and one without to speed the reading up somewhat.
16517     (if prefix
16518         (let (min max opoint group)
16519           (while (not (eobp))
16520             (condition-case ()
16521                 (progn
16522                   (read cur) (read cur)
16523                   (setq min (read cur)
16524                         max (read cur)
16525                         opoint (point))
16526                   (skip-chars-forward " \t")
16527                   (insert prefix)
16528                   (goto-char opoint)
16529                   (set (let ((obarray hashtb)) (read cur))
16530                        (cons min max)))
16531               (error (and group (symbolp group) (set group nil))))
16532             (forward-line 1)))
16533       (let (min max group)
16534         (while (not (eobp))
16535           (condition-case ()
16536               (if (= (following-char) ?2)
16537                   (progn
16538                     (read cur) (read cur)
16539                     (setq min (read cur)
16540                           max (read cur))
16541                     (set (setq group (let ((obarray hashtb)) (read cur)))
16542                          (cons min max))))
16543             (error (and group (symbolp group) (set group nil))))
16544           (forward-line 1))))))
16545
16546 (defun gnus-read-newsrc-file (&optional force)
16547   "Read startup file.
16548 If FORCE is non-nil, the .newsrc file is read."
16549   ;; Reset variables that might be defined in the .newsrc.eld file.
16550   (let ((variables gnus-variable-list))
16551     (while variables
16552       (set (car variables) nil)
16553       (setq variables (cdr variables))))
16554   (let* ((newsrc-file gnus-current-startup-file)
16555          (quick-file (concat newsrc-file ".el")))
16556     (save-excursion
16557       ;; We always load the .newsrc.eld file.  If always contains
16558       ;; much information that can not be gotten from the .newsrc
16559       ;; file (ticked articles, killed groups, foreign methods, etc.)
16560       (gnus-read-newsrc-el-file quick-file)
16561
16562       (if (and (file-exists-p gnus-current-startup-file)
16563                (or force
16564                    (and (file-newer-than-file-p newsrc-file quick-file)
16565                         (file-newer-than-file-p newsrc-file
16566                                                 (concat quick-file "d")))
16567                    (not gnus-newsrc-alist)))
16568           ;; We read the .newsrc file.  Note that if there if a
16569           ;; .newsrc.eld file exists, it has already been read, and
16570           ;; the `gnus-newsrc-hashtb' has been created.  While reading
16571           ;; the .newsrc file, Gnus will only use the information it
16572           ;; can find there for changing the data already read -
16573           ;; ie. reading the .newsrc file will not trash the data
16574           ;; already read (except for read articles).
16575           (save-excursion
16576             (gnus-message 5 "Reading %s..." newsrc-file)
16577             (set-buffer (find-file-noselect newsrc-file))
16578             (buffer-disable-undo (current-buffer))
16579             (gnus-newsrc-to-gnus-format)
16580             (kill-buffer (current-buffer))
16581             (gnus-message 5 "Reading %s...done" newsrc-file)))
16582
16583       ;; Read any slave files.
16584       (unless gnus-slave
16585         (gnus-master-read-slave-newsrc))
16586       
16587       ;; Convert old to new.
16588       (gnus-convert-old-newsrc))))
16589
16590 (defun gnus-continuum-version (version)
16591   "Return VERSION as a floating point number."
16592   (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
16593             (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
16594     (let* ((alpha (and (match-beginning 1) (match-string 1 version)))
16595            (number (match-string 2 version))
16596            major minor least)
16597       (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
16598       (setq major (string-to-number (match-string 1 number)))
16599       (setq minor (string-to-number (match-string 2 number)))
16600       (setq least (if (match-beginning 3)
16601                       (string-to-number (match-string 3 number))
16602                     0))
16603       (string-to-number
16604        (if (zerop major)
16605            (format "%s00%02d%02d"
16606                    (cond 
16607                     ((member alpha '("(ding)" "d")) "4.99")
16608                     ((member alpha '("September" "s")) "5.01")
16609                     ((member alpha '("Red" "r")) "5.03"))
16610                    minor least)
16611          (format "%d.%02d%02d" major minor least))))))
16612
16613 (defun gnus-convert-old-newsrc ()
16614   "Convert old newsrc into the new format, if needed."
16615   (let ((fcv (and gnus-newsrc-file-version
16616                   (gnus-continuum-version gnus-newsrc-file-version))))
16617     (cond
16618      ;; No .newsrc.eld file was loaded.
16619      ((null fcv) nil)
16620      ;; Gnus 5 .newsrc.eld was loaded.
16621      ((< fcv (gnus-continuum-version "September Gnus v0.1"))
16622       (gnus-convert-old-ticks)))))
16623
16624 (defun gnus-convert-old-ticks ()
16625   (let ((newsrc (cdr gnus-newsrc-alist))
16626         marks info dormant ticked)
16627     (while (setq info (pop newsrc))
16628       (when (setq marks (gnus-info-marks info))
16629         (setq dormant (cdr (assq 'dormant marks))
16630               ticked (cdr (assq 'tick marks)))
16631         (when (or dormant ticked)
16632           (gnus-info-set-read
16633            info
16634            (gnus-add-to-range
16635             (gnus-info-read info)
16636             (nconc (gnus-uncompress-range dormant)
16637                    (gnus-uncompress-range ticked)))))))))
16638
16639 (defun gnus-read-newsrc-el-file (file)
16640   (let ((ding-file (concat file "d")))
16641     ;; We always, always read the .eld file.
16642     (gnus-message 5 "Reading %s..." ding-file)
16643     (let (gnus-newsrc-assoc)
16644       (condition-case nil
16645           (load ding-file t t t)
16646         (error
16647          (gnus-error 1 "Error in %s" ding-file)))
16648       (when gnus-newsrc-assoc
16649         (setq gnus-newsrc-alist gnus-newsrc-assoc)))
16650     (gnus-make-hashtable-from-newsrc-alist)
16651     (when (file-newer-than-file-p file ding-file)
16652       ;; Old format quick file
16653       (gnus-message 5 "Reading %s..." file)
16654       ;; The .el file is newer than the .eld file, so we read that one
16655       ;; as well.
16656       (gnus-read-old-newsrc-el-file file))))
16657
16658 ;; Parse the old-style quick startup file
16659 (defun gnus-read-old-newsrc-el-file (file)
16660   (let (newsrc killed marked group m info)
16661     (prog1
16662         (let ((gnus-killed-assoc nil)
16663               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
16664           (prog1
16665               (condition-case nil
16666                   (load file t t t)
16667                 (error nil))
16668             (setq newsrc gnus-newsrc-assoc
16669                   killed gnus-killed-assoc
16670                   marked gnus-marked-assoc)))
16671       (setq gnus-newsrc-alist nil)
16672       (while (setq group (pop newsrc))
16673         (if (setq info (gnus-get-info (car group)))
16674             (progn
16675               (gnus-info-set-read info (cddr group))
16676               (gnus-info-set-level
16677                info (if (nth 1 group) gnus-level-default-subscribed
16678                       gnus-level-default-unsubscribed))
16679               (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
16680           (push (setq info
16681                       (list (car group)
16682                             (if (nth 1 group) gnus-level-default-subscribed
16683                               gnus-level-default-unsubscribed)
16684                             (cddr group)))
16685                 gnus-newsrc-alist))
16686         ;; Copy marks into info.
16687         (when (setq m (assoc (car group) marked))
16688           (unless (nthcdr 3 info)
16689             (nconc info (list nil)))
16690           (gnus-info-set-marks
16691            info (list (cons 'tick (gnus-compress-sequence 
16692                                    (sort (cdr m) '<) t))))))
16693       (setq newsrc killed)
16694       (while newsrc
16695         (setcar newsrc (caar newsrc))
16696         (setq newsrc (cdr newsrc)))
16697       (setq gnus-killed-list killed))
16698     ;; The .el file version of this variable does not begin with
16699     ;; "options", while the .eld version does, so we just add it if it
16700     ;; isn't there.
16701     (and
16702      gnus-newsrc-options
16703      (progn
16704        (and (not (string-match "^ *options" gnus-newsrc-options))
16705             (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
16706        (and (not (string-match "\n$" gnus-newsrc-options))
16707             (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
16708        ;; Finally, if we read some options lines, we parse them.
16709        (or (string= gnus-newsrc-options "")
16710            (gnus-newsrc-parse-options gnus-newsrc-options))))
16711
16712     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
16713     (gnus-make-hashtable-from-newsrc-alist)))
16714
16715 (defun gnus-make-newsrc-file (file)
16716   "Make server dependent file name by catenating FILE and server host name."
16717   (let* ((file (expand-file-name file nil))
16718          (real-file (concat file "-" (nth 1 gnus-select-method))))
16719     (if (or (file-exists-p real-file)
16720             (file-exists-p (concat real-file ".el"))
16721             (file-exists-p (concat real-file ".eld")))
16722         real-file file)))
16723
16724 (defun gnus-newsrc-to-gnus-format ()
16725   (setq gnus-newsrc-options "")
16726   (setq gnus-newsrc-options-n nil)
16727
16728   (or gnus-active-hashtb
16729       (setq gnus-active-hashtb (make-vector 4095 0)))
16730   (let ((buf (current-buffer))
16731         (already-read (> (length gnus-newsrc-alist) 1))
16732         group subscribed options-symbol newsrc Options-symbol
16733         symbol reads num1)
16734     (goto-char (point-min))
16735     ;; We intern the symbol `options' in the active hashtb so that we
16736     ;; can `eq' against it later.
16737     (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
16738     (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
16739
16740     (while (not (eobp))
16741       ;; We first read the first word on the line by narrowing and
16742       ;; then reading into `gnus-active-hashtb'.  Most groups will
16743       ;; already exist in that hashtb, so this will save some string
16744       ;; space.
16745       (narrow-to-region
16746        (point)
16747        (progn (skip-chars-forward "^ \t!:\n") (point)))
16748       (goto-char (point-min))
16749       (setq symbol
16750             (and (/= (point-min) (point-max))
16751                  (let ((obarray gnus-active-hashtb)) (read buf))))
16752       (widen)
16753       ;; Now, the symbol we have read is either `options' or a group
16754       ;; name.  If it is an options line, we just add it to a string.
16755       (cond
16756        ((or (eq symbol options-symbol)
16757             (eq symbol Options-symbol))
16758         (setq gnus-newsrc-options
16759               ;; This concating is quite inefficient, but since our
16760               ;; thorough studies show that approx 99.37% of all
16761               ;; .newsrc files only contain a single options line, we
16762               ;; don't give a damn, frankly, my dear.
16763               (concat gnus-newsrc-options
16764                       (buffer-substring
16765                        (gnus-point-at-bol)
16766                        ;; Options may continue on the next line.
16767                        (or (and (re-search-forward "^[^ \t]" nil 'move)
16768                                 (progn (beginning-of-line) (point)))
16769                            (point)))))
16770         (forward-line -1))
16771        (symbol
16772         ;; Group names can be just numbers.  
16773         (when (numberp symbol) 
16774           (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
16775         (or (boundp symbol) (set symbol nil))
16776         ;; It was a group name.
16777         (setq subscribed (= (following-char) ?:)
16778               group (symbol-name symbol)
16779               reads nil)
16780         (if (eolp)
16781             ;; If the line ends here, this is clearly a buggy line, so
16782             ;; we put point a the beginning of line and let the cond
16783             ;; below do the error handling.
16784             (beginning-of-line)
16785           ;; We skip to the beginning of the ranges.
16786           (skip-chars-forward "!: \t"))
16787         ;; We are now at the beginning of the list of read articles.
16788         ;; We read them range by range.
16789         (while
16790             (cond
16791              ((looking-at "[0-9]+")
16792               ;; We narrow and read a number instead of buffer-substring/
16793               ;; string-to-int because it's faster.  narrow/widen is
16794               ;; faster than save-restriction/narrow, and save-restriction
16795               ;; produces a garbage object.
16796               (setq num1 (progn
16797                            (narrow-to-region (match-beginning 0) (match-end 0))
16798                            (read buf)))
16799               (widen)
16800               ;; If the next character is a dash, then this is a range.
16801               (if (= (following-char) ?-)
16802                   (progn
16803                     ;; We read the upper bound of the range.
16804                     (forward-char 1)
16805                     (if (not (looking-at "[0-9]+"))
16806                         ;; This is a buggy line, by we pretend that
16807                         ;; it's kinda OK.  Perhaps the user should be
16808                         ;; dinged?
16809                         (setq reads (cons num1 reads))
16810                       (setq reads
16811                             (cons
16812                              (cons num1
16813                                    (progn
16814                                      (narrow-to-region (match-beginning 0)
16815                                                        (match-end 0))
16816                                      (read buf)))
16817                              reads))
16818                       (widen)))
16819                 ;; It was just a simple number, so we add it to the
16820                 ;; list of ranges.
16821                 (setq reads (cons num1 reads)))
16822               ;; If the next char in ?\n, then we have reached the end
16823               ;; of the line and return nil.
16824               (/= (following-char) ?\n))
16825              ((= (following-char) ?\n)
16826               ;; End of line, so we end.
16827               nil)
16828              (t
16829               ;; Not numbers and not eol, so this might be a buggy
16830               ;; line...
16831               (or (eobp)
16832                   ;; If it was eob instead of ?\n, we allow it.
16833                   (progn
16834                     ;; The line was buggy.
16835                     (setq group nil)
16836                     (gnus-error 3.1 "Mangled line: %s"
16837                                 (buffer-substring (gnus-point-at-bol)
16838                                                   (gnus-point-at-eol)))))
16839               nil))
16840           ;; Skip past ", ".  Spaces are illegal in these ranges, but
16841           ;; we allow them, because it's a common mistake to put a
16842           ;; space after the comma.
16843           (skip-chars-forward ", "))
16844
16845         ;; We have already read .newsrc.eld, so we gently update the
16846         ;; data in the hash table with the information we have just
16847         ;; read.
16848         (when group
16849           (let ((info (gnus-get-info group))
16850                 level)
16851             (if info
16852                 ;; There is an entry for this file in the alist.
16853                 (progn
16854                   (gnus-info-set-read info (nreverse reads))
16855                   ;; We update the level very gently.  In fact, we
16856                   ;; only change it if there's been a status change
16857                   ;; from subscribed to unsubscribed, or vice versa.
16858                   (setq level (gnus-info-level info))
16859                   (cond ((and (<= level gnus-level-subscribed)
16860                               (not subscribed))
16861                          (setq level (if reads
16862                                          gnus-level-default-unsubscribed
16863                                        (1+ gnus-level-default-unsubscribed))))
16864                         ((and (> level gnus-level-subscribed) subscribed)
16865                          (setq level gnus-level-default-subscribed)))
16866                   (gnus-info-set-level info level))
16867               ;; This is a new group.
16868               (setq info (list group
16869                                (if subscribed
16870                                    gnus-level-default-subscribed
16871                                  (if reads
16872                                      (1+ gnus-level-subscribed)
16873                                    gnus-level-default-unsubscribed))
16874                                (nreverse reads))))
16875             (setq newsrc (cons info newsrc))))))
16876       (forward-line 1))
16877
16878     (setq newsrc (nreverse newsrc))
16879
16880     (if (not already-read)
16881         ()
16882       ;; We now have two newsrc lists - `newsrc', which is what we
16883       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
16884       ;; what we've read from .newsrc.eld.  We have to merge these
16885       ;; lists.  We do this by "attaching" any (foreign) groups in the
16886       ;; gnus-newsrc-alist to the (native) group that precedes them.
16887       (let ((rc (cdr gnus-newsrc-alist))
16888             (prev gnus-newsrc-alist)
16889             entry mentry)
16890         (while rc
16891           (or (null (nth 4 (car rc)))   ; It's a native group.
16892               (assoc (caar rc) newsrc) ; It's already in the alist.
16893               (if (setq entry (assoc (caar prev) newsrc))
16894                   (setcdr (setq mentry (memq entry newsrc))
16895                           (cons (car rc) (cdr mentry)))
16896                 (setq newsrc (cons (car rc) newsrc))))
16897           (setq prev rc
16898                 rc (cdr rc)))))
16899
16900     (setq gnus-newsrc-alist newsrc)
16901     ;; We make the newsrc hashtb.
16902     (gnus-make-hashtable-from-newsrc-alist)
16903
16904     ;; Finally, if we read some options lines, we parse them.
16905     (or (string= gnus-newsrc-options "")
16906         (gnus-newsrc-parse-options gnus-newsrc-options))))
16907
16908 ;; Parse options lines to find "options -n !all rec.all" and stuff.
16909 ;; The return value will be a list on the form
16910 ;; ((regexp1 . ignore)
16911 ;;  (regexp2 . subscribe)...)
16912 ;; When handling new newsgroups, groups that match a `ignore' regexp
16913 ;; will be ignored, and groups that match a `subscribe' regexp will be
16914 ;; subscribed.  A line like
16915 ;; options -n !all rec.all
16916 ;; will lead to a list that looks like
16917 ;; (("^rec\\..+" . subscribe)
16918 ;;  ("^.+" . ignore))
16919 ;; So all "rec.*" groups will be subscribed, while all the other
16920 ;; groups will be ignored.  Note that "options -n !all rec.all" is very
16921 ;; different from "options -n rec.all !all".
16922 (defun gnus-newsrc-parse-options (options)
16923   (let (out eol)
16924     (save-excursion
16925       (gnus-set-work-buffer)
16926       (insert (regexp-quote options))
16927       ;; First we treat all continuation lines.
16928       (goto-char (point-min))
16929       (while (re-search-forward "\n[ \t]+" nil t)
16930         (replace-match " " t t))
16931       ;; Then we transform all "all"s into ".+"s.
16932       (goto-char (point-min))
16933       (while (re-search-forward "\\ball\\b" nil t)
16934         (replace-match ".+" t t))
16935       (goto-char (point-min))
16936       ;; We remove all other options than the "-n" ones.
16937       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
16938         (replace-match " ")
16939         (forward-char -1))
16940       (goto-char (point-min))
16941
16942       ;; We are only interested in "options -n" lines - we
16943       ;; ignore the other option lines.
16944       (while (re-search-forward "[ \t]-n" nil t)
16945         (setq eol
16946               (or (save-excursion
16947                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
16948                          (- (point) 2)))
16949                   (gnus-point-at-eol)))
16950         ;; Search for all "words"...
16951         (while (re-search-forward "[^ \t,\n]+" eol t)
16952           (if (= (char-after (match-beginning 0)) ?!)
16953               ;; If the word begins with a bang (!), this is a "not"
16954               ;; spec.  We put this spec (minus the bang) and the
16955               ;; symbol `ignore' into the list.
16956               (setq out (cons (cons (concat
16957                                      "^" (buffer-substring
16958                                           (1+ (match-beginning 0))
16959                                           (match-end 0)))
16960                                     'ignore) out))
16961             ;; There was no bang, so this is a "yes" spec.
16962             (setq out (cons (cons (concat "^" (match-string 0))
16963                                   'subscribe) out)))))
16964
16965       (setq gnus-newsrc-options-n out))))
16966
16967 (defun gnus-save-newsrc-file (&optional force)
16968   "Save .newsrc file."
16969   ;; Note: We cannot save .newsrc file if all newsgroups are removed
16970   ;; from the variable gnus-newsrc-alist.
16971   (when (and (or gnus-newsrc-alist gnus-killed-list)
16972              gnus-current-startup-file)
16973     (save-excursion
16974       (if (and (or gnus-use-dribble-file gnus-slave)
16975                (not force)
16976                (or (not gnus-dribble-buffer)
16977                    (not (buffer-name gnus-dribble-buffer))
16978                    (zerop (save-excursion
16979                             (set-buffer gnus-dribble-buffer)
16980                             (buffer-size)))))
16981           (gnus-message 4 "(No changes need to be saved)")
16982         (run-hooks 'gnus-save-newsrc-hook)
16983         (if gnus-slave
16984             (gnus-slave-save-newsrc)
16985           ;; Save .newsrc.
16986           (when gnus-save-newsrc-file
16987             (gnus-message 5 "Saving %s..." gnus-current-startup-file)
16988             (gnus-gnus-to-newsrc-format)
16989             (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
16990           ;; Save .newsrc.eld.
16991           (set-buffer (get-buffer-create " *Gnus-newsrc*"))
16992           (make-local-variable 'version-control)
16993           (setq version-control 'never)
16994           (setq buffer-file-name
16995                 (concat gnus-current-startup-file ".eld"))
16996           (setq default-directory (file-name-directory buffer-file-name))
16997           (gnus-add-current-to-buffer-list)
16998           (buffer-disable-undo (current-buffer))
16999           (erase-buffer)
17000           (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
17001           (gnus-gnus-to-quick-newsrc-format)
17002           (run-hooks 'gnus-save-quick-newsrc-hook)
17003           (save-buffer)
17004           (kill-buffer (current-buffer))
17005           (gnus-message
17006            5 "Saving %s.eld...done" gnus-current-startup-file))
17007         (gnus-dribble-delete-file)
17008         (gnus-group-set-mode-line)))))
17009
17010 (defun gnus-gnus-to-quick-newsrc-format ()
17011   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
17012   (insert ";; Gnus startup file.\n")
17013   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
17014   (insert ";; to read .newsrc.\n")
17015   (insert "(setq gnus-newsrc-file-version "
17016           (prin1-to-string gnus-version) ")\n")
17017   (let ((variables
17018          (if gnus-save-killed-list gnus-variable-list
17019            ;; Remove the `gnus-killed-list' from the list of variables
17020            ;; to be saved, if required.
17021            (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
17022         ;; Peel off the "dummy" group.
17023         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
17024         variable)
17025     ;; Insert the variables into the file.
17026     (while variables
17027       (when (and (boundp (setq variable (pop variables)))
17028                  (symbol-value variable))
17029         (insert "(setq " (symbol-name variable) " '")
17030         (prin1 (symbol-value variable) (current-buffer))
17031         (insert ")\n")))))
17032
17033 (defun gnus-gnus-to-newsrc-format ()
17034   ;; Generate and save the .newsrc file.
17035   (save-excursion
17036     (set-buffer (create-file-buffer gnus-current-startup-file))
17037     (let ((newsrc (cdr gnus-newsrc-alist))
17038           (standard-output (current-buffer))
17039           info ranges range method)
17040       (setq buffer-file-name gnus-current-startup-file)
17041       (setq default-directory (file-name-directory buffer-file-name))
17042       (buffer-disable-undo (current-buffer))
17043       (erase-buffer)
17044       ;; Write options.
17045       (if gnus-newsrc-options (insert gnus-newsrc-options))
17046       ;; Write subscribed and unsubscribed.
17047       (while (setq info (pop newsrc))
17048         ;; Don't write foreign groups to .newsrc.
17049         (when (or (null (setq method (gnus-info-method info)))
17050                   (equal method "native")
17051                   (gnus-server-equal method gnus-select-method))
17052           (insert (gnus-info-group info)
17053                   (if (> (gnus-info-level info) gnus-level-subscribed)
17054                       "!" ":"))
17055           (when (setq ranges (gnus-info-read info))
17056             (insert " ")
17057             (if (not (listp (cdr ranges)))
17058                 (if (= (car ranges) (cdr ranges))
17059                     (princ (car ranges))
17060                   (princ (car ranges))
17061                   (insert "-")
17062                   (princ (cdr ranges)))
17063               (while (setq range (pop ranges))
17064                 (if (or (atom range) (= (car range) (cdr range)))
17065                     (princ (or (and (atom range) range) (car range)))
17066                   (princ (car range))
17067                   (insert "-")
17068                   (princ (cdr range)))
17069                 (if ranges (insert ",")))))
17070           (insert "\n")))
17071       (make-local-variable 'version-control)
17072       (setq version-control 'never)
17073       ;; It has been reported that sometime the modtime on the .newsrc
17074       ;; file seems to be off.  We really do want to overwrite it, so
17075       ;; we clear the modtime here before saving.  It's a bit odd,
17076       ;; though...
17077       ;; sometimes the modtime clear isn't sufficient.  most brute force:
17078       ;; delete the silly thing entirely first.  but this fails to provide
17079       ;; such niceties as .newsrc~ creation.
17080       (if gnus-modtime-botch
17081           (delete-file gnus-startup-file)
17082         (clear-visited-file-modtime))
17083       (run-hooks 'gnus-save-standard-newsrc-hook)
17084       (save-buffer)
17085       (kill-buffer (current-buffer)))))
17086
17087 \f
17088 ;;;
17089 ;;; Slave functions.
17090 ;;;
17091
17092 (defun gnus-slave-save-newsrc ()
17093   (save-excursion
17094     (set-buffer gnus-dribble-buffer)
17095     (let ((slave-name
17096            (make-temp-name (concat gnus-current-startup-file "-slave-"))))
17097       (write-region (point-min) (point-max) slave-name nil 'nomesg))))
17098
17099 (defun gnus-master-read-slave-newsrc ()
17100   (let ((slave-files
17101          (directory-files
17102           (file-name-directory gnus-current-startup-file)
17103           t (concat
17104              "^" (regexp-quote
17105                   (concat
17106                    (file-name-nondirectory gnus-current-startup-file)
17107                    "-slave-")))
17108           t))
17109         file)
17110     (if (not slave-files)
17111         ()                              ; There are no slave files to read.
17112       (gnus-message 7 "Reading slave newsrcs...")
17113       (save-excursion
17114         (set-buffer (get-buffer-create " *gnus slave*"))
17115         (buffer-disable-undo (current-buffer))
17116         (setq slave-files
17117               (sort (mapcar (lambda (file)
17118                               (list (nth 5 (file-attributes file)) file))
17119                             slave-files)
17120                     (lambda (f1 f2)
17121                       (or (< (caar f1) (caar f2))
17122                           (< (nth 1 (car f1)) (nth 1 (car f2)))))))
17123         (while slave-files
17124           (erase-buffer)
17125           (setq file (nth 1 (car slave-files)))
17126           (insert-file-contents file)
17127           (if (condition-case ()
17128                   (progn
17129                     (eval-buffer (current-buffer))
17130                     t)
17131                 (error
17132                  (gnus-error 3.2 "Possible error in %s" file)
17133                  nil))
17134               (or gnus-slave ; Slaves shouldn't delete these files.
17135                   (condition-case ()
17136                       (delete-file file)
17137                     (error nil))))
17138           (setq slave-files (cdr slave-files))))
17139       (gnus-message 7 "Reading slave newsrcs...done"))))
17140
17141 \f
17142 ;;;
17143 ;;; Group description.
17144 ;;;
17145
17146 (defun gnus-read-all-descriptions-files ()
17147   (let ((methods (cons gnus-select-method 
17148                        (nconc
17149                         (when (gnus-archive-server-wanted-p)
17150                           (list "archive"))
17151                         gnus-secondary-select-methods))))
17152     (while methods
17153       (gnus-read-descriptions-file (car methods))
17154       (setq methods (cdr methods)))
17155     t))
17156
17157 (defun gnus-read-descriptions-file (&optional method)
17158   (let ((method (or method gnus-select-method))
17159         group)
17160     (when (stringp method)
17161       (setq method (gnus-server-to-method method)))
17162     ;; We create the hashtable whether we manage to read the desc file
17163     ;; to avoid trying to re-read after a failed read.
17164     (or gnus-description-hashtb
17165         (setq gnus-description-hashtb
17166               (gnus-make-hashtable (length gnus-active-hashtb))))
17167     ;; Mark this method's desc file as read.
17168     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
17169                   gnus-description-hashtb)
17170
17171     (gnus-message 5 "Reading descriptions file via %s..." (car method))
17172     (cond
17173      ((not (gnus-check-server method))
17174       (gnus-message 1 "Couldn't open server")
17175       nil)
17176      ((not (gnus-request-list-newsgroups method))
17177       (gnus-message 1 "Couldn't read newsgroups descriptions")
17178       nil)
17179      (t
17180       (save-excursion
17181         (save-restriction
17182           (set-buffer nntp-server-buffer)
17183           (goto-char (point-min))
17184           (when (or (search-forward "\n.\n" nil t)
17185                     (goto-char (point-max)))
17186             (beginning-of-line)
17187             (narrow-to-region (point-min) (point)))
17188           ;; If these are groups from a foreign select method, we insert the
17189           ;; group prefix in front of the group names.
17190           (and method (not (gnus-server-equal
17191                             (gnus-server-get-method nil method)
17192                             (gnus-server-get-method nil gnus-select-method)))
17193                (let ((prefix (gnus-group-prefixed-name "" method)))
17194                  (goto-char (point-min))
17195                  (while (and (not (eobp))
17196                              (progn (insert prefix)
17197                                     (zerop (forward-line 1)))))))
17198           (goto-char (point-min))
17199           (while (not (eobp))
17200             ;; If we get an error, we set group to 0, which is not a
17201             ;; symbol...
17202             (setq group
17203                   (condition-case ()
17204                       (let ((obarray gnus-description-hashtb))
17205                         ;; Group is set to a symbol interned in this
17206                         ;; hash table.
17207                         (read nntp-server-buffer))
17208                     (error 0)))
17209             (skip-chars-forward " \t")
17210             ;; ...  which leads to this line being effectively ignored.
17211             (and (symbolp group)
17212                  (set group (buffer-substring
17213                              (point) (progn (end-of-line) (point)))))
17214             (forward-line 1))))
17215       (gnus-message 5 "Reading descriptions file...done")
17216       t))))
17217
17218 (defun gnus-group-get-description (group)
17219   "Get the description of a group by sending XGTITLE to the server."
17220   (when (gnus-request-group-description group)
17221     (save-excursion
17222       (set-buffer nntp-server-buffer)
17223       (goto-char (point-min))
17224       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
17225         (match-string 1)))))
17226
17227 \f
17228 ;;;
17229 ;;; Buffering of read articles.
17230 ;;;
17231
17232 (defvar gnus-backlog-buffer " *Gnus Backlog*")
17233 (defvar gnus-backlog-articles nil)
17234 (defvar gnus-backlog-hashtb nil)
17235
17236 (defun gnus-backlog-buffer ()
17237   "Return the backlog buffer."
17238   (or (get-buffer gnus-backlog-buffer)
17239       (save-excursion
17240         (set-buffer (get-buffer-create gnus-backlog-buffer))
17241         (buffer-disable-undo (current-buffer))
17242         (setq buffer-read-only t)
17243         (gnus-add-current-to-buffer-list)
17244         (get-buffer gnus-backlog-buffer))))
17245
17246 (defun gnus-backlog-setup ()
17247   "Initialize backlog variables."
17248   (unless gnus-backlog-hashtb
17249     (setq gnus-backlog-hashtb (make-vector 1023 0))))
17250
17251 (gnus-add-shutdown 'gnus-backlog-shutdown 'gnus)
17252
17253 (defun gnus-backlog-shutdown ()
17254   "Clear all backlog variables and buffers."
17255   (when (get-buffer gnus-backlog-buffer)
17256     (kill-buffer gnus-backlog-buffer))
17257   (setq gnus-backlog-hashtb nil
17258         gnus-backlog-articles nil))
17259
17260 (defun gnus-backlog-enter-article (group number buffer)
17261   (gnus-backlog-setup)
17262   (let ((ident (intern (concat group ":" (int-to-string number))
17263                        gnus-backlog-hashtb))
17264         b)
17265     (if (memq ident gnus-backlog-articles)
17266         () ; It's already kept.
17267       ;; Remove the oldest article, if necessary.
17268       (and (numberp gnus-keep-backlog)
17269            (>= (length gnus-backlog-articles) gnus-keep-backlog)
17270            (gnus-backlog-remove-oldest-article))
17271       (setq gnus-backlog-articles (cons ident gnus-backlog-articles))
17272       ;; Insert the new article.
17273       (save-excursion
17274         (set-buffer (gnus-backlog-buffer))
17275         (let (buffer-read-only)
17276           (goto-char (point-max))
17277           (or (bolp) (insert "\n"))
17278           (setq b (point))
17279           (insert-buffer-substring buffer)
17280           ;; Tag the beginning of the article with the ident.
17281           (gnus-put-text-property b (1+ b) 'gnus-backlog ident))))))
17282
17283 (defun gnus-backlog-remove-oldest-article ()
17284   (save-excursion
17285     (set-buffer (gnus-backlog-buffer))
17286     (goto-char (point-min))
17287     (if (zerop (buffer-size))
17288         () ; The buffer is empty.
17289       (let ((ident (get-text-property (point) 'gnus-backlog))
17290             buffer-read-only)
17291         ;; Remove the ident from the list of articles.
17292         (when ident
17293           (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
17294         ;; Delete the article itself.
17295         (delete-region
17296          (point) (next-single-property-change
17297                   (1+ (point)) 'gnus-backlog nil (point-max)))))))
17298
17299 (defun gnus-backlog-remove-article (group number)
17300   "Remove article NUMBER in GROUP from the backlog."
17301   (when (numberp number)
17302     (gnus-backlog-setup)
17303     (let ((ident (intern (concat group ":" (int-to-string number))
17304                          gnus-backlog-hashtb))
17305           beg end)
17306       (when (memq ident gnus-backlog-articles)
17307         ;; It was in the backlog.
17308         (save-excursion
17309           (set-buffer (gnus-backlog-buffer))
17310           (let (buffer-read-only)
17311             (when (setq beg (text-property-any
17312                              (point-min) (point-max) 'gnus-backlog
17313                              ident))
17314               ;; Find the end (i. e., the beginning of the next article).
17315               (setq end
17316                     (next-single-property-change
17317                      (1+ beg) 'gnus-backlog (current-buffer) (point-max)))
17318               (delete-region beg end)
17319               ;; Return success.
17320               t)))))))
17321
17322 (defun gnus-backlog-request-article (group number buffer)
17323   (when (numberp number)
17324     (gnus-backlog-setup)
17325     (let ((ident (intern (concat group ":" (int-to-string number))
17326                          gnus-backlog-hashtb))
17327           beg end)
17328       (when (memq ident gnus-backlog-articles)
17329         ;; It was in the backlog.
17330         (save-excursion
17331           (set-buffer (gnus-backlog-buffer))
17332           (if (not (setq beg (text-property-any
17333                               (point-min) (point-max) 'gnus-backlog
17334                               ident)))
17335               ;; It wasn't in the backlog after all.
17336               (ignore
17337                (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
17338             ;; Find the end (i. e., the beginning of the next article).
17339             (setq end
17340                   (next-single-property-change
17341                    (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
17342         (let ((buffer-read-only nil))
17343           (erase-buffer)
17344           (insert-buffer-substring gnus-backlog-buffer beg end)
17345           t)))))
17346
17347 ;; Allow redefinition of Gnus functions.
17348
17349 (gnus-ems-redefine)
17350
17351 (provide 'gnus)
17352
17353 ;;; gnus.el ends here