2a01c733e7310c3ce1481b8bd352d0d72bb016ab
[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
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24 ;;; Commentary:
25
26 ;;; Code:
27
28 (eval '(run-hooks 'gnus-load-hook))
29
30 (require 'mail-utils)
31 (require 'timezone)
32 (require 'nnheader)
33
34 (eval-when-compile (require 'cl))
35
36 ;; Site dependent variables.  These variables should be defined in
37 ;; paths.el.
38
39 (defvar gnus-default-nntp-server nil
40   "Specify a default NNTP server.
41 This variable should be defined in paths.el, and should never be set
42 by the user.
43 If you want to change servers, you should use `gnus-select-method'.
44 See the documentation to that variable.")
45
46 (defvar gnus-backup-default-subscribed-newsgroups
47   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
48   "Default default new newsgroups the first time Gnus is run.
49 Should be set in paths.el, and shouldn't be touched by the user.")
50
51 (defvar gnus-local-domain nil
52   "Local domain name without a host name.
53 The DOMAINNAME environment variable is used instead if it is defined.
54 If the `system-name' function returns the full Internet name, there is
55 no need to set this variable.")
56
57 (defvar gnus-local-organization nil
58   "String with a description of what organization (if any) the user belongs to.
59 The ORGANIZATION environment variable is used instead if it is defined.
60 If this variable contains a function, this function will be called
61 with the current newsgroup name as the argument.  The function should
62 return a string.
63
64 In any case, if the string (either in the variable, in the environment
65 variable, or returned by the function) is a file name, the contents of
66 this file will be used as the organization.")
67
68 (defvar gnus-use-generic-from nil
69   "If nil, the full host name will be the system name prepended to the domain name.
70 If this is a string, the full host name will be this string.
71 If this is non-nil, non-string, the domain name will be used as the
72 full host name.")
73
74 (defvar gnus-use-generic-path nil
75   "If nil, use the NNTP server name in the Path header.
76 If stringp, use this; if non-nil, use no host name (user name only).")
77
78
79 ;; Customization variables
80
81 ;; Don't touch this variable.
82 (defvar gnus-nntp-service "nntp"
83   "*NNTP service name (\"nntp\" or 119).
84 This is an obsolete variable, which is scarcely used.  If you use an
85 nntp server for your newsgroup and want to change the port number
86 used to 899, you would say something along these lines:
87
88  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
89
90 (defvar gnus-nntpserver-file "/etc/nntpserver"
91   "*A file with only the name of the nntp server in it.")
92
93 ;; This function is used to check both the environment variable
94 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
95 ;; an nntp server name default.
96 (defun gnus-getenv-nntpserver ()
97   (or (getenv "NNTPSERVER")
98       (and (file-readable-p gnus-nntpserver-file)
99            (save-excursion
100              (set-buffer (get-buffer-create " *gnus nntp*"))
101              (buffer-disable-undo (current-buffer))
102              (insert-file-contents gnus-nntpserver-file)
103              (let ((name (buffer-string)))
104                (prog1
105                    (if (string-match "^[ \t\n]*$" name)
106                        nil
107                      name)
108                  (kill-buffer (current-buffer))))))))
109
110 (defvar gnus-select-method
111   (nconc
112    (list 'nntp (or (condition-case ()
113                        (gnus-getenv-nntpserver)
114                      (error nil))
115                    (if (and gnus-default-nntp-server
116                             (not (string= gnus-default-nntp-server "")))
117                        gnus-default-nntp-server)
118                    (system-name)))
119    (if (or (null gnus-nntp-service)
120            (equal gnus-nntp-service "nntp"))
121        nil
122      (list gnus-nntp-service)))
123   "*Default method for selecting a newsgroup.
124 This variable should be a list, where the first element is how the
125 news is to be fetched, the second is the address.
126
127 For instance, if you want to get your news via NNTP from
128 \"flab.flab.edu\", you could say:
129
130 (setq gnus-select-method '(nntp \"flab.flab.edu\"))
131
132 If you want to use your local spool, say:
133
134 (setq gnus-select-method (list 'nnspool (system-name)))
135
136 If you use this variable, you must set `gnus-nntp-server' to nil.
137
138 There is a lot more to know about select methods and virtual servers -
139 see the manual for details.")
140
141 (defvar gnus-message-archive-method 
142   '(nnfolder "archive" (nnfolder-directory "~/Mail/archive/")
143              (nnfolder-active-file "~/Mail/archive/active")
144              (nnfolder-get-new-mail nil)
145              (nnfolder-inhibit-expiry t))
146   "*Method used for archiving messages you've sent.
147 This should be a mail method.")
148
149 (defvar gnus-refer-article-method nil
150   "*Preferred method for fetching an article by Message-ID.
151 If you are reading news from the local spool (with nnspool), fetching
152 articles by Message-ID is painfully slow.  By setting this method to an
153 nntp method, you might get acceptable results.
154
155 The value of this variable must be a valid select method as discussed
156 in the documentation of `gnus-select-method'")
157
158 (defvar gnus-secondary-select-methods nil
159   "*A list of secondary methods that will be used for reading news.
160 This is a list where each element is a complete select method (see
161 `gnus-select-method').
162
163 If, for instance, you want to read your mail with the nnml backend,
164 you could set this variable:
165
166 (setq gnus-secondary-select-methods '((nnml \"\")))")
167
168 (defvar gnus-secondary-servers nil
169   "*List of NNTP servers that the user can choose between interactively.
170 To make Gnus query you for a server, you have to give `gnus' a
171 non-numeric prefix - `C-u M-x gnus', in short.")
172
173 (defvar gnus-nntp-server nil
174   "*The name of the host running the NNTP server.
175 This variable is semi-obsolete.  Use the `gnus-select-method'
176 variable instead.")
177
178 (defvar gnus-startup-file "~/.newsrc"
179   "*Your `.newsrc' file.
180 `.newsrc-SERVER' will be used instead if that exists.")
181
182 (defvar gnus-init-file "~/.gnus"
183   "*Your Gnus elisp startup file.
184 If a file with the .el or .elc suffixes exist, it will be read
185 instead.")
186
187 (defvar gnus-group-faq-directory
188   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
189 ;    "/ftp@ftp.uu.net:/usenet/news.answers/"
190     "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
191     "/ftp@rtfm.mit.edu:/pub/usenet/news.answers/"
192     "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
193 ;    "/ftp@ftp.Germany.EU.net:/pub/newsarchive/news.answers/"
194     "/ftp@ftp.sunet.se:/pub/usenet/"
195     "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
196     "/ftp@hwarang.postech.ac.kr:/pub/usenet/news.answers/"
197     "/ftp@ftp.hk.super.net:/mirror/faqs/")
198   "*Directory where the group FAQs are stored.
199 This will most commonly be on a remote machine, and the file will be
200 fetched by ange-ftp.
201
202 This variable can also be a list of directories.  In that case, the
203 first element in the list will be used by default, and the others will
204 be used as backup sites.
205
206 Note that Gnus uses an aol machine as the default directory.  If this
207 feels fundamentally unclean, just think of it as a way to finally get
208 something of value back from them.
209
210 If the default site is too slow, try one of these:
211
212    North America: mirrors.aol.com                /pub/rtfm/usenet
213                   ftp.seas.gwu.edu               /pub/rtfm
214                   rtfm.mit.edu                   /pub/usenet/news.answers
215    Europe:        ftp.uni-paderborn.de           /pub/FAQ
216                   ftp.sunet.se                   /pub/usenet
217    Asia:          nctuccca.edu.tw                /USENET/FAQ
218                   hwarang.postech.ac.kr          /pub/usenet/news.answers
219                   ftp.hk.super.net               /mirror/faqs")
220
221 (defvar gnus-group-archive-directory
222   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
223   "*The address of the (ding) archives.")
224
225 (defvar gnus-group-recent-archive-directory
226   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
227   "*The address of the most recent (ding) articles.")
228
229 (defvar gnus-default-subscribed-newsgroups nil
230   "*This variable lists what newsgroups should be subscribed the first time Gnus is used.
231 It should be a list of strings.
232 If it is `t', Gnus will not do anything special the first time it is
233 started; it'll just use the normal newsgroups subscription methods.")
234
235 (defvar gnus-use-cross-reference t
236   "*Non-nil means that cross referenced articles will be marked as read.
237 If nil, ignore cross references.  If t, mark articles as read in
238 subscribed newsgroups.  If neither t nor nil, mark as read in all
239 newsgroups.")
240
241 (defvar gnus-single-article-buffer t
242   "*If non-nil, display all articles in the same buffer.
243 If nil, each group will get its own article buffer.")
244
245 (defvar gnus-use-dribble-file t
246   "*Non-nil means that Gnus will use a dribble file to store user updates.
247 If Emacs should crash without saving the .newsrc files, complete
248 information can be restored from the dribble file.")
249
250 (defvar gnus-dribble-directory nil
251   "*The directory where dribble files will be saved.
252 If this variable is nil, the directory where the .newsrc files are
253 saved will be used.")
254
255 (defvar gnus-asynchronous nil
256   "*If non-nil, Gnus will supply backends with data needed for async article fetching.")
257
258 (defvar gnus-kill-summary-on-exit t
259   "*If non-nil, kill the summary buffer when you exit from it.
260 If nil, the summary will become a \"*Dead Summary*\" buffer, and
261 it will be killed sometime later.")
262
263 (defvar gnus-large-newsgroup 200
264   "*The number of articles which indicates a large newsgroup.
265 If the number of articles in a newsgroup is greater than this value,
266 confirmation is required for selecting the newsgroup.")
267
268 ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
269 (defvar gnus-no-groups-message "No news is horrible news"
270   "*Message displayed by Gnus when no groups are available.")
271
272 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
273   "*Non-nil means that the default name of a file to save articles in is the group name.
274 If it's nil, the directory form of the group name is used instead.
275
276 If this variable is a list, and the list contains the element
277 `not-score', long file names will not be used for score files; if it
278 contains the element `not-save', long file names will not be used for
279 saving; and if it contains the element `not-kill', long file names
280 will not be used for kill files.")
281
282 (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
283   "*Name of the directory articles will be saved in (default \"~/News\").
284 Initialized from the SAVEDIR environment variable.")
285
286 (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
287   "*Name of the directory where kill files will be stored (default \"~/News\").
288 Initialized from the SAVEDIR environment variable.")
289
290 (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
291   "*A function to save articles in your favorite format.
292 The function must be interactively callable (in other words, it must
293 be an Emacs command).
294
295 Gnus provides the following functions:
296
297 * gnus-summary-save-in-rmail (Rmail format)
298 * gnus-summary-save-in-mail (Unix mail format)
299 * gnus-summary-save-in-folder (MH folder)
300 * gnus-summary-save-in-file (article format).
301 * gnus-summary-save-in-vm (use VM's folder format).")
302
303 (defvar gnus-prompt-before-saving 'always
304   "*This variable says how much prompting is to be done when saving articles.
305 If it is nil, no prompting will be done, and the articles will be
306 saved to the default files.  If this variable is `always', each and
307 every article that is saved will be preceded by a prompt, even when
308 saving large batches of articles.  If this variable is neither nil not
309 `always', there the user will be prompted once for a file name for
310 each invocation of the saving commands.")
311
312 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
313   "*A function generating a file name to save articles in Rmail format.
314 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
315
316 (defvar gnus-mail-save-name (function gnus-plain-save-name)
317   "*A function generating a file name to save articles in Unix mail format.
318 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
319
320 (defvar gnus-folder-save-name (function gnus-folder-save-name)
321   "*A function generating a file name to save articles in MH folder.
322 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
323
324 (defvar gnus-file-save-name (function gnus-numeric-save-name)
325   "*A function generating a file name to save articles in article format.
326 The function is called with NEWSGROUP, HEADERS, and optional
327 LAST-FILE.")
328
329 (defvar gnus-split-methods
330   '((gnus-article-archive-name))
331   "*Variable used to suggest where articles are to be saved.
332 For instance, if you would like to save articles related to Gnus in
333 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
334 you could set this variable to something like:
335
336  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
337    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
338
339 This variable is an alist where the where the key is the match and the
340 value is a list of possible files to save in if the match is non-nil.
341
342 If the match is a string, it is used as a regexp match on the
343 article.  If the match is a symbol, that symbol will be funcalled
344 from the buffer of the article to be saved with the newsgroup as the
345 parameter.  If it is a list, it will be evaled in the same buffer.
346
347 If this form or function returns a string, this string will be used as
348 a possible file name; and if it returns a non-nil list, that list will
349 be used as possible file names.")
350
351 (defvar gnus-move-split-methods nil
352   "*Variable used to suggest where articles are to be moved to.
353 It uses the same syntax as the `gnus-split-methods' variable.")
354
355 (defvar gnus-save-score nil
356   "*If non-nil, save group scoring info.")
357
358 (defvar gnus-use-adaptive-scoring nil
359   "*If non-nil, use some adaptive scoring scheme.")
360
361 (defvar gnus-use-cache nil
362   "*If nil, Gnus will ignore the article cache.
363 If `passive', it will allow entering (and reading) articles
364 explicitly entered into the cache.  If anything else, use the
365 cache to the full extent of the law.")
366
367 (defvar gnus-use-trees nil
368   "*If non-nil, display a thread tree buffer.")
369
370 (defvar gnus-keep-backlog nil
371   "*If non-nil, Gnus will keep read articles for later re-retrieval.
372 If it is a number N, then Gnus will only keep the last N articles
373 read.  If it is neither nil nor a number, Gnus will keep all read
374 articles.  This is not a good idea.")
375
376 (defvar gnus-use-nocem nil
377   "*If non-nil, Gnus will read NoCeM cancel messages.")
378
379 (defvar gnus-use-demon nil
380   "If non-nil, Gnus might use some demons.")
381
382 (defvar gnus-use-scoring t
383   "*If non-nil, enable scoring.")
384
385 (defvar gnus-use-picons nil
386   "*If non-nil, display picons.")
387
388 (defvar gnus-fetch-old-headers nil
389   "*Non-nil means that Gnus will try to build threads by grabbing old headers.
390 If an unread article in the group refers to an older, already read (or
391 just marked as read) article, the old article will not normally be
392 displayed in the Summary buffer.  If this variable is non-nil, Gnus
393 will attempt to grab the headers to the old articles, and thereby
394 build complete threads.  If it has the value `some', only enough
395 headers to connect otherwise loose threads will be displayed.
396 This variable can also be a number.  In that case, no more than that
397 number of old headers will be fetched.
398
399 The server has to support NOV for any of this to work.")
400
401 ;see gnus-cus.el
402 ;(defvar gnus-visual t
403 ;  "*If non-nil, will do various highlighting.
404 ;If nil, no mouse highlights (or any other highlights) will be
405 ;performed.  This might speed up Gnus some when generating large group
406 ;and summary buffers.")
407
408 (defvar gnus-novice-user t
409   "*Non-nil means that you are a usenet novice.
410 If non-nil, verbose messages may be displayed and confirmations may be
411 required.")
412
413 (defvar gnus-expert-user nil
414   "*Non-nil means that you will never be asked for confirmation about anything.
415 And that means *anything*.")
416
417 (defvar gnus-verbose 7
418   "*Integer that says how verbose Gnus should be.
419 The higher the number, the more messages Gnus will flash to say what
420 it's doing.  At zero, Gnus will be totally mute; at five, Gnus will
421 display most important messages; and at ten, Gnus will keep on
422 jabbering all the time.")
423
424 (defvar gnus-keep-same-level nil
425   "*Non-nil means that the next newsgroup after the current will be on the same level.
426 When you type, for instance, `n' after reading the last article in the
427 current newsgroup, you will go to the next newsgroup.  If this variable
428 is nil, the next newsgroup will be the next from the group
429 buffer.
430 If this variable is non-nil, Gnus will either put you in the
431 next newsgroup with the same level, or, if no such newsgroup is
432 available, the next newsgroup with the lowest possible level higher
433 than the current level.
434 If this variable is `best', Gnus will make the next newsgroup the one
435 with the best level.")
436
437 (defvar gnus-summary-make-false-root 'adopt
438   "*nil means that Gnus won't gather loose threads.
439 If the root of a thread has expired or been read in a previous
440 session, the information necessary to build a complete thread has been
441 lost.  Instead of having many small sub-threads from this original thread
442 scattered all over the summary buffer, Gnus can gather them.
443
444 If non-nil, Gnus will try to gather all loose sub-threads from an
445 original thread into one large thread.
446
447 If this variable is non-nil, it should be one of `none', `adopt',
448 `dummy' or `empty'.
449
450 If this variable is `none', Gnus will not make a false root, but just
451 present the sub-threads after another.
452 If this variable is `dummy', Gnus will create a dummy root that will
453 have all the sub-threads as children.
454 If this variable is `adopt', Gnus will make one of the \"children\"
455 the parent and mark all the step-children as such.
456 If this variable is `empty', the \"children\" are printed with empty
457 subject fields.  (Or rather, they will be printed with a string
458 given by the `gnus-summary-same-subject' variable.)")
459
460 (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
461   "*A regexp to match subjects to be excluded from loose thread gathering.
462 As loose thread gathering is done on subjects only, that means that
463 there can be many false gatherings performed.  By rooting out certain
464 common subjects, gathering might become saner.")
465
466 (defvar gnus-summary-gather-subject-limit nil
467   "*Maximum length of subject comparisons when gathering loose threads.
468 Use nil to compare full subjects.  Setting this variable to a low
469 number will help gather threads that have been corrupted by
470 newsreaders chopping off subject lines, but it might also mean that
471 unrelated articles that have subject that happen to begin with the
472 same few characters will be incorrectly gathered.
473
474 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
475 comparing subjects.")
476
477 (defvar gnus-simplify-ignored-prefixes nil
478   "*Regexp, matches for which are removed from subject lines when simplifying.")
479
480 (defvar gnus-build-sparse-threads nil
481   "*If non-nil, fill in the gaps in threads.
482 If `some', only fill in the gaps that are needed to tie loose threads
483 together.  If non-nil and non-`some', fill in all gaps that Gnus
484 manages to guess.")
485
486 (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
487   "Function used for gathering loose threads.
488 There are two pre-defined functions: `gnus-gather-threads-by-subject',
489 which only takes Subjects into consideration; and
490 `gnus-gather-threads-by-references', which compared the References
491 headers of the articles to find matches.")
492
493 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
494 (defvar gnus-summary-same-subject ""
495   "*String indicating that the current article has the same subject as the previous.
496 This variable will only be used if the value of
497 `gnus-summary-make-false-root' is `empty'.")
498
499 (defvar gnus-summary-goto-unread t
500   "*If non-nil, marking commands will go to the next unread article.
501 If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article,
502 whether it is read or not.")
503
504 (defvar gnus-group-goto-unread t
505   "*If non-nil, movement commands will go to the next unread and subscribed group.")
506
507 (defvar gnus-goto-next-group-when-activating t
508   "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.")
509
510 (defvar gnus-check-new-newsgroups t
511   "*Non-nil means that Gnus will add new newsgroups at startup.
512 If this variable is `ask-server', Gnus will ask the server for new
513 groups since the last time it checked.  This means that the killed list
514 is no longer necessary, so you could set `gnus-save-killed-list' to
515 nil.
516
517 A variant is to have this variable be a list of select methods.  Gnus
518 will then use the `ask-server' method on all these select methods to
519 query for new groups from all those servers.
520
521 Eg.
522   (setq gnus-check-new-newsgroups
523         '((nntp \"some.server\") (nntp \"other.server\")))
524
525 If this variable is nil, then you have to tell Gnus explicitly to
526 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
527
528 (defvar gnus-check-bogus-newsgroups nil
529   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
530 If this variable is nil, then you have to tell Gnus explicitly to
531 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
532
533 (defvar gnus-read-active-file t
534   "*Non-nil means that Gnus will read the entire active file at startup.
535 If this variable is nil, Gnus will only know about the groups in your
536 `.newsrc' file.
537
538 If this variable is `some', Gnus will try to only read the relevant
539 parts of the active file from the server.  Not all servers support
540 this, and it might be quite slow with other servers, but this should
541 generally be faster than both the t and nil value.
542
543 If you set this variable to nil or `some', you probably still want to
544 be told about new newsgroups that arrive.  To do that, set
545 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
546 properly with all servers.")
547
548 (defvar gnus-level-subscribed 5
549   "*Groups with levels less than or equal to this variable are subscribed.")
550
551 (defvar gnus-level-unsubscribed 7
552   "*Groups with levels less than or equal to this variable are unsubscribed.
553 Groups with levels less than `gnus-level-subscribed', which should be
554 less than this variable, are subscribed.")
555
556 (defvar gnus-level-zombie 8
557   "*Groups with this level are zombie groups.")
558
559 (defvar gnus-level-killed 9
560   "*Groups with this level are killed.")
561
562 (defvar gnus-level-default-subscribed 3
563   "*New subscribed groups will be subscribed at this level.")
564
565 (defvar gnus-level-default-unsubscribed 6
566   "*New unsubscribed groups will be unsubscribed at this level.")
567
568 (defvar gnus-activate-level (1+ gnus-level-subscribed)
569   "*Groups higher than this level won't be activated on startup.
570 Setting this variable to something log might save lots of time when
571 you have many groups that you aren't interested in.")
572
573 (defvar gnus-activate-foreign-newsgroups 4
574   "*If nil, Gnus will not check foreign newsgroups at startup.
575 If it is non-nil, it should be a number between one and nine.  Foreign
576 newsgroups that have a level lower or equal to this number will be
577 activated on startup.  For instance, if you want to active all
578 subscribed newsgroups, but not the rest, you'd set this variable to
579 `gnus-level-subscribed'.
580
581 If you subscribe to lots of newsgroups from different servers, startup
582 might take a while.  By setting this variable to nil, you'll save time,
583 but you won't be told how many unread articles there are in the
584 groups.")
585
586 (defvar gnus-save-newsrc-file t
587   "*Non-nil means that Gnus will save the `.newsrc' file.
588 Gnus always saves its own startup file, which is called
589 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
590 be readily understood by other newsreaders.  If you don't plan on
591 using other newsreaders, set this variable to nil to save some time on
592 exit.")
593
594 (defvar gnus-save-killed-list t
595   "*If non-nil, save the list of killed groups to the startup file.
596 If you set this variable to nil, you'll save both time (when starting
597 and quitting) and space (both memory and disk), but it will also mean
598 that Gnus has no record of which groups are new and which are old, so
599 the automatic new newsgroups subscription methods become meaningless.
600
601 You should always set `gnus-check-new-newsgroups' to `ask-server' or
602 nil if you set this variable to nil.")
603
604 (defvar gnus-interactive-catchup t
605   "*If non-nil, require your confirmation when catching up a group.")
606
607 (defvar gnus-interactive-post t
608   "*If non-nil, group name will be asked for when posting.")
609
610 (defvar gnus-interactive-exit t
611   "*If non-nil, require your confirmation when exiting Gnus.")
612
613 (defvar gnus-kill-killed t
614   "*If non-nil, Gnus will apply kill files to already killed articles.
615 If it is nil, Gnus will never apply kill files to articles that have
616 already been through the scoring process, which might very well save lots
617 of time.")
618
619 (defvar gnus-extract-address-components 'gnus-extract-address-components
620   "*Function for extracting address components from a From header.
621 Two pre-defined function exist: `gnus-extract-address-components',
622 which is the default, quite fast, and too simplistic solution, and
623 `mail-extract-address-components', which works much better, but is
624 slower.")
625
626 (defvar gnus-summary-default-score 0
627   "*Default article score level.
628 If this variable is nil, scoring will be disabled.")
629
630 (defvar gnus-summary-zcore-fuzz 0
631   "*Fuzziness factor for the zcore in the summary buffer.
632 Articles with scores closer than this to `gnus-summary-default-score'
633 will not be marked.")
634
635 (defvar gnus-simplify-subject-fuzzy-regexp nil
636   "*Strings to be removed when doing fuzzy matches.
637 This can either be a regular expression or list of regular expressions
638 that will be removed from subject strings if fuzzy subject
639 simplification is selected.")
640
641 (defvar gnus-permanently-visible-groups nil
642   "*Regexp to match groups that should always be listed in the group buffer.
643 This means that they will still be listed when there are no unread
644 articles in the groups.")
645
646 (defvar gnus-list-groups-with-ticked-articles t
647   "*If non-nil, list groups that have only ticked articles.
648 If nil, only list groups that have unread articles.")
649
650 (defvar gnus-group-default-list-level gnus-level-subscribed
651   "*Default listing level.
652 Ignored if `gnus-group-use-permanent-levels' is non-nil.")
653
654 (defvar gnus-group-use-permanent-levels nil
655   "*If non-nil, once you set a level, Gnus will use this level.")
656
657 (defvar gnus-group-list-inactive-groups t
658   "*If non-nil, inactive groups will be listed.")
659
660 (defvar gnus-show-mime nil
661   "*If non-nil, do mime processing of articles.
662 The articles will simply be fed to the function given by
663 `gnus-show-mime-method'.")
664
665 (defvar gnus-strict-mime t
666   "*If nil, MIME-decode even if there is no Mime-Version header in the article.")
667
668 (defvar gnus-show-mime-method 'metamail-buffer
669   "*Function to process a MIME message.
670 The function is called from the article buffer.")
671
672 (defvar gnus-decode-encoded-word-method (lambda ())
673   "*Function to decode a MIME encoded-words.
674 The function is called from the article buffer.")
675
676 (defvar gnus-show-threads t
677   "*If non-nil, display threads in summary mode.")
678
679 (defvar gnus-thread-hide-subtree nil
680   "*If non-nil, hide all threads initially.
681 If threads are hidden, you have to run the command
682 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
683 to expose hidden threads.")
684
685 (defvar gnus-thread-hide-killed t
686   "*If non-nil, hide killed threads automatically.")
687
688 (defvar gnus-thread-ignore-subject nil
689   "*If non-nil, ignore subjects and do all threading based on the Reference header.
690 If nil, which is the default, articles that have different subjects
691 from their parents will start separate threads.")
692
693 (defvar gnus-thread-operation-ignore-subject t
694   "*If non-nil, subjects will be ignored when doing thread commands.
695 This affects commands like `gnus-summary-kill-thread' and
696 `gnus-summary-lower-thread'.
697
698 If this variable is nil, articles in the same thread with different
699 subjects will not be included in the operation in question.  If this
700 variable is `fuzzy', only articles that have subjects that are fuzzily
701 equal will be included.")
702
703 (defvar gnus-thread-indent-level 4
704   "*Number that says how much each sub-thread should be indented.")
705
706 (defvar gnus-ignored-newsgroups
707   (purecopy (mapconcat 'identity
708                        '("^to\\."       ; not "real" groups
709                          "^[0-9. \t]+ " ; all digits in name
710                          "[][\"#'()]"   ; bogus characters
711                          )
712                        "\\|"))
713   "*A regexp to match uninteresting newsgroups in the active file.
714 Any lines in the active file matching this regular expression are
715 removed from the newsgroup list before anything else is done to it,
716 thus making them effectively non-existent.")
717
718 (defvar gnus-ignored-headers
719   "^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:"
720   "*All headers that match this regexp will be hidden.
721 This variable can also be a list of regexps of headers to be ignored.
722 If `gnus-visible-headers' is non-nil, this variable will be ignored.")
723
724 (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-"
725   "*All headers that do not match this regexp will be hidden.
726 This variable can also be a list of regexp of headers to remain visible.
727 If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
728
729 (defvar gnus-sorted-header-list
730   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
731     "^Cc:" "^Date:" "^Organization:")
732   "*This variable is a list of regular expressions.
733 If it is non-nil, headers that match the regular expressions will
734 be placed first in the article buffer in the sequence specified by
735 this list.")
736
737 (defvar gnus-boring-article-headers
738   '(empty followup-to reply-to)
739   "*Headers that are only to be displayed if they have interesting data.
740 Possible values in this list are `empty', `newsgroups', `followup-to',
741 `reply-to', and `date'.")
742
743 (defvar gnus-show-all-headers nil
744   "*If non-nil, don't hide any headers.")
745
746 (defvar gnus-save-all-headers t
747   "*If non-nil, don't remove any headers before saving.")
748
749 (defvar gnus-saved-headers gnus-visible-headers
750   "*Headers to keep if `gnus-save-all-headers' is nil.
751 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
752 If that variable is nil, however, all headers that match this regexp
753 will be kept while the rest will be deleted before saving.")
754
755 (defvar gnus-inhibit-startup-message nil
756   "*If non-nil, the startup message will not be displayed.")
757
758 (defvar gnus-signature-separator "^-- *$"
759   "Regexp matching signature separator.")
760
761 (defvar gnus-auto-extend-newsgroup t
762   "*If non-nil, extend newsgroup forward and backward when requested.")
763
764 (defvar gnus-auto-select-first t
765   "*If nil, don't select the first unread article when entering a group.
766 If this variable is `best', select the highest-scored unread article
767 in the group.  If neither nil nor `best', select the first unread
768 article.
769
770 If you want to prevent automatic selection of the first unread article
771 in some newsgroups, set the variable to nil in
772 `gnus-select-group-hook'.")
773
774 (defvar gnus-auto-select-next t
775   "*If non-nil, offer to go to the next group from the end of the previous.
776 If the value is t and the next newsgroup is empty, Gnus will exit
777 summary mode and go back to group mode.  If the value is neither nil
778 nor t, Gnus will select the following unread newsgroup.  In
779 particular, if the value is the symbol `quietly', the next unread
780 newsgroup will be selected without any confirmation, and if it is
781 `almost-quietly', the next group will be selected without any
782 confirmation if you are located on the last article in the group.")
783
784 (defvar gnus-auto-select-same nil
785   "*If non-nil, select the next article with the same subject.")
786
787 (defvar gnus-summary-check-current nil
788   "*If non-nil, consider the current article when moving.
789 The \"unread\" movement commands will stay on the same line if the
790 current article is unread.")
791
792 (defvar gnus-auto-center-summary t
793   "*If non-nil, always center the current summary buffer.")
794
795 (defvar gnus-break-pages t
796   "*If non-nil, do page breaking on articles.
797 The page delimiter is specified by the `gnus-page-delimiter'
798 variable.")
799
800 (defvar gnus-page-delimiter "^\^L"
801   "*Regexp describing what to use as article page delimiters.
802 The default value is \"^\^L\", which is a form linefeed at the
803 beginning of a line.")
804
805 (defvar gnus-use-full-window t
806   "*If non-nil, use the entire Emacs screen.")
807
808 (defvar gnus-window-configuration nil
809   "Obsolete variable.  See `gnus-buffer-configuration'.")
810
811 (defvar gnus-window-min-width 2
812   "*Minimum width of Gnus buffers.")
813
814 (defvar gnus-window-min-height 1
815   "*Minimum height of Gnus buffers.")
816
817 (defvar gnus-buffer-configuration
818   '((group
819      (vertical 1.0
820                (group 1.0 point)
821                (if gnus-carpal '(group-carpal 4))))
822     (summary
823      (vertical 1.0
824                (summary 1.0 point)
825                (if gnus-carpal '(summary-carpal 4))))
826     (article
827      (cond 
828       (gnus-use-picons
829        '(frame 1.0
830                (vertical 1.0
831                          (summary 0.25 point)
832                          (if gnus-carpal '(summary-carpal 4))
833                          (article 1.0))
834                (vertical '((height . 5) (width . 15)
835                            (user-position . t)
836                            (left . -1) (top . 1))
837                          (picons 1.0))))
838       (gnus-use-trees
839        '(vertical 1.0
840                   (summary 0.25 point)
841                   (tree 0.25)
842                   (article 1.0)))
843       (t
844        '(vertical 1.0
845                  (summary 0.25 point)
846                  (if gnus-carpal '(summary-carpal 4))
847                  (if gnus-use-trees '(tree 0.25))
848                  (article 1.0)))))
849     (server
850      (vertical 1.0
851                (server 1.0 point)
852                (if gnus-carpal '(server-carpal 2))))
853     (browse
854      (vertical 1.0
855                (browse 1.0 point)
856                (if gnus-carpal '(browse-carpal 2))))
857     (group-mail
858      (vertical 1.0
859                (mail 1.0 point)))
860     (summary-mail
861      (vertical 1.0
862                (mail 1.0 point)))
863     (summary-reply
864      (vertical 1.0
865                (article 0.5)
866                (mail 1.0 point)))
867     (pick
868      (vertical 1.0
869                (article 1.0 point)))
870     (info
871      (vertical 1.0
872                (info 1.0 point)))
873     (summary-faq
874      (vertical 1.0
875                (summary 0.25)
876                (faq 1.0 point)))
877     (edit-group
878      (vertical 1.0
879                (group 0.5)
880                (edit-group 1.0 point)))
881     (edit-server
882      (vertical 1.0
883                (server 0.5)
884                (edit-server 1.0 point)))
885     (edit-score
886      (vertical 1.0
887                (summary 0.25)
888                (edit-score 1.0 point)))
889     (post
890      (vertical 1.0
891                (post 1.0 point)))
892     (reply
893      (vertical 1.0
894                (article 0.5)
895                (mail 1.0 point)))
896     (mail-forward
897      (vertical 1.0
898                (mail 1.0 point)))
899     (post-forward
900      (vertical 1.0
901                (post 1.0 point)))
902     (reply-yank
903      (vertical 1.0
904                (mail 1.0 point)))
905     (mail-bounce
906      (vertical 1.0
907                (article 0.5)
908                (mail 1.0 point)))
909     (draft
910      (vertical 1.0
911                (draft 1.0 point)))
912     (pipe
913      (vertical 1.0
914                (summary 0.25 point)
915                (if gnus-carpal '(summary-carpal 4))
916                ("*Shell Command Output*" 1.0)))
917     (followup
918      (vertical 1.0
919                (article 0.5)
920                (post 1.0 point)))
921     (followup-yank
922      (vertical 1.0
923                (post 1.0 point))))
924   "Window configuration for all possible Gnus buffers.
925 This variable is a list of lists.  Each of these lists has a NAME and
926 a RULE.  The NAMEs are commonsense names like `group', which names a
927 rule used when displaying the group buffer; `summary', which names a
928 rule for what happens when you enter a group and do not display an
929 article buffer; and so on.  See the value of this variable for a
930 complete list of NAMEs.
931
932 Each RULE is a list of vectors.  The first element in this vector is
933 the name of the buffer to be displayed; the second element is the
934 percentage of the screen this buffer is to occupy (a number in the
935 0.0-0.99 range); the optional third element is `point', which should
936 be present to denote which buffer point is to go to after making this
937 buffer configuration.")
938
939 (defvar gnus-window-to-buffer
940   '((group . gnus-group-buffer)
941     (summary . gnus-summary-buffer)
942     (article . gnus-article-buffer)
943     (server . gnus-server-buffer)
944     (browse . "*Gnus Browse Server*")
945     (edit-group . gnus-group-edit-buffer)
946     (edit-server . gnus-server-edit-buffer)
947     (group-carpal . gnus-carpal-group-buffer)
948     (summary-carpal . gnus-carpal-summary-buffer)
949     (server-carpal . gnus-carpal-server-buffer)
950     (browse-carpal . gnus-carpal-browse-buffer)
951     (edit-score . gnus-score-edit-buffer)
952     (mail . gnus-mail-buffer)
953     (post . gnus-post-news-buffer)
954     (faq . gnus-faq-buffer)
955     (picons . "*Picons*")
956     (tree . gnus-tree-buffer)
957     (info . gnus-info-buffer)
958     (draft . gnus-draft-buffer))
959   "Mapping from short symbols to buffer names or buffer variables.")
960
961 (defvar gnus-carpal nil
962   "*If non-nil, display clickable icons.")
963
964 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
965   "*Function called with a group name when new group is detected.
966 A few pre-made functions are supplied: `gnus-subscribe-randomly'
967 inserts new groups at the beginning of the list of groups;
968 `gnus-subscribe-alphabetically' inserts new groups in strict
969 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
970 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
971 for your decision; `gnus-subscribe-killed' kills all new groups.")
972
973 ;; Suggested by a bug report by Hallvard B Furuseth.
974 ;; <h.b.furuseth@usit.uio.no>.
975 (defvar gnus-subscribe-options-newsgroup-method
976   (function gnus-subscribe-alphabetically)
977   "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
978 If, for instance, you want to subscribe to all newsgroups in the
979 \"no\" and \"alt\" hierarchies, you'd put the following in your
980 .newsrc file:
981
982 options -n no.all alt.all
983
984 Gnus will the subscribe all new newsgroups in these hierarchies with
985 the subscription method in this variable.")
986
987 (defvar gnus-subscribe-hierarchical-interactive nil
988   "*If non-nil, Gnus will offer to subscribe hierarchically.
989 When a new hierarchy appears, Gnus will ask the user:
990
991 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
992
993 If the user pressed `d', Gnus will descend the hierarchy, `y' will
994 subscribe to all newsgroups in the hierarchy and `s' will skip this
995 hierarchy in its entirety.")
996
997 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
998   "*Function used for sorting the group buffer.
999 This function will be called with group info entries as the arguments
1000 for the groups to be sorted.  Pre-made functions include
1001 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
1002 `gnus-group-sort-by-level', `gnus-group-sort-by-score', and
1003 `gnus-group-sort-by-rank'.
1004
1005 This variable can also be a list of sorting functions.  In that case,
1006 the most significant sort function should be the last function in the
1007 list.")
1008
1009 ;; Mark variables suggested by Thomas Michanek
1010 ;; <Thomas.Michanek@telelogic.se>.
1011 (defvar gnus-unread-mark ? 
1012   "*Mark used for unread articles.")
1013 (defvar gnus-ticked-mark ?!
1014   "*Mark used for ticked articles.")
1015 (defvar gnus-dormant-mark ??
1016   "*Mark used for dormant articles.")
1017 (defvar gnus-del-mark ?r
1018   "*Mark used for del'd articles.")
1019 (defvar gnus-read-mark ?R
1020   "*Mark used for read articles.")
1021 (defvar gnus-expirable-mark ?E
1022   "*Mark used for expirable articles.")
1023 (defvar gnus-killed-mark ?K
1024   "*Mark used for killed articles.")
1025 (defvar gnus-souped-mark ?F
1026   "*Mark used for killed articles.")
1027 (defvar gnus-kill-file-mark ?X
1028   "*Mark used for articles killed by kill files.")
1029 (defvar gnus-low-score-mark ?Y
1030   "*Mark used for articles with a low score.")
1031 (defvar gnus-catchup-mark ?C
1032   "*Mark used for articles that are caught up.")
1033 (defvar gnus-replied-mark ?A
1034   "*Mark used for articles that have been replied to.")
1035 (defvar gnus-cached-mark ?*
1036   "*Mark used for articles that are in the cache.")
1037 (defvar gnus-saved-mark ?S
1038   "*Mark used for articles that have been saved to.")
1039 (defvar gnus-process-mark ?#
1040   "*Process mark.")
1041 (defvar gnus-ancient-mark ?O
1042   "*Mark used for ancient articles.")
1043 (defvar gnus-sparse-mark ?Q
1044   "*Mark used for sparsely reffed articles.")
1045 (defvar gnus-canceled-mark ?G
1046   "*Mark used for canceled articles.")
1047 (defvar gnus-score-over-mark ?+
1048   "*Score mark used for articles with high scores.")
1049 (defvar gnus-score-below-mark ?-
1050   "*Score mark used for articles with low scores.")
1051 (defvar gnus-empty-thread-mark ? 
1052   "*There is no thread under the article.")
1053 (defvar gnus-not-empty-thread-mark ?=
1054   "*There is a thread under the article.")
1055
1056 (defvar gnus-view-pseudo-asynchronously nil
1057   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
1058
1059 (defvar gnus-view-pseudos nil
1060   "*If `automatic', pseudo-articles will be viewed automatically.
1061 If `not-confirm', pseudos will be viewed automatically, and the user
1062 will not be asked to confirm the command.")
1063
1064 (defvar gnus-view-pseudos-separately t
1065   "*If non-nil, one pseudo-article will be created for each file to be viewed.
1066 If nil, all files that use the same viewing command will be given as a
1067 list of parameters to that command.")
1068
1069 (defvar gnus-insert-pseudo-articles t
1070   "*If non-nil, insert pseudo-articles when decoding articles.")
1071
1072 (defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)\n"
1073   "*Format of group lines.
1074 It works along the same lines as a normal formatting string,
1075 with some simple extensions.
1076
1077 %M    Only marked articles (character, \"*\" or \" \")
1078 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
1079 %L    Level of subscribedness (integer)
1080 %N    Number of unread articles (integer)
1081 %I    Number of dormant articles (integer)
1082 %i    Number of ticked and dormant (integer)
1083 %T    Number of ticked articles (integer)
1084 %R    Number of read articles (integer)
1085 %t    Total number of articles (integer)
1086 %y    Number of unread, unticked articles (integer)
1087 %G    Group name (string)
1088 %g    Qualified group name (string)
1089 %D    Group description (string)
1090 %s    Select method (string)
1091 %o    Moderated group (char, \"m\")
1092 %p    Process mark (char)
1093 %O    Moderated group (string, \"(m)\" or \"\")
1094 %P    Topic indentation (string)
1095 %n    Select from where (string)
1096 %z    A string that look like `<%s:%n>' if a foreign select method is used
1097 %u    User defined specifier.  The next character in the format string should
1098       be a letter.  Gnus will call the function gnus-user-format-function-X,
1099       where X is the letter following %u.  The function will be passed the
1100       current header as argument.  The function should return a string, which
1101       will be inserted into the buffer just like information from any other
1102       group specifier.
1103
1104 Text between %( and %) will be highlighted with `gnus-mouse-face' when
1105 the mouse point move inside the area.  There can only be one such area.
1106
1107 Note that this format specification is not always respected.  For
1108 reasons of efficiency, when listing killed groups, this specification
1109 is ignored altogether.  If the spec is changed considerably, your
1110 output may end up looking strange when listing both alive and killed
1111 groups.
1112
1113 If you use %o or %O, reading the active file will be slower and quite
1114 a bit of extra memory will be used. %D will also worsen performance.
1115 Also note that if you change the format specification to include any
1116 of these specs, you must probably re-start Gnus to see them go into
1117 effect.")
1118
1119 (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
1120   "*The format specification of the lines in the summary buffer.
1121
1122 It works along the same lines as a normal formatting string,
1123 with some simple extensions.
1124
1125 %N   Article number, left padded with spaces (string)
1126 %S   Subject (string)
1127 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
1128 %n   Name of the poster (string)
1129 %a   Extracted name of the poster (string)
1130 %A   Extracted address of the poster (string)
1131 %F   Contents of the From: header (string)
1132 %x   Contents of the Xref: header (string)
1133 %D   Date of the article (string)
1134 %d   Date of the article (string) in DD-MMM format
1135 %M   Message-id of the article (string)
1136 %r   References of the article (string)
1137 %c   Number of characters in the article (integer)
1138 %L   Number of lines in the article (integer)
1139 %I   Indentation based on thread level (a string of spaces)
1140 %T   A string with two possible values: 80 spaces if the article
1141      is on thread level two or larger and 0 spaces on level one
1142 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
1143 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
1144 %[   Opening bracket (character, \"[\" or \"<\")
1145 %]   Closing bracket (character, \"]\" or \">\")
1146 %>   Spaces of length thread-level (string)
1147 %<   Spaces of length (- 20 thread-level) (string)
1148 %i   Article score (number)
1149 %z   Article zcore (character)
1150 %t   Number of articles under the current thread (number).
1151 %e   Whether the thread is empty or not (character).
1152 %u   User defined specifier.  The next character in the format string should
1153      be a letter.  Gnus will call the function gnus-user-format-function-X,
1154      where X is the letter following %u.  The function will be passed the
1155      current header as argument.  The function should return a string, which
1156      will be inserted into the summary just like information from any other
1157      summary specifier.
1158
1159 Text between %( and %) will be highlighted with `gnus-mouse-face'
1160 when the mouse point is placed inside the area.  There can only be one
1161 such area.
1162
1163 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1164 with care.  For reasons of efficiency, Gnus will compute what column
1165 these characters will end up in, and \"hard-code\" that.  This means that
1166 it is illegal to have these specs after a variable-length spec.  Well,
1167 you might not be arrested, but your summary buffer will look strange,
1168 which is bad enough.
1169
1170 The smart choice is to have these specs as for to the left as
1171 possible.
1172
1173 This restriction may disappear in later versions of Gnus.")
1174
1175 (defvar gnus-summary-dummy-line-format
1176   "*  %(:                          :%) %S\n"
1177   "*The format specification for the dummy roots in the summary buffer.
1178 It works along the same lines as a normal formatting string,
1179 with some simple extensions.
1180
1181 %S  The subject")
1182
1183 (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
1184   "*The format specification for the summary mode line.
1185 It works along the same lines as a normal formatting string,
1186 with some simple extensions:
1187
1188 %G  Group name
1189 %p  Unprefixed group name
1190 %A  Current article number
1191 %V  Gnus version
1192 %U  Number of unread articles in the group
1193 %e  Number of unselected articles in the group
1194 %Z  A string with unread/unselected article counts
1195 %g  Shortish group name
1196 %S  Subject of the current article
1197 %u  User-defined spec
1198 %s  Current score file name
1199 %d  Number of dormant articles
1200 %r  Number of articles that have been marked as read in this session
1201 %E  Number of articles expunged by the score files")
1202
1203 (defvar gnus-article-mode-line-format "Gnus: %%b %S"
1204   "*The format specification for the article mode line.
1205 See `gnus-summary-mode-line-format' for a closer description.")
1206
1207 (defvar gnus-group-mode-line-format "Gnus: %%b {%M:%S}"
1208   "*The format specification for the group mode line.
1209 It works along the same lines as a normal formatting string,
1210 with some simple extensions:
1211
1212 %S   The native news server.
1213 %M   The native select method.")
1214
1215 (defvar gnus-valid-select-methods
1216   '(("nntp" post address prompt-address)
1217     ("nnspool" post)
1218     ("nnvirtual" post-mail virtual prompt-address)
1219     ("nnmbox" mail respool)
1220     ("nnml" mail respool)
1221     ("nnmh" mail respool)
1222     ("nndir" post-mail prompt-address address)
1223     ("nneething" none prompt-address)
1224     ("nndoc" none prompt-address)
1225     ("nnbabyl" mail respool)
1226     ("nnkiboze" post virtual)
1227     ("nnsoup" post-mail)
1228     ("nnfolder" mail respool))
1229   "An alist of valid select methods.
1230 The first element of each list lists should be a string with the name
1231 of the select method.  The other elements may be be the category of
1232 this method (ie. `post', `mail', `none' or whatever) or other
1233 properties that this method has (like being respoolable).
1234 If you implement a new select method, all you should have to change is
1235 this variable.  I think.")
1236
1237 (defvar gnus-updated-mode-lines '(group article summary tree)
1238   "*List of buffers that should update their mode lines.
1239 The list may contain the symbols `group', `article' and `summary'.  If
1240 the corresponding symbol is present, Gnus will keep that mode line
1241 updated with information that may be pertinent.
1242 If this variable is nil, screen refresh may be quicker.")
1243
1244 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1245 (defvar gnus-mode-non-string-length nil
1246   "*Max length of mode-line non-string contents.
1247 If this is nil, Gnus will take space as is needed, leaving the rest
1248 of the modeline intact.")
1249
1250 ;see gnus-cus.el
1251 ;(defvar gnus-mouse-face 'highlight
1252 ;  "*Face used for mouse highlighting in Gnus.
1253 ;No mouse highlights will be done if `gnus-visual' is nil.")
1254
1255 (defvar gnus-summary-mark-below nil
1256   "*Mark all articles with a score below this variable as read.
1257 This variable is local to each summary buffer and usually set by the
1258 score file.")
1259
1260 (defvar gnus-article-sort-functions '(gnus-article-sort-by-number)
1261   "*List of functions used for sorting articles in the summary buffer.
1262 This variable is only used when not using a threaded display.")
1263
1264 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
1265   "*List of functions used for sorting threads in the summary buffer.
1266 By default, threads are sorted by article number.
1267
1268 Each function takes two threads and return non-nil if the first thread
1269 should be sorted before the other.  If you use more than one function,
1270 the primary sort function should be the last.  You should probably
1271 always include `gnus-thread-sort-by-number' in the list of sorting
1272 functions -- preferably first.
1273
1274 Ready-mady functions include `gnus-thread-sort-by-number',
1275 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
1276 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
1277 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
1278
1279 (defvar gnus-thread-score-function '+
1280   "*Function used for calculating the total score of a thread.
1281
1282 The function is called with the scores of the article and each
1283 subthread and should then return the score of the thread.
1284
1285 Some functions you can use are `+', `max', or `min'.")
1286
1287 (defvar gnus-summary-expunge-below nil
1288   "All articles that have a score less than this variable will be expunged.")
1289
1290 (defvar gnus-thread-expunge-below nil
1291   "All threads that have a total score less than this variable will be expunged.
1292 See `gnus-thread-score-function' for en explanation of what a
1293 \"thread score\" is.")
1294
1295 (defvar gnus-auto-subscribed-groups
1296   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
1297   "*All new groups that match this regexp will be subscribed automatically.
1298 Note that this variable only deals with new groups.  It has no effect
1299 whatsoever on old groups.")
1300
1301 (defvar gnus-options-subscribe nil
1302   "*All new groups matching this regexp will be subscribed unconditionally.
1303 Note that this variable deals only with new newsgroups.  This variable
1304 does not affect old newsgroups.")
1305
1306 (defvar gnus-options-not-subscribe nil
1307   "*All new groups matching this regexp will be ignored.
1308 Note that this variable deals only with new newsgroups.  This variable
1309 does not affect old (already subscribed) newsgroups.")
1310
1311 (defvar gnus-auto-expirable-newsgroups nil
1312   "*Groups in which to automatically mark read articles as expirable.
1313 If non-nil, this should be a regexp that should match all groups in
1314 which to perform auto-expiry.  This only makes sense for mail groups.")
1315
1316 (defvar gnus-total-expirable-newsgroups nil
1317   "*Groups in which to perform expiry of all read articles.
1318 Use with extreme caution.  All groups that match this regexp will be
1319 expiring - which means that all read articles will be deleted after
1320 (say) one week.  (This only goes for mail groups and the like, of
1321 course.)")
1322
1323 (defvar gnus-hidden-properties '(invisible t intangible t)
1324   "Property list to use for hiding text.")
1325
1326 (defvar gnus-modtime-botch nil
1327   "*Non-nil means .newsrc should be deleted prior to save.  Its use is
1328 due to the bogus appearance that .newsrc was modified on disc.")
1329
1330 ;; Hooks.
1331
1332 (defvar gnus-group-mode-hook nil
1333   "*A hook for Gnus group mode.")
1334
1335 (defvar gnus-summary-mode-hook nil
1336   "*A hook for Gnus summary mode.
1337 This hook is run before any variables are set in the summary buffer.")
1338
1339 (defvar gnus-article-mode-hook nil
1340   "*A hook for Gnus article mode.")
1341
1342 (defvar gnus-summary-prepare-exit-hook nil
1343   "*A hook called when preparing to exit from the summary buffer.
1344 It calls `gnus-summary-expire-articles' by default.")
1345 (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
1346
1347 (defvar gnus-summary-exit-hook nil
1348   "*A hook called on exit from the summary buffer.")
1349
1350 (defvar gnus-open-server-hook nil
1351   "*A hook called just before opening connection to the news server.")
1352
1353 (defvar gnus-load-hook nil
1354   "*A hook run while Gnus is loaded.")
1355
1356 (defvar gnus-startup-hook nil
1357   "*A hook called at startup.
1358 This hook is called after Gnus is connected to the NNTP server.")
1359
1360 (defvar gnus-get-new-news-hook nil
1361   "*A hook run just before Gnus checks for new news.")
1362
1363 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
1364   "*A function that is called to generate the group buffer.
1365 The function is called with three arguments: The first is a number;
1366 all group with a level less or equal to that number should be listed,
1367 if the second is non-nil, empty groups should also be displayed.  If
1368 the third is non-nil, it is a number.  No groups with a level lower
1369 than this number should be displayed.
1370
1371 The only current function implemented is `gnus-group-prepare-flat'.")
1372
1373 (defvar gnus-group-prepare-hook nil
1374   "*A hook called after the group buffer has been generated.
1375 If you want to modify the group buffer, you can use this hook.")
1376
1377 (defvar gnus-summary-prepare-hook nil
1378   "*A hook called after the summary buffer has been generated.
1379 If you want to modify the summary buffer, you can use this hook.")
1380
1381 (defvar gnus-summary-generate-hook nil
1382   "*A hook run just before generating the summary buffer.
1383 This hook is commonly used to customize threading variables and the
1384 like.")
1385
1386 (defvar gnus-article-prepare-hook nil
1387   "*A hook called after an article has been prepared in the article buffer.
1388 If you want to run a special decoding program like nkf, use this hook.")
1389
1390 ;(defvar gnus-article-display-hook nil
1391 ;  "*A hook called after the article is displayed in the article buffer.
1392 ;The hook is designed to change the contents of the article
1393 ;buffer.  Typical functions that this hook may contain are
1394 ;`gnus-article-hide-headers' (hide selected headers),
1395 ;`gnus-article-maybe-highlight' (perform fancy article highlighting),
1396 ;`gnus-article-hide-signature' (hide signature) and
1397 ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
1398 ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
1399 ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
1400 ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight)
1401
1402 (defvar gnus-article-x-face-command
1403   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
1404   "String or function to be executed to display an X-Face header.
1405 If it is a string, the command will be executed in a sub-shell
1406 asynchronously.  The compressed face will be piped to this command.")
1407
1408 (defvar gnus-article-x-face-too-ugly nil
1409   "Regexp matching posters whose face shouldn't be shown automatically.")
1410
1411 (defvar gnus-select-group-hook nil
1412   "*A hook called when a newsgroup is selected.
1413
1414 If you'd like to simplify subjects like the
1415 `gnus-summary-next-same-subject' command does, you can use the
1416 following hook:
1417
1418  (setq gnus-select-group-hook
1419       (list
1420         (lambda ()
1421           (mapcar (lambda (header)
1422                      (mail-header-set-subject
1423                       header
1424                       (gnus-simplify-subject
1425                        (mail-header-subject header) 're-only)))
1426                   gnus-newsgroup-headers))))")
1427
1428 (defvar gnus-select-article-hook nil
1429   "*A hook called when an article is selected.")
1430
1431 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
1432   "*A hook called to apply kill files to a group.
1433 This hook is intended to apply a kill file to the selected newsgroup.
1434 The function `gnus-apply-kill-file' is called by default.
1435
1436 Since a general kill file is too heavy to use only for a few
1437 newsgroups, I recommend you to use a lighter hook function.  For
1438 example, if you'd like to apply a kill file to articles which contains
1439 a string `rmgroup' in subject in newsgroup `control', you can use the
1440 following hook:
1441
1442  (setq gnus-apply-kill-hook
1443       (list
1444         (lambda ()
1445           (cond ((string-match \"control\" gnus-newsgroup-name)
1446                  (gnus-kill \"Subject\" \"rmgroup\")
1447                  (gnus-expunge \"X\"))))))")
1448
1449 (defvar gnus-visual-mark-article-hook
1450   (list 'gnus-highlight-selected-summary)
1451   "*Hook run after selecting an article in the summary buffer.
1452 It is meant to be used for highlighting the article in some way.  It
1453 is not run if `gnus-visual' is nil.")
1454
1455 (defvar gnus-parse-headers-hook nil
1456   "*A hook called before parsing the headers.")
1457
1458 (defvar gnus-exit-group-hook nil
1459   "*A hook called when exiting (not quitting) summary mode.")
1460
1461 (defvar gnus-suspend-gnus-hook nil
1462   "*A hook called when suspending (not exiting) Gnus.")
1463
1464 (defvar gnus-exit-gnus-hook nil
1465   "*A hook called when exiting Gnus.")
1466
1467 (defvar gnus-save-newsrc-hook nil
1468   "*A hook called before saving any of the newsrc files.")
1469
1470 (defvar gnus-save-quick-newsrc-hook nil
1471   "*A hook called just before saving the quick newsrc file.
1472 Can be used to turn version control on or off.")
1473
1474 (defvar gnus-save-standard-newsrc-hook nil
1475   "*A hook called just before saving the standard newsrc file.
1476 Can be used to turn version control on or off.")
1477
1478 (defvar gnus-summary-update-hook
1479   (list 'gnus-summary-highlight-line)
1480   "*A hook called when a summary line is changed.
1481 The hook will not be called if `gnus-visual' is nil.
1482
1483 The default function `gnus-summary-highlight-line' will
1484 highlight the line according to the `gnus-summary-highlight'
1485 variable.")
1486
1487 (defvar gnus-mark-article-hook (list 'gnus-summary-mark-unread-as-read)
1488   "*A hook called when an article is selected for the first time.
1489 The hook is intended to mark an article as read (or unread)
1490 automatically when it is selected.")
1491
1492 (defvar gnus-group-change-level-function nil
1493   "Function run when a group level is changed.
1494 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.")
1495
1496 ;; Remove any hilit infestation.
1497 (add-hook 'gnus-startup-hook
1498           (lambda ()
1499             (remove-hook 'gnus-summary-prepare-hook
1500                          'hilit-rehighlight-buffer-quietly)
1501             (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
1502             (setq gnus-mark-article-hook '(gnus-summary-mark-unread-as-read))
1503             (remove-hook 'gnus-article-prepare-hook
1504                          'hilit-rehighlight-buffer-quietly)))
1505
1506
1507 \f
1508 ;; Internal variables
1509
1510 (defvar gnus-override-subscribe-method nil)
1511
1512 (defconst gnus-article-mark-lists
1513   '((marked . tick) (replied . reply)
1514     (expirable . expire) (killed . killed)
1515     (bookmarks . bookmark) (dormant . dormant)
1516     (scored . score) (saved . save)
1517     (cached . cache)))
1518
1519 ;; Avoid highlighting in kill files.
1520 (defvar gnus-summary-inhibit-highlight nil)
1521 (defvar gnus-newsgroup-selected-overlay nil)
1522
1523 (defvar gnus-inhibit-hiding nil)
1524 (defvar gnus-topic-indentation "")
1525 (defvar gnus-inhibit-limiting nil)
1526
1527 (defvar gnus-article-mode-map nil)
1528 (defvar gnus-dribble-buffer nil)
1529 (defvar gnus-headers-retrieved-by nil)
1530 (defvar gnus-article-reply nil)
1531 (defvar gnus-override-method nil)
1532 (defvar gnus-article-check-size nil)
1533
1534 (defvar gnus-nocem-hashtb nil)
1535
1536 (defvar gnus-current-score-file nil)
1537 (defvar gnus-newsgroup-adaptive-score-file nil)
1538 (defvar gnus-scores-exclude-files nil)
1539
1540 (defvar gnus-opened-servers nil)
1541
1542 (defvar gnus-current-move-group nil)
1543
1544 (defvar gnus-newsgroup-dependencies nil)
1545 (defvar gnus-newsgroup-async nil)
1546 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1547
1548 (defvar gnus-newsgroup-adaptive nil)
1549
1550 (defvar gnus-summary-display-table nil)
1551 (defvar gnus-summary-display-article-function nil)
1552
1553 (defvar gnus-summary-highlight-line-function nil
1554   "Function called after highlighting a summary line.")
1555
1556 (defvar gnus-group-line-format-alist
1557   `((?M gnus-tmp-marked-mark ?c)
1558     (?S gnus-tmp-subscribed ?c)
1559     (?L gnus-tmp-level ?d)
1560     (?N gnus-tmp-number ?s)
1561     (?R gnus-tmp-number-of-read ?s)
1562     (?t gnus-tmp-number-total ?s)
1563     (?y gnus-tmp-number-of-unread ?s)
1564     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
1565     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
1566     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1567            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
1568     (?g gnus-tmp-group ?s)
1569     (?G gnus-tmp-qualified-group ?s)
1570     (?c (gnus-short-group-name gnus-tmp-group) ?s)
1571     (?D gnus-tmp-newsgroup-description ?s)
1572     (?o gnus-tmp-moderated ?c)
1573     (?O gnus-tmp-moderated-string ?s)
1574     (?p gnus-tmp-process-marked ?c)
1575     (?s gnus-tmp-news-server ?s)
1576     (?n gnus-tmp-news-method ?s)
1577     (?P gnus-topic-indentation ?s)
1578     (?z gnus-tmp-news-method-string ?s)
1579     (?u gnus-tmp-user-defined ?s)))
1580
1581 (defvar gnus-summary-line-format-alist
1582   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1583     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1584     (?s gnus-tmp-subject-or-nil ?s)
1585     (?n gnus-tmp-name ?s)
1586     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1587         ?s)
1588     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
1589             gnus-tmp-from) ?s)
1590     (?F gnus-tmp-from ?s)
1591     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1592     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1593     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1594     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1595     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1596     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1597     (?L gnus-tmp-lines ?d)
1598     (?I gnus-tmp-indentation ?s)
1599     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1600     (?R gnus-tmp-replied ?c)
1601     (?\[ gnus-tmp-opening-bracket ?c)
1602     (?\] gnus-tmp-closing-bracket ?c)
1603     (?\> (make-string gnus-tmp-level ? ) ?s)
1604     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1605     (?i gnus-tmp-score ?d)
1606     (?z gnus-tmp-score-char ?c)
1607     (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
1608     (?U gnus-tmp-unread ?c)
1609     (?t (gnus-summary-number-of-articles-in-thread
1610          (and (boundp 'thread) (car thread)) gnus-tmp-level)
1611         ?d)
1612     (?e (gnus-summary-number-of-articles-in-thread
1613          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1614         ?c)
1615     (?u gnus-tmp-user-defined ?s))
1616   "An alist of format specifications that can appear in summary lines,
1617 and what variables they correspond with, along with the type of the
1618 variable (string, integer, character, etc).")
1619
1620 (defvar gnus-summary-dummy-line-format-alist
1621   (` ((?S gnus-tmp-subject ?s)
1622       (?N gnus-tmp-number ?d)
1623       (?u gnus-tmp-user-defined ?s))))
1624
1625 (defvar gnus-summary-mode-line-format-alist
1626   (` ((?G gnus-tmp-group-name ?s)
1627       (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1628       (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1629       (?A gnus-tmp-article-number ?d)
1630       (?Z gnus-tmp-unread-and-unselected ?s)
1631       (?V gnus-version ?s)
1632       (?U gnus-tmp-unread ?d)
1633       (?S gnus-tmp-subject ?s)
1634       (?e gnus-tmp-unselected ?d)
1635       (?u gnus-tmp-user-defined ?s)
1636       (?d (length gnus-newsgroup-dormant) ?d)
1637       (?t (length gnus-newsgroup-marked) ?d)
1638       (?r (length gnus-newsgroup-reads) ?d)
1639       (?E gnus-newsgroup-expunged-tally ?d)
1640       (?s (gnus-current-score-file-nondirectory) ?s))))
1641
1642 (defvar gnus-article-mode-line-format-alist
1643   gnus-summary-mode-line-format-alist)
1644
1645 (defvar gnus-group-mode-line-format-alist
1646   (` ((?S gnus-tmp-news-server ?s)
1647       (?M gnus-tmp-news-method ?s)
1648       (?u gnus-tmp-user-defined ?s))))
1649
1650 (defvar gnus-have-read-active-file nil)
1651
1652 (defconst gnus-maintainer
1653   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1654   "The mail address of the Gnus maintainers.")
1655
1656 (defconst gnus-version "September Gnus v0.28"
1657   "Version number for this version of Gnus.")
1658
1659 (defvar gnus-info-nodes
1660   '((gnus-group-mode            "(gnus)The Group Buffer")
1661     (gnus-summary-mode          "(gnus)The Summary Buffer")
1662     (gnus-article-mode          "(gnus)The Article Buffer"))
1663   "Assoc list of major modes and related Info nodes.")
1664
1665 (defvar gnus-group-buffer "*Group*")
1666 (defvar gnus-summary-buffer "*Summary*")
1667 (defvar gnus-article-buffer "*Article*")
1668 (defvar gnus-server-buffer "*Server*")
1669
1670 (defvar gnus-work-buffer " *gnus work*")
1671
1672 (defvar gnus-original-article-buffer " *Original Article*")
1673 (defvar gnus-original-article nil)
1674
1675 (defvar gnus-buffer-list nil
1676   "Gnus buffers that should be killed on exit.")
1677
1678 (defvar gnus-server-alist nil
1679   "List of available servers.")
1680
1681 (defvar gnus-slave nil
1682   "Whether this Gnus is a slave or not.")
1683
1684 (defvar gnus-variable-list
1685   '(gnus-newsrc-options gnus-newsrc-options-n
1686     gnus-newsrc-last-checked-date
1687     gnus-newsrc-alist gnus-server-alist
1688     gnus-killed-list gnus-zombie-list
1689     gnus-topic-topology gnus-topic-alist
1690     gnus-format-specs)
1691   "Gnus variables saved in the quick startup file.")
1692
1693 (defvar gnus-newsrc-options nil
1694   "Options line in the .newsrc file.")
1695
1696 (defvar gnus-newsrc-options-n nil
1697   "List of regexps representing groups to be subscribed/ignored unconditionally.")
1698
1699 (defvar gnus-newsrc-last-checked-date nil
1700   "Date Gnus last asked server for new newsgroups.")
1701
1702 (defvar gnus-topic-topology nil
1703   "The complete topic hierarchy.")
1704
1705 (defvar gnus-topic-alist nil
1706   "The complete topic-group alist.")
1707
1708 (defvar gnus-newsrc-alist nil
1709   "Assoc list of read articles.
1710 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1711
1712 (defvar gnus-newsrc-hashtb nil
1713   "Hashtable of gnus-newsrc-alist.")
1714
1715 (defvar gnus-killed-list nil
1716   "List of killed newsgroups.")
1717
1718 (defvar gnus-killed-hashtb nil
1719   "Hash table equivalent of gnus-killed-list.")
1720
1721 (defvar gnus-zombie-list nil
1722   "List of almost dead newsgroups.")
1723
1724 (defvar gnus-description-hashtb nil
1725   "Descriptions of newsgroups.")
1726
1727 (defvar gnus-list-of-killed-groups nil
1728   "List of newsgroups that have recently been killed by the user.")
1729
1730 (defvar gnus-active-hashtb nil
1731   "Hashtable of active articles.")
1732
1733 (defvar gnus-moderated-list nil
1734   "List of moderated newsgroups.")
1735
1736 (defvar gnus-group-marked nil)
1737
1738 (defvar gnus-current-startup-file nil
1739   "Startup file for the current host.")
1740
1741 (defvar gnus-last-search-regexp nil
1742   "Default regexp for article search command.")
1743
1744 (defvar gnus-last-shell-command nil
1745   "Default shell command on article.")
1746
1747 (defvar gnus-current-select-method nil
1748   "The current method for selecting a newsgroup.")
1749
1750 (defvar gnus-group-list-mode nil)
1751
1752 (defvar gnus-article-internal-prepare-hook nil)
1753
1754 (defvar gnus-newsgroup-name nil)
1755 (defvar gnus-newsgroup-begin nil)
1756 (defvar gnus-newsgroup-end nil)
1757 (defvar gnus-newsgroup-last-rmail nil)
1758 (defvar gnus-newsgroup-last-mail nil)
1759 (defvar gnus-newsgroup-last-folder nil)
1760 (defvar gnus-newsgroup-last-file nil)
1761 (defvar gnus-newsgroup-auto-expire nil)
1762 (defvar gnus-newsgroup-active nil)
1763
1764 (defvar gnus-newsgroup-data nil)
1765 (defvar gnus-newsgroup-data-reverse nil)
1766 (defvar gnus-newsgroup-limit nil)
1767 (defvar gnus-newsgroup-limits nil)
1768
1769 (defvar gnus-newsgroup-unreads nil
1770   "List of unread articles in the current newsgroup.")
1771
1772 (defvar gnus-newsgroup-unselected nil
1773   "List of unselected unread articles in the current newsgroup.")
1774
1775 (defvar gnus-newsgroup-reads nil
1776   "Alist of read articles and article marks in the current newsgroup.")
1777
1778 (defvar gnus-newsgroup-expunged-tally nil)
1779
1780 (defvar gnus-newsgroup-marked nil
1781   "List of ticked articles in the current newsgroup (a subset of unread art).")
1782
1783 (defvar gnus-newsgroup-killed nil
1784   "List of ranges of articles that have been through the scoring process.")
1785
1786 (defvar gnus-newsgroup-cached nil
1787   "List of articles that come from the article cache.")
1788
1789 (defvar gnus-newsgroup-saved nil
1790   "List of articles that have been saved.")
1791
1792 (defvar gnus-newsgroup-kill-headers nil)
1793
1794 (defvar gnus-newsgroup-replied nil
1795   "List of articles that have been replied to in the current newsgroup.")
1796
1797 (defvar gnus-newsgroup-expirable nil
1798   "List of articles in the current newsgroup that can be expired.")
1799
1800 (defvar gnus-newsgroup-processable nil
1801   "List of articles in the current newsgroup that can be processed.")
1802
1803 (defvar gnus-newsgroup-bookmarks nil
1804   "List of articles in the current newsgroup that have bookmarks.")
1805
1806 (defvar gnus-newsgroup-dormant nil
1807   "List of dormant articles in the current newsgroup.")
1808
1809 (defvar gnus-newsgroup-scored nil
1810   "List of scored articles in the current newsgroup.")
1811
1812 (defvar gnus-newsgroup-headers nil
1813   "List of article headers in the current newsgroup.")
1814
1815 (defvar gnus-newsgroup-threads nil)
1816
1817 (defvar gnus-newsgroup-prepared nil
1818   "Whether the current group has been prepared properly.")
1819
1820 (defvar gnus-newsgroup-ancient nil
1821   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1822
1823 (defvar gnus-newsgroup-sparse nil)
1824
1825 (defvar gnus-current-article nil)
1826 (defvar gnus-article-current nil)
1827 (defvar gnus-current-headers nil)
1828 (defvar gnus-have-all-headers nil)
1829 (defvar gnus-last-article nil)
1830 (defvar gnus-newsgroup-history nil)
1831 (defvar gnus-current-kill-article nil)
1832
1833 ;; Save window configuration.
1834 (defvar gnus-prev-winconf nil)
1835
1836 (defvar gnus-summary-mark-positions nil)
1837 (defvar gnus-group-mark-positions nil)
1838
1839 (defvar gnus-reffed-article-number nil)
1840
1841 ;;; Let the byte-compiler know that we know about this variable.
1842 (defvar rmail-default-rmail-file)
1843
1844 (defvar gnus-cache-removable-articles nil)
1845
1846 (defvar gnus-dead-summary nil)
1847
1848 (defconst gnus-summary-local-variables
1849   '(gnus-newsgroup-name
1850     gnus-newsgroup-begin gnus-newsgroup-end
1851     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1852     gnus-newsgroup-last-folder gnus-newsgroup-last-file
1853     gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1854     gnus-newsgroup-unselected gnus-newsgroup-marked
1855     gnus-newsgroup-reads gnus-newsgroup-saved
1856     gnus-newsgroup-replied gnus-newsgroup-expirable
1857     gnus-newsgroup-processable gnus-newsgroup-killed
1858     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1859     gnus-newsgroup-headers gnus-newsgroup-threads
1860     gnus-newsgroup-prepared gnus-summary-highlight-line-function
1861     gnus-current-article gnus-current-headers gnus-have-all-headers
1862     gnus-last-article gnus-article-internal-prepare-hook
1863     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1864     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1865     gnus-newsgroup-async 
1866     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
1867     gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
1868     gnus-newsgroup-history gnus-newsgroup-ancient
1869     gnus-newsgroup-sparse
1870     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1871     gnus-newsgroup-adaptive-score-file
1872     (gnus-newsgroup-expunged-tally . 0)
1873     gnus-cache-removeable-articles gnus-newsgroup-cached
1874     gnus-newsgroup-data gnus-newsgroup-data-reverse
1875     gnus-newsgroup-limit gnus-newsgroup-limits)
1876   "Variables that are buffer-local to the summary buffers.")
1877
1878 (defconst gnus-bug-message
1879   "Sending a bug report to the Gnus Towers.
1880 ========================================
1881
1882 The buffer below is a mail buffer.  When you press `C-c C-c', it will
1883 be sent to the Gnus Bug Exterminators.
1884
1885 At the bottom of the buffer you'll see lots of variable settings.
1886 Please do not delete those.  They will tell the Bug People what your
1887 environment is, so that it will be easier to locate the bugs.
1888
1889 If you have found a bug that makes Emacs go \"beep\", set
1890 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
1891 and include the backtrace in your bug report.
1892
1893 Please describe the bug in annoying, painstaking detail.
1894
1895 Thank you for your help in stamping out bugs.
1896 ")
1897
1898 ;;; End of variables.
1899
1900 ;; Define some autoload functions Gnus might use.
1901 (eval-and-compile
1902
1903   ;; This little mapcar goes through the list below and marks the
1904   ;; symbols in question as autoloaded functions.
1905   (mapcar
1906    (lambda (package)
1907      (let ((interactive (nth 1 (memq ':interactive package))))
1908        (mapcar
1909         (lambda (function)
1910           (let (keymap)
1911             (when (consp function)
1912               (setq keymap (car (memq 'keymap function)))
1913               (setq function (car function)))
1914             (autoload function (car package) nil interactive keymap)))
1915         (if (eq (nth 1 package) ':interactive)
1916             (cdddr package)
1917           (cdr package)))))
1918    '(("metamail" metamail-buffer)
1919      ("info" Info-goto-node)
1920      ("hexl" hexl-hex-string-to-integer)
1921      ("pp" pp pp-to-string pp-eval-expression)
1922      ("mail-extr" mail-extract-address-components)
1923      ("nnmail" nnmail-split-fancy nnmail-article-group)
1924      ("nnvirtual" nnvirtual-catchup-group)
1925      ("timezone" timezone-make-date-arpa-standard timezone-fix-time
1926       timezone-make-sortable-date timezone-make-time-string)
1927      ("sendmail" mail-position-on-field mail-setup)
1928      ("rmailout" rmail-output)
1929      ("rnewspost" news-mail-other-window news-reply-yank-original
1930       news-caesar-buffer-body)
1931      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
1932       rmail-show-message)
1933      ("gnus-soup" :interactive t
1934       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
1935       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1936      ("nnsoup" nnsoup-pack-replies)
1937      ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
1938       gnus-Folder-save-name gnus-folder-save-name)
1939      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
1940      ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
1941       gnus-server-make-menu-bar gnus-article-make-menu-bar
1942       gnus-browse-make-menu-bar gnus-highlight-selected-summary
1943       gnus-summary-highlight-line gnus-carpal-setup-buffer
1944       gnus-article-add-button gnus-insert-next-page-button
1945       gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu)
1946      ("gnus-vis" :interactive t
1947       gnus-article-push-button gnus-article-press-button
1948       gnus-article-highlight gnus-article-highlight-some
1949       gnus-article-highlight-headers gnus-article-highlight-signature
1950       gnus-article-add-buttons gnus-article-add-buttons-to-head
1951       gnus-article-next-button gnus-article-prev-button)
1952      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
1953       gnus-demon-add-disconnection gnus-demon-add-handler
1954       gnus-demon-remove-handler)
1955      ("gnus-demon" :interactive t
1956       gnus-demon-init gnus-demon-cancel)
1957      ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
1958       gnus-tree-open gnus-tree-close)
1959      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close)
1960      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
1961      ("gnus-srvr" gnus-browse-foreign-server)
1962      ("gnus-cite" :interactive t
1963       gnus-article-highlight-citation gnus-article-hide-citation-maybe
1964       gnus-article-hide-citation gnus-article-fill-cited-article)
1965      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
1966       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
1967       gnus-execute gnus-expunge)
1968      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
1969       gnus-cache-possibly-remove-articles gnus-cache-request-article
1970       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
1971       gnus-cache-enter-remove-article gnus-cached-article-p
1972       gnus-cache-open gnus-cache-close)
1973      ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
1974       gnus-cache-remove-article)
1975      ("gnus-score" :interactive t
1976       gnus-summary-increase-score gnus-summary-lower-score
1977       gnus-score-flush-cache gnus-score-close
1978       gnus-score-raise-same-subject-and-select
1979       gnus-score-raise-same-subject gnus-score-default
1980       gnus-score-raise-thread gnus-score-lower-same-subject-and-select
1981       gnus-score-lower-same-subject gnus-score-lower-thread
1982       gnus-possibly-score-headers)
1983      ("gnus-score"
1984       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
1985       gnus-current-score-file-nondirectory gnus-score-adaptive
1986       gnus-score-find-trace gnus-score-file-name)
1987      ("gnus-edit" :interactive t gnus-score-customize)
1988      ("gnus-topic" :interactive t gnus-topic-mode)
1989      ("gnus-topic" gnus-topic-remove-group)
1990      ("gnus-salt" :interactive t gnus-pick-mode)
1991      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
1992      ("gnus-uu" :interactive t
1993       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
1994       gnus-uu-mark-series gnus-uu-mark-region
1995       gnus-uu-mark-by-regexp gnus-uu-mark-all
1996       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
1997       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
1998       gnus-uu-decode-unshar-and-save gnus-uu-decode-save
1999       gnus-uu-decode-binhex gnus-uu-decode-uu-view
2000       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
2001       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
2002       gnus-uu-decode-binhex-view)
2003      ("gnus-msg" (gnus-summary-send-map keymap)
2004       gnus-mail-yank-original gnus-mail-send-and-exit
2005       gnus-sendmail-setup-mail gnus-article-mail
2006       gnus-inews-message-id gnus-new-mail gnus-mail-reply)
2007      ("gnus-msg" :interactive t
2008       gnus-group-post-news gnus-group-mail gnus-summary-post-news
2009       gnus-summary-followup gnus-summary-followup-with-original
2010       gnus-summary-followup-and-reply
2011       gnus-summary-followup-and-reply-with-original
2012       gnus-summary-cancel-article gnus-summary-supersede-article
2013       gnus-post-news gnus-inews-news gnus-cancel-news
2014       gnus-summary-reply gnus-summary-reply-with-original
2015       gnus-summary-mail-forward gnus-summary-mail-other-window
2016       gnus-bug)
2017      ("gnus-picon" gnus-article-display-picons)
2018      ("gnus-vm" gnus-vm-mail-setup)
2019      ("gnus-vm" :interactive t gnus-summary-save-in-vm
2020       gnus-summary-save-article-vm gnus-yank-article))))
2021
2022 \f
2023
2024 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2025 ;; If you want the cursor to go somewhere else, set these two
2026 ;; functions in some startup hook to whatever you want.
2027 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
2028 (defalias 'gnus-group-position-point 'gnus-goto-colon)
2029
2030 ;;; Various macros and substs.
2031
2032 (defun gnus-header-from (header)
2033   (mail-header-from header))
2034
2035 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
2036   "Pop to BUFFER, evaluate FORMS, and then return to the original window."
2037   `(let ((GnusStartBufferWindow (selected-window)))
2038      (unwind-protect
2039          (progn
2040            (pop-to-buffer ,buffer)
2041            ,@forms)
2042        (select-window GnusStartBufferWindow))))
2043
2044 (defmacro gnus-gethash (string hashtable)
2045   "Get hash value of STRING in HASHTABLE."
2046   `(symbol-value (intern-soft ,string ,hashtable)))
2047
2048 (defmacro gnus-sethash (string value hashtable)
2049   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2050   `(set (intern ,string ,hashtable) ,value))
2051
2052 (defmacro gnus-intern-safe (string hashtable)
2053   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2054   `(let ((symbol (intern ,string ,hashtable)))
2055      (or (boundp symbol)
2056          (set symbol nil))
2057      symbol))
2058
2059 (defmacro gnus-group-unread (group)
2060   "Get the currently computed number of unread articles in GROUP."
2061   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
2062
2063 (defmacro gnus-active (group)
2064   "Get active info on GROUP."
2065   `(gnus-gethash ,group gnus-active-hashtb))
2066
2067 (defmacro gnus-set-active (group active)
2068   "Set GROUP's active info."
2069   `(gnus-sethash ,group ,active gnus-active-hashtb))
2070
2071 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2072 ;;   function `substring' might cut on a middle of multi-octet
2073 ;;   character.
2074 (defun gnus-truncate-string (str width)
2075   (substring str 0 width))
2076
2077 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
2078 ;; to limit the length of a string.  This function is necessary since
2079 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
2080 (defsubst gnus-limit-string (str width)
2081   (if (> (length str) width)
2082       (substring str 0 width)
2083     str))
2084
2085 (defsubst gnus-simplify-subject-re (subject)
2086   "Remove \"Re:\" from subject lines."
2087   (if (string-match "^[Rr][Ee]: *" subject)
2088       (substring subject (match-end 0))
2089     subject))
2090
2091 (defsubst gnus-goto-char (point)
2092   (and point (goto-char point)))
2093
2094 (defmacro gnus-buffer-exists-p (buffer)
2095   `(and ,buffer
2096         (funcall (if (stringp ,buffer) 'get-buffer 'buffer-name)
2097                  ,buffer)))
2098
2099 (defmacro gnus-kill-buffer (buffer)
2100   `(let ((buf ,buffer))
2101      (if (gnus-buffer-exists-p buf)
2102          (kill-buffer buf))))
2103
2104 (defsubst gnus-point-at-bol ()
2105   "Return point at the beginning of the line."
2106   (let ((p (point)))
2107     (beginning-of-line)
2108     (prog1
2109         (point)
2110       (goto-char p))))
2111
2112 (defsubst gnus-point-at-eol ()
2113   "Return point at the end of the line."
2114   (let ((p (point)))
2115     (end-of-line)
2116     (prog1
2117         (point)
2118       (goto-char p))))
2119
2120 ;; Delete the current line (and the next N lines.);
2121 (defmacro gnus-delete-line (&optional n)
2122   `(delete-region (progn (beginning-of-line) (point))
2123                   (progn (forward-line ,(or n 1)) (point))))
2124
2125 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
2126 (defvar gnus-init-inhibit nil)
2127 (defun gnus-read-init-file (&optional inhibit-next)
2128   (if gnus-init-inhibit
2129       (setq gnus-init-inhibit nil)
2130     (setq gnus-init-inhibit inhibit-next)
2131     (and gnus-init-file
2132          (or (and (file-exists-p gnus-init-file)
2133                   ;; Don't try to load a directory.
2134                   (not (file-directory-p gnus-init-file)))
2135              (file-exists-p (concat gnus-init-file ".el"))
2136              (file-exists-p (concat gnus-init-file ".elc")))
2137          (condition-case var
2138              (load gnus-init-file nil t)
2139            (error
2140             (error "Error in %s: %s" gnus-init-file var))))))
2141
2142 ;; Info access macros.
2143
2144 (defmacro gnus-info-group (info)
2145   `(nth 0 ,info))
2146 (defmacro gnus-info-rank (info)
2147   `(nth 1 ,info))
2148 (defmacro gnus-info-read (info)
2149   `(nth 2 ,info))
2150 (defmacro gnus-info-marks (info)
2151   `(nth 3 ,info))
2152 (defmacro gnus-info-method (info)
2153   `(nth 4 ,info))
2154 (defmacro gnus-info-params (info)
2155   `(nth 5 ,info))
2156
2157 (defmacro gnus-info-level (info)
2158   `(let ((rank (gnus-info-rank ,info)))
2159      (if (consp rank)
2160          (car rank)
2161        rank)))
2162 (defmacro gnus-info-score (info)
2163   `(let ((rank (gnus-info-rank ,info)))
2164      (or (and (consp rank) (cdr rank)) 0)))
2165
2166 (defmacro gnus-info-set-group (info group)
2167   `(setcar ,info ,group))
2168 (defmacro gnus-info-set-rank (info rank)
2169   `(setcar (nthcdr 1 ,info) ,rank))
2170 (defmacro gnus-info-set-read (info read)
2171   `(setcar (nthcdr 2 ,info) ,read))
2172 (defmacro gnus-info-set-marks (info marks)
2173   `(setcar (nthcdr 3 ,info) ,marks))
2174 (defmacro gnus-info-set-method (info method)
2175   `(setcar (nthcdr 4 ,info) ,method))
2176 (defmacro gnus-info-set-params (info params)
2177   `(setcar (nthcdr 5 ,info) ,params))
2178
2179 (defmacro gnus-info-set-level (info level)
2180   `(let ((rank (cdr ,info)))
2181      (if (consp (car rank))
2182          (setcar (car rank) ,level)
2183        (setcar rank ,level))))
2184 (defmacro gnus-info-set-score (info score)
2185   `(let ((rank (cdr ,info)))
2186      (if (consp (car rank))
2187          (setcdr (car rank) ,score)
2188        (setcar rank (cons (car rank) ,score)))))
2189
2190 (defmacro gnus-get-info (group)
2191   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2192
2193 (defun gnus-byte-code (func)
2194   "Return a form that can be `eval'ed based on FUNC."
2195   (let ((fval (symbol-function func)))
2196     (if (byte-code-function-p fval)
2197         (let ((flist (append fval nil)))
2198           (setcar flist 'byte-code)
2199           flist)
2200       (cons 'progn (cdr (cdr fval))))))
2201
2202 ;;; Load the compatability functions.
2203
2204 (require 'gnus-cus)
2205 (require 'gnus-ems)
2206
2207 \f
2208
2209 ;; Format specs.  The chunks below are the machine-generated forms
2210 ;; that are to be evaled as the result of the default format strings.
2211 ;; We write them in here to get them byte-compiled.  That way the
2212 ;; default actions will be quite fast, while still retaining the full
2213 ;; flexibility of the user-defined format specs.
2214
2215 ;; First we have lots of dummy defvars to let the compiler know these
2216 ;; are really dynamic variables.
2217
2218 (defvar gnus-tmp-unread)
2219 (defvar gnus-tmp-replied)
2220 (defvar gnus-tmp-score-char)
2221 (defvar gnus-tmp-indentation)
2222 (defvar gnus-tmp-opening-bracket)
2223 (defvar gnus-tmp-lines)
2224 (defvar gnus-tmp-name)
2225 (defvar gnus-tmp-closing-bracket)
2226 (defvar gnus-tmp-subject-or-nil)
2227 (defvar gnus-tmp-subject)
2228 (defvar gnus-tmp-marked)
2229 (defvar gnus-tmp-marked-mark)
2230 (defvar gnus-tmp-subscribed)
2231 (defvar gnus-tmp-process-marked)
2232 (defvar gnus-tmp-number-of-unread)
2233 (defvar gnus-tmp-group-name)
2234 (defvar gnus-tmp-group)
2235 (defvar gnus-tmp-article-number)
2236 (defvar gnus-tmp-unread-and-unselected)
2237 (defvar gnus-tmp-news-method)
2238 (defvar gnus-tmp-news-server)
2239 (defvar gnus-tmp-article-number)
2240 (defvar gnus-mouse-face)
2241 (defvar gnus-mouse-face-prop)
2242
2243 (defun gnus-summary-line-format-spec ()
2244   (insert gnus-tmp-unread gnus-tmp-replied
2245           gnus-tmp-score-char gnus-tmp-indentation)
2246   (put-text-property
2247    (point)
2248    (progn
2249      (insert
2250       gnus-tmp-opening-bracket
2251       (format "%4d: %-20s"
2252               gnus-tmp-lines
2253               (if (> (length gnus-tmp-name) 20)
2254                   (substring gnus-tmp-name 0 20)
2255                 gnus-tmp-name))
2256       gnus-tmp-closing-bracket)
2257      (point))
2258    gnus-mouse-face-prop gnus-mouse-face)
2259   (insert " " gnus-tmp-subject-or-nil "\n"))
2260
2261 (defvar gnus-summary-line-format-spec
2262   (gnus-byte-code 'gnus-summary-line-format-spec))
2263
2264 (defun gnus-summary-dummy-line-format-spec ()
2265   (insert "*  ")
2266   (put-text-property
2267    (point)
2268    (progn
2269      (insert ":                          :")
2270      (point))
2271    gnus-mouse-face-prop gnus-mouse-face)
2272   (insert " " gnus-tmp-subject "\n"))
2273
2274 (defvar gnus-summary-dummy-line-format-spec
2275   (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
2276
2277 (defun gnus-group-line-format-spec ()
2278   (insert gnus-tmp-marked-mark gnus-tmp-subscribed
2279           gnus-tmp-process-marked
2280           gnus-topic-indentation
2281           (format "%5s: " gnus-tmp-number-of-unread))
2282   (put-text-property
2283    (point)
2284    (progn
2285      (insert gnus-tmp-group "\n")
2286      (1- (point)))
2287    gnus-mouse-face-prop gnus-mouse-face))
2288 (defvar gnus-group-line-format-spec
2289   (gnus-byte-code 'gnus-group-line-format-spec))
2290
2291 (defvar gnus-format-specs
2292   `((version . ,emacs-version)
2293     (group ,gnus-group-line-format ,gnus-group-line-format-spec)
2294     (summary-dummy ,gnus-summary-dummy-line-format
2295                    ,gnus-summary-dummy-line-format-spec)
2296     (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec)))
2297
2298 (defvar gnus-article-mode-line-format-spec nil)
2299 (defvar gnus-summary-mode-line-format-spec nil)
2300 (defvar gnus-group-mode-line-format-spec nil)
2301
2302 ;;; Phew.  All that gruft is over, fortunately.
2303
2304 \f
2305 ;;;
2306 ;;; Gnus Utility Functions
2307 ;;;
2308
2309 (defun gnus-extract-address-components (from)
2310   (let (name address)
2311     ;; First find the address - the thing with the @ in it.  This may
2312     ;; not be accurate in mail addresses, but does the trick most of
2313     ;; the time in news messages.
2314     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
2315         (setq address (substring from (match-beginning 0) (match-end 0))))
2316     ;; Then we check whether the "name <address>" format is used.
2317     (and address
2318          ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2319          ;; Linear white space is not required.
2320          (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
2321          (and (setq name (substring from 0 (match-beginning 0)))
2322               ;; Strip any quotes from the name.
2323               (string-match "\".*\"" name)
2324               (setq name (substring name 1 (1- (match-end 0))))))
2325     ;; If not, then "address (name)" is used.
2326     (or name
2327         (and (string-match "(.+)" from)
2328              (setq name (substring from (1+ (match-beginning 0))
2329                                    (1- (match-end 0)))))
2330         (and (string-match "()" from)
2331              (setq name address))
2332         ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
2333         ;; XOVER might not support folded From headers.
2334         (and (string-match "(.*" from)
2335              (setq name (substring from (1+ (match-beginning 0))
2336                                    (match-end 0)))))
2337     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2338     (list (or name from) (or address from))))
2339
2340 (defun gnus-fetch-field (field)
2341   "Return the value of the header FIELD of current article."
2342   (save-excursion
2343     (save-restriction
2344       (let ((case-fold-search t))
2345         (nnheader-narrow-to-headers)
2346         (mail-fetch-field field)))))
2347
2348 (defun gnus-goto-colon ()
2349   (beginning-of-line)
2350   (search-forward ":" (gnus-point-at-eol) t))
2351
2352 ;;;###autoload
2353 (defun gnus-update-format (var)
2354   "Update the format specification near point."
2355   (interactive
2356    (list
2357     (save-excursion
2358       (eval-defun nil)
2359       ;; Find the end of the current word.
2360       (re-search-forward "[ \t\n]" nil t)
2361       ;; Search backward.
2362       (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
2363         (match-string 1)))))
2364   (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
2365                               (match-string 1 var))))
2366          (entry (assq type gnus-format-specs))
2367          value spec)
2368     (when entry
2369       (setq gnus-format-specs (delq entry gnus-format-specs)))
2370     (set
2371      (intern (format "%s-spec" var))
2372      (gnus-parse-format (setq value (symbol-value (intern var)))
2373                         (symbol-value (intern (format "%s-alist" var)))
2374                         (not (string-match "mode" var))))
2375     (setq spec (symbol-value (intern (format "%s-spec" var))))
2376     (push (list type value spec) gnus-format-specs)
2377
2378     (pop-to-buffer "*Gnus Format*")
2379     (erase-buffer)
2380     (lisp-interaction-mode)
2381     (insert (pp-to-string spec))))
2382
2383
2384 (defun gnus-update-format-specifications (&optional force)
2385   "Update all (necessary) format specifications."
2386   ;; Make the indentation array.
2387   (gnus-make-thread-indent-array)
2388
2389   (when (or force
2390             (and (assq 'version gnus-format-specs)
2391                  (not (equal emacs-version
2392                              (cdr (assq 'version gnus-format-specs))))))
2393     (setq gnus-format-specs nil))
2394
2395   (let ((types '(summary summary-dummy group
2396                            summary-mode group-mode article-mode))
2397         old-format new-format entry type val)
2398     (while types
2399       (setq type (pop types))
2400       (setq new-format (symbol-value
2401                         (intern (format "gnus-%s-line-format" type))))
2402       (setq entry (cdr (assq type gnus-format-specs)))
2403       (if (and entry
2404                (equal (car entry) new-format))
2405           (set (intern (format "gnus-%s-line-format-spec" type))
2406                (car (cdr entry)))
2407         (setq val
2408               (if (not (stringp new-format))
2409                   ;; This is a function call or something.
2410                   new-format
2411                 ;; This is a "real" format.
2412                 (gnus-parse-format
2413                  new-format
2414                  (symbol-value
2415                   (intern (format "gnus-%s-line-format-alist"
2416                                   (if (eq type 'article-mode)
2417                                       'summary-mode type))))
2418                  (not (string-match "mode$" (symbol-name type))))))
2419         (set (intern (format "gnus-%s-line-format-spec" type)) val)
2420         (if entry
2421             (setcar (cdr entry) val)
2422           (push (list type new-format val) gnus-format-specs)))))
2423
2424   (gnus-update-group-mark-positions)
2425   (gnus-update-summary-mark-positions)
2426
2427   (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
2428            (not gnus-description-hashtb)
2429            gnus-read-active-file)
2430       (gnus-read-all-descriptions-files)))
2431
2432 (defun gnus-update-summary-mark-positions ()
2433   (save-excursion
2434     (let ((gnus-replied-mark 129)
2435           (gnus-score-below-mark 130)
2436           (gnus-score-over-mark 130)
2437           (thread nil)
2438           (gnus-visual nil)
2439           pos)
2440       (gnus-set-work-buffer)
2441       (gnus-summary-insert-line
2442        [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
2443       (goto-char (point-min))
2444       (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
2445                                          (- (point) 2)))))
2446       (goto-char (point-min))
2447       (setq pos (cons (cons 'replied (and (search-forward "\201" nil t)
2448                                           (- (point) 2))) pos))
2449       (goto-char (point-min))
2450       (setq pos (cons (cons 'score (and (search-forward "\202" nil t)
2451                                         (- (point) 2))) pos))
2452       (setq gnus-summary-mark-positions pos))))
2453
2454 (defun gnus-update-group-mark-positions ()
2455   (save-excursion
2456     (let ((gnus-process-mark 128)
2457           (gnus-group-marked '("dummy.group")))
2458       (gnus-set-active "dummy.group" '(0 . 0))
2459       (gnus-set-work-buffer)
2460       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
2461       (goto-char (point-min))
2462       (setq gnus-group-mark-positions
2463             (list (cons 'process (and (search-forward "\200" nil t)
2464                                       (- (point) 2))))))))
2465
2466 (defvar gnus-mouse-face-0 'highlight)
2467 (defvar gnus-mouse-face-1 'highlight)
2468 (defvar gnus-mouse-face-2 'highlight)
2469 (defvar gnus-mouse-face-3 'highlight)
2470 (defvar gnus-mouse-face-4 'highlight)
2471
2472 (defun gnus-mouse-face-function (form type)
2473   `(put-text-property
2474     (point) (progn ,@form (point))
2475     gnus-mouse-face-prop
2476     ,(if (equal type 0)
2477          'gnus-mouse-face
2478        `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
2479
2480 (defvar gnus-face-0 'bold)
2481 (defvar gnus-face-1 'italic)
2482 (defvar gnus-face-2 'bold-italic)
2483 (defvar gnus-face-3 'bold)
2484 (defvar gnus-face-4 'bold)
2485
2486 (defun gnus-face-face-function (form type)
2487   `(put-text-property
2488     (point) (progn ,@form (point))
2489     'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
2490
2491 (defun gnus-max-width-function (el max-width)
2492   (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
2493   (if (symbolp el)
2494       `(if (> (length ,el) ,max-width)
2495            (substring ,el 0 ,max-width)
2496          ,el)
2497     `(let ((val (eval ,el)))
2498        (if (numberp val)
2499            (setq val (int-to-string val)))
2500        (if (> (length val) ,max-width)
2501            (substring val 0 ,max-width)
2502          val))))
2503
2504 (defun gnus-parse-format (format spec-alist &optional insert)
2505   ;; This function parses the FORMAT string with the help of the
2506   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
2507   ;; string.  If the FORMAT string contains the specifiers %( and %)
2508   ;; the text between them will have the mouse-face text property.
2509   (if (string-match
2510        "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
2511        format)
2512       (gnus-parse-complex-format format spec-alist)
2513     ;; This is a simple format.
2514     (gnus-parse-simple-format format spec-alist insert)))
2515
2516 (defun gnus-parse-complex-format (format spec-alist)
2517   (save-excursion
2518     (gnus-set-work-buffer)
2519     (insert format)
2520     (goto-char (point-min))
2521     (while (re-search-forward "\"" nil t)
2522       (replace-match "\\\"" nil t))
2523     (goto-char (point-min))
2524     (insert "(\"")
2525     (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
2526       (let ((number (if (match-beginning 1)
2527                         (match-string 1) "0"))
2528             (delim (aref (match-string 2) 0)))
2529         (if (or (= delim ?\() (= delim ?\{))
2530             (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
2531                                    " " number " \""))
2532           (replace-match "\")\""))))
2533     (goto-char (point-max))
2534     (insert "\")")
2535     (goto-char (point-min))
2536     (let ((form (read (current-buffer))))
2537       (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
2538
2539 (defun gnus-complex-form-to-spec (form spec-alist)
2540   (delq nil
2541         (mapcar
2542          (lambda (sform)
2543            (if (stringp sform)
2544                (gnus-parse-simple-format sform spec-alist t)
2545              (funcall (intern (format "gnus-%s-face-function"
2546                                       (car sform)))
2547                       (gnus-complex-form-to-spec
2548                        (cdr (cdr sform)) spec-alist)
2549                       (nth 1 sform))))
2550          form)))
2551
2552 (defun gnus-parse-simple-format (format spec-alist &optional insert)
2553   ;; This function parses the FORMAT string with the help of the
2554   ;; SPEC-ALIST and returns a list that can be eval'ed to return a
2555   ;; string.
2556   (let ((max-width 0)
2557         spec flist fstring newspec elem beg result dontinsert)
2558     (save-excursion
2559       (gnus-set-work-buffer)
2560       (insert format)
2561       (goto-char (point-min))
2562       (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
2563                                 nil t)
2564         (if (= (setq spec (string-to-char (match-string 2))) ?%)
2565               (setq newspec "%"
2566                     beg (1+ (match-beginning 0)))
2567           ;; First check if there are any specs that look anything like
2568           ;; "%12,12A", ie. with a "max width specification".  These have
2569           ;; to be treated specially.
2570           (if (setq beg (match-beginning 1))
2571               (setq max-width
2572                     (string-to-int
2573                      (buffer-substring
2574                       (1+ (match-beginning 1)) (match-end 1))))
2575             (setq max-width 0)
2576             (setq beg (match-beginning 2)))
2577           ;; Find the specification from `spec-alist'.
2578           (unless (setq elem (cdr (assq spec spec-alist)))
2579             (setq elem '("*" ?s)))
2580           ;; Treat user defined format specifiers specially.
2581           (when (eq (car elem) 'gnus-tmp-user-defined)
2582             (setq elem
2583                   (list
2584                    (list (intern (concat "gnus-user-format-function-"
2585                                          (match-string 3)))
2586                          'gnus-tmp-header) ?s))
2587             (delete-region (match-beginning 3) (match-end 3)))
2588           (if (not (zerop max-width))
2589               (let ((el (car elem)))
2590                 (cond ((= (car (cdr elem)) ?c)
2591                        (setq el (list 'char-to-string el)))
2592                       ((= (car (cdr elem)) ?d)
2593                        (setq el (list 'int-to-string el))))
2594                 (setq flist (cons (gnus-max-width-function el max-width)
2595                                   flist))
2596                 (setq newspec ?s))
2597             (progn
2598               (setq flist (cons (car elem) flist))
2599               (setq newspec (car (cdr elem))))))
2600         ;; Remove the old specification (and possibly a ",12" string).
2601         (delete-region beg (match-end 2))
2602         ;; Insert the new specification.
2603         (goto-char beg)
2604         (insert newspec))
2605       (setq fstring (buffer-substring 1 (point-max))))
2606     ;; Do some postprocessing to increase efficiency.
2607     (setq
2608      result
2609      (cond
2610       ;; Emptyness.
2611       ((string= fstring "")
2612        nil)
2613       ;; Not a format string.
2614       ((not (string-match "%" fstring))
2615        (list fstring))
2616       ;; A format string with just a single string spec.
2617       ((string= fstring "%s")
2618        (list (car flist)))
2619       ;; A single character.
2620       ((string= fstring "%c")
2621        (list (car flist)))
2622       ;; A single number.
2623       ((string= fstring "%d")
2624        (setq dontinsert)
2625        (if insert
2626            (list `(princ ,(car flist)))
2627          (list `(int-to-string ,(car flist)))))
2628       ;; Just lots of chars and strings.
2629       ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
2630        (nreverse flist))
2631       ;; A single string spec at the beginning of the spec.
2632       ((string-match "\\`%[sc][^%]+\\'" fstring)
2633        (list (car flist) (substring fstring 2)))
2634       ;; A single string spec in the middle of the spec.
2635       ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
2636        (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
2637       ;; A single string spec in the end of the spec.
2638       ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
2639        (list (match-string 1 fstring) (car flist)))
2640       ;; A more complex spec.
2641       (t
2642        (list (cons 'format (cons fstring (nreverse flist)))))))
2643
2644     (if insert
2645         (when result
2646           (if dontinsert
2647               result
2648             (cons 'insert result)))
2649       (cond ((stringp result)
2650              result)
2651             ((consp result)
2652              (cons 'concat result))
2653             (t "")))))
2654
2655 (defun gnus-eval-format (format &optional alist props)
2656   "Eval the format variable FORMAT, using ALIST.
2657 If PROPS, insert the result."
2658   (let ((form (gnus-parse-format format alist props)))
2659     (if props
2660         (add-text-properties (point) (progn (eval form) (point)) props)
2661       (eval form))))
2662
2663 (defun gnus-remove-text-with-property (prop)
2664   "Delete all text in the current buffer with text property PROP."
2665   (save-excursion
2666     (goto-char (point-min))
2667     (while (not (eobp))
2668       (while (get-text-property (point) prop)
2669         (delete-char 1))
2670       (goto-char (next-single-property-change (point) prop nil (point-max))))))
2671
2672 (defun gnus-set-work-buffer ()
2673   (if (get-buffer gnus-work-buffer)
2674       (progn
2675         (set-buffer gnus-work-buffer)
2676         (erase-buffer))
2677     (set-buffer (get-buffer-create gnus-work-buffer))
2678     (kill-all-local-variables)
2679     (buffer-disable-undo (current-buffer))
2680     (gnus-add-current-to-buffer-list)))
2681
2682 ;; Article file names when saving.
2683
2684 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
2685   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2686 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
2687 Otherwise, it is like ~/News/news/group/num."
2688   (let ((default
2689           (expand-file-name
2690            (concat (if (gnus-use-long-file-name 'not-save)
2691                        (gnus-capitalize-newsgroup newsgroup)
2692                      (gnus-newsgroup-directory-form newsgroup))
2693                    "/" (int-to-string (mail-header-number headers)))
2694            (or gnus-article-save-directory "~/News"))))
2695     (if (and last-file
2696              (string-equal (file-name-directory default)
2697                            (file-name-directory last-file))
2698              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2699         default
2700       (or last-file default))))
2701
2702 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
2703   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2704 If variable `gnus-use-long-file-name' is non-nil, it is
2705 ~/News/news.group/num.  Otherwise, it is like ~/News/news/group/num."
2706   (let ((default
2707           (expand-file-name
2708            (concat (if (gnus-use-long-file-name 'not-save)
2709                        newsgroup
2710                      (gnus-newsgroup-directory-form newsgroup))
2711                    "/" (int-to-string (mail-header-number headers)))
2712            (or gnus-article-save-directory "~/News"))))
2713     (if (and last-file
2714              (string-equal (file-name-directory default)
2715                            (file-name-directory last-file))
2716              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2717         default
2718       (or last-file default))))
2719
2720 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
2721   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2722 If variable `gnus-use-long-file-name' is non-nil, it is
2723 ~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
2724   (or last-file
2725       (expand-file-name
2726        (if (gnus-use-long-file-name 'not-save)
2727            (gnus-capitalize-newsgroup newsgroup)
2728          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2729        (or gnus-article-save-directory "~/News"))))
2730
2731 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2732   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2733 If variable `gnus-use-long-file-name' is non-nil, it is
2734 ~/News/news.group.  Otherwise, it is like ~/News/news/group/news."
2735   (or last-file
2736       (expand-file-name
2737        (if (gnus-use-long-file-name 'not-save)
2738            newsgroup
2739          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2740        (or gnus-article-save-directory "~/News"))))
2741
2742 ;; For subscribing new newsgroup
2743
2744 (defun gnus-subscribe-hierarchical-interactive (groups)
2745   (let ((groups (sort groups 'string<))
2746         prefixes prefix start ans group starts)
2747     (while groups
2748       (setq prefixes (list "^"))
2749       (while (and groups prefixes)
2750         (while (not (string-match (car prefixes) (car groups)))
2751           (setq prefixes (cdr prefixes)))
2752         (setq prefix (car prefixes))
2753         (setq start (1- (length prefix)))
2754         (if (and (string-match "[^\\.]\\." (car groups) start)
2755                  (cdr groups)
2756                  (setq prefix
2757                        (concat "^" (substring (car groups) 0 (match-end 0))))
2758                  (string-match prefix (car (cdr groups))))
2759             (progn
2760               (setq prefixes (cons prefix prefixes))
2761               (message "Descend hierarchy %s? ([y]nsq): "
2762                        (substring prefix 1 (1- (length prefix))))
2763               (setq ans (read-char))
2764               (cond ((= ans ?n)
2765                      (while (and groups
2766                                  (string-match prefix
2767                                                (setq group (car groups))))
2768                        (setq gnus-killed-list
2769                              (cons group gnus-killed-list))
2770                        (gnus-sethash group group gnus-killed-hashtb)
2771                        (setq groups (cdr groups)))
2772                      (setq starts (cdr starts)))
2773                     ((= ans ?s)
2774                      (while (and groups
2775                                  (string-match prefix
2776                                                (setq group (car groups))))
2777                        (gnus-sethash group group gnus-killed-hashtb)
2778                        (gnus-subscribe-alphabetically (car groups))
2779                        (setq groups (cdr groups)))
2780                      (setq starts (cdr starts)))
2781                     ((= ans ?q)
2782                      (while groups
2783                        (setq group (car groups))
2784                        (setq gnus-killed-list (cons group gnus-killed-list))
2785                        (gnus-sethash group group gnus-killed-hashtb)
2786                        (setq groups (cdr groups))))
2787                     (t nil)))
2788           (message "Subscribe %s? ([n]yq)" (car groups))
2789           (setq ans (read-char))
2790           (setq group (car groups))
2791           (cond ((= ans ?y)
2792                  (gnus-subscribe-alphabetically (car groups))
2793                  (gnus-sethash group group gnus-killed-hashtb))
2794                 ((= ans ?q)
2795                  (while groups
2796                    (setq group (car groups))
2797                    (setq gnus-killed-list (cons group gnus-killed-list))
2798                    (gnus-sethash group group gnus-killed-hashtb)
2799                    (setq groups (cdr groups))))
2800                 (t
2801                  (setq gnus-killed-list (cons group gnus-killed-list))
2802                  (gnus-sethash group group gnus-killed-hashtb)))
2803           (setq groups (cdr groups)))))))
2804
2805 (defun gnus-subscribe-randomly (newsgroup)
2806   "Subscribe new NEWSGROUP by making it the first newsgroup."
2807   (gnus-subscribe-newsgroup newsgroup))
2808
2809 (defun gnus-subscribe-alphabetically (newgroup)
2810   "Subscribe new NEWSGROUP and insert it in alphabetical order."
2811   (let ((groups (cdr gnus-newsrc-alist))
2812         before)
2813     (while (and (not before) groups)
2814       (if (string< newgroup (car (car groups)))
2815           (setq before (car (car groups)))
2816         (setq groups (cdr groups))))
2817     (gnus-subscribe-newsgroup newgroup before)))
2818
2819 (defun gnus-subscribe-hierarchically (newgroup)
2820   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
2821   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2822   (save-excursion
2823     (set-buffer (find-file-noselect gnus-current-startup-file))
2824     (let ((groupkey newgroup)
2825           before)
2826       (while (and (not before) groupkey)
2827         (goto-char (point-min))
2828         (let ((groupkey-re
2829                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
2830           (while (and (re-search-forward groupkey-re nil t)
2831                       (progn
2832                         (setq before (match-string 1))
2833                         (string< before newgroup)))))
2834         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
2835         (setq groupkey
2836               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
2837                   (substring groupkey (match-beginning 1) (match-end 1)))))
2838       (gnus-subscribe-newsgroup newgroup before))))
2839
2840 (defun gnus-subscribe-interactively (group)
2841   "Subscribe the new GROUP interactively.
2842 It is inserted in hierarchical newsgroup order if subscribed.  If not,
2843 it is killed."
2844   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
2845       (gnus-subscribe-hierarchically group)
2846     (push group gnus-killed-list)))
2847
2848 (defun gnus-subscribe-zombies (group)
2849   "Make the new GROUP into a zombie group."
2850   (push group gnus-zombie-list))
2851
2852 (defun gnus-subscribe-killed (group)
2853   "Make the new GROUP a killed group."
2854   (push group gnus-killed-list))
2855
2856 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
2857   "Subscribe new NEWSGROUP.
2858 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
2859 the first newsgroup."
2860   ;; We subscribe the group by changing its level to `subscribed'.
2861   (gnus-group-change-level
2862    newsgroup gnus-level-default-subscribed
2863    gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
2864   (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
2865
2866 ;; For directories
2867
2868 (defun gnus-newsgroup-directory-form (newsgroup)
2869   "Make hierarchical directory name from NEWSGROUP name."
2870   (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
2871         (len (length newsgroup))
2872         idx)
2873     ;; If this is a foreign group, we don't want to translate the
2874     ;; entire name.
2875     (if (setq idx (string-match ":" newsgroup))
2876         (aset newsgroup idx ?/)
2877       (setq idx 0))
2878     ;; Replace all occurrences of `.' with `/'.
2879     (while (< idx len)
2880       (if (= (aref newsgroup idx) ?.)
2881           (aset newsgroup idx ?/))
2882       (setq idx (1+ idx)))
2883     newsgroup))
2884
2885 (defun gnus-newsgroup-savable-name (group)
2886   ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
2887   ;; with dots.
2888   (nnheader-replace-chars-in-string group ?/ ?.))
2889
2890 (defun gnus-make-directory (dir)
2891   "Make DIRECTORY recursively."
2892   ;; Why don't we use `(make-directory dir 'parents)'?  That's just one
2893   ;; of the many mysteries of the universe.
2894   (let* ((dir (expand-file-name dir default-directory))
2895          dirs err)
2896     (if (string-match "/$" dir)
2897         (setq dir (substring dir 0 (match-beginning 0))))
2898     ;; First go down the path until we find a directory that exists.
2899     (while (not (file-exists-p dir))
2900       (setq dirs (cons dir dirs))
2901       (string-match "/[^/]+$" dir)
2902       (setq dir (substring dir 0 (match-beginning 0))))
2903     ;; Then create all the subdirs.
2904     (while (and dirs (not err))
2905       (condition-case ()
2906           (make-directory (car dirs))
2907         (error (setq err t)))
2908       (setq dirs (cdr dirs)))
2909     ;; We return whether we were successful or not.
2910     (not dirs)))
2911
2912 (defun gnus-capitalize-newsgroup (newsgroup)
2913   "Capitalize NEWSGROUP name."
2914   (and (not (zerop (length newsgroup)))
2915        (concat (char-to-string (upcase (aref newsgroup 0)))
2916                (substring newsgroup 1))))
2917
2918 ;; Various... things.
2919
2920 (defun gnus-simplify-subject (subject &optional re-only)
2921   "Remove `Re:' and words in parentheses.
2922 If RE-ONLY is non-nil, strip leading `Re:'s only."
2923   (let ((case-fold-search t))           ;Ignore case.
2924     ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
2925     (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
2926       (setq subject (substring subject (match-end 0))))
2927     ;; Remove uninteresting prefixes.
2928     (if (and (not re-only)
2929              gnus-simplify-ignored-prefixes
2930              (string-match gnus-simplify-ignored-prefixes subject))
2931         (setq subject (substring subject (match-end 0))))
2932     ;; Remove words in parentheses from end.
2933     (unless re-only
2934       (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
2935         (setq subject (substring subject 0 (match-beginning 0)))))
2936     ;; Return subject string.
2937     subject))
2938
2939 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
2940 ;; all whitespace.
2941 ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
2942 (defun gnus-simplify-buffer-fuzzy ()
2943   (goto-char (point-min))
2944   (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*" nil t)
2945   (goto-char (match-beginning 0))
2946   (while (or
2947           (looking-at "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*")
2948           (looking-at "^[[].*:[ \t].*[]]$"))
2949     (goto-char (point-min))
2950     (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
2951                               nil t)
2952       (replace-match "" t t))
2953     (goto-char (point-min))
2954     (while (re-search-forward "^[[].*:[ \t].*[]]$" nil t)
2955       (goto-char (match-end 0))
2956       (delete-char -1)
2957       (delete-region
2958        (progn (goto-char (match-beginning 0)))
2959        (re-search-forward ":"))))
2960   (goto-char (point-min))
2961   (while (re-search-forward "[ \t\n]*([^()]*)[ \t]*$" nil t)
2962     (replace-match "" t t))
2963   (goto-char (point-min))
2964   (while (re-search-forward "[ \t]+" nil t)
2965     (replace-match " " t t))
2966   (goto-char (point-min))
2967   (while (re-search-forward "[ \t]+$" nil t)
2968     (replace-match "" t t))
2969   (goto-char (point-min))
2970   (while (re-search-forward "^[ \t]+" nil t)
2971     (replace-match "" t t))
2972   (goto-char (point-min))
2973   (if gnus-simplify-subject-fuzzy-regexp
2974       (if (listp gnus-simplify-subject-fuzzy-regexp)
2975           (let ((list gnus-simplify-subject-fuzzy-regexp))
2976             (while list
2977               (goto-char (point-min))
2978               (while (re-search-forward (car list) nil t)
2979                 (replace-match "" t t))
2980               (setq list (cdr list))))
2981         (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
2982           (replace-match "" t t)))))
2983
2984 (defun gnus-simplify-subject-fuzzy (subject)
2985   "Siplify a subject string fuzzily."
2986   (let ((case-fold-search t))
2987     (save-excursion
2988       (gnus-set-work-buffer)
2989       (insert subject)
2990       (inline (gnus-simplify-buffer-fuzzy))
2991       (buffer-string))))
2992
2993 ;; Add the current buffer to the list of buffers to be killed on exit.
2994 (defun gnus-add-current-to-buffer-list ()
2995   (or (memq (current-buffer) gnus-buffer-list)
2996       (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
2997
2998 (defun gnus-string> (s1 s2)
2999   (not (or (string< s1 s2)
3000            (string= s1 s2))))
3001
3002 ;;; General various misc type functions.
3003
3004 (defun gnus-clear-system ()
3005   "Clear all variables and buffers."
3006   ;; Clear Gnus variables.
3007   (let ((variables gnus-variable-list))
3008     (while variables
3009       (set (car variables) nil)
3010       (setq variables (cdr variables))))
3011   ;; Clear other internal variables.
3012   (setq gnus-list-of-killed-groups nil
3013         gnus-have-read-active-file nil
3014         gnus-newsrc-alist nil
3015         gnus-newsrc-hashtb nil
3016         gnus-killed-list nil
3017         gnus-zombie-list nil
3018         gnus-killed-hashtb nil
3019         gnus-active-hashtb nil
3020         gnus-moderated-list nil
3021         gnus-description-hashtb nil
3022         gnus-newsgroup-headers nil
3023         gnus-newsgroup-name nil
3024         gnus-server-alist nil
3025         gnus-opened-servers nil
3026         gnus-current-select-method nil)
3027   ;; Reset any score variables.
3028   (and gnus-use-scoring (gnus-score-close))
3029   ;; Kill the startup file.
3030   (and gnus-current-startup-file
3031        (get-file-buffer gnus-current-startup-file)
3032        (kill-buffer (get-file-buffer gnus-current-startup-file)))
3033   ;; Save any cache buffers.
3034   (and gnus-use-cache (gnus-cache-save-buffers))
3035   ;; Clear the dribble buffer.
3036   (gnus-dribble-clear)
3037   ;; Close down NoCeM.
3038   (and gnus-use-nocem (gnus-nocem-close))
3039   ;; Shut down the demons.
3040   (and gnus-use-demon (gnus-demon-cancel))
3041   ;; Kill global KILL file buffer.
3042   (if (get-file-buffer (gnus-newsgroup-kill-file nil))
3043       (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
3044   (gnus-kill-buffer nntp-server-buffer)
3045   ;; Backlog.
3046   (and gnus-keep-backlog (gnus-backlog-shutdown))
3047   ;; Kill Gnus buffers.
3048   (while gnus-buffer-list
3049     (gnus-kill-buffer (car gnus-buffer-list))
3050     (setq gnus-buffer-list (cdr gnus-buffer-list))))
3051
3052 (defun gnus-windows-old-to-new (setting)
3053   ;; First we take care of the really, really old Gnus 3 actions.
3054   (if (symbolp setting)
3055       (setq setting
3056             (cond ((memq setting '(SelectArticle))
3057                    'article)
3058                   ((memq setting '(SelectSubject ExpandSubject))
3059                    'summary)
3060                   ((memq setting '(SelectNewsgroup ExitNewsgroup))
3061                    'group)
3062                   (t setting))))
3063   (if (or (listp setting)
3064           (not (and gnus-window-configuration
3065                     (memq setting '(group summary article)))))
3066       setting
3067     (let* ((setting (if (eq setting 'group)
3068                         (if (assq 'newsgroup gnus-window-configuration)
3069                             'newsgroup
3070                           'newsgroups) setting))
3071            (elem (car (cdr (assq setting gnus-window-configuration))))
3072            (total (apply '+ elem))
3073            (types '(group summary article))
3074            (pbuf (if (eq setting 'newsgroups) 'group 'summary))
3075            (i 0)
3076            perc
3077            out)
3078       (while (< i 3)
3079         (or (not (numberp (nth i elem)))
3080             (zerop (nth i elem))
3081             (progn
3082               (setq perc  (/ (float (nth 0 elem)) total))
3083               (setq out (cons (if (eq pbuf (nth i types))
3084                                   (vector (nth i types) perc 'point)
3085                                 (vector (nth i types) perc))
3086                               out))))
3087         (setq i (1+ i)))
3088       (list (nreverse out)))))
3089
3090 (defun gnus-add-configuration (conf)
3091   "Add the window configuration CONF to `gnus-buffer-configuration'."
3092   (setq gnus-buffer-configuration
3093         (cons conf (delq (assq (car conf) gnus-buffer-configuration)
3094                          gnus-buffer-configuration))))
3095
3096 (defvar gnus-frame-list nil)
3097
3098 (defun gnus-configure-frame (split &optional window)
3099   "Split WINDOW according to SPLIT."
3100   (unless window
3101     (setq window (get-buffer-window (current-buffer))))
3102   (select-window window)
3103   ;; This might be an old-stylee buffer config.
3104   (when (vectorp split)
3105     (setq split (append split nil)))
3106   (when (or (consp (car split))
3107             (vectorp (car split)))
3108     (push 1.0 split)
3109     (push 'vertical split))
3110   ;; The SPLIT might be something that is to be evaled to
3111   ;; return a new SPLIT.
3112   (while (and (not (assq (car split) gnus-window-to-buffer))
3113               (gnus-functionp (car split)))
3114     (setq split (eval split)))
3115   (let* ((type (car split))
3116          (subs (cddr split))
3117          (len (if (eq type 'horizontal) (window-width) (window-height)))
3118          (total 0)
3119          (window-min-width (or gnus-window-min-width window-min-width))
3120          (window-min-height (or gnus-window-min-height window-min-height))
3121          s result new-win rest comp-subs size sub)
3122     (cond
3123      ;; Nothing to do here.
3124      ((null split))
3125      ;; Don't switch buffers.
3126      ((null type)
3127       (and (memq 'point split) window))
3128      ;; This is a buffer to be selected.
3129      ((not (memq type '(frame horizontal vertical)))
3130       (let ((buffer (cond ((stringp type) type)
3131                           (t (cdr (assq type gnus-window-to-buffer)))))
3132             buf)
3133         (unless buffer
3134           (error "Illegal buffer type: %s" type))
3135         (unless (setq buf (get-buffer (if (symbolp buffer)
3136                                           (symbol-value buffer) buffer)))
3137           (setq buf (get-buffer-create (if (symbolp buffer)
3138                                            (symbol-value buffer) buffer))))
3139         (switch-to-buffer buf)
3140         ;; We return the window if it has the `point' spec.
3141         (and (memq 'point split) window)))
3142      ;; This is a frame split.
3143      ((eq type 'frame)
3144       (unless gnus-frame-list
3145         (setq gnus-frame-list (list (window-frame
3146                                      (get-buffer-window (current-buffer))))))
3147       (let ((i 0)
3148             params frame fresult)
3149         (while (< i (length subs))
3150           ;; Frame parameter is gotten from the sub-split.
3151           (setq params (cadr (elt subs i)))
3152           ;; It should be a list.
3153           (unless (listp params)
3154             (setq params nil))
3155           ;; Create a new frame?
3156           (unless (setq frame (elt gnus-frame-list i))
3157             (nconc gnus-frame-list (list (setq frame (make-frame params)))))
3158           ;; Is the old frame still alive?
3159           (unless (frame-live-p frame)
3160             (setcar (nthcdr i gnus-frame-list)
3161                     (setq frame (make-frame params))))
3162           ;; Select the frame in question and do more splits there.
3163           (select-frame frame)
3164           (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
3165           (incf i))
3166         ;; Select the frame that has the selected buffer.
3167         (when fresult
3168           (select-frame (window-frame fresult)))))
3169      ;; This is a normal split.
3170      (t
3171       (when (> (length subs) 0)
3172         ;; First we have to compute the sizes of all new windows.
3173         (while subs
3174           (setq sub (append (pop subs) nil))
3175           (while (and (not (assq (car sub) gnus-window-to-buffer))
3176                       (gnus-functionp (car sub)))
3177             (setq sub (eval sub)))
3178           (when sub
3179             (push sub comp-subs)
3180             (setq size (cadar comp-subs))
3181             (cond ((equal size 1.0)
3182                    (setq rest (car comp-subs))
3183                    (setq s 0))
3184                   ((floatp size)
3185                    (setq s (floor (* size len))))
3186                   ((integerp size)
3187                    (setq s size))
3188                   (t
3189                    (error "Illegal size: %s" size)))
3190             ;; Try to make sure that we are inside the safe limits.
3191             (cond ((zerop s))
3192                   ((eq type 'horizontal)
3193                    (setq s (max s window-min-width)))
3194                   ((eq type 'vertical)
3195                    (setq s (max s window-min-height))))
3196             (setcar (cdar comp-subs) s)
3197             (incf total s)))
3198         ;; Take care of the "1.0" spec.
3199         (if rest
3200             (setcar (cdr rest) (- len total))
3201           (error "No 1.0 specs in %s" split))
3202         ;; The we do the actual splitting in a nice recursive
3203         ;; fashion.
3204         (setq comp-subs (nreverse comp-subs))
3205         (while comp-subs
3206           (if (null (cdr comp-subs))
3207               (setq new-win window)
3208             (setq new-win
3209                   (split-window window (cadar comp-subs)
3210                                 (eq type 'horizontal))))
3211           (setq result (or (gnus-configure-frame
3212                             (car comp-subs) window) result))
3213           (select-window new-win)
3214           (setq window new-win)
3215           (setq comp-subs (cdr comp-subs))))
3216       ;; Return the proper window, if any.
3217       (when result
3218         (select-window result))))))
3219
3220 (defun gnus-configure-windows (setting &optional force)
3221   (setq setting (gnus-windows-old-to-new setting))
3222   (let ((split (if (symbolp setting)
3223                    (car (cdr (assq setting gnus-buffer-configuration)))
3224                  setting))
3225         (in-buf (current-buffer))
3226         rule val w height hor ohor heights sub jump-buffer
3227         rel total to-buf all-visible)
3228
3229     (unless split
3230       (error "No such setting: %s" setting))
3231
3232     (if (and (not force) (setq all-visible (gnus-all-windows-visible-p split)))
3233         ;; All the windows mentioned are already visible, so we just
3234         ;; put point in the assigned buffer, and do not touch the
3235         ;; winconf.
3236         (select-window all-visible)
3237
3238       ;; Either remove all windows or just remove all Gnus windows.
3239       (if gnus-use-full-window
3240           (delete-other-windows)
3241         (gnus-remove-some-windows)
3242         (switch-to-buffer nntp-server-buffer))
3243
3244       (switch-to-buffer nntp-server-buffer)
3245       (gnus-configure-frame split (get-buffer-window (current-buffer))))))
3246
3247 (defun gnus-all-windows-visible-p (split)
3248   (when (vectorp split)
3249     (setq split (append split nil)))
3250   (when (or (consp (car split))
3251             (vectorp (car split)))
3252     (push 1.0 split)
3253     (push 'vertical split))
3254   ;; The SPLIT might be something that is to be evaled to
3255   ;; return a new SPLIT.
3256   (while (and (not (assq (car split) gnus-window-to-buffer))
3257               (gnus-functionp (car split)))
3258     (setq split (eval split)))
3259   (let* ((type (elt split 0)))
3260     (cond
3261      ((null split)
3262       t)
3263      ((not (or (eq type 'horizontal) (eq type 'vertical)))
3264       (let ((buffer (cond ((stringp type) type)
3265                           (t (cdr (assq type gnus-window-to-buffer)))))
3266             win buf)
3267         (unless buffer
3268           (error "Illegal buffer type: %s" type))
3269         (when (setq buf (get-buffer (if (symbolp buffer) (symbol-value buffer)
3270                                       buffer)))
3271           (setq win (get-buffer-window buf)))
3272         (when win
3273           (if (memq 'point split)
3274               win
3275             t))))
3276      (t
3277       (let ((n (mapcar 'gnus-all-windows-visible-p
3278                        (cdr (cdr split))))
3279             (win t))
3280         (while n
3281           (cond ((windowp (car n))
3282                  (setq win (car n)))
3283                 ((null (car n))
3284                  (setq win nil)))
3285           (setq n (cdr n)))
3286         win)))))
3287
3288 (defun gnus-window-top-edge (&optional window)
3289   (nth 1 (window-edges window)))
3290
3291 (defun gnus-remove-some-windows ()
3292   (let ((buffers gnus-window-to-buffer)
3293         buf bufs lowest-buf lowest)
3294     (save-excursion
3295       ;; Remove windows on all known Gnus buffers.
3296       (while buffers
3297         (setq buf (cdr (car buffers)))
3298         (if (symbolp buf)
3299             (setq buf (and (boundp buf) (symbol-value buf))))
3300         (and buf
3301              (get-buffer-window buf)
3302              (progn
3303                (setq bufs (cons buf bufs))
3304                (pop-to-buffer buf)
3305                (if (or (not lowest)
3306                        (< (gnus-window-top-edge) lowest))
3307                    (progn
3308                      (setq lowest (gnus-window-top-edge))
3309                      (setq lowest-buf buf)))))
3310         (setq buffers (cdr buffers)))
3311       ;; Remove windows on *all* summary buffers.
3312       (let (wins)
3313         (walk-windows
3314          (lambda (win)
3315            (let ((buf (window-buffer win)))
3316              (if (string-match  "^\\*Summary" (buffer-name buf))
3317                  (progn
3318                    (setq bufs (cons buf bufs))
3319                    (pop-to-buffer buf)
3320                    (if (or (not lowest)
3321                            (< (gnus-window-top-edge) lowest))
3322                        (progn
3323                          (setq lowest-buf buf)
3324                          (setq lowest (gnus-window-top-edge))))))))))
3325       (and lowest-buf
3326            (progn
3327              (pop-to-buffer lowest-buf)
3328              (switch-to-buffer nntp-server-buffer)))
3329       (while bufs
3330         (and (not (eq (car bufs) lowest-buf))
3331              (delete-windows-on (car bufs)))
3332         (setq bufs (cdr bufs))))))
3333
3334 (defun gnus-version ()
3335   "Version numbers of this version of Gnus."
3336   (interactive)
3337   (let ((methods gnus-valid-select-methods)
3338         (mess gnus-version)
3339         meth)
3340     ;; Go through all the legal select methods and add their version
3341     ;; numbers to the total version string.  Only the backends that are
3342     ;; currently in use will have their message numbers taken into
3343     ;; consideration.
3344     (while methods
3345       (setq meth (intern (concat (car (car methods)) "-version")))
3346       (and (boundp meth)
3347            (stringp (symbol-value meth))
3348            (setq mess (concat mess "; " (symbol-value meth))))
3349       (setq methods (cdr methods)))
3350     (gnus-message 2 mess)))
3351
3352 (defun gnus-info-find-node ()
3353   "Find Info documentation of Gnus."
3354   (interactive)
3355   ;; Enlarge info window if needed.
3356   (let ((mode major-mode)
3357         gnus-info-buffer)
3358     (Info-goto-node (car (cdr (assq mode gnus-info-nodes))))
3359     (setq gnus-info-buffer (current-buffer))
3360     (gnus-configure-windows 'info)))
3361
3362 (defun gnus-days-between (date1 date2)
3363   ;; Return the number of days between date1 and date2.
3364   (- (gnus-day-number date1) (gnus-day-number date2)))
3365
3366 (defun gnus-day-number (date)
3367   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
3368                      (timezone-parse-date date))))
3369     (timezone-absolute-from-gregorian
3370      (nth 1 dat) (nth 2 dat) (car dat))))
3371
3372 (defun gnus-encode-date (date)
3373   "Convert DATE to internal time."
3374   (let* ((parse (timezone-parse-date date))
3375          (date (mapcar (lambda (d) (and d (string-to-int d))) parse))
3376          (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
3377     (encode-time (caddr time) (cadr time) (car time)
3378                  (caddr date) (cadr date) (car date) (nth 4 date))))
3379
3380 (defun gnus-time-minus (t1 t2)
3381   "Subtract two internal times."
3382   (let ((borrow (< (cadr t1) (cadr t2))))
3383     (list (- (car t1) (car t2) (if borrow 1 0))
3384           (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
3385
3386 (defun gnus-file-newer-than (file date)
3387   (let ((fdate (nth 5 (file-attributes file))))
3388     (or (> (car fdate) (car date))
3389         (and (= (car fdate) (car date))
3390              (> (nth 1 fdate) (nth 1 date))))))
3391
3392 (defmacro gnus-define-keys (keymap &rest plist)
3393   "Define all keys in PLIST in KEYMAP."
3394   `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
3395
3396 (defun gnus-define-keys-1 (keymap plist)
3397   (when (null keymap)
3398     (error "Can't set keys in a null keymap"))
3399   (cond ((symbolp keymap)
3400          (setq keymap (symbol-value keymap)))
3401         ((listp keymap)
3402          (set (car keymap) nil)
3403          (define-prefix-command (car keymap))
3404          (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
3405          (setq keymap (symbol-value (car keymap)))))
3406   (let (key)
3407     (while plist
3408       (when (symbolp (setq key (pop plist)))
3409         (setq key (symbol-value key)))
3410       (define-key keymap key (pop plist)))))
3411
3412 (defun gnus-group-read-only-p (&optional group)
3413   "Check whether GROUP supports editing or not.
3414 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
3415 that that variable is buffer-local to the summary buffers."
3416   (let ((group (or group gnus-newsgroup-name)))
3417     (not (gnus-check-backend-function 'request-replace-article group))))
3418
3419 (defun gnus-group-total-expirable-p (group)
3420   "Check whether GROUP is total-expirable or not."
3421   (let ((params (gnus-info-params (gnus-get-info group))))
3422     (or (memq 'total-expire params)
3423         (cdr (assq 'total-expire params)) ; (total-expire . t)
3424         (and gnus-total-expirable-newsgroups ; Check var.
3425              (string-match gnus-total-expirable-newsgroups group)))))
3426
3427 (defun gnus-group-auto-expirable-p (group)
3428   "Check whether GROUP is total-expirable or not."
3429   (let ((params (gnus-info-params (gnus-get-info group))))
3430     (or (memq 'auto-expire params)
3431         (cdr (assq 'auto-expire params)) ; (auto-expire . t)
3432         (and gnus-auto-expirable-newsgroups ; Check var.
3433              (string-match gnus-auto-expirable-newsgroups group)))))
3434
3435 (defun gnus-virtual-group-p (group)
3436   "Say whether GROUP is virtual or not."
3437   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
3438                         gnus-valid-select-methods)))
3439
3440 (defsubst gnus-simplify-subject-fully (subject)
3441   "Simplify a subject string according to the user's wishes."
3442   (cond
3443    ((null gnus-summary-gather-subject-limit)
3444     (gnus-simplify-subject-re subject))
3445    ((eq gnus-summary-gather-subject-limit 'fuzzy)
3446     (gnus-simplify-subject-fuzzy subject))
3447    ((numberp gnus-summary-gather-subject-limit)
3448     (gnus-limit-string (gnus-simplify-subject-re subject)
3449                        gnus-summary-gather-subject-limit))
3450    (t
3451     subject)))
3452
3453 (defsubst gnus-subject-equal (s1 s2 &optional simple-first)
3454   "Check whether two subjects are equal.  If optional argument
3455 simple-first is t, first argument is already simplified."
3456   (cond
3457    ((null simple-first)
3458     (equal (gnus-simplify-subject-fully s1)
3459            (gnus-simplify-subject-fully s2)))
3460    (t
3461     (equal s1
3462            (gnus-simplify-subject-fully s2)))))
3463
3464 ;; Returns a list of writable groups.
3465 (defun gnus-writable-groups ()
3466   (let ((alist gnus-newsrc-alist)
3467         groups)
3468     (while alist
3469       (or (gnus-group-read-only-p (car (car alist)))
3470           (setq groups (cons (car (car alist)) groups)))
3471       (setq alist (cdr alist)))
3472     (nreverse groups)))
3473
3474 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
3475 ;; the echo area.
3476 (defun gnus-y-or-n-p (prompt)
3477   (prog1
3478       (y-or-n-p prompt)
3479     (message "")))
3480
3481 (defun gnus-yes-or-no-p (prompt)
3482   (prog1
3483       (yes-or-no-p prompt)
3484     (message "")))
3485
3486 ;; Check whether to use long file names.
3487 (defun gnus-use-long-file-name (symbol)
3488   ;; The variable has to be set...
3489   (and gnus-use-long-file-name
3490        ;; If it isn't a list, then we return t.
3491        (or (not (listp gnus-use-long-file-name))
3492            ;; If it is a list, and the list contains `symbol', we
3493            ;; return nil.
3494            (not (memq symbol gnus-use-long-file-name)))))
3495
3496 ;; I suspect there's a better way, but I haven't taken the time to do
3497 ;; it yet. -erik selberg@cs.washington.edu
3498 (defun gnus-dd-mmm (messy-date)
3499   "Return a string like DD-MMM from a big messy string"
3500   (let ((datevec (timezone-parse-date messy-date)))
3501     (format "%2s-%s"
3502             (or (aref datevec 2) "??")
3503             (capitalize
3504              (or (car
3505                   (nth (1- (string-to-number (aref datevec 1)))
3506                        timezone-months-assoc))
3507                  "???")))))
3508
3509 ;; Make a hash table (default and minimum size is 255).
3510 ;; Optional argument HASHSIZE specifies the table size.
3511 (defun gnus-make-hashtable (&optional hashsize)
3512   (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
3513
3514 ;; Make a number that is suitable for hashing; bigger than MIN and one
3515 ;; less than 2^x.
3516 (defun gnus-create-hash-size (min)
3517   (let ((i 1))
3518     (while (< i min)
3519       (setq i (* 2 i)))
3520     (1- i)))
3521
3522 ;; Show message if message has a lower level than `gnus-verbose'.
3523 ;; Guideline for numbers:
3524 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
3525 ;; for things that take a long time, 7 - not very important messages
3526 ;; on stuff, 9 - messages inside loops.
3527 (defun gnus-message (level &rest args)
3528   (if (<= level gnus-verbose)
3529       (apply 'message args)
3530     ;; We have to do this format thingy here even if the result isn't
3531     ;; shown - the return value has to be the same as the return value
3532     ;; from `message'.
3533     (apply 'format args)))
3534
3535 (defun gnus-functionp (form)
3536   "Return non-nil if FORM is funcallable."
3537   (or (and (symbolp form) (fboundp form))
3538       (and (listp form) (eq (car form) 'lambda))))
3539
3540 ;; Generate a unique new group name.
3541 (defun gnus-generate-new-group-name (leaf)
3542   (let ((name leaf)
3543         (num 0))
3544     (while (gnus-gethash name gnus-newsrc-hashtb)
3545       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3546     name))
3547
3548 ;; Find out whether the gnus-visual TYPE is wanted.
3549 (defun gnus-visual-p (&optional type class)
3550   (and gnus-visual                      ; Has to be non-nil, at least.
3551        (if (not type)                   ; We don't care about type.
3552            gnus-visual
3553          (if (listp gnus-visual)        ; It's a list, so we check it.
3554              (or (memq type gnus-visual)
3555                  (memq class gnus-visual))
3556            t))))
3557
3558 (defun gnus-parent-id (references)
3559   "Return the last Message-ID in REFERENCES."
3560   (when (and references
3561              (string-match "\\(<[^<>]+>\\)[ \t\n]*\\'" references))
3562     (substring references (match-beginning 1) (match-end 1))))
3563
3564 (defun gnus-split-references (references)
3565   "Return a list of Message-IDs in REFERENCES."
3566   (let ((beg 0)
3567         ids)
3568     (while (string-match "<[^>]+>" references beg)
3569       (push (substring references (match-beginning 0) (setq beg (match-end 0)))
3570             ids))
3571     (nreverse ids)))
3572
3573 (defun gnus-ephemeral-group-p (group)
3574   "Say whether GROUP is ephemeral or not."
3575   (assoc 'quit-config (gnus-find-method-for-group group)))
3576
3577 (defun gnus-group-quit-config (group)
3578   "Return the quit-config of GROUP."
3579   (nth 1 (assoc 'quit-config (gnus-find-method-for-group group))))
3580
3581 (defun gnus-simplify-mode-line ()
3582   "Make mode lines a bit simpler."
3583   (setq mode-line-modified "-- ")
3584   (when (listp mode-line-format)
3585     (make-local-variable 'mode-line-format)
3586     (setq mode-line-format (copy-sequence mode-line-format))
3587     (when (equal (nth 3 mode-line-format) "   ")
3588       (setcar (nthcdr 3 mode-line-format) " "))))
3589
3590 ;;; List and range functions
3591
3592 (defun gnus-last-element (list)
3593   "Return last element of LIST."
3594   (while (cdr list)
3595     (setq list (cdr list)))
3596   (car list))
3597
3598 (defun gnus-copy-sequence (list)
3599   "Do a complete, total copy of a list."
3600   (if (and (consp list) (not (consp (cdr list))))
3601       (cons (car list) (cdr list))
3602     (mapcar (lambda (elem) (if (consp elem)
3603                                (if (consp (cdr elem))
3604                                    (gnus-copy-sequence elem)
3605                                  (cons (car elem) (cdr elem)))
3606                              elem))
3607             list)))
3608
3609 (defun gnus-set-difference (list1 list2)
3610   "Return a list of elements of LIST1 that do not appear in LIST2."
3611   (let ((list1 (copy-sequence list1)))
3612     (while list2
3613       (setq list1 (delq (car list2) list1))
3614       (setq list2 (cdr list2)))
3615     list1))
3616
3617 (defun gnus-sorted-complement (list1 list2)
3618   "Return a list of elements of LIST1 that do not appear in LIST2.
3619 Both lists have to be sorted over <."
3620   (let (out)
3621     (if (or (null list1) (null list2))
3622         (or list1 list2)
3623       (while (and list1 list2)
3624         (cond ((= (car list1) (car list2))
3625                (setq list1 (cdr list1)
3626                      list2 (cdr list2)))
3627               ((< (car list1) (car list2))
3628                (setq out (cons (car list1) out))
3629                (setq list1 (cdr list1)))
3630               (t
3631                (setq out (cons (car list2) out))
3632                (setq list2 (cdr list2)))))
3633       (nconc (nreverse out) (or list1 list2)))))
3634
3635 (defun gnus-intersection (list1 list2)
3636   (let ((result nil))
3637     (while list2
3638       (if (memq (car list2) list1)
3639           (setq result (cons (car list2) result)))
3640       (setq list2 (cdr list2)))
3641     result))
3642
3643 (defun gnus-sorted-intersection (list1 list2)
3644   ;; LIST1 and LIST2 have to be sorted over <.
3645   (let (out)
3646     (while (and list1 list2)
3647       (cond ((= (car list1) (car list2))
3648              (setq out (cons (car list1) out)
3649                    list1 (cdr list1)
3650                    list2 (cdr list2)))
3651             ((< (car list1) (car list2))
3652              (setq list1 (cdr list1)))
3653             (t
3654              (setq list2 (cdr list2)))))
3655     (nreverse out)))
3656
3657 (defun gnus-set-sorted-intersection (list1 list2)
3658   ;; LIST1 and LIST2 have to be sorted over <.
3659   ;; This function modifies LIST1.
3660   (let* ((top (cons nil list1))
3661          (prev top))
3662     (while (and list1 list2)
3663       (cond ((= (car list1) (car list2))
3664              (setq prev list1
3665                    list1 (cdr list1)
3666                    list2 (cdr list2)))
3667             ((< (car list1) (car list2))
3668              (setcdr prev (cdr list1))
3669              (setq list1 (cdr list1)))
3670             (t
3671              (setq list2 (cdr list2)))))
3672     (setcdr prev nil)
3673     (cdr top)))
3674
3675 (defun gnus-compress-sequence (numbers &optional always-list)
3676   "Convert list of numbers to a list of ranges or a single range.
3677 If ALWAYS-LIST is non-nil, this function will always release a list of
3678 ranges."
3679   (let* ((first (car numbers))
3680          (last (car numbers))
3681          result)
3682     (if (null numbers)
3683         nil
3684       (if (not (listp (cdr numbers)))
3685           numbers
3686         (while numbers
3687           (cond ((= last (car numbers)) nil) ;Omit duplicated number
3688                 ((= (1+ last) (car numbers)) ;Still in sequence
3689                  (setq last (car numbers)))
3690                 (t                      ;End of one sequence
3691                  (setq result
3692                        (cons (if (= first last) first
3693                                (cons first last)) result))
3694                  (setq first (car numbers))
3695                  (setq last  (car numbers))))
3696           (setq numbers (cdr numbers)))
3697         (if (and (not always-list) (null result))
3698             (if (= first last) (list first) (cons first last))
3699           (nreverse (cons (if (= first last) first (cons first last))
3700                           result)))))))
3701
3702 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
3703 (defun gnus-uncompress-range (ranges)
3704   "Expand a list of ranges into a list of numbers.
3705 RANGES is either a single range on the form `(num . num)' or a list of
3706 these ranges."
3707   (let (first last result)
3708     (cond
3709      ((null ranges)
3710       nil)
3711      ((not (listp (cdr ranges)))
3712       (setq first (car ranges))
3713       (setq last (cdr ranges))
3714       (while (<= first last)
3715         (setq result (cons first result))
3716         (setq first (1+ first)))
3717       (nreverse result))
3718      (t
3719       (while ranges
3720         (if (atom (car ranges))
3721             (if (numberp (car ranges))
3722                 (setq result (cons (car ranges) result)))
3723           (setq first (car (car ranges)))
3724           (setq last  (cdr (car ranges)))
3725           (while (<= first last)
3726             (setq result (cons first result))
3727             (setq first (1+ first))))
3728         (setq ranges (cdr ranges)))
3729       (nreverse result)))))
3730
3731 (defun gnus-add-to-range (ranges list)
3732   "Return a list of ranges that has all articles from both RANGES and LIST.
3733 Note: LIST has to be sorted over `<'."
3734   (if (not ranges)
3735       (gnus-compress-sequence list t)
3736     (setq list (copy-sequence list))
3737     (or (listp (cdr ranges))
3738         (setq ranges (list ranges)))
3739     (let ((out ranges)
3740           ilist lowest highest temp)
3741       (while (and ranges list)
3742         (setq ilist list)
3743         (setq lowest (or (and (atom (car ranges)) (car ranges))
3744                          (car (car ranges))))
3745         (while (and list (cdr list) (< (car (cdr list)) lowest))
3746           (setq list (cdr list)))
3747         (if (< (car ilist) lowest)
3748             (progn
3749               (setq temp list)
3750               (setq list (cdr list))
3751               (setcdr temp nil)
3752               (setq out (nconc (gnus-compress-sequence ilist t) out))))
3753         (setq highest (or (and (atom (car ranges)) (car ranges))
3754                           (cdr (car ranges))))
3755         (while (and list (<= (car list) highest))
3756           (setq list (cdr list)))
3757         (setq ranges (cdr ranges)))
3758       (if list
3759           (setq out (nconc (gnus-compress-sequence list t) out)))
3760       (setq out (sort out (lambda (r1 r2)
3761                             (< (or (and (atom r1) r1) (car r1))
3762                                (or (and (atom r2) r2) (car r2))))))
3763       (setq ranges out)
3764       (while ranges
3765         (if (atom (car ranges))
3766             (if (cdr ranges)
3767                 (if (atom (car (cdr ranges)))
3768                     (if (= (1+ (car ranges)) (car (cdr ranges)))
3769                         (progn
3770                           (setcar ranges (cons (car ranges)
3771                                                (car (cdr ranges))))
3772                           (setcdr ranges (cdr (cdr ranges)))))
3773                   (if (= (1+ (car ranges)) (car (car (cdr ranges))))
3774                       (progn
3775                         (setcar (car (cdr ranges)) (car ranges))
3776                         (setcar ranges (car (cdr ranges)))
3777                         (setcdr ranges (cdr (cdr ranges)))))))
3778           (if (cdr ranges)
3779               (if (atom (car (cdr ranges)))
3780                   (if (= (1+ (cdr (car ranges))) (car (cdr ranges)))
3781                       (progn
3782                         (setcdr (car ranges) (car (cdr ranges)))
3783                         (setcdr ranges (cdr (cdr ranges)))))
3784                 (if (= (1+ (cdr (car ranges))) (car (car (cdr ranges))))
3785                     (progn
3786                       (setcdr (car ranges) (cdr (car (cdr ranges))))
3787                       (setcdr ranges (cdr (cdr ranges))))))))
3788         (setq ranges (cdr ranges)))
3789       out)))
3790
3791 (defun gnus-remove-from-range (ranges list)
3792   "Return a list of ranges that has all articles from LIST removed from RANGES.
3793 Note: LIST has to be sorted over `<'."
3794   ;; !!! This function shouldn't look like this, but I've got a headache.
3795   (gnus-compress-sequence
3796    (gnus-sorted-complement
3797     (gnus-uncompress-range ranges) list)))
3798
3799 (defun gnus-member-of-range (number ranges)
3800   (if (not (listp (cdr ranges)))
3801       (and (>= number (car ranges))
3802            (<= number (cdr ranges)))
3803     (let ((not-stop t))
3804       (while (and ranges
3805                   (if (numberp (car ranges))
3806                       (>= number (car ranges))
3807                     (>= number (car (car ranges))))
3808                   not-stop)
3809         (if (if (numberp (car ranges))
3810                 (= number (car ranges))
3811               (and (>= number (car (car ranges)))
3812                    (<= number (cdr (car ranges)))))
3813             (setq not-stop nil))
3814         (setq ranges (cdr ranges)))
3815       (not not-stop))))
3816
3817 (defun gnus-range-length (range)
3818   "Return the length RANGE would have if uncompressed."
3819   (length (gnus-uncompress-range range)))
3820
3821 (defun gnus-sublist-p (list sublist)
3822   "Test whether all elements in SUBLIST are members of LIST."
3823   (let ((sublistp t))
3824     (while sublist
3825       (unless (memq (pop sublist) list)
3826         (setq sublistp nil
3827               sublist nil)))
3828     sublistp))
3829
3830 \f
3831 ;;;
3832 ;;; Gnus group mode
3833 ;;;
3834
3835 (defvar gnus-group-mode-map nil)
3836 (put 'gnus-group-mode 'mode-class 'special)
3837
3838 (unless gnus-group-mode-map
3839   (setq gnus-group-mode-map (make-keymap))
3840   (suppress-keymap gnus-group-mode-map)
3841
3842   (gnus-define-keys
3843    gnus-group-mode-map
3844    " " gnus-group-read-group
3845    "=" gnus-group-select-group
3846    "\M- " gnus-group-unhidden-select-group
3847    "\r" gnus-group-select-group
3848    "\M-\r" gnus-group-quick-select-group
3849    "j" gnus-group-jump-to-group
3850    "n" gnus-group-next-unread-group
3851    "p" gnus-group-prev-unread-group
3852    "\177" gnus-group-prev-unread-group
3853    "N" gnus-group-next-group
3854    "P" gnus-group-prev-group
3855    "\M-n" gnus-group-next-unread-group-same-level
3856    "\M-p" gnus-group-prev-unread-group-same-level
3857    "," gnus-group-best-unread-group
3858    "." gnus-group-first-unread-group
3859    "u" gnus-group-unsubscribe-current-group
3860    "U" gnus-group-unsubscribe-group
3861    "c" gnus-group-catchup-current
3862    "C" gnus-group-catchup-current-all
3863    "l" gnus-group-list-groups
3864    "L" gnus-group-list-all-groups
3865    "m" gnus-group-mail
3866    "g" gnus-group-get-new-news
3867    "\M-g" gnus-group-get-new-news-this-group
3868    "R" gnus-group-restart
3869    "r" gnus-group-read-init-file
3870    "B" gnus-group-browse-foreign-server
3871    "b" gnus-group-check-bogus-groups
3872    "F" gnus-find-new-newsgroups
3873    "\C-c\C-d" gnus-group-describe-group
3874    "\M-d" gnus-group-describe-all-groups
3875    "\C-c\C-a" gnus-group-apropos
3876    "\C-c\M-\C-a" gnus-group-description-apropos
3877    "a" gnus-group-post-news
3878    "\ek" gnus-group-edit-local-kill
3879    "\eK" gnus-group-edit-global-kill
3880    "\C-k" gnus-group-kill-group
3881    "\C-y" gnus-group-yank-group
3882    "\C-w" gnus-group-kill-region
3883    "\C-x\C-t" gnus-group-transpose-groups
3884    "\C-c\C-l" gnus-group-list-killed
3885    "\C-c\C-x" gnus-group-expire-articles
3886    "\C-c\M-\C-x" gnus-group-expire-all-groups
3887    "V" gnus-version
3888    "s" gnus-group-save-newsrc
3889    "z" gnus-group-suspend
3890    "Z" gnus-group-clear-dribble
3891    "q" gnus-group-exit
3892    "Q" gnus-group-quit
3893    "?" gnus-group-describe-briefly
3894    "\C-c\C-i" gnus-info-find-node
3895    "\M-e" gnus-group-edit-group-method
3896    "^" gnus-group-enter-server-mode
3897    gnus-mouse-2 gnus-mouse-pick-group
3898    "<" beginning-of-buffer
3899    ">" end-of-buffer
3900    "\C-c\C-b" gnus-bug
3901    "\C-c\C-s" gnus-group-sort-groups
3902    "t" gnus-topic-mode
3903    "\C-c\M-g" gnus-activate-all-groups
3904    "\M-&" gnus-group-universal-argument
3905    "#" gnus-group-mark-group
3906    "\M-#" gnus-group-unmark-group)
3907
3908   (gnus-define-keys
3909    (gnus-group-mark-map "M" gnus-group-mode-map)
3910    "m" gnus-group-mark-group
3911    "u" gnus-group-unmark-group
3912    "w" gnus-group-mark-region
3913    "r" gnus-group-mark-regexp
3914    "U" gnus-group-unmark-all-groups)
3915
3916   (gnus-define-keys
3917    (gnus-group-group-map "G" gnus-group-mode-map)
3918    "d" gnus-group-make-directory-group
3919    "h" gnus-group-make-help-group
3920    "a" gnus-group-make-archive-group
3921    "k" gnus-group-make-kiboze-group
3922    "m" gnus-group-make-group
3923    "E" gnus-group-edit-group
3924    "e" gnus-group-edit-group-method
3925    "p" gnus-group-edit-group-parameters
3926    "v" gnus-group-add-to-virtual
3927    "V" gnus-group-make-empty-virtual
3928    "D" gnus-group-enter-directory
3929    "f" gnus-group-make-doc-group
3930    "r" gnus-group-rename-group
3931    "\177" gnus-group-delete-group)
3932
3933    (gnus-define-keys
3934     (gnus-group-soup-map "s" gnus-group-group-map)
3935     "b" gnus-group-brew-soup
3936     "w" gnus-soup-save-areas
3937     "s" gnus-soup-send-replies
3938     "p" gnus-soup-pack-packet
3939     "r" nnsoup-pack-replies)
3940
3941    (gnus-define-keys
3942     (gnus-group-sort-map "S" gnus-group-group-map)
3943     "s" gnus-group-sort-groups
3944     "a" gnus-group-sort-groups-by-alphabet
3945     "u" gnus-group-sort-groups-by-unread
3946     "l" gnus-group-sort-groups-by-level
3947     "v" gnus-group-sort-groups-by-score
3948     "r" gnus-group-sort-groups-by-rank
3949     "m" gnus-group-sort-groups-by-method)
3950
3951    (gnus-define-keys
3952     (gnus-group-list-map "A" gnus-group-mode-map)
3953     "k" gnus-group-list-killed
3954     "z" gnus-group-list-zombies
3955     "s" gnus-group-list-groups
3956     "u" gnus-group-list-all-groups
3957     "A" gnus-group-list-active
3958     "a" gnus-group-apropos
3959     "d" gnus-group-description-apropos
3960     "m" gnus-group-list-matching
3961     "M" gnus-group-list-all-matching
3962     "l" gnus-group-list-level)
3963
3964    (gnus-define-keys
3965     (gnus-group-score-map "W" gnus-group-mode-map)
3966     "f" gnus-score-flush-cache)
3967
3968    (gnus-define-keys
3969     (gnus-group-help-map "H" gnus-group-mode-map)
3970     "f" gnus-group-fetch-faq)
3971
3972    (gnus-define-keys
3973     (gnus-group-sub-map "S" gnus-group-mode-map)
3974     "l" gnus-group-set-current-level
3975     "t" gnus-group-unsubscribe-current-group
3976     "s" gnus-group-unsubscribe-group
3977     "k" gnus-group-kill-group
3978     "y" gnus-group-yank-group
3979     "w" gnus-group-kill-region
3980     "\C-k" gnus-group-kill-level
3981     "z" gnus-group-kill-all-zombies))
3982
3983 (defun gnus-group-mode ()
3984   "Major mode for reading news.
3985
3986 All normal editing commands are switched off.
3987 \\<gnus-group-mode-map>
3988 The group buffer lists (some of) the groups available.  For instance,
3989 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
3990 lists all zombie groups.
3991
3992 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
3993 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
3994
3995 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
3996
3997 The following commands are available:
3998
3999 \\{gnus-group-mode-map}"
4000   (interactive)
4001   (when (and menu-bar-mode
4002              (gnus-visual-p 'group-menu 'menu))
4003     (gnus-group-make-menu-bar))
4004   (kill-all-local-variables)
4005   (gnus-simplify-mode-line)
4006   (setq major-mode 'gnus-group-mode)
4007   (setq mode-name "Group")
4008   (gnus-group-set-mode-line)
4009   (setq mode-line-process nil)
4010   (use-local-map gnus-group-mode-map)
4011   (buffer-disable-undo (current-buffer))
4012   (setq truncate-lines t)
4013   (setq buffer-read-only t)
4014   (run-hooks 'gnus-group-mode-hook))
4015
4016 (defun gnus-mouse-pick-group (e)
4017   "Enter the group under the mouse pointer."
4018   (interactive "e")
4019   (mouse-set-point e)
4020   (gnus-group-read-group nil))
4021
4022 ;; Look at LEVEL and find out what the level is really supposed to be.
4023 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
4024 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
4025 (defun gnus-group-default-level (&optional level number-or-nil)
4026   (cond
4027    (gnus-group-use-permanent-levels
4028     (setq gnus-group-default-list-level
4029           (or level gnus-group-default-list-level))
4030     (or gnus-group-default-list-level gnus-level-subscribed))
4031    (number-or-nil
4032     level)
4033    (t
4034     (or level gnus-group-default-list-level gnus-level-subscribed))))
4035
4036 ;;;###autoload
4037 (defun gnus-slave-no-server (&optional arg)
4038   "Read network news as a slave, without connecting to local server"
4039   (interactive "P")
4040   (gnus-no-server arg t))
4041
4042 ;;;###autoload
4043 (defun gnus-no-server (&optional arg slave)
4044   "Read network news.
4045 If ARG is a positive number, Gnus will use that as the
4046 startup level.  If ARG is nil, Gnus will be started at level 2.
4047 If ARG is non-nil and not a positive number, Gnus will
4048 prompt the user for the name of an NNTP server to use.
4049 As opposed to `gnus', this command will not connect to the local server."
4050   (interactive "P")
4051   (make-local-variable 'gnus-group-use-permanent-levels)
4052   (setq gnus-group-use-permanent-levels t)
4053   (gnus (or arg (1- gnus-level-default-subscribed)) t slave))
4054
4055 ;;;###autoload
4056 (defun gnus-slave (&optional arg)
4057   "Read news as a slave."
4058   (interactive "P")
4059   (gnus arg nil 'slave))
4060
4061 ;;;###autoload
4062 (defun gnus-other-frame (&optional arg)
4063   "Pop up a frame to read news."
4064   (interactive "P")
4065   (if (get-buffer gnus-group-buffer)
4066       (let ((pop-up-frames t))
4067         (gnus arg))
4068     (select-frame (make-frame))
4069     (gnus arg)))
4070
4071 ;;;###autoload
4072 (defun gnus (&optional arg dont-connect slave)
4073   "Read network news.
4074 If ARG is non-nil and a positive number, Gnus will use that as the
4075 startup level.  If ARG is non-nil and not a positive number, Gnus will
4076 prompt the user for the name of an NNTP server to use."
4077   (interactive "P")
4078
4079   (if (get-buffer gnus-group-buffer)
4080       (progn
4081         (switch-to-buffer gnus-group-buffer)
4082         (gnus-group-get-new-news))
4083
4084     (gnus-clear-system)
4085     (nnheader-init-server-buffer)
4086     (gnus-read-init-file)
4087     (setq gnus-slave slave)
4088
4089     (gnus-group-setup-buffer)
4090     (let ((buffer-read-only nil))
4091       (erase-buffer)
4092       (if (not gnus-inhibit-startup-message)
4093           (progn
4094             (gnus-group-startup-message)
4095             (sit-for 0))))
4096
4097     (let ((level (and (numberp arg) (> arg 0) arg))
4098           did-connect)
4099       (unwind-protect
4100           (progn
4101             (or dont-connect
4102                 (setq did-connect
4103                       (gnus-start-news-server (and arg (not level))))))
4104         (if (and (not dont-connect)
4105                  (not did-connect))
4106             (gnus-group-quit)
4107           (run-hooks 'gnus-startup-hook)
4108           ;; NNTP server is successfully open.
4109
4110           ;; Find the current startup file name.
4111           (setq gnus-current-startup-file
4112                 (gnus-make-newsrc-file gnus-startup-file))
4113
4114           ;; Read the dribble file.
4115           (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
4116
4117           (gnus-summary-make-display-table)
4118           ;; Do the actual startup.
4119           (gnus-setup-news nil level)
4120           ;; Generate the group buffer.
4121           (gnus-group-list-groups level)
4122           (gnus-configure-windows 'group)
4123           (gnus-group-set-mode-line))))))
4124
4125 (defun gnus-unload ()
4126   "Unload all Gnus features."
4127   (interactive)
4128   (or (boundp 'load-history)
4129       (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
4130   (let ((history load-history)
4131         feature)
4132     (while history
4133       (and (string-match "^gnus" (car (car history)))
4134            (setq feature (cdr (assq 'provide (car history))))
4135            (unload-feature feature 'force))
4136       (setq history (cdr history)))))
4137
4138 (defun gnus-compile ()
4139   "Byte-compile the user-defined format specs."
4140   (interactive)
4141   (let ((entries gnus-format-specs)
4142         entry gnus-tmp-func)
4143     (save-excursion
4144       (gnus-message 7 "Compiling format specs...")
4145
4146       (while entries
4147         (setq entry (pop entries))
4148         (if (eq (car entry) 'version)
4149             (setq gnus-format-specs (delq entry gnus-format-specs))
4150           (when (and (listp (caddr entry))
4151                      (not (eq 'byte-code (caaddr entry))))
4152             (fset 'gnus-tmp-func
4153                   `(lambda () ,(caddr entry)))
4154             (byte-compile 'gnus-tmp-func)
4155             (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
4156
4157       (push (cons 'version emacs-version) gnus-format-specs)
4158
4159       (gnus-message 7 "Compiling user specs...done"))))
4160
4161 (defun gnus-indent-rigidly (start end arg)
4162   "Indent rigidly using only spaces and no tabs."
4163   (save-excursion
4164     (save-restriction
4165       (narrow-to-region start end)
4166       (indent-rigidly start end arg)
4167       (goto-char (point-min))
4168       (while (search-forward "\t" nil t)
4169         (replace-match "        " t t)))))
4170
4171 (defun gnus-group-startup-message (&optional x y)
4172   "Insert startup message in current buffer."
4173   ;; Insert the message.
4174   (erase-buffer)
4175   (insert
4176    (format "              %s
4177           _    ___ _             _
4178           _ ___ __ ___  __    _ ___
4179           __   _     ___    __  ___
4180               _           ___     _
4181              _  _ __             _
4182              ___   __            _
4183                    __           _
4184                     _      _   _
4185                    _      _    _
4186                       _  _    _
4187                   __  ___
4188                  _   _ _     _
4189                 _   _
4190               _    _
4191              _    _
4192             _
4193           __
4194
4195 "
4196            ""))
4197   ;; And then hack it.
4198   (gnus-indent-rigidly (point-min) (point-max)
4199                        (/ (max (- (window-width) (or x 46)) 0) 2))
4200   (goto-char (point-min))
4201   (forward-line 1)
4202   (let* ((pheight (count-lines (point-min) (point-max)))
4203          (wheight (window-height))
4204          (rest (- wheight pheight)))
4205     (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
4206   ;; Fontify some.
4207   (goto-char (point-min))
4208   (and (search-forward "Praxis" nil t)
4209        (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
4210   (goto-char (point-min))
4211   (let* ((mode-string (gnus-group-set-mode-line)))
4212     (setq mode-line-buffer-identification
4213           (list (concat gnus-version (substring (car mode-string) 4))))
4214     (set-buffer-modified-p t)))
4215
4216 (defun gnus-group-setup-buffer ()
4217   (or (get-buffer gnus-group-buffer)
4218       (progn
4219         (switch-to-buffer gnus-group-buffer)
4220         (gnus-add-current-to-buffer-list)
4221         (gnus-group-mode)
4222         (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
4223
4224 (defun gnus-group-list-groups (&optional level unread lowest)
4225   "List newsgroups with level LEVEL or lower that have unread articles.
4226 Default is all subscribed groups.
4227 If argument UNREAD is non-nil, groups with no unread articles are also
4228 listed."
4229   (interactive (list (if current-prefix-arg
4230                          (prefix-numeric-value current-prefix-arg)
4231                        (or
4232                         (gnus-group-default-level nil t)
4233                         gnus-group-default-list-level
4234                         gnus-level-subscribed))))
4235   (or level
4236       (setq level (car gnus-group-list-mode)
4237             unread (cdr gnus-group-list-mode)))
4238   (setq level (gnus-group-default-level level))
4239   (gnus-group-setup-buffer)             ;May call from out of group buffer
4240   (gnus-update-format-specifications)
4241   (let ((case-fold-search nil)
4242         (group (gnus-group-group-name)))
4243     (funcall gnus-group-prepare-function level unread lowest)
4244     (if (zerop (buffer-size))
4245         (gnus-message 5 gnus-no-groups-message)
4246       (goto-char (point-min))
4247       (if (not group)
4248           ;; Go to the first group with unread articles.
4249           (gnus-group-search-forward nil nil nil t)
4250         ;; Find the right group to put point on.  If the current group
4251         ;; has disappeared in the new listing, try to find the next
4252         ;; one.  If no next one can be found, just leave point at the
4253         ;; first newsgroup in the buffer.
4254         (if (not (gnus-goto-char
4255                   (text-property-any
4256                    (point-min) (point-max)
4257                    'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
4258             (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb))))
4259               (while (and newsrc
4260                           (not (gnus-goto-char
4261                                 (text-property-any
4262                                  (point-min) (point-max) 'gnus-group
4263                                  (gnus-intern-safe
4264                                   (car (car newsrc)) gnus-active-hashtb)))))
4265                 (setq newsrc (cdr newsrc)))
4266               (or newsrc (progn (goto-char (point-max))
4267                                 (forward-line -1))))))
4268       ;; Adjust cursor point.
4269       (gnus-group-position-point))))
4270
4271 (defun gnus-group-list-level (level &optional all)
4272   "List groups on LEVEL.
4273 If ALL (the prefix), also list groups that have no unread articles."
4274   (interactive "nList groups on level: \nP")
4275   (gnus-group-list-groups level all level))
4276
4277 (defun gnus-group-prepare-flat (level &optional all lowest regexp)
4278   "List all newsgroups with unread articles of level LEVEL or lower.
4279 If ALL is non-nil, list groups that have no unread articles.
4280 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
4281 If REGEXP, only list groups matching REGEXP."
4282   (set-buffer gnus-group-buffer)
4283   (setq gnus-topic-indentation "")
4284   (let ((buffer-read-only nil)
4285         (newsrc (cdr gnus-newsrc-alist))
4286         (lowest (or lowest 1))
4287         info clevel unread group params)
4288     (erase-buffer)
4289     (if (< lowest gnus-level-zombie)
4290         ;; List living groups.
4291         (while newsrc
4292           (setq info (car newsrc)
4293                 group (gnus-info-group info)
4294                 params (gnus-info-params info)
4295                 newsrc (cdr newsrc)
4296                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
4297           (and unread                   ; This group might be bogus
4298                (or (not regexp)
4299                    (string-match regexp group))
4300                (<= (setq clevel (gnus-info-level info)) level)
4301                (>= clevel lowest)
4302                (or all                  ; We list all groups?
4303                    (and gnus-group-list-inactive-groups
4304                         (eq unread t))  ; We list unactivated groups
4305                    (> unread 0)         ; We list groups with unread articles
4306                    (and gnus-list-groups-with-ticked-articles
4307                         (cdr (assq 'tick (gnus-info-marks info))))
4308                                         ; And groups with tickeds
4309                    ;; Check for permanent visibility.
4310                    (and gnus-permanently-visible-groups
4311                         (string-match gnus-permanently-visible-groups
4312                                       group))
4313                    (memq 'visible params)
4314                    (cdr (assq 'visible params)))
4315                (gnus-group-insert-group-line
4316                 group (gnus-info-level info)
4317                 (gnus-info-marks info) unread (gnus-info-method info)))))
4318
4319     ;; List dead groups.
4320     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
4321          (gnus-group-prepare-flat-list-dead
4322           (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
4323           gnus-level-zombie ?Z
4324           regexp))
4325     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
4326          (gnus-group-prepare-flat-list-dead
4327           (setq gnus-killed-list (sort gnus-killed-list 'string<))
4328           gnus-level-killed ?K regexp))
4329
4330     (gnus-group-set-mode-line)
4331     (setq gnus-group-list-mode (cons level all))
4332     (run-hooks 'gnus-group-prepare-hook)))
4333
4334 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
4335   ;; List zombies and killed lists somewhat faster, which was
4336   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
4337   ;; this by ignoring the group format specification altogether.
4338   (let (group beg)
4339     (if regexp
4340         ;; This loop is used when listing groups that match some
4341         ;; regexp.
4342         (while groups
4343           (setq group (pop groups))
4344           (when (string-match regexp group)
4345             (add-text-properties
4346              (point) (prog1 (1+ (point))
4347                        (insert " " mark "     *: " group "\n"))
4348              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4349                    'gnus-unread t
4350                    'gnus-level level))))
4351       ;; This loop is used when listing all groups.
4352       (while groups
4353         (add-text-properties
4354          (point) (prog1 (1+ (point))
4355                    (insert " " mark "     *: "
4356                            (setq group (pop groups)) "\n"))
4357          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4358                'gnus-unread t
4359                'gnus-level level))))))
4360
4361 (defmacro gnus-group-real-name (group)
4362   "Find the real name of a foreign newsgroup."
4363   `(let ((gname ,group))
4364      (if (string-match ":[^:]+$" gname)
4365          (substring gname (1+ (match-beginning 0)))
4366        gname)))
4367
4368 (defsubst gnus-server-add-address (method)
4369   (let ((method-name (symbol-name (car method))))
4370     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
4371              (not (assq (intern (concat method-name "-address")) method)))
4372         (append method (list (list (intern (concat method-name "-address"))
4373                                    (nth 1 method))))
4374       method)))
4375
4376 (defsubst gnus-server-get-method (group method)
4377   ;; Input either a server name, and extended server name, or a
4378   ;; select method, and return a select method.
4379   (cond ((stringp method)
4380          (gnus-server-to-method method))
4381         ((and (stringp (car method)) group)
4382          (gnus-server-extend-method group method))
4383         (t
4384          (gnus-server-add-address method))))
4385
4386 (defun gnus-server-to-method (server)
4387   "Map virtual server names to select methods."
4388   (or (and (equal server "native") gnus-select-method)
4389       (cdr (assoc server gnus-server-alist))))
4390
4391 (defmacro gnus-server-equal (ss1 ss2)
4392   "Say whether two servers are equal."
4393   `(let ((s1 ,ss1)
4394          (s2 ,ss2))
4395      (or (equal s1 s2)
4396          (and (= (length s1) (length s2))
4397               (progn
4398                 (while (and s1 (member (car s1) s2))
4399                   (setq s1 (cdr s1)))
4400                 (null s1))))))
4401
4402 (defun gnus-group-prefixed-name (group method)
4403   "Return the whole name from GROUP and METHOD."
4404   (and (stringp method) (setq method (gnus-server-to-method method)))
4405   (concat (format "%s" (car method))
4406           (if (and
4407                (assoc (format "%s" (car method)) (gnus-methods-using 'address))
4408                (not (string= (nth 1 method) "")))
4409               (concat "+" (nth 1 method)))
4410           ":" group))
4411
4412 (defun gnus-group-real-prefix (group)
4413   "Return the prefix of the current group name."
4414   (if (string-match "^[^:]+:" group)
4415       (substring group 0 (match-end 0))
4416     ""))
4417
4418 (defun gnus-group-method-name (group)
4419   "Return the method used for selecting GROUP."
4420   (let ((prefix (gnus-group-real-prefix group)))
4421     (if (equal prefix "")
4422         gnus-select-method
4423       (if (string-match "^[^\\+]+\\+" prefix)
4424           (list (intern (substring prefix 0 (1- (match-end 0))))
4425                 (substring prefix (match-end 0) (1- (length prefix))))
4426         (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
4427
4428 (defsubst gnus-secondary-method-p (method)
4429   "Return whether METHOD is a secondary select method."
4430   (let ((methods gnus-secondary-select-methods)
4431         (gmethod (gnus-server-get-method nil method)))
4432     (while (and methods
4433                 (not (equal (gnus-server-get-method nil (car methods))
4434                             gmethod)))
4435       (setq methods (cdr methods)))
4436     methods))
4437
4438 (defun gnus-group-foreign-p (group)
4439   "Say whether a group is foreign or not."
4440   (and (not (gnus-group-native-p group))
4441        (not (gnus-group-secondary-p group))))
4442
4443 (defun gnus-group-native-p (group)
4444   "Say whether the group is native or not."
4445   (not (string-match ":" group)))
4446
4447 (defun gnus-group-secondary-p (group)
4448   "Say whether the group is secondary or not."
4449   (gnus-secondary-method-p (gnus-find-method-for-group group)))
4450
4451 (defun gnus-group-get-parameter (group &optional symbol)
4452   "Returns the group parameters for GROUP.
4453 If SYMBOL, return the value of that symbol in the group parameters."
4454   (let ((params (gnus-info-params (gnus-get-info group))))
4455     (if symbol
4456         (gnus-group-parameter-value params symbol)
4457       params)))
4458
4459 (defun gnus-group-parameter-value (params symbol)
4460   "Return the value of SYMBOL in group PARAMS."
4461   (or (car (memq symbol params))        ; It's either a simple symbol
4462       (cdr (assq symbol params))))      ; or a cons.
4463
4464 (defun gnus-group-add-parameter (group param)
4465   "Add parameter PARAM to GROUP."
4466   (let ((info (gnus-get-info group)))
4467     (if (not info)
4468         () ; This is a dead group.  We just ignore it.
4469       ;; Cons the new param to the old one and update.
4470       (gnus-group-set-info (cons param (gnus-info-params info))
4471                            group 'params))))
4472
4473 (defun gnus-group-add-score (group &optional score)
4474   "Add SCORE to the GROUP score.
4475 If SCORE is nil, add 1 to the score of GROUP."
4476   (let ((info (gnus-get-info group)))
4477     (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))
4478
4479 (defun gnus-summary-bubble-group ()
4480   "Increase the score of the current group.
4481 This is a handy function to add to `gnus-summary-exit-hook' to
4482 increase the score of each group you read."
4483   (gnus-group-add-score gnus-newsgroup-name))
4484
4485 (defun gnus-group-set-info (info &optional method-only-group part)
4486   (let* ((entry (gnus-gethash
4487                  (or method-only-group (gnus-info-group info))
4488                  gnus-newsrc-hashtb))
4489          (part-info info)
4490          (info (if method-only-group (nth 2 entry) info)))
4491     (when method-only-group
4492       (unless entry
4493         (error "Trying to change non-existent group %s" method-only-group))
4494       ;; We have received parts of the actual group info - either the
4495       ;; select method or the group parameters.  We first check
4496       ;; whether we have to extend the info, and if so, do that.
4497       (let ((len (length info))
4498             (total (if (eq part 'method) 5 6)))
4499         (when (< len total)
4500           (setcdr (nthcdr (1- len) info)
4501                   (make-list (- total len) nil)))
4502         ;; Then we enter the new info.
4503         (setcar (nthcdr (1- total) info) part-info)))
4504     (unless entry
4505       ;; This is a new group, so we just create it.
4506       (save-excursion
4507         (set-buffer gnus-group-buffer)
4508         (if (gnus-info-method info)
4509             ;; It's a foreign group...
4510             (gnus-group-make-group
4511              (gnus-group-real-name (gnus-info-group info))
4512              (prin1-to-string (car (gnus-info-method info)))
4513              (nth 1 (gnus-info-method info)))
4514           ;; It's a native group.
4515           (gnus-group-make-group (gnus-info-group info)))
4516         (gnus-message 6 "Note: New group created")
4517         (setq entry
4518               (gnus-gethash (gnus-group-prefixed-name
4519                              (gnus-group-real-name (gnus-info-group info))
4520                              (or (gnus-info-method info) gnus-select-method))
4521                             gnus-newsrc-hashtb))))
4522     ;; Whether it was a new group or not, we now have the entry, so we
4523     ;; can do the update.
4524     (if entry
4525         (progn
4526           (setcar (nthcdr 2 entry) info)
4527           (when (and (not (eq (car entry) t))
4528                      (gnus-active (gnus-info-group info)))
4529             (let ((marked (gnus-info-marks info)))
4530               (setcar entry (length (gnus-list-of-unread-articles
4531                                      (car info)))))))
4532       (error "No such group: %s" (gnus-info-group info)))))
4533
4534 (defun gnus-group-set-method-info (group select-method)
4535   (gnus-group-set-info select-method group 'method))
4536
4537 (defun gnus-group-set-params-info (group params)
4538   (gnus-group-set-info params group 'params))
4539
4540 (defun gnus-group-update-group-line ()
4541   "Update the current line in the group buffer."
4542   (let* ((buffer-read-only nil)
4543          (group (gnus-group-group-name))
4544          (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
4545     (and entry
4546          (not (gnus-ephemeral-group-p group))
4547          (gnus-dribble-enter
4548           (concat "(gnus-group-set-info '"
4549                   (prin1-to-string (nth 2 entry)) ")")))
4550     (gnus-delete-line)
4551     (gnus-group-insert-group-line-info group)
4552     (forward-line -1)
4553     (gnus-group-position-point)))
4554
4555 (defun gnus-group-insert-group-line-info (group)
4556   "Insert GROUP on the current line."
4557   (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
4558         active info)
4559     (if entry
4560         (progn
4561           ;; (Un)subscribed group.
4562           (setq info (nth 2 entry))
4563           (gnus-group-insert-group-line
4564            group (gnus-info-level info) (gnus-info-marks info)
4565            (or (car entry) t) (gnus-info-method info)))
4566       ;; This group is dead.
4567       (gnus-group-insert-group-line
4568        group
4569        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
4570        nil
4571        (if (setq active (gnus-active group))
4572            (- (1+ (cdr active)) (car active)) 0)
4573        nil))))
4574
4575 ;; Dummy function redefined when running under XEmacs.
4576 (defalias 'gnus-group-remove-excess-properties 'ignore)
4577
4578 (defun gnus-group-insert-group-line
4579   (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number
4580                   gnus-tmp-method)
4581   "Insert a group line in the group buffer."
4582   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
4583          (gnus-tmp-number-total
4584           (if gnus-tmp-active
4585               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
4586             0))
4587          (gnus-tmp-number-of-unread
4588           (if (numberp number) (int-to-string (max 0 number))
4589             "*"))
4590          (gnus-tmp-number-of-read
4591           (if (numberp number)
4592               (int-to-string (max 0 (- gnus-tmp-number-total number)))
4593             "*"))
4594          (gnus-tmp-subscribed
4595           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
4596                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
4597                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
4598                 (t ?K)))
4599          (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
4600          (gnus-tmp-newsgroup-description
4601           (if gnus-description-hashtb
4602               (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
4603             ""))
4604          (gnus-tmp-moderated
4605           (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
4606          (gnus-tmp-moderated-string
4607           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
4608          (gnus-tmp-method
4609           (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
4610          (gnus-tmp-news-server (or (car (cdr gnus-tmp-method)) ""))
4611          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
4612          (gnus-tmp-news-method-string
4613           (if gnus-tmp-method
4614               (format "(%s:%s)" (car gnus-tmp-method)
4615                       (car (cdr gnus-tmp-method))) ""))
4616          (gnus-tmp-marked-mark
4617           (if (and (numberp number)
4618                    (zerop number)
4619                    (cdr (assq 'tick gnus-tmp-marked)))
4620               ?* ? ))
4621          (gnus-tmp-number
4622           (cond ((eq number t) "*" )
4623                 ((numberp number) (int-to-string number))
4624                 (t number)))
4625          (gnus-tmp-process-marked
4626           (if (member gnus-tmp-group gnus-group-marked)
4627               gnus-process-mark ? ))
4628          (buffer-read-only nil)
4629          header)                        ; passed as parameter to user-funcs.
4630     (beginning-of-line)
4631     (add-text-properties
4632      (point)
4633      (prog1 (1+ (point))
4634        ;; Insert the text.
4635        (eval gnus-group-line-format-spec))
4636      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
4637        gnus-unread ,(if (numberp number)
4638                         (string-to-int gnus-tmp-number-of-unread)
4639                       t)
4640        gnus-marked ,gnus-tmp-marked-mark
4641        gnus-level ,gnus-tmp-level))
4642     ;; Allow XEmacs to remove front-sticky text properties.
4643     (gnus-group-remove-excess-properties)))
4644
4645 (defun gnus-group-update-group (group &optional visible-only)
4646   "Update all lines where GROUP appear.
4647 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
4648 already."
4649   (save-excursion
4650     (set-buffer gnus-group-buffer)
4651     ;; The buffer may be narrowed.
4652     (save-restriction
4653       (widen)
4654       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
4655             (loc (point-min))
4656             found buffer-read-only visible)
4657         ;; Enter the current status into the dribble buffer.
4658         (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
4659           (if (and entry (not (gnus-ephemeral-group-p group)))
4660               (gnus-dribble-enter
4661                (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
4662                        ")"))))
4663         ;; Find all group instances.  If topics are in use, each group
4664         ;; may be listed in more than once.
4665         (while (setq loc (text-property-any
4666                           loc (point-max) 'gnus-group ident))
4667           (setq found t)
4668           (goto-char loc)
4669           (gnus-delete-line)
4670           (gnus-group-insert-group-line-info group)
4671           (setq loc (1+ loc)))
4672         (if (or found visible-only)
4673             ()
4674           ;; No such line in the buffer, find out where it's supposed to
4675           ;; go, and insert it there (or at the end of the buffer).
4676           ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
4677           (let ((entry (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb)))))
4678             (while (and entry (car entry)
4679                         (not
4680                          (gnus-goto-char
4681                           (text-property-any
4682                            (point-min) (point-max)
4683                            'gnus-group (gnus-intern-safe
4684                                         (car (car entry))
4685                                         gnus-active-hashtb)))))
4686               (setq entry (cdr entry)))
4687             (or entry (goto-char (point-max))))
4688           ;; Finally insert the line.
4689           (gnus-group-insert-group-line-info group))
4690         (gnus-group-set-mode-line)))))
4691
4692 (defun gnus-group-set-mode-line ()
4693   (when (memq 'group gnus-updated-mode-lines)
4694     (let* ((gformat (or gnus-group-mode-line-format-spec
4695                         (setq gnus-group-mode-line-format-spec
4696                               (gnus-parse-format
4697                                gnus-group-mode-line-format
4698                                gnus-group-mode-line-format-alist))))
4699            (gnus-tmp-news-server (car (cdr gnus-select-method)))
4700            (gnus-tmp-news-method (car gnus-select-method))
4701            (max-len 60)
4702            header                       ;Dummy binding for user-defined formats
4703            ;; Get the resulting string.
4704            (mode-string (eval gformat)))
4705       ;; If the line is too long, we chop it off.
4706       (when (> (length mode-string) max-len)
4707         (setq mode-string (substring mode-string 0 (- max-len 4))))
4708       (prog1
4709           (setq mode-line-buffer-identification (list mode-string))
4710         (set-buffer-modified-p t)))))
4711
4712 (defun gnus-group-group-name ()
4713   "Get the name of the newsgroup on the current line."
4714   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
4715     (and group (symbol-name group))))
4716
4717 (defun gnus-group-group-level ()
4718   "Get the level of the newsgroup on the current line."
4719   (get-text-property (gnus-point-at-bol) 'gnus-level))
4720
4721 (defun gnus-group-group-unread ()
4722   "Get the number of unread articles of the newsgroup on the current line."
4723   (get-text-property (gnus-point-at-bol) 'gnus-unread))
4724
4725 (defun gnus-group-search-forward (&optional backward all level first-too)
4726   "Find the next newsgroup with unread articles.
4727 If BACKWARD is non-nil, find the previous newsgroup instead.
4728 If ALL is non-nil, just find any newsgroup.
4729 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
4730 group exists.
4731 If FIRST-TOO, the current line is also eligible as a target."
4732   (let ((way (if backward -1 1))
4733         (low gnus-level-killed)
4734         (beg (point))
4735         pos found lev)
4736     (if (and backward (progn (beginning-of-line)) (bobp))
4737         nil
4738       (or first-too (forward-line way))
4739       (while (and
4740               (not (eobp))
4741               (not (setq
4742                     found
4743                     (and (or all
4744                              (and
4745                               (let ((unread
4746                                      (get-text-property (point) 'gnus-unread)))
4747                                 (and (numberp unread) (> unread 0)))
4748                               (setq lev (get-text-property (point)
4749                                                            'gnus-level))
4750                               (<= lev gnus-level-subscribed)))
4751                          (or (not level)
4752                              (and (setq lev (get-text-property (point)
4753                                                                'gnus-level))
4754                                   (or (= lev level)
4755                                       (and (< lev low)
4756                                            (< level lev)
4757                                            (progn
4758                                              (setq low lev)
4759                                              (setq pos (point))
4760                                              nil))))))))
4761               (zerop (forward-line way)))))
4762     (if found
4763         (progn (gnus-group-position-point) t)
4764       (goto-char (or pos beg))
4765       (and pos t))))
4766
4767 ;;; Gnus group mode commands
4768
4769 ;; Group marking.
4770
4771 (defun gnus-group-mark-group (n &optional unmark no-advance)
4772   "Mark the current group."
4773   (interactive "p")
4774   (let ((buffer-read-only nil)
4775         group)
4776     (while
4777         (and (> n 0)
4778              (setq group (gnus-group-group-name))
4779              (progn
4780                (beginning-of-line)
4781                (forward-char
4782                 (or (cdr (assq 'process gnus-group-mark-positions)) 2))
4783                (delete-char 1)
4784                (if unmark
4785                    (progn
4786                      (insert " ")
4787                      (setq gnus-group-marked (delete group gnus-group-marked)))
4788                  (insert "#")
4789                  (setq gnus-group-marked
4790                        (cons group (delete group gnus-group-marked))))
4791                t)
4792              (or no-advance (zerop (gnus-group-next-group 1))))
4793       (setq n (1- n)))
4794     (gnus-summary-position-point)
4795     n))
4796
4797 (defun gnus-group-unmark-group (n)
4798   "Remove the mark from the current group."
4799   (interactive "p")
4800   (gnus-group-mark-group n 'unmark)
4801   (gnus-group-position-point))
4802
4803 (defun gnus-group-unmark-all-groups ()
4804   "Unmark all groups."
4805   (let ((groups gnus-group-marked))
4806     (save-excursion
4807       (while groups
4808         (gnus-group-remove-mark (pop groups)))))
4809   (gnus-group-position-point))
4810
4811 (defun gnus-group-mark-region (unmark beg end)
4812   "Mark all groups between point and mark.
4813 If UNMARK, remove the mark instead."
4814   (interactive "P\nr")
4815   (let ((num (count-lines beg end)))
4816     (save-excursion
4817       (goto-char beg)
4818       (- num (gnus-group-mark-group num unmark)))))
4819
4820 (defun gnus-group-mark-regexp (regexp)
4821   "Mark all groups that match some regexp."
4822   (interactive "sMark (regexp): ")
4823   (let ((alist (cdr gnus-newsrc-alist))
4824         group)
4825     (while alist
4826       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
4827         (gnus-group-set-mark group))))
4828   (gnus-group-position-point))
4829
4830 (defun gnus-group-remove-mark (group)
4831   (if (gnus-group-goto-group group)
4832       (save-excursion
4833         (gnus-group-mark-group 1 'unmark t))
4834     (setq gnus-group-marked
4835           (delete group gnus-group-marked))))
4836
4837 (defun gnus-group-set-mark (group)
4838   "Set the process mark on GROUP."
4839   (if (gnus-group-goto-group group)
4840       (save-excursion
4841         (gnus-group-mark-group 1 nil t))
4842     (setq gnus-group-marked
4843           (cons group (delete group gnus-group-marked)))))
4844
4845 (defun gnus-group-universal-argument (arg &optional groups func)
4846   "Perform any command on all groups accoring to the process/prefix convention."
4847   (interactive "P")
4848   (let ((groups (or groups (gnus-group-process-prefix arg)))
4849         group func)
4850     (if (eq (setq func (or func
4851                            (key-binding
4852                             (read-key-sequence
4853                              (substitute-command-keys
4854                               "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
4855             'undefined)
4856         (progn
4857           (message "Undefined key")
4858           (ding))
4859       (while groups
4860         (gnus-group-remove-mark (setq group (pop groups)))
4861         (command-execute func))))
4862   (gnus-group-position-point))
4863
4864 (defun gnus-group-process-prefix (n)
4865   "Return a list of groups to work on.
4866 Take into consideration N (the prefix) and the list of marked groups."
4867   (cond
4868    (n
4869     (setq n (prefix-numeric-value n))
4870     ;; There is a prefix, so we return a list of the N next
4871     ;; groups.
4872     (let ((way (if (< n 0) -1 1))
4873           (n (abs n))
4874           group groups)
4875       (save-excursion
4876         (while (and (> n 0)
4877                     (setq group (gnus-group-group-name)))
4878           (setq groups (cons group groups))
4879           (setq n (1- n))
4880           (gnus-group-next-group way)))
4881       (nreverse groups)))
4882    ((and (boundp 'transient-mark-mode)
4883          transient-mark-mode
4884          mark-active)
4885     ;; Work on the region between point and mark.
4886     (let ((max (max (point) (mark)))
4887           groups)
4888       (save-excursion
4889         (goto-char (min (point) (mark)))
4890         (while
4891             (and
4892              (push (gnus-group-group-name) groups)
4893              (zerop (gnus-group-next-group 1))
4894              (< (point) max)))
4895         (nreverse groups))))
4896    (gnus-group-marked
4897     ;; No prefix, but a list of marked articles.
4898     (reverse gnus-group-marked))
4899    (t
4900     ;; Neither marked articles or a prefix, so we return the
4901     ;; current group.
4902     (let ((group (gnus-group-group-name)))
4903       (and group (list group))))))
4904
4905 ;; Selecting groups.
4906
4907 (defun gnus-group-read-group (&optional all no-article group)
4908   "Read news in this newsgroup.
4909 If the prefix argument ALL is non-nil, already read articles become
4910 readable.  IF ALL is a number, fetch this number of articles.  If the
4911 optional argument NO-ARTICLE is non-nil, no article will be
4912 auto-selected upon group entry.  If GROUP is non-nil, fetch that
4913 group."
4914   (interactive "P")
4915   (let ((group (or group (gnus-group-group-name)))
4916         number active marked entry)
4917     (or group (error "No group on current line"))
4918     (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
4919                                             group gnus-newsrc-hashtb)))))
4920     ;; This group might be a dead group.  In that case we have to get
4921     ;; the number of unread articles from `gnus-active-hashtb'.
4922     (setq number
4923           (cond ((numberp all) all)
4924                 (entry (car entry))
4925                 ((setq active (gnus-active group))
4926                  (- (1+ (cdr active)) (car active)))))
4927     (gnus-summary-read-group
4928      group (or all (and (numberp number)
4929                         (zerop (+ number (length (cdr (assq 'tick marked)))
4930                                   (length (cdr (assq 'dormant marked)))))))
4931      no-article)))
4932
4933 (defun gnus-group-select-group (&optional all)
4934   "Select this newsgroup.
4935 No article is selected automatically.
4936 If ALL is non-nil, already read articles become readable.
4937 If ALL is a number, fetch this number of articles."
4938   (interactive "P")
4939   (gnus-group-read-group all t))
4940
4941 (defun gnus-group-quick-select-group (&optional all)
4942   "Select the current group \"quickly\".
4943 This means that no highlighting or scoring will be performed."
4944   (interactive "P")
4945   (let (gnus-visual
4946         gnus-score-find-score-files-function
4947         gnus-apply-kill-hook
4948         gnus-summary-expunge-below)
4949     (gnus-group-read-group all t)))
4950
4951 (defun gnus-group-visible-select-group (&optional all)
4952   "Select the current group without hiding any articles."
4953   (interactive "P")
4954   (let ((gnus-inhibit-limiting t))
4955     (gnus-group-read-group all t)))
4956
4957 ;;;###autoload
4958 (defun gnus-fetch-group (group)
4959   "Start Gnus if necessary and enter GROUP.
4960 Returns whether the fetching was successful or not."
4961   (interactive "sGroup name: ")
4962   (or (get-buffer gnus-group-buffer)
4963       (gnus))
4964   (gnus-group-select-group))
4965
4966 ;; Enter a group that is not in the group buffer.  Non-nil is returned
4967 ;; if selection was successful.
4968 (defun gnus-group-read-ephemeral-group
4969   (group method &optional activate quit-config)
4970   (let ((group (if (gnus-group-foreign-p group) group
4971                  (gnus-group-prefixed-name group method))))
4972     (gnus-sethash
4973      group
4974      (list t nil (list group gnus-level-default-subscribed nil nil
4975                        (append method
4976                                (list
4977                                 (list 'quit-config
4978                                       (if quit-config quit-config
4979                                         (cons (current-buffer) 'summary)))))))
4980      gnus-newsrc-hashtb)
4981     (set-buffer gnus-group-buffer)
4982     (or (gnus-check-server method)
4983         (error "Unable to contact server: %s" (gnus-status-message method)))
4984     (if activate (or (gnus-request-group group)
4985                      (error "Couldn't request group")))
4986     (condition-case ()
4987         (gnus-group-read-group t t group)
4988       (error nil)
4989       (quit nil))))
4990
4991 (defun gnus-group-jump-to-group (group)
4992   "Jump to newsgroup GROUP."
4993   (interactive
4994    (list (completing-read
4995           "Group: " gnus-active-hashtb nil
4996           (memq gnus-select-method gnus-have-read-active-file))))
4997
4998   (if (equal group "")
4999       (error "Empty group name"))
5000
5001   (let ((b (text-property-any
5002             (point-min) (point-max)
5003             'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
5004     (if b
5005         ;; Either go to the line in the group buffer...
5006         (goto-char b)
5007       ;; ... or insert the line.
5008       (or
5009        (gnus-active group)
5010        (gnus-activate-group group)
5011        (error "%s error: %s" group (gnus-status-message group)))
5012
5013       (gnus-group-update-group group)
5014       (goto-char (text-property-any
5015                   (point-min) (point-max)
5016                   'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
5017   ;; Adjust cursor point.
5018   (gnus-group-position-point))
5019
5020 (defun gnus-group-goto-group (group)
5021   "Goto to newsgroup GROUP."
5022   (when group
5023     (let ((b (text-property-any (point-min) (point-max)
5024                                 'gnus-group (gnus-intern-safe
5025                                              group gnus-active-hashtb))))
5026       (and b (goto-char b)))))
5027
5028 (defun gnus-group-next-group (n)
5029   "Go to next N'th newsgroup.
5030 If N is negative, search backward instead.
5031 Returns the difference between N and the number of skips actually
5032 done."
5033   (interactive "p")
5034   (gnus-group-next-unread-group n t))
5035
5036 (defun gnus-group-next-unread-group (n &optional all level)
5037   "Go to next N'th unread newsgroup.
5038 If N is negative, search backward instead.
5039 If ALL is non-nil, choose any newsgroup, unread or not.
5040 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
5041 such group can be found, the next group with a level higher than
5042 LEVEL.
5043 Returns the difference between N and the number of skips actually
5044 made."
5045   (interactive "p")
5046   (let ((backward (< n 0))
5047         (n (abs n)))
5048     (while (and (> n 0)
5049                 (gnus-group-search-forward
5050                  backward (or (not gnus-group-goto-unread) all) level))
5051       (setq n (1- n)))
5052     (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
5053                                (if level " on this level or higher" "")))
5054     n))
5055
5056 (defun gnus-group-prev-group (n)
5057   "Go to previous N'th newsgroup.
5058 Returns the difference between N and the number of skips actually
5059 done."
5060   (interactive "p")
5061   (gnus-group-next-unread-group (- n) t))
5062
5063 (defun gnus-group-prev-unread-group (n)
5064   "Go to previous N'th unread newsgroup.
5065 Returns the difference between N and the number of skips actually
5066 done."
5067   (interactive "p")
5068   (gnus-group-next-unread-group (- n)))
5069
5070 (defun gnus-group-next-unread-group-same-level (n)
5071   "Go to next N'th unread newsgroup on the same level.
5072 If N is negative, search backward instead.
5073 Returns the difference between N and the number of skips actually
5074 done."
5075   (interactive "p")
5076   (gnus-group-next-unread-group n t (gnus-group-group-level))
5077   (gnus-group-position-point))
5078
5079 (defun gnus-group-prev-unread-group-same-level (n)
5080   "Go to next N'th unread newsgroup on the same level.
5081 Returns the difference between N and the number of skips actually
5082 done."
5083   (interactive "p")
5084   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
5085   (gnus-group-position-point))
5086
5087 (defun gnus-group-best-unread-group (&optional exclude-group)
5088   "Go to the group with the highest level.
5089 If EXCLUDE-GROUP, do not go to that group."
5090   (interactive)
5091   (goto-char (point-min))
5092   (let ((best 100000)
5093         unread best-point)
5094     (while (setq unread (get-text-property (point) 'gnus-unread))
5095       (if (and (numberp unread) (> unread 0))
5096           (progn
5097             (if (and (< (get-text-property (point) 'gnus-level) best)
5098                      (or (not exclude-group)
5099                          (not (equal exclude-group (gnus-group-group-name)))))
5100                 (progn
5101                   (setq best (get-text-property (point) 'gnus-level))
5102                   (setq best-point (point))))))
5103       (forward-line 1))
5104     (if best-point (goto-char best-point))
5105     (gnus-summary-position-point)
5106     (and best-point (gnus-group-group-name))))
5107
5108 (defun gnus-group-first-unread-group ()
5109   "Go to the first group with unread articles."
5110   (interactive)
5111   (prog1
5112       (let ((opoint (point))
5113             unread)
5114         (goto-char (point-min))
5115         (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
5116                 (and (numberp unread)   ; Not a topic.
5117                      (not (zerop unread))) ; Has unread articles.
5118                 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
5119             (point)                     ; Success.
5120           (goto-char opoint)
5121           nil))                         ; Not success.
5122     (gnus-group-position-point)))
5123
5124 (defun gnus-group-enter-server-mode ()
5125   "Jump to the server buffer."
5126   (interactive)
5127   (gnus-enter-server-buffer))
5128
5129 (defun gnus-group-make-group (name &optional method address)
5130   "Add a new newsgroup.
5131 The user will be prompted for a NAME, for a select METHOD, and an
5132 ADDRESS."
5133   (interactive
5134    (cons
5135     (read-string "Group name: ")
5136     (let ((method
5137            (completing-read
5138             "Method: " (append gnus-valid-select-methods gnus-server-alist)
5139             nil t)))
5140       (if (assoc method gnus-valid-select-methods)
5141           (list method
5142                 (if (memq 'prompt-address
5143                           (assoc method gnus-valid-select-methods))
5144                     (read-string "Address: ")
5145                   ""))
5146         (list method nil)))))
5147
5148   (save-excursion
5149     (set-buffer gnus-group-buffer)
5150     (let* ((meth (and method (if address (list (intern method) address)
5151                                method)))
5152            (nname (if method (gnus-group-prefixed-name name meth) name))
5153            info)
5154       (and (gnus-gethash nname gnus-newsrc-hashtb)
5155            (error "Group %s already exists" nname))
5156       (gnus-group-change-level
5157        (setq info (list t nname gnus-level-default-subscribed nil nil meth))
5158        gnus-level-default-subscribed gnus-level-killed
5159        (and (gnus-group-group-name)
5160             (gnus-gethash (gnus-group-group-name)
5161                           gnus-newsrc-hashtb))
5162        t)
5163       (gnus-set-active nname (cons 1 0))
5164       (or (gnus-ephemeral-group-p name)
5165           (gnus-dribble-enter
5166            (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
5167       (gnus-group-insert-group-line-info nname)
5168
5169       (if (assoc method gnus-valid-select-methods)
5170           (require (intern method)))
5171       (and (gnus-check-backend-function 'request-create-group nname)
5172            (gnus-request-create-group nname))
5173       t)))
5174
5175 (defun gnus-group-delete-group (group &optional force)
5176   "Delete the current group.
5177 If FORCE (the prefix) is non-nil, all the articles in the group will
5178 be deleted.  This is \"deleted\" as in \"removed forever from the face
5179 of the Earth\".  There is no undo."
5180   (interactive
5181    (list (gnus-group-group-name)
5182          current-prefix-arg))
5183   (or group (error "No group to rename"))
5184   (or (gnus-check-backend-function 'request-delete-group group)
5185       (error "This backend does not support group deletion"))
5186   (prog1
5187       (if (not (gnus-yes-or-no-p
5188                 (format
5189                  "Do you really want to delete %s%s? "
5190                  group (if force " and all its contents" ""))))
5191           () ; Whew!
5192         (gnus-message 6 "Deleting group %s..." group)
5193         (if (not (gnus-request-delete-group group force))
5194             (progn
5195               (gnus-message 3 "Couldn't delete group %s" group)
5196               (ding))
5197           (gnus-message 6 "Deleting group %s...done" group)
5198           (gnus-group-goto-group group)
5199           (gnus-group-kill-group 1 t)
5200           t))
5201     (gnus-group-position-point)))
5202
5203 (defun gnus-group-rename-group (group new-name)
5204   (interactive
5205    (list
5206     (gnus-group-group-name)
5207     (progn
5208       (or (gnus-check-backend-function
5209            'request-rename-group (gnus-group-group-name))
5210           (error "This backend does not support renaming groups"))
5211       (read-string "New group name: "))))
5212
5213   (or (gnus-check-backend-function 'request-rename-group group)
5214       (error "This backend does not support renaming groups"))
5215
5216   (or group (error "No group to rename"))
5217   (and (string-match "^[ \t]*$" new-name)
5218        (error "Not a valid group name"))
5219
5220   ;; We find the proper prefixed name.
5221   (setq new-name
5222         (gnus-group-prefixed-name
5223          (gnus-group-real-name new-name)
5224          (gnus-info-method (gnus-get-info group))))
5225
5226   (gnus-message 6 "Renaming group %s to %s..." group new-name)
5227   (prog1
5228       (if (not (gnus-request-rename-group group new-name))
5229           (progn
5230             (gnus-message 3 "Couldn't rename group %s to %s" group new-name)
5231             (ding))
5232         ;; We rename the group internally by killing it...
5233         (gnus-group-goto-group group)
5234         (gnus-group-kill-group)
5235         ;; ... changing its name ...
5236         (setcar (cdr (car gnus-list-of-killed-groups))
5237                 new-name)
5238         ;; ... and then yanking it.  Magic!
5239         (gnus-group-yank-group)
5240         (gnus-set-active new-name (gnus-active group))
5241         (gnus-message 6 "Renaming group %s to %s...done" group new-name)
5242         new-name)
5243     (gnus-group-position-point)))
5244
5245
5246 (defun gnus-group-edit-group (group &optional part)
5247   "Edit the group on the current line."
5248   (interactive (list (gnus-group-group-name)))
5249   (let ((done-func '(lambda ()
5250                       "Exit editing mode and update the information."
5251                       (interactive)
5252                       (gnus-group-edit-group-done 'part 'group)))
5253         (part (or part 'info))
5254         (winconf (current-window-configuration))
5255         info)
5256     (or group (error "No group on current line"))
5257     (or (setq info (gnus-get-info group))
5258         (error "Killed group; can't be edited"))
5259     (set-buffer (get-buffer-create gnus-group-edit-buffer))
5260     (gnus-configure-windows 'edit-group)
5261     (gnus-add-current-to-buffer-list)
5262     (emacs-lisp-mode)
5263     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
5264     (use-local-map (copy-keymap emacs-lisp-mode-map))
5265     (local-set-key "\C-c\C-c" done-func)
5266     (make-local-variable 'gnus-prev-winconf)
5267     (setq gnus-prev-winconf winconf)
5268     ;; We modify the func to let it know what part it is editing.
5269     (setcar (cdr (nth 4 done-func)) (list 'quote part))
5270     (setcar (cdr (cdr (nth 4 done-func))) group)
5271     (erase-buffer)
5272     (insert
5273      (cond
5274       ((eq part 'method)
5275        ";; Type `C-c C-c' after editing the select method.\n\n")
5276       ((eq part 'params)
5277        ";; Type `C-c C-c' after editing the group parameters.\n\n")
5278       ((eq part 'info)
5279        ";; Type `C-c C-c' after editing the group info.\n\n")))
5280     (insert
5281      (pp-to-string
5282       (cond ((eq part 'method)
5283              (or (gnus-info-method info) "native"))
5284             ((eq part 'params)
5285              (gnus-info-params info))
5286             (t info)))
5287      "\n")))
5288
5289 (defun gnus-group-edit-group-method (group)
5290   "Edit the select method of GROUP."
5291   (interactive (list (gnus-group-group-name)))
5292   (gnus-group-edit-group group 'method))
5293
5294 (defun gnus-group-edit-group-parameters (group)
5295   "Edit the group parameters of GROUP."
5296   (interactive (list (gnus-group-group-name)))
5297   (gnus-group-edit-group group 'params))
5298
5299 (defun gnus-group-edit-group-done (part group)
5300   "Get info from buffer, update variables and jump to the group buffer."
5301   (set-buffer (get-buffer-create gnus-group-edit-buffer))
5302   (goto-char (point-min))
5303   (let* ((form (read (current-buffer)))
5304          (winconf gnus-prev-winconf)
5305          (new-group (when (eq part 'info)
5306                       (if (or (not (nth 4 form))
5307                               (gnus-server-equal
5308                                gnus-select-method (nth 4 form)))
5309                           (gnus-group-real-name (car form))
5310                         (gnus-group-prefixed-name
5311                          (gnus-group-real-name (car form)) (nth 4 form))))))
5312     ;; Set the info.
5313     (if (eq part 'info)
5314         (progn
5315           (when new-group (setcar form new-group))
5316           (gnus-group-set-info form))
5317       (gnus-group-set-info form group part))
5318     (kill-buffer (current-buffer))
5319     (and winconf (set-window-configuration winconf))
5320     (set-buffer gnus-group-buffer)
5321     (when (and new-group
5322              (not (equal new-group group)))
5323       (when (gnus-group-goto-group group)
5324         (gnus-group-kill-group 1))
5325       (gnus-activate-group new-group))
5326     (gnus-group-update-group (or new-group group))
5327     (gnus-group-position-point)))
5328
5329 (defun gnus-group-make-help-group ()
5330   "Create the Gnus documentation group."
5331   (interactive)
5332   (let ((path load-path)
5333         (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
5334         file dir)
5335     (and (gnus-gethash name gnus-newsrc-hashtb)
5336          (error "Documentation group already exists"))
5337     (while path
5338       (setq dir (file-name-as-directory (expand-file-name (pop path)))
5339             file nil)
5340       (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt")))
5341                 (file-exists-p
5342                  (setq file (concat (file-name-directory
5343                                      (directory-file-name dir))
5344                                     "etc/gnus-tut.txt"))))
5345         (setq path nil)))
5346     (if (not file)
5347         (message "Couldn't find doc group")
5348       (gnus-group-make-group
5349        (gnus-group-real-name name)
5350        (list 'nndoc name
5351              (list 'nndoc-address file)
5352              (list 'nndoc-article-type 'mbox)))))
5353   (gnus-group-position-point))
5354
5355 (defun gnus-group-make-doc-group (file type)
5356   "Create a group that uses a single file as the source."
5357   (interactive
5358    (list (read-file-name "File name: ")
5359          (and current-prefix-arg 'ask)))
5360   (when (eq type 'ask)
5361     (let ((err "")
5362           char found)
5363       (while (not found)
5364         (message
5365          "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
5366          err)
5367         (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
5368                           ((= char ?b) 'babyl)
5369                           ((= char ?d) 'digest)
5370                           ((= char ?f) 'forward)
5371                           ((= char ?a) 'mmfd)
5372                           (t (setq err (format "%c unknown. " char))
5373                              nil))))
5374       (setq type found)))
5375   (let* ((file (expand-file-name file))
5376          (name (gnus-generate-new-group-name
5377                 (gnus-group-prefixed-name
5378                  (file-name-nondirectory file) '(nndoc "")))))
5379     (gnus-group-make-group
5380      (gnus-group-real-name name)
5381      (list 'nndoc name
5382            (list 'nndoc-address file)
5383            (list 'nndoc-article-type (or type 'guess))))
5384     (forward-line -1)
5385     (gnus-group-position-point)))
5386
5387 (defun gnus-group-make-archive-group (&optional all)
5388   "Create the (ding) Gnus archive group of the most recent articles.
5389 Given a prefix, create a full group."
5390   (interactive "P")
5391   (let ((group (gnus-group-prefixed-name
5392                 (if all "ding.archives" "ding.recent") '(nndir ""))))
5393     (and (gnus-gethash group gnus-newsrc-hashtb)
5394          (error "Archive group already exists"))
5395     (gnus-group-make-group
5396      (gnus-group-real-name group)
5397      (list 'nndir (if all "hpc" "edu")
5398            (list 'nndir-directory
5399                  (if all gnus-group-archive-directory
5400                    gnus-group-recent-archive-directory)))))
5401   (forward-line -1)
5402   (gnus-group-position-point))
5403
5404 (defun gnus-group-make-directory-group (dir)
5405   "Create an nndir group.
5406 The user will be prompted for a directory.  The contents of this
5407 directory will be used as a newsgroup.  The directory should contain
5408 mail messages or news articles in files that have numeric names."
5409   (interactive
5410    (list (read-file-name "Create group from directory: ")))
5411   (or (file-exists-p dir) (error "No such directory"))
5412   (or (file-directory-p dir) (error "Not a directory"))
5413   (let ((ext "")
5414         (i 0)
5415         group)
5416     (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
5417       (setq group
5418             (gnus-group-prefixed-name
5419              (concat (file-name-as-directory (directory-file-name dir))
5420                      ext)
5421              '(nndir "")))
5422       (setq ext (format "<%d>" (setq i (1+ i)))))
5423     (gnus-group-make-group
5424      (gnus-group-real-name group)
5425      (list 'nndir group (list 'nndir-directory dir))))
5426   (forward-line -1)
5427   (gnus-group-position-point))
5428
5429 (defun gnus-group-make-kiboze-group (group address scores)
5430   "Create an nnkiboze group.
5431 The user will be prompted for a name, a regexp to match groups, and
5432 score file entries for articles to include in the group."
5433   (interactive
5434    (list
5435     (read-string "nnkiboze group name: ")
5436     (read-string "Source groups (regexp): ")
5437     (let ((headers (mapcar (lambda (group) (list group))
5438                            '("subject" "from" "number" "date" "message-id"
5439                              "references" "chars" "lines" "xref"
5440                              "followup" "all" "body" "head")))
5441           scores header regexp regexps)
5442       (while (not (equal "" (setq header (completing-read
5443                                           "Match on header: " headers nil t))))
5444         (setq regexps nil)
5445         (while (not (equal "" (setq regexp (read-string
5446                                             (format "Match on %s (string): "
5447                                                     header)))))
5448           (setq regexps (cons (list regexp nil nil 'r) regexps)))
5449         (setq scores (cons (cons header regexps) scores)))
5450       scores)))
5451   (gnus-group-make-group group "nnkiboze" address)
5452   (save-excursion
5453     (gnus-set-work-buffer)
5454     (let (emacs-lisp-mode-hook)
5455       (pp scores (current-buffer)))
5456     (write-region (point-min) (point-max)
5457                   (gnus-score-file-name (concat "nnkiboze:" group))))
5458   (forward-line -1)
5459   (gnus-group-position-point))
5460
5461 (defun gnus-group-add-to-virtual (n vgroup)
5462   "Add the current group to a virtual group."
5463   (interactive
5464    (list current-prefix-arg
5465          (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
5466                           "nnvirtual:")))
5467   (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
5468       (error "%s is not an nnvirtual group" vgroup))
5469   (let* ((groups (gnus-group-process-prefix n))
5470          (method (gnus-info-method (gnus-get-info vgroup))))
5471     (setcar (cdr method)
5472             (concat
5473              (nth 1 method) "\\|"
5474              (mapconcat
5475               (lambda (s)
5476                 (gnus-group-remove-mark s)
5477                 (concat "\\(^" (regexp-quote s) "$\\)"))
5478               groups "\\|"))))
5479   (gnus-group-position-point))
5480
5481 (defun gnus-group-make-empty-virtual (group)
5482   "Create a new, fresh, empty virtual group."
5483   (interactive "sCreate new, empty virtual group: ")
5484   (let* ((method (list 'nnvirtual "^$"))
5485          (pgroup (gnus-group-prefixed-name group method)))
5486     ;; Check whether it exists already.
5487     (and (gnus-gethash pgroup gnus-newsrc-hashtb)
5488          (error "Group %s already exists." pgroup))
5489     ;; Subscribe the new group after the group on the current line.
5490     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
5491     (gnus-group-update-group pgroup)
5492     (forward-line -1)
5493     (gnus-group-position-point)))
5494
5495 (defun gnus-group-enter-directory (dir)
5496   "Enter an ephemeral nneething group."
5497   (interactive "DDirectory to read: ")
5498   (let* ((method (list 'nneething dir))
5499          (leaf (gnus-group-prefixed-name
5500                 (file-name-nondirectory (directory-file-name dir))
5501                 method))
5502          (name (gnus-generate-new-group-name leaf)))
5503     (let ((nneething-read-only t))
5504       (or (gnus-group-read-ephemeral-group
5505            name method t
5506            (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
5507                                       'summary 'group)))
5508           (error "Couldn't enter %s" dir)))))
5509
5510 ;; Group sorting commands
5511 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
5512
5513 (defun gnus-group-sort-groups (func &optional reverse)
5514   "Sort the group buffer according to FUNC.
5515 If REVERSE, reverse the sorting order."
5516   (interactive (list gnus-group-sort-function
5517                      current-prefix-arg))
5518   (let ((func (cond 
5519                ((not (listp func))
5520                 func)
5521                ((= 1 (length func))
5522                 (car func))
5523                (t
5524                 `(lambda (t1 t2)
5525                    ,(gnus-make-sort-function 
5526                      (reverse func)))))))
5527     ;; We peel off the dummy group from the alist.
5528     (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
5529       (pop gnus-newsrc-alist))
5530     ;; Do the sorting.
5531     (setq gnus-newsrc-alist
5532           (sort gnus-newsrc-alist func))
5533     (when reverse
5534       (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
5535     ;; Regenerate the hash table.
5536     (gnus-make-hashtable-from-newsrc-alist)
5537     (gnus-group-list-groups)))
5538
5539 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
5540   "Sort the group buffer alphabetically by group name.
5541 If REVERSE, sort in reverse order."
5542   (interactive "P")
5543   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
5544
5545 (defun gnus-group-sort-groups-by-unread (&optional reverse)
5546   "Sort the group buffer by number of unread articles.
5547 If REVERSE, sort in reverse order."
5548   (interactive "P")
5549   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
5550
5551 (defun gnus-group-sort-groups-by-level (&optional reverse)
5552   "Sort the group buffer by group level.
5553 If REVERSE, sort in reverse order."
5554   (interactive "P")
5555   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
5556
5557 (defun gnus-group-sort-groups-by-score (&optional reverse)
5558   "Sort the group buffer by group score.
5559 If REVERSE, sort in reverse order."
5560   (interactive "P")
5561   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
5562
5563 (defun gnus-group-sort-groups-by-rank (&optional reverse)
5564   "Sort the group buffer by group rank.
5565 If REVERSE, sort in reverse order."
5566   (interactive "P")
5567   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
5568
5569 (defun gnus-group-sort-groups-by-method (&optional reverse)
5570   "Sort the group buffer alphabetically by backend name.
5571 If REVERSE, sort in reverse order."
5572   (interactive "P")
5573   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
5574
5575 (defun gnus-group-sort-by-alphabet (info1 info2)
5576   "Sort alphabetically."
5577   (string< (gnus-info-group info1) (gnus-info-group info2)))
5578
5579 (defun gnus-group-sort-by-unread (info1 info2)
5580   "Sort by number of unread articles."
5581   (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
5582         (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
5583     (< (or (and (numberp n1) n1) 0)
5584        (or (and (numberp n2) n2) 0))))
5585
5586 (defun gnus-group-sort-by-level (info1 info2)
5587   "Sort by level."
5588   (< (gnus-info-level info1) (gnus-info-level info2)))
5589
5590 (defun gnus-group-sort-by-method (info1 info2)
5591   "Sort alphabetically by backend name."
5592   (string< (symbol-name (car (gnus-find-method-for-group
5593                               (gnus-info-group info1) info1)))
5594            (symbol-name (car (gnus-find-method-for-group
5595                               (gnus-info-group info2) info2)))))
5596
5597 (defun gnus-group-sort-by-score (info1 info2)
5598   "Sort by group score."
5599   (< (gnus-info-score info1) (gnus-info-score info2)))
5600
5601 (defun gnus-group-sort-by-rank (info1 info2)
5602   "Sort by level and score."
5603   (let ((level1 (gnus-info-level info1))
5604         (level2 (gnus-info-level info2)))
5605     (or (< level1 level2)
5606         (and (= level1 level2)
5607              (< (gnus-info-score info1) (gnus-info-score info2))))))
5608
5609 ;; Group catching up.
5610
5611 (defun gnus-group-catchup-current (&optional n all)
5612   "Mark all articles not marked as unread in current newsgroup as read.
5613 If prefix argument N is numeric, the ARG next newsgroups will be
5614 caught up.  If ALL is non-nil, marked articles will also be marked as
5615 read.  Cross references (Xref: header) of articles are ignored.
5616 The difference between N and actual number of newsgroups that were
5617 caught up is returned."
5618   (interactive "P")
5619   (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
5620                gnus-expert-user
5621                (gnus-y-or-n-p
5622                 (if all
5623                     "Do you really want to mark all articles as read? "
5624                   "Mark all unread articles as read? "))))
5625       n
5626     (let ((groups (gnus-group-process-prefix n))
5627           (ret 0))
5628       (while groups
5629         ;; Virtual groups have to be given special treatment.
5630         (let ((method (gnus-find-method-for-group (car groups))))
5631           (if (eq 'nnvirtual (car method))
5632               (nnvirtual-catchup-group
5633                (gnus-group-real-name (car groups)) (nth 1 method) all)))
5634         (gnus-group-remove-mark (car groups))
5635         (if (prog1
5636                 (gnus-group-goto-group (car groups))
5637               (gnus-group-catchup (car groups) all))
5638             (gnus-group-update-group-line)
5639           (setq ret (1+ ret)))
5640         (setq groups (cdr groups)))
5641       (gnus-group-next-unread-group 1)
5642       ret)))
5643
5644 (defun gnus-group-catchup-current-all (&optional n)
5645   "Mark all articles in current newsgroup as read.
5646 Cross references (Xref: header) of articles are ignored."
5647   (interactive "P")
5648   (gnus-group-catchup-current n 'all))
5649
5650 (defun gnus-group-catchup (group &optional all)
5651   "Mark all articles in GROUP as read.
5652 If ALL is non-nil, all articles are marked as read.
5653 The return value is the number of articles that were marked as read,
5654 or nil if no action could be taken."
5655   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
5656          (num (car entry)))
5657     ;; Do the updating only if the newsgroup isn't killed.
5658     (if (not (numberp (car entry)))
5659         (gnus-message 1 "Can't catch up; non-active group")
5660       ;; Do auto-expirable marks if that's required.
5661       (when (gnus-group-auto-expirable-p group)
5662         (gnus-add-marked-articles
5663          group 'expire (gnus-list-of-unread-articles group))
5664         (when all
5665           (let ((marks (nth 3 (nth 2 entry))))
5666             (gnus-add-marked-articles
5667              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
5668             (gnus-add-marked-articles
5669              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
5670       (when entry
5671         (gnus-update-read-articles group nil)
5672         ;; Also nix out the lists of marks and dormants.
5673         (when all
5674           (gnus-add-marked-articles group 'tick nil nil 'force)
5675           (gnus-add-marked-articles group 'dormant nil nil 'force))
5676         num))))
5677
5678 (defun gnus-group-expire-articles (&optional n)
5679   "Expire all expirable articles in the current newsgroup."
5680   (interactive "P")
5681   (let ((groups (gnus-group-process-prefix n))
5682         group)
5683     (unless groups
5684       (error "No groups to expire"))
5685     (while (setq group (pop groups))
5686       (gnus-group-remove-mark group)
5687       (when (gnus-check-backend-function 'request-expire-articles group)
5688         (gnus-message 6 "Expiring articles in %s..." group)
5689         (let* ((info (gnus-get-info group))
5690                (expirable (if (gnus-group-total-expirable-p group)
5691                               (cons nil (gnus-list-of-read-articles group))
5692                             (assq 'expire (gnus-info-marks info))))
5693                (expiry-wait (gnus-group-get-parameter group 'expiry-wait)))
5694           (when expirable
5695             (setcdr expirable
5696                     (gnus-compress-sequence
5697                      (if expiry-wait
5698                          (let ((nnmail-expiry-wait-function nil)
5699                                (nnmail-expiry-wait expiry-wait))
5700                            (gnus-request-expire-articles
5701                             (gnus-uncompress-sequence (cdr expirable)) group))
5702                        (gnus-request-expire-articles
5703                         (gnus-uncompress-sequence (cdr expirable))
5704                         group)))))
5705           (gnus-message 6 "Expiring articles in %s...done" group)))
5706       (gnus-group-position-point))))
5707
5708
5709 (defun gnus-group-expire-all-groups ()
5710   "Expire all expirable articles in all newsgroups."
5711   (interactive)
5712   (save-excursion
5713     (gnus-message 5 "Expiring...")
5714     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
5715                                      (cdr gnus-newsrc-alist))))
5716       (gnus-group-expire-articles nil)))
5717   (gnus-group-position-point)
5718   (gnus-message 5 "Expiring...done"))
5719
5720 (defun gnus-group-set-current-level (n level)
5721   "Set the level of the next N groups to LEVEL."
5722   (interactive
5723    (list
5724     current-prefix-arg
5725     (string-to-int
5726      (let ((s (read-string
5727                (format "Level (default %s): " (gnus-group-group-level)))))
5728        (if (string-match "^\\s-*$" s)
5729            (int-to-string (gnus-group-group-level))
5730          s)))))
5731   (or (and (>= level 1) (<= level gnus-level-killed))
5732       (error "Illegal level: %d" level))
5733   (let ((groups (gnus-group-process-prefix n))
5734         group)
5735     (while groups
5736       (setq group (car groups)
5737             groups (cdr groups))
5738       (gnus-group-remove-mark group)
5739       (gnus-message 6 "Changed level of %s from %d to %d"
5740                     group (or (gnus-group-group-level) gnus-level-killed)
5741                     level)
5742       (gnus-group-change-level
5743        group level (or (gnus-group-group-level) gnus-level-killed))
5744       (gnus-group-update-group-line)))
5745   (gnus-group-position-point))
5746
5747 (defun gnus-group-unsubscribe-current-group (&optional n)
5748   "Toggle subscription of the current group.
5749 If given numerical prefix, toggle the N next groups."
5750   (interactive "P")
5751   (let ((groups (gnus-group-process-prefix n))
5752         group)
5753     (while groups
5754       (setq group (car groups)
5755             groups (cdr groups))
5756       (gnus-group-remove-mark group)
5757       (gnus-group-unsubscribe-group
5758        group (if (<= (gnus-group-group-level) gnus-level-subscribed)
5759                  gnus-level-default-unsubscribed
5760                gnus-level-default-subscribed) t)
5761       (gnus-group-update-group-line))
5762     (gnus-group-next-group 1)))
5763
5764 (defun gnus-group-unsubscribe-group (group &optional level silent)
5765   "Toggle subscription to GROUP.
5766 Killed newsgroups are subscribed.  If SILENT, don't try to update the
5767 group line."
5768   (interactive
5769    (list (completing-read
5770           "Group: " gnus-active-hashtb nil
5771           (memq gnus-select-method gnus-have-read-active-file))))
5772   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
5773     (cond
5774      ((string-match "^[ \t]$" group)
5775       (error "Empty group name"))
5776      (newsrc
5777       ;; Toggle subscription flag.
5778       (gnus-group-change-level
5779        newsrc (if level level (if (<= (nth 1 (nth 2 newsrc))
5780                                       gnus-level-subscribed)
5781                                   (1+ gnus-level-subscribed)
5782                                 gnus-level-default-subscribed)))
5783       (unless silent
5784         (gnus-group-update-group group)))
5785      ((and (stringp group)
5786            (or (not (memq gnus-select-method gnus-have-read-active-file))
5787                (gnus-active group)))
5788       ;; Add new newsgroup.
5789       (gnus-group-change-level
5790        group
5791        (if level level gnus-level-default-subscribed)
5792        (or (and (member group gnus-zombie-list)
5793                 gnus-level-zombie)
5794            gnus-level-killed)
5795        (and (gnus-group-group-name)
5796             (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
5797       (unless silent
5798         (gnus-group-update-group group)))
5799      (t (error "No such newsgroup: %s" group)))
5800     (gnus-group-position-point)))
5801
5802 (defun gnus-group-transpose-groups (n)
5803   "Move the current newsgroup up N places.
5804 If given a negative prefix, move down instead.  The difference between
5805 N and the number of steps taken is returned."
5806   (interactive "p")
5807   (or (gnus-group-group-name)
5808       (error "No group on current line"))
5809   (gnus-group-kill-group 1)
5810   (prog1
5811       (forward-line (- n))
5812     (gnus-group-yank-group)
5813     (gnus-group-position-point)))
5814
5815 (defun gnus-group-kill-all-zombies ()
5816   "Kill all zombie newsgroups."
5817   (interactive)
5818   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
5819   (setq gnus-zombie-list nil)
5820   (gnus-group-list-groups))
5821
5822 (defun gnus-group-kill-region (begin end)
5823   "Kill newsgroups in current region (excluding current point).
5824 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
5825   (interactive "r")
5826   (let ((lines
5827          ;; Count lines.
5828          (save-excursion
5829            (count-lines
5830             (progn
5831               (goto-char begin)
5832               (beginning-of-line)
5833               (point))
5834             (progn
5835               (goto-char end)
5836               (beginning-of-line)
5837               (point))))))
5838     (goto-char begin)
5839     (beginning-of-line)                 ;Important when LINES < 1
5840     (gnus-group-kill-group lines)))
5841
5842 (defun gnus-group-kill-group (&optional n discard)
5843   "Kill the next N groups.
5844 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
5845 However, only groups that were alive can be yanked; already killed
5846 groups or zombie groups can't be yanked.
5847 The return value is the name of the group that was killed, or a list
5848 of groups killed."
5849   (interactive "P")
5850   (let ((buffer-read-only nil)
5851         (groups (gnus-group-process-prefix n))
5852         group entry level out)
5853     (if (< (length groups) 10)
5854         ;; This is faster when there are few groups.
5855         (while groups
5856           (push (setq group (pop groups)) out)
5857           (gnus-group-remove-mark group)
5858           (setq level (gnus-group-group-level))
5859           (gnus-delete-line)
5860           (if (and (not discard)
5861                    (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
5862               (setq gnus-list-of-killed-groups
5863                     (cons (cons (car entry) (nth 2 entry))
5864                           gnus-list-of-killed-groups)))
5865           (gnus-group-change-level
5866            (if entry entry group) gnus-level-killed (if entry nil level)))
5867       ;; If there are lots and lots of groups to be killed, we use
5868       ;; this thing instead.
5869       (let (entry)
5870         (setq groups (nreverse groups))
5871         (while groups
5872           (gnus-group-remove-mark (car groups))
5873           (gnus-delete-line)
5874           (setq entry (gnus-gethash (pop groups) gnus-newsrc-hashtb))
5875           (push (cons (car entry) (nth 2 entry))
5876                 gnus-list-of-killed-groups)
5877           (setcdr (cdr entry) (cdr (cdr (cdr entry)))))
5878         (gnus-make-hashtable-from-newsrc-alist)))
5879
5880     (gnus-group-position-point)
5881     (if (< (length out) 2) (car out) (nreverse out))))
5882
5883 (defun gnus-group-yank-group (&optional arg)
5884   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
5885 inserting it before the current newsgroup.  The numeric ARG specifies
5886 how many newsgroups are to be yanked.  The name of the newsgroup yanked
5887 is returned, or (if several groups are yanked) a list of yanked groups
5888 is returned."
5889   (interactive "p")
5890   (setq arg (or arg 1))
5891   (let (info group prev out)
5892     (while (>= (decf arg) 0)
5893       (if (not (setq info (pop gnus-list-of-killed-groups)))
5894           (error "No more newsgroups to yank"))
5895       (push (setq group (nth 1 info)) out)
5896       ;; Find which newsgroup to insert this one before - search
5897       ;; backward until something suitable is found.  If there are no
5898       ;; other newsgroups in this buffer, just make this newsgroup the
5899       ;; first newsgroup.
5900       (setq prev (gnus-group-group-name))
5901       (gnus-group-change-level
5902        info (nth 2 info) gnus-level-killed
5903        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
5904        t)
5905       (gnus-group-insert-group-line-info group))
5906     (forward-line -1)
5907     (gnus-group-position-point)
5908     (if (< (length out) 2) (car out) (nreverse out))))
5909
5910 (defun gnus-group-kill-level (level)
5911   "Kill all groups that is on a certain LEVEL."
5912   (interactive "nKill all groups on level: ")
5913   (cond
5914    ((= level gnus-level-zombie)
5915     (setq gnus-killed-list
5916           (nconc gnus-zombie-list gnus-killed-list))
5917     (setq gnus-zombie-list nil))
5918    ((and (< level gnus-level-zombie)
5919          (> level 0)
5920          (or gnus-expert-user
5921              (gnus-yes-or-no-p
5922               (format
5923                "Do you really want to kill all groups on level %d? "
5924                level))))
5925     (let* ((prev gnus-newsrc-alist)
5926            (alist (cdr prev)))
5927       (while alist
5928         (if (= (gnus-info-level level) level)
5929             (setcdr prev (cdr alist))
5930           (setq prev alist))
5931         (setq alist (cdr alist)))
5932       (gnus-make-hashtable-from-newsrc-alist)
5933       (gnus-group-list-groups)))
5934    (t
5935     (error "Can't kill; illegal level: %d" level))))
5936
5937 (defun gnus-group-list-all-groups (&optional arg)
5938   "List all newsgroups with level ARG or lower.
5939 Default is gnus-level-unsubscribed, which lists all subscribed and most
5940 unsubscribed groups."
5941   (interactive "P")
5942   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
5943
5944 ;; Redefine this to list ALL killed groups if prefix arg used.
5945 ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
5946 (defun gnus-group-list-killed (&optional arg)
5947   "List all killed newsgroups in the group buffer.
5948 If ARG is non-nil, list ALL killed groups known to Gnus.  This may
5949 entail asking the server for the groups."
5950   (interactive "P")
5951   ;; Find all possible killed newsgroups if arg.
5952   (when arg
5953     ;; First make sure active file has been read.
5954     (unless gnus-have-read-active-file
5955       (let ((gnus-read-active-file t))
5956         (gnus-read-active-file)))
5957     (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
5958     ;; Go through all newsgroups that are known to Gnus - enlarge kill list
5959     (mapatoms
5960      (lambda (sym)
5961        (let ((groups 0)
5962              (group (symbol-name sym)))
5963          (if (or (null group)
5964                  (gnus-gethash group gnus-killed-hashtb)
5965                  (gnus-gethash group gnus-newsrc-hashtb))
5966              ()
5967            (let ((do-sub (gnus-matches-options-n group)))
5968              (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
5969                  ()
5970                (setq groups (1+ groups))
5971                (setq gnus-killed-list
5972                      (cons group gnus-killed-list))
5973                (gnus-sethash group group gnus-killed-hashtb))))))
5974      gnus-active-hashtb))
5975   (if (not gnus-killed-list)
5976       (gnus-message 6 "No killed groups")
5977     (let (gnus-group-list-mode)
5978       (funcall gnus-group-prepare-function
5979                gnus-level-killed t gnus-level-killed))
5980     (goto-char (point-min)))
5981   (gnus-group-position-point))
5982
5983 (defun gnus-group-list-zombies ()
5984   "List all zombie newsgroups in the group buffer."
5985   (interactive)
5986   (if (not gnus-zombie-list)
5987       (gnus-message 6 "No zombie groups")
5988     (let (gnus-group-list-mode)
5989       (funcall gnus-group-prepare-function
5990                gnus-level-zombie t gnus-level-zombie))
5991     (goto-char (point-min)))
5992   (gnus-group-position-point))
5993
5994 (defun gnus-group-list-active ()
5995   "List all groups that are available from the server(s)."
5996   (interactive)
5997   ;; First we make sure that we have really read the active file.
5998   (unless gnus-have-read-active-file
5999     (let ((gnus-read-active-file t))
6000       (gnus-read-active-file)))
6001   ;; Find all groups and sort them.
6002   (let ((groups
6003          (sort
6004           (let (list)
6005             (mapatoms
6006              (lambda (sym)
6007                (and (symbol-value sym)
6008                     (setq list (cons (symbol-name sym) list))))
6009              gnus-active-hashtb)
6010             list)
6011           'string<))
6012         (buffer-read-only nil))
6013     (erase-buffer)
6014     (while groups
6015       (gnus-group-insert-group-line-info (car groups))
6016       (setq groups (cdr groups)))
6017     (goto-char (point-min))))
6018
6019 (defun gnus-activate-all-groups (level)
6020   "Activate absolutely all groups."
6021   (interactive (list 7))
6022   (let ((gnus-activate-level level)
6023         (gnus-activate-foreign-newsgroups level))
6024     (gnus-group-get-new-news)))
6025
6026 (defun gnus-group-get-new-news (&optional arg)
6027   "Get newly arrived articles.
6028 If ARG is a number, it specifies which levels you are interested in
6029 re-scanning.  If ARG is non-nil and not a number, this will force
6030 \"hard\" re-reading of the active files from all servers."
6031   (interactive "P")
6032   (run-hooks 'gnus-get-new-news-hook)
6033   ;; We might read in new NoCeM messages here.
6034   (and gnus-use-nocem (gnus-nocem-scan-groups))
6035   ;; If ARG is not a number, then we read the active file.
6036   (and arg
6037        (not (numberp arg))
6038        (progn
6039          (let ((gnus-read-active-file t))
6040            (gnus-read-active-file))
6041          (setq arg nil)))
6042
6043   (setq arg (gnus-group-default-level arg t))
6044   (if (and gnus-read-active-file (not arg))
6045       (progn
6046         (gnus-read-active-file)
6047         (gnus-get-unread-articles arg))
6048     (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
6049       (gnus-get-unread-articles arg)))
6050   (gnus-group-list-groups))
6051
6052 (defun gnus-group-get-new-news-this-group (&optional n)
6053   "Check for newly arrived news in the current group (and the N-1 next groups).
6054 The difference between N and the number of newsgroup checked is returned.
6055 If N is negative, this group and the N-1 previous groups will be checked."
6056   (interactive "P")
6057   (let* ((groups (gnus-group-process-prefix n))
6058          (ret (if (numberp n) (- n (length groups)) 0))
6059          group)
6060     (while groups
6061       (setq group (car groups)
6062             groups (cdr groups))
6063       (gnus-group-remove-mark group)
6064       (unless (gnus-get-new-news-in-group group)
6065         (ding)
6066         (gnus-message 3 "%s error: %s" group (gnus-status-message group))))
6067     (when gnus-goto-next-group-when-activating
6068       (gnus-group-next-unread-group 1 t))
6069     (gnus-summary-position-point)
6070     ret))
6071
6072 (defun gnus-get-new-news-in-group (group)
6073   (when (and group (gnus-activate-group group 'scan))
6074     (gnus-get-unread-articles-in-group
6075      (gnus-get-info group) (gnus-active group) t)
6076     (when (gnus-group-goto-group group)
6077       (gnus-group-update-group-line))
6078     t))
6079
6080 (defun gnus-group-fetch-faq (group &optional faq-dir)
6081   "Fetch the FAQ for the current group."
6082   (interactive
6083    (list
6084     (gnus-group-real-name (gnus-group-group-name))
6085     (cond (current-prefix-arg
6086            (completing-read
6087             "Faq dir: " (and (listp gnus-group-faq-directory)
6088                              gnus-group-faq-directory))))))
6089   (or faq-dir
6090       (setq faq-dir (if (listp gnus-group-faq-directory)
6091                         (car gnus-group-faq-directory)
6092                       gnus-group-faq-directory)))
6093   (or group (error "No group name given"))
6094   (let ((file (concat (file-name-as-directory faq-dir)
6095                       (gnus-group-real-name group))))
6096     (if (not (file-exists-p file))
6097         (error "No such file: %s" file)
6098       (find-file file))))
6099
6100 (defun gnus-group-describe-group (force &optional group)
6101   "Display a description of the current newsgroup."
6102   (interactive (list current-prefix-arg (gnus-group-group-name)))
6103   (and force (setq gnus-description-hashtb nil))
6104   (let ((method (gnus-find-method-for-group group))
6105         desc)
6106     (or group (error "No group name given"))
6107     (and (or (and gnus-description-hashtb
6108                   ;; We check whether this group's method has been
6109                   ;; queried for a description file.
6110                   (gnus-gethash
6111                    (gnus-group-prefixed-name "" method)
6112                    gnus-description-hashtb))
6113              (setq desc (gnus-group-get-description group))
6114              (gnus-read-descriptions-file method))
6115          (message
6116           (or desc (gnus-gethash group gnus-description-hashtb)
6117               "No description available")))))
6118
6119 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6120 (defun gnus-group-describe-all-groups (&optional force)
6121   "Pop up a buffer with descriptions of all newsgroups."
6122   (interactive "P")
6123   (and force (setq gnus-description-hashtb nil))
6124   (if (not (or gnus-description-hashtb
6125                (gnus-read-all-descriptions-files)))
6126       (error "Couldn't request descriptions file"))
6127   (let ((buffer-read-only nil)
6128         b)
6129     (erase-buffer)
6130     (mapatoms
6131      (lambda (group)
6132        (setq b (point))
6133        (insert (format "      *: %-20s %s\n" (symbol-name group)
6134                        (symbol-value group)))
6135        (add-text-properties
6136         b (1+ b) (list 'gnus-group group
6137                        'gnus-unread t 'gnus-marked nil
6138                        'gnus-level (1+ gnus-level-subscribed))))
6139      gnus-description-hashtb)
6140     (goto-char (point-min))
6141     (gnus-group-position-point)))
6142
6143 ;; Suggested by by Daniel Quinlan <quinlan@best.com>.
6144 (defun gnus-group-apropos (regexp &optional search-description)
6145   "List all newsgroups that have names that match a regexp."
6146   (interactive "sGnus apropos (regexp): ")
6147   (let ((prev "")
6148         (obuf (current-buffer))
6149         groups des)
6150     ;; Go through all newsgroups that are known to Gnus.
6151     (mapatoms
6152      (lambda (group)
6153        (and (symbol-name group)
6154             (string-match regexp (symbol-name group))
6155             (setq groups (cons (symbol-name group) groups))))
6156      gnus-active-hashtb)
6157     ;; Go through all descriptions that are known to Gnus.
6158     (if search-description
6159         (mapatoms
6160          (lambda (group)
6161            (and (string-match regexp (symbol-value group))
6162                 (gnus-active (symbol-name group))
6163                 (setq groups (cons (symbol-name group) groups))))
6164          gnus-description-hashtb))
6165     (if (not groups)
6166         (gnus-message 3 "No groups matched \"%s\"." regexp)
6167       ;; Print out all the groups.
6168       (save-excursion
6169         (pop-to-buffer "*Gnus Help*")
6170         (buffer-disable-undo (current-buffer))
6171         (erase-buffer)
6172         (setq groups (sort groups 'string<))
6173         (while groups
6174           ;; Groups may be entered twice into the list of groups.
6175           (if (not (string= (car groups) prev))
6176               (progn
6177                 (insert (setq prev (car groups)) "\n")
6178                 (if (and gnus-description-hashtb
6179                          (setq des (gnus-gethash (car groups)
6180                                                  gnus-description-hashtb)))
6181                     (insert "  " des "\n"))))
6182           (setq groups (cdr groups)))
6183         (goto-char (point-min))))
6184     (pop-to-buffer obuf)))
6185
6186 (defun gnus-group-description-apropos (regexp)
6187   "List all newsgroups that have names or descriptions that match a regexp."
6188   (interactive "sGnus description apropos (regexp): ")
6189   (if (not (or gnus-description-hashtb
6190                (gnus-read-all-descriptions-files)))
6191       (error "Couldn't request descriptions file"))
6192   (gnus-group-apropos regexp t))
6193
6194 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6195 (defun gnus-group-list-matching (level regexp &optional all lowest)
6196   "List all groups with unread articles that match REGEXP.
6197 If the prefix LEVEL is non-nil, it should be a number that says which
6198 level to cut off listing groups.
6199 If ALL, also list groups with no unread articles.
6200 If LOWEST, don't list groups with level lower than LOWEST."
6201   (interactive "P\nsList newsgroups matching: ")
6202   (gnus-group-prepare-flat (or level gnus-level-subscribed)
6203                            all (or lowest 1) regexp)
6204   (goto-char (point-min))
6205   (gnus-group-position-point))
6206
6207 (defun gnus-group-list-all-matching (level regexp &optional lowest)
6208   "List all groups that match REGEXP.
6209 If the prefix LEVEL is non-nil, it should be a number that says which
6210 level to cut off listing groups.
6211 If LOWEST, don't list groups with level lower than LOWEST."
6212   (interactive "P\nsList newsgroups matching: ")
6213   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
6214
6215 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
6216 (defun gnus-group-save-newsrc (&optional force)
6217   "Save the Gnus startup files.
6218 If FORCE, force saving whether it is necessary or not."
6219   (interactive "P")
6220   (gnus-save-newsrc-file force))
6221
6222 (defun gnus-group-restart (&optional arg)
6223   "Force Gnus to read the .newsrc file."
6224   (interactive "P")
6225   (gnus-save-newsrc-file)
6226   (gnus-setup-news 'force)
6227   (gnus-group-list-groups arg))
6228
6229 (defun gnus-group-read-init-file ()
6230   "Read the Gnus elisp init file."
6231   (interactive)
6232   (gnus-read-init-file))
6233
6234 (defun gnus-group-check-bogus-groups (&optional silent)
6235   "Check bogus newsgroups.
6236 If given a prefix, don't ask for confirmation before removing a bogus
6237 group."
6238   (interactive "P")
6239   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
6240   (gnus-group-list-groups))
6241
6242 (defun gnus-group-edit-global-kill (&optional article group)
6243   "Edit the global kill file.
6244 If GROUP, edit that local kill file instead."
6245   (interactive "P")
6246   (setq gnus-current-kill-article article)
6247   (gnus-kill-file-edit-file group)
6248   (gnus-message
6249    6
6250    (substitute-command-keys
6251     (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
6252             (if group "local" "global")))))
6253
6254 (defun gnus-group-edit-local-kill (article group)
6255   "Edit a local kill file."
6256   (interactive (list nil (gnus-group-group-name)))
6257   (gnus-group-edit-global-kill article group))
6258
6259 (defun gnus-group-force-update ()
6260   "Update `.newsrc' file."
6261   (interactive)
6262   (gnus-save-newsrc-file))
6263
6264 (defun gnus-group-suspend ()
6265   "Suspend the current Gnus session.
6266 In fact, cleanup buffers except for group mode buffer.
6267 The hook gnus-suspend-gnus-hook is called before actually suspending."
6268   (interactive)
6269   (run-hooks 'gnus-suspend-gnus-hook)
6270   ;; Kill Gnus buffers except for group mode buffer.
6271   (let ((group-buf (get-buffer gnus-group-buffer)))
6272     ;; Do this on a separate list in case the user does a ^G before we finish
6273     (let ((gnus-buffer-list
6274            (delq group-buf (delq gnus-dribble-buffer
6275                                  (append gnus-buffer-list nil)))))
6276       (while gnus-buffer-list
6277         (gnus-kill-buffer (car gnus-buffer-list))
6278         (setq gnus-buffer-list (cdr gnus-buffer-list))))
6279     (if group-buf
6280         (progn
6281           (setq gnus-buffer-list (list group-buf))
6282           (bury-buffer group-buf)
6283           (delete-windows-on group-buf t)))))
6284
6285 (defun gnus-group-clear-dribble ()
6286   "Clear all information from the dribble buffer."
6287   (interactive)
6288   (gnus-dribble-clear)
6289   (gnus-message 7 "Cleared dribble buffer"))
6290
6291 (defun gnus-group-exit ()
6292   "Quit reading news after updating .newsrc.eld and .newsrc.
6293 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6294   (interactive)
6295   (if (or noninteractive                ;For gnus-batch-kill
6296           (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
6297           (not gnus-interactive-exit)   ;Without confirmation
6298           gnus-expert-user
6299           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
6300       (progn
6301         (run-hooks 'gnus-exit-gnus-hook)
6302         ;; Offer to save data from non-quitted summary buffers.
6303         (gnus-offer-save-summaries)
6304         ;; Save the newsrc file(s).
6305         (gnus-save-newsrc-file)
6306         ;; Kill-em-all.
6307         (gnus-close-backends)
6308         ;; Shut down the cache.
6309         (when gnus-use-cache
6310           (gnus-cache-close))
6311         ;; Reset everything.
6312         (gnus-clear-system))))
6313
6314 (defun gnus-close-backends ()
6315   ;; Send a close request to all backends that support such a request.
6316   (let ((methods gnus-valid-select-methods)
6317         func)
6318     (while methods
6319       (if (fboundp (setq func (intern (concat (car (car methods))
6320                                               "-request-close"))))
6321           (funcall func))
6322       (setq methods (cdr methods)))))
6323
6324 (defun gnus-group-quit ()
6325   "Quit reading news without updating .newsrc.eld or .newsrc.
6326 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6327   (interactive)
6328   (when (or noninteractive              ;For gnus-batch-kill
6329             (zerop (buffer-size))
6330             (not (gnus-server-opened gnus-select-method))
6331             gnus-expert-user
6332             (not gnus-current-startup-file)
6333             (gnus-yes-or-no-p
6334              (format "Quit reading news without saving %s? "
6335                      (file-name-nondirectory gnus-current-startup-file))))
6336     (run-hooks 'gnus-exit-gnus-hook)
6337     (if gnus-use-full-window
6338         (delete-other-windows)
6339       (gnus-remove-some-windows))
6340     (gnus-dribble-save)
6341     (gnus-close-backends)
6342     ;; Shut down the cache.
6343     (when gnus-use-cache
6344       (gnus-cache-close))
6345     (gnus-clear-system)))
6346
6347 (defun gnus-offer-save-summaries ()
6348   "Offer to save all active summary buffers."
6349   (save-excursion
6350     (let ((buflist (buffer-list))
6351           buffers bufname)
6352       ;; Go through all buffers and find all summaries.
6353       (while buflist
6354         (and (setq bufname (buffer-name (car buflist)))
6355              (string-match "Summary" bufname)
6356              (save-excursion
6357                (set-buffer bufname)
6358                ;; We check that this is, indeed, a summary buffer.
6359                (and (eq major-mode 'gnus-summary-mode)
6360                     ;; Also make sure this isn't bogus.
6361                     gnus-newsgroup-prepared))
6362              (push bufname buffers))
6363         (setq buflist (cdr buflist)))
6364       ;; Go through all these summary buffers and offer to save them.
6365       (when buffers
6366         (map-y-or-n-p
6367          "Update summary buffer %s? "
6368          (lambda (buf) (set-buffer buf) (gnus-summary-exit))
6369          buffers)))))
6370
6371 (defun gnus-group-describe-briefly ()
6372   "Give a one line description of the group mode commands."
6373   (interactive)
6374   (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")))
6375
6376 (defun gnus-group-browse-foreign-server (method)
6377   "Browse a foreign news server.
6378 If called interactively, this function will ask for a select method
6379  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
6380 If not, METHOD should be a list where the first element is the method
6381 and the second element is the address."
6382   (interactive
6383    (list (let ((how (completing-read
6384                      "Which backend: "
6385                      (append gnus-valid-select-methods gnus-server-alist)
6386                      nil t (cons "nntp" 0))))
6387            ;; We either got a backend name or a virtual server name.
6388            ;; If the first, we also need an address.
6389            (if (assoc how gnus-valid-select-methods)
6390                (list (intern how)
6391                      ;; Suggested by mapjph@bath.ac.uk.
6392                      (completing-read
6393                       "Address: "
6394                       (mapcar (lambda (server) (list server))
6395                               gnus-secondary-servers)))
6396              ;; We got a server name, so we find the method.
6397              (gnus-server-to-method how)))))
6398   (gnus-browse-foreign-server method))
6399
6400 \f
6401 ;;;
6402 ;;; Gnus summary mode
6403 ;;;
6404
6405 (defvar gnus-summary-mode-map nil)
6406
6407 (put 'gnus-summary-mode 'mode-class 'special)
6408
6409 (unless gnus-summary-mode-map
6410   (setq gnus-summary-mode-map (make-keymap))
6411   (suppress-keymap gnus-summary-mode-map)
6412
6413   ;; Non-orthogonal keys
6414
6415   (gnus-define-keys
6416    gnus-summary-mode-map
6417    " " gnus-summary-next-page
6418    "\177" gnus-summary-prev-page
6419    "\r" gnus-summary-scroll-up
6420    "n" gnus-summary-next-unread-article
6421    "p" gnus-summary-prev-unread-article
6422    "N" gnus-summary-next-article
6423    "P" gnus-summary-prev-article
6424    "\M-\C-n" gnus-summary-next-same-subject
6425    "\M-\C-p" gnus-summary-prev-same-subject
6426    "\M-n" gnus-summary-next-unread-subject
6427    "\M-p" gnus-summary-prev-unread-subject
6428    "." gnus-summary-first-unread-article
6429    "," gnus-summary-best-unread-article
6430    "\M-s" gnus-summary-search-article-forward
6431    "\M-r" gnus-summary-search-article-backward
6432    "<" gnus-summary-beginning-of-article
6433    ">" gnus-summary-end-of-article
6434    "j" gnus-summary-goto-article
6435    "^" gnus-summary-refer-parent-article
6436    "\M-^" gnus-summary-refer-article
6437    "u" gnus-summary-tick-article-forward
6438    "!" gnus-summary-tick-article-forward
6439    "U" gnus-summary-tick-article-backward
6440    "d" gnus-summary-mark-as-read-forward
6441    "D" gnus-summary-mark-as-read-backward
6442    "E" gnus-summary-mark-as-expirable
6443    "\M-u" gnus-summary-clear-mark-forward
6444    "\M-U" gnus-summary-clear-mark-backward
6445    "k" gnus-summary-kill-same-subject-and-select
6446    "\C-k" gnus-summary-kill-same-subject
6447    "\M-\C-k" gnus-summary-kill-thread
6448    "\M-\C-l" gnus-summary-lower-thread
6449    "e" gnus-summary-edit-article
6450    "#" gnus-summary-mark-as-processable
6451    "\M-#" gnus-summary-unmark-as-processable
6452    "\M-\C-t" gnus-summary-toggle-threads
6453    "\M-\C-s" gnus-summary-show-thread
6454    "\M-\C-h" gnus-summary-hide-thread
6455    "\M-\C-f" gnus-summary-next-thread
6456    "\M-\C-b" gnus-summary-prev-thread
6457    "\M-\C-u" gnus-summary-up-thread
6458    "\M-\C-d" gnus-summary-down-thread
6459    "&" gnus-summary-execute-command
6460    "c" gnus-summary-catchup-and-exit
6461    "\C-w" gnus-summary-mark-region-as-read
6462    "\C-t" gnus-summary-toggle-truncation
6463    "?" gnus-summary-mark-as-dormant
6464    "\C-c\M-\C-s" gnus-summary-limit-include-expunged
6465    "\C-c\C-s\C-n" gnus-summary-sort-by-number
6466    "\C-c\C-s\C-a" gnus-summary-sort-by-author
6467    "\C-c\C-s\C-s" gnus-summary-sort-by-subject
6468    "\C-c\C-s\C-d" gnus-summary-sort-by-date
6469    "\C-c\C-s\C-i" gnus-summary-sort-by-score
6470    "=" gnus-summary-expand-window
6471    "\C-x\C-s" gnus-summary-reselect-current-group
6472    "\M-g" gnus-summary-rescan-group
6473    "w" gnus-summary-stop-page-breaking
6474    "\C-c\C-r" gnus-summary-caesar-message
6475    "\M-t" gnus-summary-toggle-mime
6476    "f" gnus-summary-followup
6477    "F" gnus-summary-followup-with-original
6478    "C" gnus-summary-cancel-article
6479    "r" gnus-summary-reply
6480    "R" gnus-summary-reply-with-original
6481    "\C-c\C-f" gnus-summary-mail-forward
6482    "o" gnus-summary-save-article
6483    "\C-o" gnus-summary-save-article-mail
6484    "|" gnus-summary-pipe-output
6485    "\M-k" gnus-summary-edit-local-kill
6486    "\M-K" gnus-summary-edit-global-kill
6487    "V" gnus-version
6488    "\C-c\C-d" gnus-summary-describe-group
6489    "q" gnus-summary-exit
6490    "Q" gnus-summary-exit-no-update
6491    "\C-c\C-i" gnus-info-find-node
6492    gnus-mouse-2 gnus-mouse-pick-article
6493    "m" gnus-summary-mail-other-window
6494    "a" gnus-summary-post-news
6495    "x" gnus-summary-limit-to-unread
6496    "s" gnus-summary-isearch-article
6497    "t" gnus-summary-toggle-header
6498    "g" gnus-summary-show-article
6499    "l" gnus-summary-goto-last-article
6500    "\C-c\C-v\C-v" gnus-uu-decode-uu-view
6501    "\C-d" gnus-summary-enter-digest-group
6502    "v" gnus-summary-verbose-headers
6503    "\C-c\C-b" gnus-bug
6504    "*" gnus-cache-enter-article
6505    "\M-*" gnus-cache-remove-article
6506    "\M-&" gnus-summary-universal-argument
6507    "D" gnus-summary-enter-digest-group
6508    "I" gnus-summary-increase-score
6509    "L" gnus-summary-lower-score
6510
6511    "V" gnus-summary-score-map
6512    "X" gnus-uu-extract-map
6513    "S" gnus-summary-send-map)
6514
6515   ;; Sort of orthogonal keymap
6516   (gnus-define-keys
6517    (gnus-summary-mark-map "M" gnus-summary-mode-map)
6518    "t" gnus-summary-tick-article-forward
6519    "!" gnus-summary-tick-article-forward
6520    "d" gnus-summary-mark-as-read-forward
6521    "r" gnus-summary-mark-as-read-forward
6522    "c" gnus-summary-clear-mark-forward
6523    " " gnus-summary-clear-mark-forward
6524    "e" gnus-summary-mark-as-expirable
6525    "x" gnus-summary-mark-as-expirable
6526    "?" gnus-summary-mark-as-dormant
6527    "b" gnus-summary-set-bookmark
6528    "B" gnus-summary-remove-bookmark
6529    "#" gnus-summary-mark-as-processable
6530    "\M-#" gnus-summary-unmark-as-processable
6531    "S" gnus-summary-limit-include-expunged
6532    "C" gnus-summary-catchup
6533    "H" gnus-summary-catchup-to-here
6534    "\C-c" gnus-summary-catchup-all
6535    "k" gnus-summary-kill-same-subject-and-select
6536    "K" gnus-summary-kill-same-subject
6537    "P" gnus-uu-mark-map)
6538
6539   (gnus-define-keys
6540    (gnus-summary-mscore-map "V" gnus-summary-mode-map)
6541    "c" gnus-summary-clear-above
6542    "u" gnus-summary-tick-above
6543    "m" gnus-summary-mark-above
6544    "k" gnus-summary-kill-below)
6545
6546   (gnus-define-keys
6547    (gnus-summary-limit-map "/" gnus-summary-mode-map)
6548    "/" gnus-summary-limit-to-subject
6549    "n" gnus-summary-limit-to-articles
6550    "w" gnus-summary-pop-limit
6551    "s" gnus-summary-limit-to-subject
6552    "a" gnus-summary-limit-to-author
6553    "u" gnus-summary-limit-to-unread
6554    "m" gnus-summary-limit-to-marks
6555    "v" gnus-summary-limit-to-score
6556    "D" gnus-summary-limit-include-dormant
6557    "d" gnus-summary-limit-exclude-dormant
6558 ;;  "t" gnus-summary-limit-exclude-thread
6559    "E" gnus-summary-limit-include-expunged
6560    "c" gnus-summary-limit-exclude-childless-dormant
6561    "C" gnus-summary-limit-mark-excluded-as-read)
6562
6563   (gnus-define-keys
6564    (gnus-summary-goto-map "G" gnus-summary-mode-map)
6565    "n" gnus-summary-next-unread-article
6566    "p" gnus-summary-prev-unread-article
6567    "N" gnus-summary-next-article
6568    "P" gnus-summary-prev-article
6569    "\C-n" gnus-summary-next-same-subject
6570    "\C-p" gnus-summary-prev-same-subject
6571    "\M-n" gnus-summary-next-unread-subject
6572    "\M-p" gnus-summary-prev-unread-subject
6573    "f" gnus-summary-first-unread-article
6574    "b" gnus-summary-best-unread-article
6575    "g" gnus-summary-goto-subject
6576    "l" gnus-summary-goto-last-article
6577    "p" gnus-summary-pop-article)
6578
6579   (gnus-define-keys
6580    (gnus-summary-thread-map "T" gnus-summary-mode-map)
6581    "k" gnus-summary-kill-thread
6582    "l" gnus-summary-lower-thread
6583    "i" gnus-summary-raise-thread
6584    "T" gnus-summary-toggle-threads
6585    "t" gnus-summary-rethread-current
6586    "s" gnus-summary-show-thread
6587    "S" gnus-summary-show-all-threads
6588    "h" gnus-summary-hide-thread
6589    "H" gnus-summary-hide-all-threads
6590    "n" gnus-summary-next-thread
6591    "p" gnus-summary-prev-thread
6592    "u" gnus-summary-up-thread
6593    "o" gnus-summary-top-thread
6594    "d" gnus-summary-down-thread
6595    "#" gnus-uu-mark-thread
6596    "\M-#" gnus-uu-unmark-thread)
6597
6598   (gnus-define-keys
6599    (gnus-summary-exit-map "Z" gnus-summary-mode-map)
6600    "c" gnus-summary-catchup-and-exit
6601    "C" gnus-summary-catchup-all-and-exit
6602    "E" gnus-summary-exit-no-update
6603    "Q" gnus-summary-exit
6604    "Z" gnus-summary-exit
6605    "n" gnus-summary-catchup-and-goto-next-group
6606    "R" gnus-summary-reselect-current-group
6607    "G" gnus-summary-rescan-group
6608    "N" gnus-summary-next-group
6609    "P" gnus-summary-prev-group)
6610
6611   (gnus-define-keys
6612    (gnus-summary-article-map "A" gnus-summary-mode-map)
6613    " " gnus-summary-next-page
6614    "n" gnus-summary-next-page
6615    "\177" gnus-summary-prev-page
6616    "p" gnus-summary-prev-page
6617    "\r" gnus-summary-scroll-up
6618    "<" gnus-summary-beginning-of-article
6619    ">" gnus-summary-end-of-article
6620    "b" gnus-summary-beginning-of-article
6621    "e" gnus-summary-end-of-article
6622    "^" gnus-summary-refer-parent-article
6623    "r" gnus-summary-refer-parent-article
6624    "R" gnus-summary-refer-references
6625    "g" gnus-summary-show-article
6626    "s" gnus-summary-isearch-article)
6627
6628   (gnus-define-keys
6629    (gnus-summary-wash-map "W" gnus-summary-mode-map)
6630    "b" gnus-article-add-buttons
6631    "B" gnus-article-add-buttons-to-head
6632    "o" gnus-article-treat-overstrike
6633 ;;  "w" gnus-article-word-wrap
6634    "w" gnus-article-fill-cited-article
6635    "c" gnus-article-remove-cr
6636    "L" gnus-article-remove-trailing-blank-lines
6637    "q" gnus-article-de-quoted-unreadable
6638    "f" gnus-article-display-x-face
6639    "l" gnus-summary-stop-page-breaking
6640    "r" gnus-summary-caesar-message
6641    "t" gnus-summary-toggle-header
6642    "m" gnus-summary-toggle-mime)
6643
6644   (gnus-define-keys
6645    (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
6646    "a" gnus-article-hide
6647    "h" gnus-article-hide-headers
6648    "b" gnus-article-hide-boring-headers
6649    "s" gnus-article-hide-signature
6650    "c" gnus-article-hide-citation
6651    "p" gnus-article-hide-pgp
6652    "\C-c" gnus-article-hide-citation-maybe)
6653
6654   (gnus-define-keys
6655    (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
6656    "a" gnus-article-highlight
6657    "h" gnus-article-highlight-headers
6658    "c" gnus-article-highlight-citation
6659    "s" gnus-article-highlight-signature)
6660
6661   (gnus-define-keys
6662    (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
6663    "z" gnus-article-date-ut
6664    "u" gnus-article-date-ut
6665    "l" gnus-article-date-local
6666    "e" gnus-article-date-lapsed
6667    "o" gnus-article-date-original)
6668
6669   (gnus-define-keys
6670    (gnus-summary-help-map "H" gnus-summary-mode-map)
6671    "v" gnus-version
6672    "f" gnus-summary-fetch-faq
6673    "d" gnus-summary-describe-group
6674    "h" gnus-summary-describe-briefly
6675    "i" gnus-info-find-node)
6676
6677   (gnus-define-keys
6678    (gnus-summary-backend-map "B" gnus-summary-mode-map)
6679    "e" gnus-summary-expire-articles
6680    "\M-\C-e" gnus-summary-expire-articles-now
6681    "\177" gnus-summary-delete-article
6682    "m" gnus-summary-move-article
6683    "r" gnus-summary-respool-article
6684    "w" gnus-summary-edit-article
6685    "c" gnus-summary-copy-article
6686    "B" gnus-summary-crosspost-article
6687    "q" gnus-summary-respool-query
6688    "i" gnus-summary-import-article)
6689
6690   (gnus-define-keys
6691    (gnus-summary-save-map "O" gnus-summary-mode-map)
6692    "o" gnus-summary-save-article
6693    "m" gnus-summary-save-article-mail
6694    "r" gnus-summary-save-article-rmail
6695    "f" gnus-summary-save-article-file
6696    "b" gnus-summary-save-article-body-file
6697    "h" gnus-summary-save-article-folder
6698    "v" gnus-summary-save-article-vm
6699    "p" gnus-summary-pipe-output
6700    "s" gnus-soup-add-article)
6701   )
6702
6703
6704 \f
6705
6706 (defun gnus-summary-mode (&optional group)
6707   "Major mode for reading articles.
6708
6709 All normal editing commands are switched off.
6710 \\<gnus-summary-mode-map>
6711 Each line in this buffer represents one article.  To read an
6712 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
6713 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
6714 respectively.
6715
6716 You can also post articles and send mail from this buffer.  To
6717 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author
6718 of an article, type `\\[gnus-summary-reply]'.
6719
6720 There are approx. one gazillion commands you can execute in this
6721 buffer; read the info pages for more information (`\\[gnus-info-find-node]').
6722
6723 The following commands are available:
6724
6725 \\{gnus-summary-mode-map}"
6726   (interactive)
6727   (when (and menu-bar-mode
6728              (gnus-visual-p 'summary-menu 'menu))
6729     (gnus-summary-make-menu-bar))
6730   (kill-all-local-variables)
6731   (let ((locals gnus-summary-local-variables))
6732     (while locals
6733       (if (consp (car locals))
6734           (progn
6735             (make-local-variable (car (car locals)))
6736             (set (car (car locals)) (eval (cdr (car locals)))))
6737         (make-local-variable (car locals))
6738         (set (car locals) nil))
6739       (setq locals (cdr locals))))
6740   (gnus-make-thread-indent-array)
6741   (gnus-simplify-mode-line)
6742   (setq major-mode 'gnus-summary-mode)
6743   (setq mode-name "Summary")
6744   (make-local-variable 'minor-mode-alist)
6745   (use-local-map gnus-summary-mode-map)
6746   (buffer-disable-undo (current-buffer))
6747   (setq buffer-read-only t)             ;Disable modification
6748   (setq truncate-lines t)
6749   (setq selective-display t)
6750   (setq selective-display-ellipses t)   ;Display `...'
6751   (setq buffer-display-table gnus-summary-display-table)
6752   (setq gnus-newsgroup-name group)
6753   (run-hooks 'gnus-summary-mode-hook))
6754
6755 (defun gnus-summary-make-display-table ()
6756   ;; Change the display table.  Odd characters have a tendency to mess
6757   ;; up nicely formatted displays - we make all possible glyphs
6758   ;; display only a single character.
6759
6760   ;; We start from the standard display table, if any.
6761   (setq gnus-summary-display-table
6762         (or (copy-sequence standard-display-table)
6763             (make-display-table)))
6764   ;; Nix out all the control chars...
6765   (let ((i 32))
6766     (while (>= (setq i (1- i)) 0)
6767       (aset gnus-summary-display-table i [??])))
6768   ;; ... but not newline and cr, of course. (cr is necessary for the
6769   ;; selective display).
6770   (aset gnus-summary-display-table ?\n nil)
6771   (aset gnus-summary-display-table ?\r nil)
6772   ;; We nix out any glyphs over 126 that are not set already.
6773   (let ((i 256))
6774     (while (>= (setq i (1- i)) 127)
6775       ;; Only modify if the entry is nil.
6776       (or (aref gnus-summary-display-table i)
6777           (aset gnus-summary-display-table i [??])))))
6778
6779 (defun gnus-summary-clear-local-variables ()
6780   (let ((locals gnus-summary-local-variables))
6781     (while locals
6782       (if (consp (car locals))
6783           (and (vectorp (car (car locals)))
6784                (set (car (car locals)) nil))
6785         (and (vectorp (car locals))
6786              (set (car locals) nil)))
6787       (setq locals (cdr locals)))))
6788
6789 ;; Summary data functions.
6790
6791 (defmacro gnus-data-number (data)
6792   `(car ,data))
6793
6794 (defmacro gnus-data-mark (data)
6795   `(nth 1 ,data))
6796
6797 (defmacro gnus-data-set-mark (data mark)
6798   `(setcar (nthcdr 1 ,data) ,mark))
6799
6800 (defmacro gnus-data-pos (data)
6801   `(nth 2 ,data))
6802
6803 (defmacro gnus-data-set-pos (data pos)
6804   `(setcar (nthcdr 2 ,data) ,pos))
6805
6806 (defmacro gnus-data-header (data)
6807   `(nth 3 ,data))
6808
6809 (defmacro gnus-data-level (data)
6810   `(nth 4 ,data))
6811
6812 (defmacro gnus-data-unread-p (data)
6813   `(= (nth 1 ,data) gnus-unread-mark))
6814
6815 (defmacro gnus-data-pseudo-p (data)
6816   `(consp (nth 3 ,data)))
6817
6818 (defmacro gnus-data-find (number)
6819   `(assq ,number gnus-newsgroup-data))
6820
6821 (defmacro gnus-data-find-list (number &optional data)
6822   `(let ((bdata ,(or data 'gnus-newsgroup-data)))
6823      (memq (assq ,number bdata)
6824            bdata)))
6825
6826 (defmacro gnus-data-make (number mark pos header level)
6827   `(list ,number ,mark ,pos ,header ,level))
6828
6829 (defun gnus-data-enter (after-article number mark pos header level offset)
6830   (let ((data (gnus-data-find-list after-article)))
6831     (or data (error "No such article: %d" after-article))
6832     (setcdr data (cons (gnus-data-make number mark pos header level)
6833                        (cdr data)))
6834     (setq gnus-newsgroup-data-reverse nil)
6835     (gnus-data-update-list (cdr (cdr data)) offset)))
6836
6837 (defun gnus-data-enter-list (after-article list &optional offset)
6838   (when list
6839     (let ((data (and after-article (gnus-data-find-list after-article)))
6840           (ilist list))
6841       (or data (not after-article) (error "No such article: %d" after-article))
6842       ;; Find the last element in the list to be spliced into the main
6843       ;; list.
6844       (while (cdr list)
6845         (setq list (cdr list)))
6846       (if (not data)
6847           (progn
6848             (setcdr list gnus-newsgroup-data)
6849             (setq gnus-newsgroup-data ilist)
6850             (and offset (gnus-data-update-list (cdr list) offset)))
6851         (setcdr list (cdr data))
6852         (setcdr data ilist)
6853         (and offset (gnus-data-update-list (cdr data) offset)))
6854       (setq gnus-newsgroup-data-reverse nil))))
6855
6856 (defun gnus-data-remove (article &optional offset)
6857   (let ((data gnus-newsgroup-data))
6858     (if (= (gnus-data-number (car data)) article)
6859         (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
6860               gnus-newsgroup-data-reverse nil)
6861       (while (cdr data)
6862         (and (= (gnus-data-number (car (cdr data))) article)
6863              (progn
6864                (setcdr data (cdr (cdr data)))
6865                (and offset (gnus-data-update-list (cdr data) offset))
6866                (setq data nil
6867                      gnus-newsgroup-data-reverse nil)))
6868         (setq data (cdr data))))))
6869
6870 (defmacro gnus-data-list (backward)
6871   `(if ,backward
6872        (or gnus-newsgroup-data-reverse
6873            (setq gnus-newsgroup-data-reverse
6874                  (reverse gnus-newsgroup-data)))
6875      gnus-newsgroup-data))
6876
6877 (defun gnus-data-update-list (data offset)
6878   "Add OFFSET to the POS of all data entries in DATA."
6879   (while data
6880     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
6881     (setq data (cdr data))))
6882
6883 (defun gnus-data-compute-positions ()
6884   "Compute the positions of all articles."
6885   (let ((data gnus-newsgroup-data)
6886         pos)
6887     (while data
6888       (when (setq pos (text-property-any
6889                        (point-min) (point-max)
6890                        'gnus-number (gnus-data-number (car data))))
6891         (gnus-data-set-pos (car data) (+ pos 3)))
6892       (setq data (cdr data)))))
6893
6894 (defun gnus-summary-article-pseudo-p (article)
6895   "Say whether this article is a pseudo article or not."
6896   (not (vectorp (gnus-data-header (gnus-data-find article)))))
6897
6898 (defun gnus-article-parent-p (number)
6899   "Say whether this article is a parent or not."
6900   (let* ((data (gnus-data-find-list number)))
6901     (and (cdr data)                     ; There has to be an article after...
6902          (< (gnus-data-level (car data)) ; And it has to have a higher level.
6903             (gnus-data-level (nth 1 data))))))
6904
6905 (defmacro gnus-summary-skip-intangible ()
6906   "If the current article is intangible, then jump to a different article."
6907   '(let ((to (get-text-property (point) 'gnus-intangible)))
6908     (when to
6909       (gnus-summary-goto-subject to))))
6910
6911 (defmacro gnus-summary-article-intangible-p ()
6912   "Say whether this article is intangible or not."
6913   '(get-text-property (point) 'gnus-intangible))
6914
6915 ;; Some summary mode macros.
6916
6917 (defmacro gnus-summary-article-number ()
6918   "The article number of the article on the current line.
6919 If there isn's an article number here, then we return the current
6920 article number."
6921   '(progn
6922      (gnus-summary-skip-intangible)
6923      (or (get-text-property (point) 'gnus-number)
6924          (gnus-summary-last-subject))))
6925
6926 (defmacro gnus-summary-article-header (&optional number)
6927   `(gnus-data-header (gnus-data-find
6928                       ,(or number '(gnus-summary-article-number)))))
6929
6930 (defmacro gnus-summary-thread-level (&optional number)
6931   `(if (and (eq gnus-summary-make-false-root 'dummy)
6932             (get-text-property (point) 'gnus-intangible))
6933        0
6934      (gnus-data-level (gnus-data-find
6935                        ,(or number '(gnus-summary-article-number))))))
6936
6937 (defmacro gnus-summary-article-mark (&optional number)
6938   `(gnus-data-mark (gnus-data-find
6939                     ,(or number '(gnus-summary-article-number)))))
6940
6941 (defmacro gnus-summary-article-pos (&optional number)
6942   `(gnus-data-pos (gnus-data-find
6943                    ,(or number '(gnus-summary-article-number)))))
6944
6945 (defmacro gnus-summary-article-subject (&optional number)
6946   "Return current subject string or nil if nothing."
6947   `(let ((headers
6948           ,(if number
6949                `(gnus-data-header (assq ,number gnus-newsgroup-data))
6950              '(gnus-data-header (assq (gnus-summary-article-number)
6951                                       gnus-newsgroup-data)))))
6952      (and headers
6953           (vectorp headers)
6954           (mail-header-subject headers))))
6955
6956 (defmacro gnus-summary-article-score (&optional number)
6957   "Return current article score."
6958   `(or (cdr (assq ,(or number '(gnus-summary-article-number))
6959                   gnus-newsgroup-scored))
6960        gnus-summary-default-score 0))
6961
6962 (defun gnus-summary-article-children (&optional number)
6963   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
6964          (level (gnus-data-level (car data)))
6965          l children)
6966     (while (and (setq data (cdr data))
6967                 (> (setq l (gnus-data-level (car data))) level))
6968       (and (= (1+ level) l)
6969            (setq children (cons (gnus-data-number (car data))
6970                                 children))))
6971     (nreverse children)))
6972
6973 (defun gnus-summary-article-parent (&optional number)
6974   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
6975                                     (gnus-data-list t)))
6976          (level (gnus-data-level (car data)))
6977          l)
6978     (if (zerop level)
6979         () ; This is a root.
6980       ;; We search until we find an article with a level less than
6981       ;; this one.  That function has to be the parent.
6982       (while (and (setq data (cdr data))
6983                   (not (< (gnus-data-level (car data)) level))))
6984       (and data (gnus-data-number (car data))))))
6985
6986
6987 ;; Various summary mode internalish functions.
6988
6989 (defun gnus-mouse-pick-article (e)
6990   (interactive "e")
6991   (mouse-set-point e)
6992   (gnus-summary-next-page nil t))
6993
6994 (defun gnus-summary-setup-buffer (group)
6995   "Initialize summary buffer."
6996   (let ((buffer (concat "*Summary " group "*")))
6997     (if (get-buffer buffer)
6998         (progn
6999           (set-buffer buffer)
7000           (setq gnus-summary-buffer (current-buffer))
7001           (not gnus-newsgroup-prepared))
7002       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
7003       (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
7004       (gnus-add-current-to-buffer-list)
7005       (gnus-summary-mode group)
7006       (when gnus-carpal
7007         (gnus-carpal-setup-buffer 'summary))
7008       (unless gnus-single-article-buffer
7009         (make-local-variable 'gnus-article-buffer)
7010         (make-local-variable 'gnus-original-article-buffer))
7011       (setq gnus-newsgroup-name group)
7012       t)))
7013
7014 (defun gnus-set-global-variables ()
7015   ;; Set the global equivalents of the summary buffer-local variables
7016   ;; to the latest values they had.  These reflect the summary buffer
7017   ;; that was in action when the last article was fetched.
7018   (when (eq major-mode 'gnus-summary-mode)
7019     (setq gnus-summary-buffer (current-buffer))
7020     (let ((name gnus-newsgroup-name)
7021           (marked gnus-newsgroup-marked)
7022           (unread gnus-newsgroup-unreads)
7023           (headers gnus-current-headers)
7024           (data gnus-newsgroup-data)
7025           (article-buffer gnus-article-buffer)
7026           (score-file gnus-current-score-file))
7027       (save-excursion
7028         (set-buffer gnus-group-buffer)
7029         (setq gnus-newsgroup-name name)
7030         (setq gnus-newsgroup-marked marked)
7031         (setq gnus-newsgroup-unreads unread)
7032         (setq gnus-current-headers headers)
7033         (setq gnus-newsgroup-data data)
7034         (setq gnus-article-buffer article-buffer)
7035         (setq gnus-current-score-file score-file)))))
7036
7037 (defun gnus-summary-last-article-p (&optional article)
7038   "Return whether ARTICLE is the last article in the buffer."
7039   (if (not (setq article (or article (gnus-summary-article-number))))
7040       t ; All non-existant numbers are the last article. :-)
7041     (cdr (gnus-data-find-list article))))
7042
7043 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
7044   "Insert a dummy root in the summary buffer."
7045   (beginning-of-line)
7046   (add-text-properties
7047    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
7048    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
7049
7050 (defvar gnus-thread-indent-array nil)
7051 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
7052 (defun gnus-make-thread-indent-array ()
7053   (let ((n 200))
7054     (if (and gnus-thread-indent-array
7055              (= gnus-thread-indent-level gnus-thread-indent-array-level))
7056         nil
7057       (setq gnus-thread-indent-array (make-vector 201 "")
7058             gnus-thread-indent-array-level gnus-thread-indent-level)
7059       (while (>= n 0)
7060         (aset gnus-thread-indent-array n
7061               (make-string (* n gnus-thread-indent-level) ? ))
7062         (setq n (1- n))))))
7063
7064 (defun gnus-summary-insert-line
7065   (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread
7066                    gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
7067                    &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
7068   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
7069          (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
7070          (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
7071          (gnus-tmp-score-char
7072           (if (or (null gnus-summary-default-score)
7073                   (<= (abs (- gnus-tmp-score gnus-summary-default-score))
7074                       gnus-summary-zcore-fuzz)) ? 
7075             (if (< gnus-tmp-score gnus-summary-default-score)
7076                 gnus-score-below-mark gnus-score-over-mark)))
7077          (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark)
7078                                  ((memq gnus-tmp-current gnus-newsgroup-cached)
7079                                   gnus-cached-mark)
7080                                  (gnus-tmp-replied gnus-replied-mark)
7081                                  ((memq gnus-tmp-current gnus-newsgroup-saved)
7082                                   gnus-saved-mark)
7083                                  (t gnus-unread-mark)))
7084          (gnus-tmp-from (mail-header-from gnus-tmp-header))
7085          (gnus-tmp-name
7086           (cond
7087            ((string-match "(.+)" gnus-tmp-from)
7088             (substring gnus-tmp-from
7089                        (1+ (match-beginning 0)) (1- (match-end 0))))
7090            ((string-match "<[^>]+> *$" gnus-tmp-from)
7091             (let ((beg (match-beginning 0)))
7092               (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
7093                        (substring gnus-tmp-from (1+ (match-beginning 0))
7094                                   (1- (match-end 0))))
7095                   (substring gnus-tmp-from 0 beg))))
7096            (t gnus-tmp-from)))
7097          (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
7098          (gnus-tmp-number (mail-header-number gnus-tmp-header))
7099          (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
7100          (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
7101          (buffer-read-only nil))
7102     (when (string= gnus-tmp-name "")
7103       (setq gnus-tmp-name gnus-tmp-from))
7104     (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
7105     (put-text-property
7106      (point)
7107      (progn (eval gnus-summary-line-format-spec) (point))
7108      'gnus-number gnus-tmp-number)
7109     (when (gnus-visual-p 'summary-highlight 'highlight)
7110       (forward-line -1)
7111       (run-hooks 'gnus-summary-update-hook)
7112       (forward-line 1))))
7113
7114 (defun gnus-summary-update-line (&optional dont-update)
7115   ;; Update summary line after change.
7116   (when (and gnus-summary-default-score
7117              (not gnus-summary-inhibit-highlight))
7118     (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
7119            (article (gnus-summary-article-number))
7120            (score (gnus-summary-article-score article)))
7121       (unless dont-update
7122         (if (and gnus-summary-mark-below
7123                  (< (gnus-summary-article-score)
7124                     gnus-summary-mark-below))
7125             ;; This article has a low score, so we mark it as read.
7126             (when (memq article gnus-newsgroup-unreads)
7127               (gnus-summary-mark-article-as-read gnus-low-score-mark))
7128           (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
7129             ;; This article was previously marked as read on account
7130             ;; of a low score, but now it has risen, so we mark it as
7131             ;; unread.
7132             (gnus-summary-mark-article-as-unread gnus-unread-mark)))
7133         (gnus-summary-update-mark
7134          (if (or (null gnus-summary-default-score)
7135                  (<= (abs (- score gnus-summary-default-score))
7136                      gnus-summary-zcore-fuzz)) ? 
7137            (if (< score gnus-summary-default-score)
7138                gnus-score-below-mark gnus-score-over-mark)) 'score))
7139       ;; Do visual highlighting.
7140       (when (gnus-visual-p 'summary-highlight 'highlight)
7141         (run-hooks 'gnus-summary-update-hook)))))
7142
7143 (defvar gnus-tmp-new-adopts nil)
7144
7145 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
7146   ;; Sum up all elements (and sub-elements) in a list.
7147   (let* ((number
7148           ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
7149           (cond
7150            ((and (consp thread) (cdr thread))
7151             (apply
7152              '+ 1 (mapcar
7153                    'gnus-summary-number-of-articles-in-thread (cdr thread))))
7154            ((null thread)
7155             1)
7156            ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
7157             1)
7158            (t 1))))
7159     (when (and level (zerop level) gnus-tmp-new-adopts)
7160       (incf number
7161             (apply '+ (mapcar
7162                        'gnus-summary-number-of-articles-in-thread
7163                        gnus-tmp-new-adopts))))
7164     (if char
7165         (if (> number 1) gnus-not-empty-thread-mark
7166           gnus-empty-thread-mark)
7167       number)))
7168
7169 (defun gnus-summary-set-local-parameters (group)
7170  "Go through the local params of GROUP and set all variable specs in that list."
7171   (let ((params (gnus-info-params (gnus-get-info group)))
7172         elem)
7173     (while params
7174       (setq elem (car params)
7175             params (cdr params))
7176       (and (consp elem)                 ; Has to be a cons.
7177            (consp (cdr elem))           ; The cdr has to be a list.
7178            (symbolp (car elem))         ; Has to be a symbol in there.
7179            (progn                       ; So we set it.
7180              (make-local-variable (car elem))
7181              (set (car elem) (eval (nth 1 elem))))))))
7182
7183 (defun gnus-summary-read-group
7184   (group &optional show-all no-article kill-buffer no-display)
7185   "Start reading news in newsgroup GROUP.
7186 If SHOW-ALL is non-nil, already read articles are also listed.
7187 If NO-ARTICLE is non-nil, no article is selected initially.
7188 If NO-DISPLAY, don't generate a summary buffer."
7189   (gnus-message 5 "Retrieving newsgroup: %s..." group)
7190   (let* ((new-group (gnus-summary-setup-buffer group))
7191          (quit-config (gnus-group-quit-config group))
7192          (did-select (and new-group (gnus-select-newsgroup group show-all))))
7193     (cond
7194      ;; This summary buffer exists already, so we just select it.
7195      ((not new-group)
7196       (gnus-set-global-variables)
7197       (when kill-buffer
7198         (gnus-kill-or-deaden-summary kill-buffer))
7199       (gnus-configure-windows 'summary 'force)
7200       (gnus-set-mode-line 'summary)
7201       (gnus-summary-position-point)
7202       (message "")
7203       t)
7204      ;; We couldn't select this group.
7205      ((null did-select)
7206       (when (and (eq major-mode 'gnus-summary-mode)
7207                  (not (equal (current-buffer) kill-buffer)))
7208         (kill-buffer (current-buffer))
7209         (if (not quit-config)
7210             (progn
7211               (set-buffer gnus-group-buffer)
7212               (gnus-group-jump-to-group group)
7213               (gnus-group-next-unread-group 1))
7214           (if (not (buffer-name (car quit-config)))
7215               (gnus-configure-windows 'group 'force)
7216             (set-buffer (car quit-config))
7217             (and (eq major-mode 'gnus-summary-mode)
7218                  (gnus-set-global-variables))
7219             (gnus-configure-windows (cdr quit-config)))))
7220       (gnus-message 3 "Can't select group")
7221       nil)
7222      ;; The user did a `C-g' while prompting for number of articles,
7223      ;; so we exit this group.
7224      ((eq did-select 'quit)
7225       (and (eq major-mode 'gnus-summary-mode)
7226            (not (equal (current-buffer) kill-buffer))
7227            (kill-buffer (current-buffer)))
7228       (when kill-buffer
7229         (gnus-kill-or-deaden-summary kill-buffer))
7230       (if (not quit-config)
7231           (progn
7232             (set-buffer gnus-group-buffer)
7233             (gnus-group-jump-to-group group)
7234             (gnus-group-next-unread-group 1)
7235             (gnus-configure-windows 'group 'force))
7236         (if (not (buffer-name (car quit-config)))
7237             (gnus-configure-windows 'group 'force)
7238           (set-buffer (car quit-config))
7239           (and (eq major-mode 'gnus-summary-mode)
7240                (gnus-set-global-variables))
7241           (gnus-configure-windows (cdr quit-config))))
7242       ;; Finally signal the quit.
7243       (signal 'quit nil))
7244      ;; The group was successfully selected.
7245      (t
7246       (gnus-set-global-variables)
7247       ;; Save the active value in effect when the group was entered.
7248       (setq gnus-newsgroup-active
7249             (gnus-copy-sequence
7250              (gnus-active gnus-newsgroup-name)))
7251       ;; You can change the summary buffer in some way with this hook.
7252       (run-hooks 'gnus-select-group-hook)
7253       ;; Set any local variables in the group parameters.
7254       (gnus-summary-set-local-parameters gnus-newsgroup-name)
7255       ;; Do score processing.
7256       (when gnus-use-scoring
7257         (gnus-possibly-score-headers))
7258       (gnus-update-format-specifications)
7259       ;; Check whether to fill in the gaps in the threads.
7260       (when gnus-build-sparse-threads
7261         (gnus-build-sparse-threads))
7262       ;; Find the initial limit.
7263       (gnus-summary-initial-limit show-all)
7264       ;; Generate the summary buffer.
7265       (unless no-display
7266         (gnus-summary-prepare))
7267       (when gnus-use-trees
7268         (gnus-tree-open group)
7269         (setq gnus-summary-highlight-line-function
7270               'gnus-tree-highlight-article))
7271       ;; If the summary buffer is empty, but there are some low-scored
7272       ;; articles or some excluded dormants, we include these in the
7273       ;; buffer.
7274       (when (zerop (buffer-size))
7275         (cond (gnus-newsgroup-dormant
7276                (gnus-summary-limit-include-dormant))
7277               ((and gnus-newsgroup-scored show-all)
7278                (gnus-summary-limit-include-expunged))))
7279       ;; Function `gnus-apply-kill-file' must be called in this hook.
7280       (run-hooks 'gnus-apply-kill-hook)
7281       (if (zerop (buffer-size))
7282           (progn
7283             ;; This newsgroup is empty.
7284             (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
7285             (gnus-message 6 "No unread news")
7286             (when kill-buffer
7287               (gnus-kill-or-deaden-summary kill-buffer))
7288             ;; Return nil from this function.
7289             nil)
7290         ;; Hide conversation thread subtrees.  We cannot do this in
7291         ;; gnus-summary-prepare-hook since kill processing may not
7292         ;; work with hidden articles.
7293         (and gnus-show-threads
7294              gnus-thread-hide-subtree
7295              (gnus-summary-hide-all-threads))
7296         ;; Show first unread article if requested.
7297         (if (and (not no-article)
7298                  gnus-newsgroup-unreads
7299                  gnus-auto-select-first)
7300             (if (eq gnus-auto-select-first 'best)
7301                 (gnus-summary-best-unread-article)
7302               (gnus-summary-first-unread-article))
7303           ;; Don't select any articles, just move point to the first
7304           ;; article in the group.
7305           (goto-char (point-min))
7306           (gnus-summary-position-point)
7307           (gnus-set-mode-line 'summary)
7308           (gnus-configure-windows 'summary 'force))
7309         ;; If we are in async mode, we send some info to the backend.
7310         (when gnus-newsgroup-async
7311           (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data))
7312         (when kill-buffer
7313           (gnus-kill-or-deaden-summary kill-buffer))
7314         (when (get-buffer-window gnus-group-buffer)
7315           ;; Gotta use windows, because recenter does wierd stuff if
7316           ;; the current buffer ain't the displayed window.
7317           (let ((owin (selected-window)))
7318             (select-window (get-buffer-window gnus-group-buffer))
7319             (when (gnus-group-goto-group group)
7320               (recenter))
7321             (select-window owin))))
7322       ;; Mark this buffer as "prepared".
7323       (setq gnus-newsgroup-prepared t)
7324       t))))
7325
7326 (defun gnus-summary-prepare ()
7327   "Generate the summary buffer."
7328   (let ((buffer-read-only nil))
7329     (erase-buffer)
7330     (setq gnus-newsgroup-data nil
7331           gnus-newsgroup-data-reverse nil)
7332     (run-hooks 'gnus-summary-generate-hook)
7333     ;; Generate the buffer, either with threads or without.
7334     (when gnus-newsgroup-headers
7335       (gnus-summary-prepare-threads
7336        (if gnus-show-threads
7337            (gnus-sort-gathered-threads
7338             (funcall gnus-summary-thread-gathering-function
7339                      (gnus-sort-threads
7340                       (gnus-cut-threads (gnus-make-threads)))))
7341          ;; Unthreaded display.
7342          (gnus-sort-articles gnus-newsgroup-headers))))
7343     (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
7344     ;; Call hooks for modifying summary buffer.
7345     (goto-char (point-min))
7346     (run-hooks 'gnus-summary-prepare-hook)))
7347
7348 (defun gnus-gather-threads-by-subject (threads)
7349   "Gather threads by looking at Subject headers."
7350   (if (not gnus-summary-make-false-root)
7351       threads
7352     (let ((hashtb (gnus-make-hashtable 1023))
7353           (prev threads)
7354           (result threads)
7355           subject hthread whole-subject)
7356       (while threads
7357         (setq whole-subject (mail-header-subject (car (car threads))))
7358         (if (and gnus-summary-gather-exclude-subject
7359                  (string-match gnus-summary-gather-exclude-subject
7360                                whole-subject))
7361             () ; We don't want to do anything with this article.
7362           ;; We simplify the subject before looking it up in the
7363           ;; hash table.
7364           (setq subject
7365                 (cond
7366                  ;; Truncate the subject.
7367                  ((numberp gnus-summary-gather-subject-limit)
7368                   (setq subject (gnus-simplify-subject-re whole-subject))
7369                   (if (> (length subject) gnus-summary-gather-subject-limit)
7370                       (substring subject 0 gnus-summary-gather-subject-limit)
7371                     subject))
7372                  ;; Fuzzily simplify it.
7373                  ((eq 'fuzzy gnus-summary-gather-subject-limit)
7374                   (gnus-simplify-subject-fuzzy whole-subject))
7375                  ;; Just remove the leading "Re:".
7376                  (t
7377                   (gnus-simplify-subject-re whole-subject))))
7378
7379           (if (setq hthread (gnus-gethash subject hashtb))
7380               (progn
7381                 ;; We enter a dummy root into the thread, if we
7382                 ;; haven't done that already.
7383                 (unless (stringp (car (car hthread)))
7384                   (setcar hthread (list whole-subject (car hthread))))
7385                 ;; We add this new gathered thread to this gathered
7386                 ;; thread.
7387                 (setcdr (car hthread)
7388                         (nconc (cdr (car hthread)) (list (car threads))))
7389                 ;; Remove it from the list of threads.
7390                 (setcdr prev (cdr threads))
7391                 (setq threads prev))
7392             ;; Enter this thread into the hash table.
7393             (gnus-sethash subject threads hashtb)))
7394         (setq prev threads)
7395         (setq threads (cdr threads)))
7396       result)))
7397
7398 (defun gnus-summary-gather-threads-by-references (threads)
7399   "Gather threads by looking at References headers."
7400   (let ((idhashtb (gnus-make-hashtable 1023))
7401         (thhashtb (gnus-make-hashtable 1023))
7402         (prev threads)
7403         (result threads)
7404         ids references id gthread gid entered)
7405     (while threads
7406       (when (setq references (mail-header-references (caar threads)))
7407         (setq id (mail-header-id (caar threads)))
7408         (setq ids (gnus-split-references references))
7409         (setq entered nil)
7410         (while ids
7411           (if (not (setq gid (gnus-gethash (car ids) idhashtb)))
7412               (progn
7413                 (gnus-sethash (car ids) id idhashtb)
7414                 (gnus-sethash id threads thhashtb))
7415             (setq gthread (gnus-gethash gid thhashtb))
7416             (unless entered
7417               ;; We enter a dummy root into the thread, if we
7418               ;; haven't done that already.
7419               (unless (stringp (caar gthread))
7420                 (setcar gthread (list (mail-header-subject (caar gthread))
7421                                       (car gthread))))
7422               ;; We add this new gathered thread to this gathered
7423               ;; thread.
7424               (setcdr (car gthread)
7425                       (nconc (cdar gthread) (list (car threads)))))
7426             ;; Add it into the thread hash table.
7427             (gnus-sethash id gthread thhashtb)
7428             (setq entered t)
7429             ;; Remove it from the list of threads.
7430             (setcdr prev (cdr threads))
7431             (setq threads prev))
7432           (setq ids (cdr ids))))
7433       (setq prev threads)
7434       (setq threads (cdr threads)))
7435     result))
7436
7437 (defun gnus-sort-gathered-threads (threads)
7438   "Sort subtreads inside each gathered thread by article number."
7439   (let ((result threads))
7440     (while threads
7441       (when (stringp (car (car threads)))
7442         (setcdr (car threads)
7443                 (sort (cdr (car threads)) 'gnus-thread-sort-by-number)))
7444       (setq threads (cdr threads)))
7445     result))
7446
7447 (defun gnus-make-threads ()
7448   "Go through the dependency hashtb and find the roots.  Return all threads."
7449   (let (threads)
7450     (mapatoms
7451      (lambda (refs)
7452        (unless (car (symbol-value refs))
7453          ;; These threads do not refer back to any other articles,
7454          ;; so they're roots.
7455          (setq threads (append (cdr (symbol-value refs)) threads))))
7456      gnus-newsgroup-dependencies)
7457     threads))
7458
7459 (defun gnus-build-sparse-threads ()
7460   (let ((headers gnus-newsgroup-headers)
7461         (deps gnus-newsgroup-dependencies)
7462         header references generation relations 
7463         cthread subject child end pthread relation)
7464     ;; First we create an alist of generations/relations, where 
7465     ;; generations is how much we trust the ralation, and the relation
7466     ;; is parent/child.
7467     (gnus-message 7 "Making sparse threads...")
7468     (save-excursion
7469       (nnheader-set-temp-buffer " *gnus sparse threads*")
7470       (while (setq header (pop headers))
7471         (when (and (setq references (mail-header-references header))
7472                    (not (string= references "")))
7473           (insert references)
7474           (setq child (downcase (mail-header-id header))
7475                 subject (mail-header-subject header))
7476           (setq generation 0)
7477           (while (search-backward ">" nil t)
7478             (setq end (1+ (point)))
7479             (when (search-backward "<" nil t)
7480               (push (list (incf generation) 
7481                           child (setq child (downcase
7482                                              (buffer-substring (point) end)))
7483                           subject)
7484                     relations)))
7485           (push (list (1+ generation) child nil subject) relations)
7486           (erase-buffer)))
7487       (kill-buffer (current-buffer)))
7488     ;; Sort over trustworthiness.
7489     (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2)))))
7490     (while (setq relation (pop relations))
7491       (when (if (boundp (setq cthread (intern (cadr relation) deps)))
7492                 (unless (car (symbol-value cthread))
7493                   ;; Make this article the parent of these threads.
7494                   (setcar (symbol-value cthread)
7495                           (vector gnus-reffed-article-number 
7496                                   (cadddr relation) 
7497                                   "" ""
7498                                   (cadr relation) 
7499                                   (or (caddr relation) "") 0 0 "")))
7500               (set cthread (list (vector gnus-reffed-article-number
7501                                          (cadddr relation) 
7502                                          "" "" (cadr relation) 
7503                                          (or (caddr relation) "") 0 0 ""))))
7504         (push gnus-reffed-article-number gnus-newsgroup-limit)
7505         (push gnus-reffed-article-number gnus-newsgroup-sparse)
7506         (push (cons gnus-reffed-article-number gnus-sparse-mark)
7507               gnus-newsgroup-reads)
7508         (decf gnus-reffed-article-number)
7509         ;; Make this new thread the child of its parent.
7510         (if (boundp (setq pthread (intern (or (caddr relation) "none") deps)))
7511             (setcdr (symbol-value pthread)
7512                     (nconc (cdr (symbol-value pthread))
7513                            (list (symbol-value cthread))))
7514           (set pthread (list nil (symbol-value cthread))))))
7515     (gnus-message 7 "Making sparse threads...done")))
7516
7517 (defun gnus-build-old-threads ()
7518   ;; Look at all the articles that refer back to old articles, and
7519   ;; fetch the headers for the articles that aren't there.  This will
7520   ;; build complete threads - if the roots haven't been expired by the
7521   ;; server, that is.
7522   (let (id heads)
7523     (mapatoms
7524      (lambda (refs)
7525        (when (not (car (symbol-value refs)))
7526          (setq heads (cdr (symbol-value refs)))
7527          (while heads
7528            (if (memq (mail-header-number (car (car heads)))
7529                      gnus-newsgroup-dormant)
7530                (setq heads (cdr heads))
7531              (setq id (symbol-name refs))
7532              (while (and (setq id (gnus-build-get-header id))
7533                          (not (car (gnus-gethash
7534                                     id gnus-newsgroup-dependencies)))))
7535              (setq heads nil)))))
7536      gnus-newsgroup-dependencies)))
7537
7538 (defun gnus-build-get-header (id)
7539   ;; Look through the buffer of NOV lines and find the header to
7540   ;; ID.  Enter this line into the dependencies hash table, and return
7541   ;; the id of the parent article (if any).
7542   (let ((deps gnus-newsgroup-dependencies)
7543         found header)
7544     (prog1
7545         (save-excursion
7546           (set-buffer nntp-server-buffer)
7547           (goto-char (point-min))
7548           (while (and (not found) (search-forward id nil t))
7549             (beginning-of-line)
7550             (setq found (looking-at
7551                          (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
7552                                  (regexp-quote id))))
7553             (or found (beginning-of-line 2)))
7554           (when found
7555             (let (ref)
7556               (beginning-of-line)
7557               (and
7558                (setq header (gnus-nov-parse-line
7559                              (read (current-buffer)) deps))
7560                (gnus-parent-id (mail-header-references header))))))
7561       (when header
7562         (let ((number (mail-header-number header)))
7563           (push number gnus-newsgroup-limit)
7564           (push header gnus-newsgroup-headers)
7565           (if (memq number gnus-newsgroup-unselected)
7566               (progn
7567                 (push number gnus-newsgroup-unreads)
7568                 (setq gnus-newsgroup-unselected
7569                       (delq number gnus-newsgroup-unselected)))
7570             (push number gnus-newsgroup-ancient)))))))
7571
7572 (defun gnus-summary-update-article (article)
7573   "Update ARTICLE in the summary buffer."
7574   (let ((id (mail-header-id (gnus-summary-article-header article))))
7575     (setcar (gnus-id-to-thread id) nil)
7576     (gnus-summary-insert-subject id)))
7577
7578 (defun gnus-rebuild-thread (id)
7579   "Rebuild the thread containing ID."
7580   (let ((dep gnus-newsgroup-dependencies)
7581         (buffer-read-only nil)
7582         current headers refs thread art data)
7583     (if (not gnus-show-threads)
7584         (setq thread (list (car (gnus-id-to-thread id))))
7585       ;; Get the thread this article is part of.
7586       (setq thread (gnus-remove-thread id)))
7587     (setq current (save-excursion
7588                     (and (zerop (forward-line -1))
7589                          (gnus-summary-article-number))))
7590     ;; If this is a gathered thread, we have to go some re-gathering.
7591     (when (stringp (car thread))
7592       (let ((subject (car thread))
7593             roots thr)
7594         (setq thread (cdr thread))
7595         (while thread
7596           (unless (memq (setq thr (gnus-id-to-thread
7597                                       (gnus-root-id
7598                                        (mail-header-id (car (car thread))))))
7599                         roots)
7600             (push thr roots))
7601           (setq thread (cdr thread)))
7602         ;; We now have all (unique) roots.
7603         (if (= (length roots) 1)
7604             ;; All the loose roots are now one solid root.
7605             (setq thread (car roots))
7606           (setq thread (cons subject (gnus-sort-threads roots))))))
7607     (let ((beg (point))
7608           threads)
7609       ;; We then insert this thread into the summary buffer.
7610       (let (gnus-newsgroup-data gnus-newsgroup-threads)
7611         (gnus-summary-prepare-threads (list thread))
7612         (setq data (nreverse gnus-newsgroup-data))
7613         (setq threads gnus-newsgroup-threads))
7614       ;; We splice the new data into the data structure.
7615       (gnus-data-enter-list current data)
7616       (gnus-data-compute-positions)
7617       (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
7618
7619 (defun gnus-id-to-thread (id)
7620   "Return the (sub-)thread where ID appears."
7621   (gnus-gethash (downcase id) gnus-newsgroup-dependencies))
7622
7623 (defun gnus-id-to-article (id)
7624   "Return the article number of ID."
7625   (let ((thread (gnus-id-to-thread id)))
7626     (when thread
7627       (mail-header-number (car thread)))))
7628
7629 (defun gnus-id-to-header (id)
7630   "Return the article headers of ID."
7631   (car (gnus-id-to-thread id)))
7632
7633 (defun gnus-article-displayed-root-p (article)
7634   "Say whether ARTICLE is a root(ish) article."
7635   (let ((level (gnus-summary-thread-level article))
7636         particle)
7637     (cond 
7638      ((null level) nil)
7639      ((zerop level) t)
7640      ((and (= 1 level)
7641            (null (setq particle (gnus-id-to-article
7642                                  (gnus-parent-id 
7643                                   (mail-header-references 
7644                                    (gnus-summary-article-header article))))))
7645            (null (gnus-summary-thread-level particle)))))))
7646
7647 (defun gnus-root-id (id)
7648   "Return the id of the root of the thread where ID appears."
7649   (let (last-id prev)
7650     (while (and id (setq prev (car (gnus-gethash
7651                                     (downcase id)
7652                                     gnus-newsgroup-dependencies))))
7653       (setq last-id id
7654             id (gnus-parent-id (mail-header-references prev))))
7655     last-id))
7656
7657 (defun gnus-remove-thread (id &optional dont-remove)
7658   "Remove the thread that has ID in it."
7659   (let ((dep gnus-newsgroup-dependencies)
7660         headers thread prev last-id)
7661     ;; First go up in this thread until we find the root.
7662     (setq last-id (gnus-root-id id))
7663     (setq headers (list (car (gnus-id-to-thread last-id))
7664                         (car (car (cdr (gnus-id-to-thread last-id))))))
7665     ;; We have now found the real root of this thread.  It might have
7666     ;; been gathered into some loose thread, so we have to search
7667     ;; through the threads to find the thread we wanted.
7668     (let ((threads gnus-newsgroup-threads)
7669           sub)
7670       (while threads
7671         (setq sub (car threads))
7672         (if (stringp (car sub))
7673             ;; This is a gathered threads, so we look at the roots
7674             ;; below it to find whether this article in in this
7675             ;; gathered root.
7676             (progn
7677               (setq sub (cdr sub))
7678               (while sub
7679                 (when (member (car (car sub)) headers)
7680                   (setq thread (car threads)
7681                         threads nil
7682                         sub nil))
7683                 (setq sub (cdr sub))))
7684           ;; It's an ordinary thread, so we check it.
7685           (when (eq (car sub) (car headers))
7686             (setq thread sub
7687                   threads nil)))
7688         (setq threads (cdr threads)))
7689       ;; If this article is in no thread, then it's a root.
7690       (if thread
7691           (unless dont-remove
7692             (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
7693         (setq thread (gnus-gethash (downcase last-id) dep)))
7694       (when thread
7695         (prog1
7696             thread ; We return this thread.
7697           (unless dont-remove
7698             (if (stringp (car thread))
7699                 (progn
7700                   ;; If we use dummy roots, then we have to remove the
7701                   ;; dummy root as well.
7702                   (when (eq gnus-summary-make-false-root 'dummy)
7703                     ;; Uhm.
7704                     )
7705                   (setq thread (cdr thread))
7706                   (while thread
7707                     (gnus-remove-thread-1 (car thread))
7708                     (setq thread (cdr thread))))
7709               (gnus-remove-thread-1 thread))))))))
7710
7711 (defun gnus-remove-thread-1 (thread)
7712   "Remove the thread THREAD recursively."
7713   (let ((number (mail-header-number (car thread)))
7714         pos)
7715     (when (setq pos (text-property-any
7716                      (point-min) (point-max) 'gnus-number number))
7717       (goto-char pos)
7718       (gnus-delete-line)
7719       (gnus-data-remove number))
7720     (setq thread (cdr thread))
7721     (while thread
7722       (gnus-remove-thread-1 (car thread))
7723       (setq thread (cdr thread)))))
7724
7725 (defun gnus-sort-threads (threads)
7726   "Sort THREADS."
7727   (when gnus-thread-sort-functions
7728     (let ((func (if (= 1 (length gnus-thread-sort-functions))
7729                     (car gnus-thread-sort-functions)
7730                   `(lambda (t1 t2)
7731                      ,(gnus-make-sort-function 
7732                        (reverse gnus-thread-sort-functions))))))
7733       (gnus-message 7 "Sorting threads...")
7734       (prog1
7735           (sort threads func)
7736         (gnus-message 7 "Sorting threads...done")))))
7737
7738 (defun gnus-sort-articles (articles)
7739   "Sort ARTICLES."
7740   (when gnus-article-sort-functions
7741     (let ((func (if (= 1 (length gnus-article-sort-functions))
7742                     (car gnus-article-sort-functions)
7743                   `(lambda (t1 t2)
7744                      ,(gnus-make-sort-function 
7745                        (reverse gnus-article-sort-functions))))))
7746       (gnus-message 7 "Sorting articles...")
7747       (prog1
7748           (sort articles func)
7749         (gnus-message 7 "Sorting articles...done")))))
7750
7751 (defun gnus-make-sort-function (funs)
7752   "Return a composite sort condition based on the functions in FUNC."
7753   (if (cdr funs)
7754       `(or (,(car funs) t1 t2)
7755            (and (not (,(car funs) t2 t1))
7756                 ,(gnus-make-sort-function (cdr funs))))
7757     `(,(car funs) t1 t2)))
7758                  
7759 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
7760 (defmacro gnus-thread-header (thread)
7761   ;; Return header of first article in THREAD.
7762   ;; Note that THREAD must never, ever be anything else than a variable -
7763   ;; using some other form will lead to serious barfage.
7764   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
7765   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
7766   (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
7767         (vector thread) 2))
7768
7769 (defsubst gnus-article-sort-by-number (h1 h2)
7770   "Sort articles by article number."
7771   (< (mail-header-number h1)
7772      (mail-header-number h2)))
7773
7774 (defun gnus-thread-sort-by-number (h1 h2)
7775   "Sort threads by root article number."
7776   (gnus-article-sort-by-number
7777    (gnus-thread-header h1) (gnus-thread-header h2)))
7778
7779 (defsubst gnus-article-sort-by-author (h1 h2)
7780   "Sort articles by root author."
7781   (string-lessp
7782    (let ((extract (funcall
7783                    gnus-extract-address-components
7784                    (mail-header-from h1))))
7785      (or (car extract) (cdr extract)))
7786    (let ((extract (funcall
7787                    gnus-extract-address-components
7788                    (mail-header-from h2))))
7789      (or (car extract) (cdr extract)))))
7790
7791 (defun gnus-thread-sort-by-author (h1 h2)
7792   "Sort threads by root author."
7793   (gnus-article-sort-by-author
7794    (gnus-thread-header h1)  (gnus-thread-header h2)))
7795
7796 (defsubst gnus-article-sort-by-subject (h1 h2)
7797   "Sort articles by root subject."
7798   (string-lessp
7799    (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
7800    (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
7801
7802 (defun gnus-thread-sort-by-subject (h1 h2)
7803   "Sort threads by root subject."
7804   (gnus-article-sort-by-subject
7805    (gnus-thread-header h1) (gnus-thread-header h2)))
7806
7807 (defsubst gnus-article-sort-by-date (h1 h2)
7808   "Sort articles by root article date."
7809   (string-lessp
7810    (gnus-sortable-date (mail-header-date h1))
7811    (gnus-sortable-date (mail-header-date h2))))
7812
7813 (defun gnus-thread-sort-by-date (h1 h2)
7814   "Sort threads by root article date."
7815   (gnus-article-sort-by-date
7816    (gnus-thread-header h1) (gnus-thread-header h2)))
7817
7818 (defsubst gnus-article-sort-by-score (h1 h2)
7819   "Sort articles by root article score.
7820 Unscored articles will be counted as having a score of zero."
7821   (> (or (cdr (assq (mail-header-number h1)
7822                     gnus-newsgroup-scored))
7823          gnus-summary-default-score 0)
7824      (or (cdr (assq (mail-header-number h2)
7825                     gnus-newsgroup-scored))
7826          gnus-summary-default-score 0)))
7827
7828 (defun gnus-thread-sort-by-score (h1 h2)
7829   "Sort threads by root article score."
7830   (gnus-article-sort-by-score
7831    (gnus-thread-header h1) (gnus-thread-header h2)))
7832
7833 (defun gnus-thread-sort-by-total-score (h1 h2)
7834   "Sort threads by the sum of all scores in the thread.
7835 Unscored articles will be counted as having a score of zero."
7836   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
7837
7838 (defun gnus-thread-total-score (thread)
7839   ;;  This function find the total score of THREAD.
7840   (if (consp thread)
7841       (if (stringp (car thread))
7842           (apply gnus-thread-score-function 0
7843                  (mapcar 'gnus-thread-total-score-1 (cdr thread)))
7844         (gnus-thread-total-score-1 thread))
7845     (gnus-thread-total-score-1 (list thread))))
7846
7847 (defun gnus-thread-total-score-1 (root)
7848   ;; This function find the total score of the thread below ROOT.
7849   (setq root (car root))
7850   (apply gnus-thread-score-function
7851          (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
7852              gnus-summary-default-score 0)
7853          (mapcar 'gnus-thread-total-score
7854                  (cdr (gnus-gethash (downcase (mail-header-id root))
7855                                     gnus-newsgroup-dependencies)))))
7856
7857 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
7858 (defvar gnus-tmp-prev-subject nil)
7859 (defvar gnus-tmp-false-parent nil)
7860 (defvar gnus-tmp-root-expunged nil)
7861 (defvar gnus-tmp-dummy-line nil)
7862
7863 (defun gnus-summary-prepare-threads (threads)
7864   "Prepare summary buffer from THREADS and indentation LEVEL.
7865 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
7866 or a straight list of headers."
7867   (gnus-message 7 "Generating summary...")
7868
7869   (setq gnus-newsgroup-threads threads)
7870   (beginning-of-line)
7871
7872   (let ((gnus-tmp-level 0)
7873         (default-score (or gnus-summary-default-score 0))
7874         (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
7875         thread number subject stack state gnus-tmp-gathered beg-match
7876         new-roots gnus-tmp-new-adopts thread-end
7877         gnus-tmp-header gnus-tmp-unread
7878         gnus-tmp-replied gnus-tmp-subject-or-nil
7879         gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
7880         gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
7881         gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
7882
7883     (setq gnus-tmp-prev-subject nil)
7884
7885     (if (vectorp (car threads))
7886         ;; If this is a straight (sic) list of headers, then a
7887         ;; threaded summary display isn't required, so we just create
7888         ;; an unthreaded one.
7889         (gnus-summary-prepare-unthreaded threads)
7890
7891       ;; Do the threaded display.
7892
7893       (while (or threads stack gnus-tmp-new-adopts new-roots)
7894
7895         (if (and (= gnus-tmp-level 0)
7896                  (not (setq gnus-tmp-dummy-line nil))
7897                  (or (not stack)
7898                      (= (car (car stack)) 0))
7899                  (not gnus-tmp-false-parent)
7900                  (or gnus-tmp-new-adopts new-roots))
7901             (if gnus-tmp-new-adopts
7902                 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
7903                       thread (list (car gnus-tmp-new-adopts))
7904                       gnus-tmp-header (car (car thread))
7905                       gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
7906               (if new-roots
7907                   (setq thread (list (car new-roots))
7908                         gnus-tmp-header (car (car thread))
7909                         new-roots (cdr new-roots))))
7910
7911           (if threads
7912               ;; If there are some threads, we do them before the
7913               ;; threads on the stack.
7914               (setq thread threads
7915                     gnus-tmp-header (car (car thread)))
7916             ;; There were no current threads, so we pop something off
7917             ;; the stack.
7918             (setq state (car stack)
7919                   gnus-tmp-level (car state)
7920                   thread (cdr state)
7921                   stack (cdr stack)
7922                   gnus-tmp-header (car (car thread)))))
7923
7924         (setq gnus-tmp-false-parent nil)
7925         (setq gnus-tmp-root-expunged nil)
7926         (setq thread-end nil)
7927
7928         (if (stringp gnus-tmp-header)
7929             ;; The header is a dummy root.
7930             (cond
7931              ((eq gnus-summary-make-false-root 'adopt)
7932               ;; We let the first article adopt the rest.
7933               (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
7934                                                (cdr (cdr (car thread)))))
7935               (setq gnus-tmp-gathered
7936                     (nconc (mapcar
7937                             (lambda (h) (mail-header-number (car h)))
7938                             (cdr (cdr (car thread))))
7939                            gnus-tmp-gathered))
7940               (setq thread (cons (list (car (car thread))
7941                                        (car (cdr (car thread))))
7942                                  (cdr thread)))
7943               (setq gnus-tmp-level -1
7944                     gnus-tmp-false-parent t))
7945              ((eq gnus-summary-make-false-root 'empty)
7946               ;; We print adopted articles with empty subject fields.
7947               (setq gnus-tmp-gathered
7948                     (nconc (mapcar
7949                             (lambda (h) (mail-header-number (car h)))
7950                             (cdr (cdr (car thread))))
7951                            gnus-tmp-gathered))
7952               (setq gnus-tmp-level -1))
7953              ((eq gnus-summary-make-false-root 'dummy)
7954               ;; We remember that we probably want to output a dummy
7955               ;; root.
7956               (setq gnus-tmp-dummy-line gnus-tmp-header)
7957               (setq gnus-tmp-prev-subject gnus-tmp-header))
7958              (t
7959               ;; We do not make a root for the gathered
7960               ;; sub-threads at all.
7961               (setq gnus-tmp-level -1)))
7962
7963           (setq number (mail-header-number gnus-tmp-header)
7964                 subject (mail-header-subject gnus-tmp-header))
7965
7966           (cond
7967            ;; If the thread has changed subject, we might want to make
7968            ;; this subthread into a root.
7969            ((and (null gnus-thread-ignore-subject)
7970                  (not (zerop gnus-tmp-level))
7971                  gnus-tmp-prev-subject
7972                  (not (inline
7973                         (gnus-subject-equal gnus-tmp-prev-subject subject))))
7974             (setq new-roots (nconc new-roots (list (car thread)))
7975                   thread-end t
7976                   gnus-tmp-header nil))
7977            ;; If the article lies outside the current limit,
7978            ;; then we do not display it.
7979            ((not (memq number gnus-newsgroup-limit))
7980             (setq gnus-tmp-gathered
7981                   (nconc (mapcar
7982                           (lambda (h) (mail-header-number (car h)))
7983                           (cdr (car thread)))
7984                          gnus-tmp-gathered))
7985             (setq gnus-tmp-new-adopts (if (cdr (car thread))
7986                                           (append gnus-tmp-new-adopts
7987                                                   (cdr (car thread)))
7988                                         gnus-tmp-new-adopts)
7989                   thread-end t
7990                   gnus-tmp-header nil)
7991             (when (zerop gnus-tmp-level)
7992               (setq gnus-tmp-root-expunged t)))
7993            ;; Perhaps this article is to be marked as read?
7994            ((and gnus-summary-mark-below
7995                  (< (or (cdr (assq number gnus-newsgroup-scored))
7996                         default-score)
7997                     gnus-summary-mark-below))
7998             (setq gnus-newsgroup-unreads
7999                   (delq number gnus-newsgroup-unreads))
8000             (if gnus-newsgroup-auto-expire
8001                 (push number gnus-newsgroup-expirable)
8002               (push (cons number gnus-low-score-mark)
8003                     gnus-newsgroup-reads))))
8004
8005           (when gnus-tmp-header
8006             ;; We may have an old dummy line to output before this
8007             ;; article.
8008             (when gnus-tmp-dummy-line
8009               (gnus-summary-insert-dummy-line
8010                gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
8011               (setq gnus-tmp-dummy-line nil))
8012
8013             ;; Compute the mark.
8014             (setq
8015              gnus-tmp-unread
8016              (cond
8017               ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8018               ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8019               ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8020               ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8021               (t (or (cdr (assq number gnus-newsgroup-reads))
8022                      gnus-ancient-mark))))
8023
8024             (push (gnus-data-make number gnus-tmp-unread (1+ (point))
8025                                   gnus-tmp-header gnus-tmp-level)
8026                   gnus-newsgroup-data)
8027
8028             ;; Actually insert the line.
8029             (setq
8030              gnus-tmp-subject-or-nil
8031              (cond
8032               ((and gnus-thread-ignore-subject
8033                     gnus-tmp-prev-subject
8034                     (not (inline (gnus-subject-equal
8035                                   gnus-tmp-prev-subject subject))))
8036                subject)
8037               ((zerop gnus-tmp-level)
8038                (if (and (eq gnus-summary-make-false-root 'empty)
8039                         (memq number gnus-tmp-gathered)
8040                         gnus-tmp-prev-subject
8041                         (inline (gnus-subject-equal
8042                                  gnus-tmp-prev-subject subject)))
8043                    gnus-summary-same-subject
8044                  subject))
8045               (t gnus-summary-same-subject)))
8046             (if (and (eq gnus-summary-make-false-root 'adopt)
8047                      (= gnus-tmp-level 1)
8048                      (memq number gnus-tmp-gathered))
8049                 (setq gnus-tmp-opening-bracket ?\<
8050                       gnus-tmp-closing-bracket ?\>)
8051               (setq gnus-tmp-opening-bracket ?\[
8052                     gnus-tmp-closing-bracket ?\]))
8053             (setq
8054              gnus-tmp-indentation
8055              (aref gnus-thread-indent-array gnus-tmp-level)
8056              gnus-tmp-lines (mail-header-lines gnus-tmp-header)
8057              gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
8058                                 gnus-summary-default-score 0)
8059              gnus-tmp-score-char
8060              (if (or (null gnus-summary-default-score)
8061                      (<= (abs (- gnus-tmp-score gnus-summary-default-score))
8062                          gnus-summary-zcore-fuzz)) ? 
8063                (if (< gnus-tmp-score gnus-summary-default-score)
8064                    gnus-score-below-mark gnus-score-over-mark))
8065              gnus-tmp-replied
8066              (cond ((memq number gnus-newsgroup-processable)
8067                     gnus-process-mark)
8068                    ((memq number gnus-newsgroup-cached)
8069                     gnus-cached-mark)
8070                    ((memq number gnus-newsgroup-replied)
8071                     gnus-replied-mark)
8072                    (t gnus-unread-mark))
8073              gnus-tmp-from (mail-header-from gnus-tmp-header)
8074              gnus-tmp-name
8075              (cond
8076               ((string-match "(.+)" gnus-tmp-from)
8077                (substring gnus-tmp-from
8078                           (1+ (match-beginning 0)) (1- (match-end 0))))
8079               ((string-match "<[^>]+> *$" gnus-tmp-from)
8080                (setq beg-match (match-beginning 0))
8081                (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
8082                         (substring gnus-tmp-from (1+ (match-beginning 0))
8083                                    (1- (match-end 0))))
8084                    (substring gnus-tmp-from 0 beg-match)))
8085               (t gnus-tmp-from)))
8086             (when (string= gnus-tmp-name "")
8087               (setq gnus-tmp-name gnus-tmp-from))
8088             (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
8089             (put-text-property
8090              (point)
8091              (progn (eval gnus-summary-line-format-spec) (point))
8092              'gnus-number number)
8093             (when gnus-visual-p
8094               (forward-line -1)
8095               (run-hooks 'gnus-summary-update-hook)
8096               (forward-line 1))
8097
8098             (setq gnus-tmp-prev-subject subject)))
8099
8100         (when (nth 1 thread)
8101           (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
8102         (incf gnus-tmp-level)
8103         (setq threads (if thread-end nil (cdr (car thread))))
8104         (unless threads
8105           (setq gnus-tmp-level 0)))))
8106   (gnus-message 7 "Generating summary...done"))
8107
8108 (defun gnus-summary-prepare-unthreaded (headers)
8109   "Generate an unthreaded summary buffer based on HEADERS."
8110   (let (header number mark)
8111
8112     (while headers
8113       (setq header (car headers)
8114             headers (cdr headers)
8115             number (mail-header-number header))
8116
8117       ;; We may have to root out some bad articles...
8118       (when (memq number gnus-newsgroup-limit)
8119         (when (and gnus-summary-mark-below
8120                    (< (or (cdr (assq number gnus-newsgroup-scored))
8121                           gnus-summary-default-score 0)
8122                       gnus-summary-mark-below))
8123           (setq gnus-newsgroup-unreads
8124                 (delq number gnus-newsgroup-unreads))
8125           (if gnus-newsgroup-auto-expire
8126               (push number gnus-newsgroup-expirable)
8127             (push (cons number gnus-low-score-mark)
8128                   gnus-newsgroup-reads)))
8129
8130         (setq mark
8131               (cond
8132                ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8133                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8134                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8135                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8136                (t (or (cdr (assq number gnus-newsgroup-reads))
8137                       gnus-ancient-mark))))
8138         (setq gnus-newsgroup-data
8139               (cons (gnus-data-make number mark (1+ (point)) header 0)
8140                     gnus-newsgroup-data))
8141         (gnus-summary-insert-line
8142          header 0 nil mark (memq number gnus-newsgroup-replied)
8143          (memq number gnus-newsgroup-expirable)
8144          (mail-header-subject header) nil
8145          (cdr (assq number gnus-newsgroup-scored))
8146          (memq number gnus-newsgroup-processable))))))
8147
8148 (defun gnus-select-newsgroup (group &optional read-all)
8149   "Select newsgroup GROUP.
8150 If READ-ALL is non-nil, all articles in the group are selected."
8151   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
8152          (info (nth 2 entry))
8153          articles fetched-articles cached)
8154
8155     (or (gnus-check-server
8156          (setq gnus-current-select-method (gnus-find-method-for-group group)))
8157         (error "Couldn't open server"))
8158
8159     (or (and entry (not (eq (car entry) t))) ; Either it's active...
8160         (gnus-activate-group group) ; Or we can activate it...
8161         (progn ; Or we bug out.
8162           (kill-buffer (current-buffer))
8163           (error "Couldn't request group %s: %s"
8164                  group (gnus-status-message group))))
8165
8166     (setq gnus-newsgroup-name group)
8167     (setq gnus-newsgroup-unselected nil)
8168     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
8169
8170     (and gnus-asynchronous
8171          (gnus-check-backend-function
8172           'request-asynchronous gnus-newsgroup-name)
8173          (setq gnus-newsgroup-async
8174                (gnus-request-asynchronous gnus-newsgroup-name)))
8175
8176     ;; Adjust and set lists of article marks.
8177     (when info
8178       (gnus-adjust-marked-articles info))
8179
8180     ;; Kludge to avoid having cached articles nixed out in virtual groups.
8181     (when (gnus-virtual-group-p group)
8182       (setq cached gnus-newsgroup-cached))
8183
8184     (setq gnus-newsgroup-unreads
8185           (gnus-set-difference
8186            (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
8187            gnus-newsgroup-dormant))
8188
8189     (setq gnus-newsgroup-processable nil)
8190
8191     (setq articles (gnus-articles-to-read group read-all))
8192
8193     (cond
8194      ((null articles)
8195       (gnus-message 3 "Couldn't select newsgroup -- no articles to display")
8196       'quit)
8197      ((eq articles 0) nil)
8198      (t
8199       ;; Init the dependencies hash table.
8200       (setq gnus-newsgroup-dependencies
8201             (gnus-make-hashtable (length articles)))
8202       ;; Retrieve the headers and read them in.
8203       (gnus-message 5 "Fetching headers...")
8204       (setq gnus-newsgroup-headers
8205             (if (eq 'nov
8206                     (setq gnus-headers-retrieved-by
8207                           (gnus-retrieve-headers
8208                            articles gnus-newsgroup-name
8209                            ;; We might want to fetch old headers, but
8210                            ;; not if there is only 1 article.
8211                            (and gnus-fetch-old-headers
8212                                 (or (and
8213                                      (not (eq gnus-fetch-old-headers 'some))
8214                                      (not (numberp gnus-fetch-old-headers)))
8215                                     (> (length articles) 1))))))
8216                 (gnus-get-newsgroup-headers-xover articles)
8217               (gnus-get-newsgroup-headers)))
8218       (gnus-message 5 "Fetching headers...done")
8219
8220       ;; Kludge to avoid having cached articles nixed out in virtual groups.
8221       (when cached
8222         (setq gnus-newsgroup-cached cached))
8223
8224       ;; Set the initial limit.
8225       (setq gnus-newsgroup-limit (copy-sequence articles))
8226       ;; Remove canceled articles from the list of unread articles.
8227       (setq gnus-newsgroup-unreads
8228             (gnus-set-sorted-intersection
8229              gnus-newsgroup-unreads
8230              (setq fetched-articles
8231                    (mapcar (lambda (headers) (mail-header-number headers))
8232                            gnus-newsgroup-headers))))
8233       ;; Removed marked articles that do not exist.
8234       (gnus-update-missing-marks
8235        (gnus-sorted-complement fetched-articles articles))
8236       ;; We might want to build some more threads first.
8237       (and gnus-fetch-old-headers
8238            (eq gnus-headers-retrieved-by 'nov)
8239            (gnus-build-old-threads))
8240       ;; Check whether auto-expire is to be done in this group.
8241       (setq gnus-newsgroup-auto-expire
8242             (gnus-group-auto-expirable-p group))
8243       ;; First and last article in this newsgroup.
8244       (and gnus-newsgroup-headers
8245            (setq gnus-newsgroup-begin
8246                  (mail-header-number (car gnus-newsgroup-headers)))
8247            (setq gnus-newsgroup-end
8248                  (mail-header-number
8249                   (gnus-last-element gnus-newsgroup-headers))))
8250       (setq gnus-reffed-article-number -1)
8251       ;; GROUP is successfully selected.
8252       (or gnus-newsgroup-headers t)))))
8253
8254 (defun gnus-articles-to-read (group read-all)
8255   ;; Find out what articles the user wants to read.
8256   (let* ((articles
8257           ;; Select all articles if `read-all' is non-nil, or if there
8258           ;; are no unread articles.
8259           (if (or read-all
8260                   (and (zerop (length gnus-newsgroup-marked))
8261                        (zerop (length gnus-newsgroup-unreads))))
8262               (gnus-uncompress-range (gnus-active group))
8263             (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
8264                           (copy-sequence gnus-newsgroup-unreads))
8265                   '<)))
8266          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
8267          (scored (length scored-list))
8268          (number (length articles))
8269          (marked (+ (length gnus-newsgroup-marked)
8270                     (length gnus-newsgroup-dormant)))
8271          (select
8272           (cond
8273            ((numberp read-all)
8274             read-all)
8275            (t
8276             (condition-case ()
8277                 (cond
8278                  ((and (or (<= scored marked) (= scored number))
8279                        (numberp gnus-large-newsgroup)
8280                        (> number gnus-large-newsgroup))
8281                   (let ((input
8282                          (read-string
8283                           (format
8284                            "How many articles from %s (default %d): "
8285                            gnus-newsgroup-name number))))
8286                     (if (string-match "^[ \t]*$" input) number input)))
8287                  ((and (> scored marked) (< scored number))
8288                   (let ((input
8289                          (read-string
8290                           (format "%s %s (%d scored, %d total): "
8291                                   "How many articles from"
8292                                   group scored number))))
8293                     (if (string-match "^[ \t]*$" input)
8294                         number input)))
8295                  (t number))
8296               (quit nil))))))
8297     (setq select (if (stringp select) (string-to-number select) select))
8298     (if (or (null select) (zerop select))
8299         select
8300       (if (and (not (zerop scored)) (<= (abs select) scored))
8301           (progn
8302             (setq articles (sort scored-list '<))
8303             (setq number (length articles)))
8304         (setq articles (copy-sequence articles)))
8305
8306       (if (< (abs select) number)
8307           (if (< select 0)
8308               ;; Select the N oldest articles.
8309               (setcdr (nthcdr (1- (abs select)) articles) nil)
8310             ;; Select the N most recent articles.
8311             (setq articles (nthcdr (- number select) articles))))
8312       (setq gnus-newsgroup-unselected
8313             (gnus-sorted-intersection
8314              gnus-newsgroup-unreads
8315              (gnus-sorted-complement gnus-newsgroup-unreads articles)))
8316       articles)))
8317
8318 (defun gnus-killed-articles (killed articles)
8319   (let (out)
8320     (while articles
8321       (if (inline (gnus-member-of-range (car articles) killed))
8322           (setq out (cons (car articles) out)))
8323       (setq articles (cdr articles)))
8324     out))
8325
8326 (defun gnus-uncompress-marks (marks)
8327   "Uncompress the mark ranges in MARKS."
8328   (let ((uncompressed '(score bookmark))
8329         out)
8330     (while marks
8331       (if (memq (caar marks) uncompressed)
8332           (push (car marks) out)
8333         (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
8334       (setq marks (cdr marks)))
8335     out))
8336
8337 (defun gnus-adjust-marked-articles (info)
8338   "Set all article lists and remove all marks that are no longer legal."
8339   (let* ((marked-lists (gnus-info-marks info))
8340          (active (gnus-active (gnus-info-group info)))
8341          (min (car active))
8342          (max (cdr active))
8343          (types gnus-article-mark-lists)
8344          (uncompressed '(score bookmark))
8345          marks var articles article mark)
8346
8347     (while marked-lists
8348       (setq marks (pop marked-lists))
8349       (set (setq var (intern (format "gnus-newsgroup-%s"
8350                                      (car (rassq (setq mark (car marks))
8351                                                  types)))))
8352            (if (memq (car marks) uncompressed) (cdr marks)
8353              (gnus-uncompress-range (cdr marks))))
8354
8355       (setq articles (symbol-value var))
8356
8357       ;; All articles have to be subsets of the active articles.
8358       (cond
8359        ;; Adjust "simple" lists.
8360        ((memq mark '(tick dormant expirable reply killed save))
8361         (while articles
8362           (when (or (< (setq article (pop articles)) min) (> article max))
8363             (set var (delq article (symbol-value var))))))
8364        ;; Adjust assocs.
8365        ((memq mark '(score bookmark))
8366         (while articles
8367           (when (or (< (car (setq article (pop articles))) min)
8368                     (> (car article) max))
8369             (set var (delq article (symbol-value var))))))))))
8370
8371 (defun gnus-update-missing-marks (missing)
8372   "Go through the list of MISSING articles and remove them mark lists."
8373   (when missing
8374     (let ((types gnus-article-mark-lists)
8375           var m)
8376       ;; Go through all types.
8377       (while types
8378         (setq var (intern (format "gnus-newsgroup-%s" (car (pop types)))))
8379         (when (symbol-value var)
8380           ;; This list has articles.  So we delete all missing articles
8381           ;; from it.
8382           (setq m missing)
8383           (while m
8384             (set var (delq (pop m) (symbol-value var)))))))))
8385
8386 (defun gnus-update-marks ()
8387   "Enter the various lists of marked articles into the newsgroup info list."
8388   (let ((types gnus-article-mark-lists)
8389         (info (gnus-get-info gnus-newsgroup-name))
8390         (uncompressed '(score bookmark killed))
8391         var type list newmarked symbol)
8392     (when info
8393       ;; Add all marks lists that are non-nil to the list of marks lists.
8394       (while types
8395         (setq type (pop types))
8396         (when (setq list (symbol-value
8397                           (setq symbol
8398                                 (intern (format "gnus-newsgroup-%s"
8399                                                 (car type))))))
8400           (push (cons (cdr type)
8401                       (if (memq (cdr type) uncompressed) list
8402                         (gnus-compress-sequence (set symbol (sort list '<)) t)))
8403                 newmarked)))
8404
8405       ;; Enter these new marks into the info of the group.
8406       (if (nthcdr 3 info)
8407           (setcar (nthcdr 3 info) newmarked)
8408         ;; Add the marks lists to the end of the info.
8409         (when newmarked
8410           (setcdr (nthcdr 2 info) (list newmarked))))
8411
8412       ;; Cut off the end of the info if there's nothing else there.
8413       (let ((i 5))
8414         (while (and (> i 2)
8415                     (not (nth i info)))
8416           (when (nthcdr (decf i) info)
8417             (setcdr (nthcdr i info) nil)))))))
8418
8419 (defun gnus-add-marked-articles (group type articles &optional info force)
8420   ;; Add ARTICLES of TYPE to the info of GROUP.
8421   ;; If INFO is non-nil, use that info.  If FORCE is non-nil, don't
8422   ;; add, but replace marked articles of TYPE with ARTICLES.
8423   (let ((info (or info (gnus-get-info group)))
8424         (uncompressed '(score bookmark killed))
8425         marked m)
8426     (or (not info)
8427         (and (not (setq marked (nthcdr 3 info)))
8428              (setcdr (nthcdr 2 info)
8429                      (list (list (cons type (gnus-compress-sequence
8430                                              articles t))))))
8431         (and (not (setq m (assq type (car marked))))
8432              (setcar marked
8433                      (cons (cons type (gnus-compress-sequence articles t) )
8434                            (car marked))))
8435         (if force
8436             (setcdr m (gnus-compress-sequence articles t))
8437           (setcdr m (gnus-compress-sequence
8438                      (sort (nconc (gnus-uncompress-range m)
8439                                   (copy-sequence articles)) '<) t))))))
8440
8441 (defun gnus-set-mode-line (where)
8442   "This function sets the mode line of the article or summary buffers.
8443 If WHERE is `summary', the summary mode line format will be used."
8444   ;; Is this mode line one we keep updated?
8445   (when (memq where gnus-updated-mode-lines)
8446     (let (mode-string)
8447       (save-excursion
8448         ;; We evaluate this in the summary buffer since these
8449         ;; variables are buffer-local to that buffer.
8450         (set-buffer gnus-summary-buffer)
8451         ;; We bind all these variables that are used in the `eval' form
8452         ;; below.
8453         (let* ((mformat (symbol-value
8454                          (intern
8455                           (format "gnus-%s-mode-line-format-spec" where))))
8456                (gnus-tmp-group-name gnus-newsgroup-name)
8457                (gnus-tmp-article-number (or gnus-current-article 0))
8458                (gnus-tmp-unread gnus-newsgroup-unreads)
8459                (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
8460                (gnus-tmp-unselected (length gnus-newsgroup-unselected))
8461                (gnus-tmp-unread-and-unselected
8462                 (cond ((and (zerop gnus-tmp-unread-and-unticked)
8463                             (zerop gnus-tmp-unselected)) "")
8464                       ((zerop gnus-tmp-unselected)
8465                        (format "{%d more}" gnus-tmp-unread-and-unticked))
8466                       (t (format "{%d(+%d) more}"
8467                                  gnus-tmp-unread-and-unticked
8468                                  gnus-tmp-unselected))))
8469                (gnus-tmp-subject
8470                 (if (and gnus-current-headers
8471                          (vectorp gnus-current-headers))
8472                     (mail-header-subject gnus-current-headers) ""))
8473                max-len
8474                header);; passed as argument to any user-format-funcs
8475           (setq mode-string (eval mformat))
8476           (setq max-len (max 4 (if gnus-mode-non-string-length
8477                                    (- (frame-width)
8478                                       gnus-mode-non-string-length)
8479                                  (length mode-string))))
8480           ;; We might have to chop a bit of the string off...
8481           (when (> (length mode-string) max-len)
8482             (setq mode-string
8483                   (concat (gnus-truncate-string mode-string (- max-len 3))
8484                           "...")))
8485           ;; Pad the mode string a bit.
8486           (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
8487       ;; Update the mode line.
8488       (setq mode-line-buffer-identification (list mode-string))
8489       (set-buffer-modified-p t))))
8490
8491 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
8492   "Go through the HEADERS list and add all Xrefs to a hash table.
8493 The resulting hash table is returned, or nil if no Xrefs were found."
8494   (let* ((from-method (gnus-find-method-for-group from-newsgroup))
8495          (virtual (gnus-virtual-group-p from-newsgroup))
8496          (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
8497          (xref-hashtb (make-vector 63 0))
8498          start group entry number xrefs header)
8499     (while headers
8500       (setq header (pop headers))
8501       (when (and (setq xrefs (mail-header-xref header))
8502                  (not (memq (setq number (mail-header-number header))
8503                             unreads)))
8504         (setq start 0)
8505         (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
8506           (setq start (match-end 0))
8507           (setq group (concat prefix (substring xrefs (match-beginning 1)
8508                                                 (match-end 1))))
8509           (setq number
8510                 (string-to-int (substring xrefs (match-beginning 2)
8511                                           (match-end 2))))
8512           (if (setq entry (gnus-gethash group xref-hashtb))
8513               (setcdr entry (cons number (cdr entry)))
8514             (gnus-sethash group (cons number nil) xref-hashtb)))))
8515     (and start xref-hashtb)))
8516
8517 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
8518   "Look through all the headers and mark the Xrefs as read."
8519   (let ((virtual (gnus-virtual-group-p from-newsgroup))
8520         name entry info xref-hashtb idlist method nth4)
8521     (save-excursion
8522       (set-buffer gnus-group-buffer)
8523       (when (setq xref-hashtb
8524                   (gnus-create-xref-hashtb from-newsgroup headers unreads))
8525         (mapatoms
8526          (lambda (group)
8527            (unless (string= from-newsgroup (setq name (symbol-name group)))
8528              (setq idlist (symbol-value group))
8529              ;; Dead groups are not updated.
8530              (and (prog1
8531                       (setq entry (gnus-gethash name gnus-newsrc-hashtb)
8532                             info (nth 2 entry))
8533                     (if (stringp (setq nth4 (gnus-info-method info)))
8534                         (setq nth4 (gnus-server-to-method nth4))))
8535                   ;; Only do the xrefs if the group has the same
8536                   ;; select method as the group we have just read.
8537                   (or (gnus-methods-equal-p
8538                        nth4 (gnus-find-method-for-group from-newsgroup))
8539                       virtual
8540                       (equal nth4 (setq method (gnus-find-method-for-group
8541                                                 from-newsgroup)))
8542                       (and (equal (car nth4) (car method))
8543                            (equal (nth 1 nth4) (nth 1 method))))
8544                   gnus-use-cross-reference
8545                   (or (not (eq gnus-use-cross-reference t))
8546                       virtual
8547                       ;; Only do cross-references on subscribed
8548                       ;; groups, if that is what is wanted.
8549                       (<= (gnus-info-level info) gnus-level-subscribed))
8550                   (gnus-group-make-articles-read name idlist))))
8551          xref-hashtb)))))
8552
8553 (defun gnus-group-make-articles-read (group articles)
8554   (let* ((num 0)
8555          (entry (gnus-gethash group gnus-newsrc-hashtb))
8556          (info (nth 2 entry))
8557          (active (gnus-active group))
8558          range)
8559     ;; First peel off all illegal article numbers.
8560     (if active
8561         (let ((ids articles)
8562               id first)
8563           (while ids
8564             (setq id (car ids))
8565             (if (and first (> id (cdr active)))
8566                 (progn
8567                   ;; We'll end up in this situation in one particular
8568                   ;; obscure situation.  If you re-scan a group and get
8569                   ;; a new article that is cross-posted to a different
8570                   ;; group that has not been re-scanned, you might get
8571                   ;; crossposted article that has a higher number than
8572                   ;; Gnus believes possible.  So we re-activate this
8573                   ;; group as well.  This might mean doing the
8574                   ;; crossposting thingy will *increase* the number
8575                   ;; of articles in some groups.  Tsk, tsk.
8576                   (setq active (or (gnus-activate-group group) active))))
8577             (if (or (> id (cdr active))
8578                     (< id (car active)))
8579                 (setq articles (delq id articles)))
8580             (setq ids (cdr ids)))))
8581     ;; If the read list is nil, we init it.
8582     (and active
8583          (null (gnus-info-read info))
8584          (> (car active) 1)
8585          (gnus-info-set-read info (cons 1 (1- (car active)))))
8586     ;; Then we add the read articles to the range.
8587     (gnus-info-set-read
8588      info
8589      (setq range
8590            (gnus-add-to-range
8591             (gnus-info-read info) (setq articles (sort articles '<)))))
8592     ;; Then we have to re-compute how many unread
8593     ;; articles there are in this group.
8594     (if active
8595         (progn
8596           (cond
8597            ((not range)
8598             (setq num (- (1+ (cdr active)) (car active))))
8599            ((not (listp (cdr range)))
8600             (setq num (- (cdr active) (- (1+ (cdr range))
8601                                          (car range)))))
8602            (t
8603             (while range
8604               (if (numberp (car range))
8605                   (setq num (1+ num))
8606                 (setq num (+ num (- (1+ (cdr (car range)))
8607                                     (car (car range))))))
8608               (setq range (cdr range)))
8609             (setq num (- (cdr active) num))))
8610           ;; Update the number of unread articles.
8611           (setcar entry num)
8612           ;; Update the group buffer.
8613           (gnus-group-update-group group t)))))
8614
8615 (defun gnus-methods-equal-p (m1 m2)
8616   (let ((m1 (or m1 gnus-select-method))
8617         (m2 (or m2 gnus-select-method)))
8618     (or (equal m1 m2)
8619         (and (eq (car m1) (car m2))
8620              (or (not (memq 'address (assoc (symbol-name (car m1))
8621                                             gnus-valid-select-methods)))
8622                  (equal (nth 1 m1) (nth 1 m2)))))))
8623
8624 (defsubst gnus-header-value ()
8625   (buffer-substring (match-end 0) (gnus-point-at-eol)))
8626
8627 (defvar gnus-newsgroup-none-id 0)
8628
8629 (defun gnus-get-newsgroup-headers (&optional dependencies force-new)
8630   (let ((cur nntp-server-buffer)
8631         (dependencies
8632          (or dependencies
8633              (save-excursion (set-buffer gnus-summary-buffer)
8634                              gnus-newsgroup-dependencies)))
8635         headers id id-dep ref-dep end ref)
8636     (save-excursion
8637       (set-buffer nntp-server-buffer)
8638       (let ((case-fold-search t)
8639             in-reply-to header number p lines)
8640         (goto-char (point-min))
8641         ;; Search to the beginning of the next header.  Error messages
8642         ;; do not begin with 2 or 3.
8643         (while (re-search-forward "^[23][0-9]+ " nil t)
8644           (setq id nil
8645                 ref nil)
8646           ;; This implementation of this function, with nine
8647           ;; search-forwards instead of the one re-search-forward and
8648           ;; a case (which basically was the old function) is actually
8649           ;; about twice as fast, even though it looks messier.  You
8650           ;; can't have everything, I guess.  Speed and elegance
8651           ;; doesn't always go hand in hand.
8652           (setq
8653            header
8654            (vector
8655             ;; Number.
8656             (prog1
8657                 (read cur)
8658               (end-of-line)
8659               (setq p (point))
8660               (narrow-to-region (point)
8661                                 (or (and (search-forward "\n.\n" nil t)
8662                                          (- (point) 2))
8663                                     (point))))
8664             ;; Subject.
8665             (progn
8666               (goto-char p)
8667               (if (search-forward "\nsubject: " nil t)
8668                   (gnus-header-value) "(none)"))
8669             ;; From.
8670             (progn
8671               (goto-char p)
8672               (if (search-forward "\nfrom: " nil t)
8673                   (gnus-header-value) "(nobody)"))
8674             ;; Date.
8675             (progn
8676               (goto-char p)
8677               (if (search-forward "\ndate: " nil t)
8678                   (gnus-header-value) ""))
8679             ;; Message-ID.
8680             (progn
8681               (goto-char p)
8682               (if (search-forward "\nmessage-id: " nil t)
8683                   (setq id (gnus-header-value))
8684                 ;; If there was no message-id, we just fake one to make
8685                 ;; subsequent routines simpler.
8686                 (setq id (concat "none+"
8687                                  (int-to-string
8688                                   (setq gnus-newsgroup-none-id
8689                                         (1+ gnus-newsgroup-none-id)))))))
8690             ;; References.
8691             (progn
8692               (goto-char p)
8693               (if (search-forward "\nreferences: " nil t)
8694                   (prog1
8695                       (gnus-header-value)
8696                     (setq end (match-end 0))
8697                     (save-excursion
8698                       (setq ref
8699                             (downcase
8700                              (buffer-substring
8701                               (progn
8702                                 (end-of-line)
8703                                 (search-backward ">" end t)
8704                                 (1+ (point)))
8705                               (progn
8706                                 (search-backward "<" end t)
8707                                 (point)))))))
8708                 ;; Get the references from the in-reply-to header if there
8709                 ;; were no references and the in-reply-to header looks
8710                 ;; promising.
8711                 (if (and (search-forward "\nin-reply-to: " nil t)
8712                          (setq in-reply-to (gnus-header-value))
8713                          (string-match "<[^>]+>" in-reply-to))
8714                     (prog1
8715                         (setq ref (substring in-reply-to (match-beginning 0)
8716                                              (match-end 0)))
8717                       (setq ref (downcase ref))))
8718                 (setq ref "")))
8719             ;; Chars.
8720             0
8721             ;; Lines.
8722             (progn
8723               (goto-char p)
8724               (if (search-forward "\nlines: " nil t)
8725                   (if (numberp (setq lines (read cur)))
8726                       lines 0)
8727                 0))
8728             ;; Xref.
8729             (progn
8730               (goto-char p)
8731               (and (search-forward "\nxref: " nil t)
8732                    (gnus-header-value)))))
8733           (if (and gnus-nocem-hashtb
8734                    (gnus-gethash id gnus-nocem-hashtb))
8735               ;; Banned article.
8736               (setq header nil)
8737             ;; We do the threading while we read the headers.  The
8738             ;; message-id and the last reference are both entered into
8739             ;; the same hash table.  Some tippy-toeing around has to be
8740             ;; done in case an article has arrived before the article
8741             ;; which it refers to.
8742             (if (boundp (setq id-dep (intern (downcase id) dependencies)))
8743                 (if (and (car (symbol-value id-dep))
8744                          (not force-new))
8745                     ;; An article with this Message-ID has already
8746                     ;; been seen, so we ignore this one, except we add
8747                     ;; any additional Xrefs (in case the two articles
8748                     ;; came from different servers).
8749                     (progn
8750                       (mail-header-set-xref
8751                        (car (symbol-value id-dep))
8752                        (concat (or (mail-header-xref
8753                                     (car (symbol-value id-dep))) "")
8754                                (or (mail-header-xref header) "")))
8755                       (setq header nil))
8756                   (setcar (symbol-value id-dep) header))
8757               (set id-dep (list header))))
8758           (when header
8759             (if (boundp (setq ref-dep (intern ref dependencies)))
8760                 (setcdr (symbol-value ref-dep)
8761                         (nconc (cdr (symbol-value ref-dep))
8762                                (list (symbol-value id-dep))))
8763               (set ref-dep (list nil (symbol-value id-dep))))
8764             (setq headers (cons header headers)))
8765           (goto-char (point-max))
8766           (widen))
8767         (nreverse headers)))))
8768
8769 ;; The following macros and functions were written by Felix Lee
8770 ;; <flee@cse.psu.edu>.
8771
8772 (defmacro gnus-nov-read-integer ()
8773   '(prog1
8774        (if (= (following-char) ?\t)
8775            0
8776          (let ((num (condition-case nil (read buffer) (error nil))))
8777            (if (numberp num) num 0)))
8778      (or (eobp) (forward-char 1))))
8779
8780 (defmacro gnus-nov-skip-field ()
8781   '(search-forward "\t" eol 'move))
8782
8783 (defmacro gnus-nov-field ()
8784   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
8785
8786 ;; Goes through the xover lines and returns a list of vectors
8787 (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new)
8788   "Parse the news overview data in the server buffer, and return a
8789 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
8790   ;; Get the Xref when the users reads the articles since most/some
8791   ;; NNTP servers do not include Xrefs when using XOVER.
8792   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
8793   (let ((cur nntp-server-buffer)
8794         (dependencies gnus-newsgroup-dependencies)
8795         number headers header)
8796     (save-excursion
8797       (set-buffer nntp-server-buffer)
8798       ;; Allow the user to mangle the headers before parsing them.
8799       (run-hooks 'gnus-parse-headers-hook)
8800       ;; Allow the user to mangle the headers before parsing them.
8801       (run-hooks 'gnus-parse-headers-hook)
8802       (goto-char (point-min))
8803       (while (and sequence (not (eobp)))
8804         (setq number (read cur))
8805         (while (and sequence (< (car sequence) number))
8806           (setq sequence (cdr sequence)))
8807         (and sequence
8808              (eq number (car sequence))
8809              (progn
8810                (setq sequence (cdr sequence))
8811                (if (setq header
8812                          (inline (gnus-nov-parse-line
8813                                   number dependencies force-new)))
8814                    (setq headers (cons header headers)))))
8815         (forward-line 1))
8816       (setq headers (nreverse headers)))
8817     headers))
8818
8819 ;; This function has to be called with point after the article number
8820 ;; on the beginning of the line.
8821 (defun gnus-nov-parse-line (number dependencies &optional force-new)
8822   (let ((none 0)
8823         (eol (gnus-point-at-eol))
8824         (buffer (current-buffer))
8825         header ref id id-dep ref-dep)
8826
8827     ;; overview: [num subject from date id refs chars lines misc]
8828     (narrow-to-region (point) eol)
8829     (or (eobp) (forward-char))
8830
8831     (condition-case nil
8832         (setq header
8833               (vector
8834                number                   ; number
8835                (gnus-nov-field)         ; subject
8836                (gnus-nov-field)         ; from
8837                (gnus-nov-field)         ; date
8838                (setq id (or (gnus-nov-field)
8839                             (concat "none+"
8840                                     (int-to-string
8841                                      (setq none (1+ none)))))) ; id
8842                (progn
8843                  (save-excursion
8844                    (let ((beg (point)))
8845                      (search-forward "\t" eol)
8846                      (if (search-backward ">" beg t)
8847                          (setq ref
8848                                (downcase
8849                                 (buffer-substring
8850                                  (1+ (point))
8851                                  (progn
8852                                    (search-backward "<" beg t)
8853                                    (point)))))
8854                        (setq ref nil))))
8855                  (gnus-nov-field))      ; refs
8856                (gnus-nov-read-integer)  ; chars
8857                (gnus-nov-read-integer)  ; lines
8858                (if (= (following-char) ?\n)
8859                    nil
8860                  (gnus-nov-field))      ; misc
8861                ))
8862       (error (progn
8863                (ding)
8864                (gnus-message 4 "Strange nov line")
8865                (setq header nil)
8866                (goto-char eol))))
8867
8868     (widen)
8869
8870     ;; We build the thread tree.
8871     (and header
8872          (if (and gnus-nocem-hashtb
8873                   (gnus-gethash id gnus-nocem-hashtb))
8874              ;; Banned article.
8875              (setq header nil)
8876            (if (boundp (setq id-dep (intern (downcase id) dependencies)))
8877                (if (and (car (symbol-value id-dep))
8878                         (not force-new))
8879                    ;; An article with this Message-ID has already been seen,
8880                    ;; so we ignore this one, except we add any additional
8881                    ;; Xrefs (in case the two articles came from different
8882                    ;; servers.
8883                    (progn
8884                      (mail-header-set-xref
8885                       (car (symbol-value id-dep))
8886                       (concat (or (mail-header-xref
8887                                    (car (symbol-value id-dep))) "")
8888                               (or (mail-header-xref header) "")))
8889                      (setq header nil))
8890                  (setcar (symbol-value id-dep) header))
8891              (set id-dep (list header)))))
8892     (if header
8893         (progn
8894           (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
8895               (setcdr (symbol-value ref-dep)
8896                       (nconc (cdr (symbol-value ref-dep))
8897                              (list (symbol-value id-dep))))
8898             (set ref-dep (list nil (symbol-value id-dep))))))
8899     header))
8900
8901 (defun gnus-article-get-xrefs ()
8902   "Fill in the Xref value in `gnus-current-headers', if necessary.
8903 This is meant to be called in `gnus-article-internal-prepare-hook'."
8904   (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
8905                                  gnus-current-headers)))
8906     (or (not gnus-use-cross-reference)
8907         (not headers)
8908         (and (mail-header-xref headers)
8909              (not (string= (mail-header-xref headers) "")))
8910         (let ((case-fold-search t)
8911               xref)
8912           (save-restriction
8913             (nnheader-narrow-to-headers)
8914             (goto-char (point-min))
8915             (if (or (and (eq (downcase (following-char)) ?x)
8916                          (looking-at "Xref:"))
8917                     (search-forward "\nXref:" nil t))
8918                 (progn
8919                   (goto-char (1+ (match-end 0)))
8920                   (setq xref (buffer-substring (point)
8921                                                (progn (end-of-line) (point))))
8922                   (mail-header-set-xref headers xref))))))))
8923
8924 (defun gnus-summary-insert-subject (id)
8925   "Find article ID and insert the summary line for that article."
8926   (let ((header (gnus-read-header id))
8927         (number (and (numberp id) id)))
8928     (when header
8929       ;; Rebuild the thread that this article is part of and go to the
8930       ;; article we have fetched.
8931       (gnus-rebuild-thread (mail-header-id header))
8932       (gnus-summary-goto-subject (setq number (mail-header-number header))))
8933     (when (and (numberp number)
8934                (> number 0))
8935       ;; We have to update the boundaries even if we can't fetch the
8936       ;; article if ID is a number -- so that the next `P' or `N'
8937       ;; command will fetch the previous (or next) article even
8938       ;; if the one we tried to fetch this time has been canceled.
8939       (and (> number gnus-newsgroup-end)
8940            (setq gnus-newsgroup-end number))
8941       (and (< number gnus-newsgroup-begin)
8942            (setq gnus-newsgroup-begin number))
8943       (setq gnus-newsgroup-unselected
8944             (delq number gnus-newsgroup-unselected)))
8945     ;; Report back a success?
8946     (and header number)))
8947
8948 (defun gnus-summary-work-articles (n)
8949   "Return a list of articles to be worked upon.  The prefix argument,
8950 the list of process marked articles, and the current article will be
8951 taken into consideration."
8952   (cond
8953    ((and n (numberp n))
8954     ;; A numerical prefix has been given.
8955     (let ((backward (< n 0))
8956           (n (abs n))
8957           articles article)
8958       (save-excursion
8959         (while
8960             (and (> n 0)
8961                  (push (setq article (gnus-summary-article-number))
8962                        articles)
8963                  (if backward
8964                      (gnus-summary-find-prev nil article)
8965                    (gnus-summary-find-next nil article)))
8966           (decf n)))
8967       (nreverse articles)))
8968    ((and (boundp 'transient-mark-mode)
8969          transient-mark-mode
8970          mark-active)
8971     ;; Work on the region between point and mark.
8972     (let ((max (max (point) (mark)))
8973           articles article)
8974       (save-excursion
8975         (goto-char (min (point) (mark)))
8976         (while
8977             (and
8978              (push (setq article (gnus-summary-article-number)) articles)
8979              (gnus-summary-find-next nil article)
8980              (< (point) max)))
8981         (nreverse articles))))
8982    (gnus-newsgroup-processable
8983     ;; There are process-marked articles present.
8984     (reverse gnus-newsgroup-processable))
8985    (t
8986     ;; Just return the current article.
8987     (list (gnus-summary-article-number)))))
8988
8989 (defun gnus-summary-search-group (&optional backward use-level)
8990   "Search for next unread newsgroup.
8991 If optional argument BACKWARD is non-nil, search backward instead."
8992   (save-excursion
8993     (set-buffer gnus-group-buffer)
8994     (if (gnus-group-search-forward
8995          backward nil (if use-level (gnus-group-group-level) nil))
8996         (gnus-group-group-name))))
8997
8998 (defun gnus-summary-best-group (&optional exclude-group)
8999   "Find the name of the best unread group.
9000 If EXCLUDE-GROUP, do not go to this group."
9001   (save-excursion
9002     (set-buffer gnus-group-buffer)
9003     (save-excursion
9004       (gnus-group-best-unread-group exclude-group))))
9005
9006 (defun gnus-summary-find-next (&optional unread article backward)
9007   (if backward (gnus-summary-find-prev)
9008     (let* ((article (or article (gnus-summary-article-number)))
9009            (arts (gnus-data-find-list article))
9010            result)
9011       (when (or (not gnus-summary-check-current)
9012                 (not unread)
9013                 (not (gnus-data-unread-p (car arts))))
9014         (setq arts (cdr arts)))
9015       (when (setq result
9016                   (if unread
9017                       (progn
9018                         (while arts
9019                           (when (gnus-data-unread-p (car arts))
9020                             (setq result (car arts)
9021                                   arts nil))
9022                           (setq arts (cdr arts)))
9023                         result)
9024                     (car arts)))
9025         (goto-char (gnus-data-pos result))
9026         (gnus-data-number result)))))
9027
9028 (defun gnus-summary-find-prev (&optional unread article)
9029   (let* ((article (or article (gnus-summary-article-number)))
9030          (arts (gnus-data-find-list article (gnus-data-list 'rev)))
9031          result)
9032     (when (or (not gnus-summary-check-current)
9033               (not unread)
9034               (not (gnus-data-unread-p (car arts))))
9035       (setq arts (cdr arts)))
9036     (if (setq result
9037               (if unread
9038                   (progn
9039                     (while arts
9040                       (and (gnus-data-unread-p (car arts))
9041                            (setq result (car arts)
9042                                  arts nil))
9043                       (setq arts (cdr arts)))
9044                     result)
9045                 (car arts)))
9046         (progn
9047           (goto-char (gnus-data-pos result))
9048           (gnus-data-number result)))))
9049
9050 (defun gnus-summary-find-subject (subject &optional unread backward article)
9051   (let* ((simp-subject (gnus-simplify-subject-fully subject))
9052          (article (or article (gnus-summary-article-number)))
9053          (articles (gnus-data-list backward))
9054          (arts (gnus-data-find-list article articles))
9055          result)
9056     (when (or (not gnus-summary-check-current)
9057               (not unread)
9058               (not (gnus-data-unread-p (car arts))))
9059       (setq arts (cdr arts)))
9060     (while arts
9061       (and (or (not unread)
9062                (gnus-data-unread-p (car arts)))
9063            (vectorp (gnus-data-header (car arts)))
9064            (gnus-subject-equal
9065             simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
9066            (setq result (car arts)
9067                  arts nil))
9068       (setq arts (cdr arts)))
9069     (and result
9070          (goto-char (gnus-data-pos result))
9071          (gnus-data-number result))))
9072
9073 (defun gnus-summary-search-forward (&optional unread subject backward)
9074   (cond (subject
9075          (gnus-summary-find-subject subject unread backward))
9076         (backward
9077          (gnus-summary-find-prev unread))
9078         (t
9079          (gnus-summary-find-next unread))))
9080
9081 (defun gnus-summary-recenter ()
9082   "Center point in the summary window.
9083 If `gnus-auto-center-summary' is nil, or the article buffer isn't
9084 displayed, no centering will be performed."
9085   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
9086   ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
9087   (let* ((top (cond ((< (window-height) 4) 0)
9088                     ((< (window-height) 7) 1)
9089                     (t 2)))
9090          (height (1- (window-height)))
9091          (bottom (save-excursion (goto-char (point-max))
9092                                  (forward-line (- height))
9093                                  (point)))
9094          (window (get-buffer-window (current-buffer))))
9095     ;; The user has to want it.
9096     (when gnus-auto-center-summary
9097       (when (get-buffer-window gnus-article-buffer)
9098        ;; Only do recentering when the article buffer is displayed,
9099        ;; Set the window start to either `bottom', which is the biggest
9100        ;; possible valid number, or the second line from the top,
9101        ;; whichever is the least.
9102        (set-window-start
9103         window (min bottom (save-excursion 
9104                              (forward-line (- top)) (point)))))
9105       ;; Do horizontal recentering while we're at it.
9106       (gnus-horizontal-recenter))))
9107
9108 (defun gnus-horizontal-recenter ()
9109   "Recenter the current buffer horizontally."
9110   (if (< (current-column) (/ (window-width) 2))
9111       (set-window-hscroll (get-buffer-window (current-buffer)) 0)
9112     (let* ((orig (point))
9113            (max 0))
9114       ;; Find the longest line currently displayed in the window.
9115       (goto-char (window-start))
9116       (while (< (point) (window-end))
9117         (end-of-line)
9118         (setq max (max max (current-column)))
9119         (forward-line 1))
9120       (goto-char orig)
9121       ;; Scroll horizontally to center (sort of) the point.
9122       (if (> max (window-width))
9123           (set-window-hscroll 
9124            (get-buffer-window (current-buffer))
9125            (min (- (current-column) 
9126                    (/ (+ (window-width) (window-hscroll)) 2)) 
9127                 (+ 2 (- max (window-width)))))
9128         (set-window-hscroll (get-buffer-window (current-buffer)) 0)))))
9129     
9130 ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
9131 (defun gnus-short-group-name (group &optional levels)
9132   "Collapse GROUP name LEVELS."
9133   (let* ((name "") (foreign "") (depth 0) (skip 1)
9134          (levels (or levels
9135                      (progn
9136                        (while (string-match "\\." group skip)
9137                          (setq skip (match-end 0)
9138                                depth (+ depth 1)))
9139                        depth))))
9140     (if (string-match ":" group)
9141         (setq foreign (substring group 0 (match-end 0))
9142               group (substring group (match-end 0))))
9143     (while group
9144       (if (and (string-match "\\." group) (> levels 0))
9145           (setq name (concat name (substring group 0 1))
9146                 group (substring group (match-end 0))
9147                 levels (- levels 1)
9148                 name (concat name "."))
9149         (setq name (concat foreign name group)
9150               group nil)))
9151     name))
9152
9153 (defun gnus-summary-jump-to-group (newsgroup)
9154   "Move point to NEWSGROUP in group mode buffer."
9155   ;; Keep update point of group mode buffer if visible.
9156   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
9157       (save-window-excursion
9158         ;; Take care of tree window mode.
9159         (if (get-buffer-window gnus-group-buffer)
9160             (pop-to-buffer gnus-group-buffer))
9161         (gnus-group-jump-to-group newsgroup))
9162     (save-excursion
9163       ;; Take care of tree window mode.
9164       (if (get-buffer-window gnus-group-buffer)
9165           (pop-to-buffer gnus-group-buffer)
9166         (set-buffer gnus-group-buffer))
9167       (gnus-group-jump-to-group newsgroup))))
9168
9169 ;; This function returns a list of article numbers based on the
9170 ;; difference between the ranges of read articles in this group and
9171 ;; the range of active articles.
9172 (defun gnus-list-of-unread-articles (group)
9173   (let* ((read (gnus-info-read (gnus-get-info group)))
9174          (active (gnus-active group))
9175          (last (cdr active))
9176          first nlast unread)
9177     ;; If none are read, then all are unread.
9178     (if (not read)
9179         (setq first (car active))
9180       ;; If the range of read articles is a single range, then the
9181       ;; first unread article is the article after the last read
9182       ;; article.  Sounds logical, doesn't it?
9183       (if (not (listp (cdr read)))
9184           (setq first (1+ (cdr read)))
9185         ;; `read' is a list of ranges.
9186         (if (/= (setq nlast (or (and (numberp (car read)) (car read))
9187                                 (car (car read)))) 1)
9188             (setq first 1))
9189         (while read
9190           (if first
9191               (while (< first nlast)
9192                 (setq unread (cons first unread))
9193                 (setq first (1+ first))))
9194           (setq first (1+ (if (atom (car read)) (car read) (cdr (car read)))))
9195           (setq nlast (if (atom (car (cdr read)))
9196                           (car (cdr read))
9197                         (car (car (cdr read)))))
9198           (setq read (cdr read)))))
9199     ;; And add the last unread articles.
9200     (while (<= first last)
9201       (setq unread (cons first unread))
9202       (setq first (1+ first)))
9203     ;; Return the list of unread articles.
9204     (nreverse unread)))
9205
9206 (defun gnus-list-of-read-articles (group)
9207   "Return a list of unread, unticked and non-dormant articles."
9208   (let* ((info (gnus-get-info group))
9209          (marked (gnus-info-marks info))
9210          (active (gnus-active group)))
9211     (and info active
9212          (gnus-set-difference
9213           (gnus-sorted-complement
9214            (gnus-uncompress-range active)
9215            (gnus-list-of-unread-articles group))
9216           (append
9217            (gnus-uncompress-range (cdr (assq 'dormant marked)))
9218            (gnus-uncompress-range (cdr (assq 'tick marked))))))))
9219
9220 ;; Various summary commands
9221
9222 (defun gnus-summary-universal-argument (arg)
9223   "Perform any operation on all articles that are process/prefixed."
9224   (interactive "P")
9225   (gnus-set-global-variables)
9226   (let ((articles (gnus-summary-work-articles arg))
9227         func article)
9228     (if (eq
9229          (setq
9230           func
9231           (key-binding
9232            (read-key-sequence
9233             (substitute-command-keys
9234              "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
9235              ))))
9236          'undefined)
9237         (progn
9238           (message "Undefined key")
9239           (ding))
9240       (save-excursion
9241         (while articles
9242           (gnus-summary-goto-subject (setq article (pop articles)))
9243           (command-execute func)
9244           (gnus-summary-remove-process-mark article)))))
9245   (gnus-summary-position-point))
9246
9247 (defun gnus-summary-toggle-truncation (&optional arg)
9248   "Toggle truncation of summary lines.
9249 With arg, turn line truncation on iff arg is positive."
9250   (interactive "P")
9251   (setq truncate-lines
9252         (if (null arg) (not truncate-lines)
9253           (> (prefix-numeric-value arg) 0)))
9254   (redraw-display))
9255
9256 (defun gnus-summary-reselect-current-group (&optional all rescan)
9257   "Exit and then reselect the current newsgroup.
9258 The prefix argument ALL means to select all articles."
9259   (interactive "P")
9260   (gnus-set-global-variables)
9261   (let ((current-subject (gnus-summary-article-number))
9262         (group gnus-newsgroup-name))
9263     (setq gnus-newsgroup-begin nil)
9264     (gnus-summary-exit)
9265     ;; We have to adjust the point of group mode buffer because the
9266     ;; current point was moved to the next unread newsgroup by
9267     ;; exiting.
9268     (gnus-summary-jump-to-group group)
9269     (when rescan
9270       (save-excursion
9271         (gnus-group-get-new-news-this-group 1)))
9272     (gnus-group-read-group all t)
9273     (gnus-summary-goto-subject current-subject)))
9274
9275 (defun gnus-summary-rescan-group (&optional all)
9276   "Exit the newsgroup, ask for new articles, and select the newsgroup."
9277   (interactive "P")
9278   (gnus-summary-reselect-current-group all t))
9279
9280 (defun gnus-summary-update-info ()
9281   (let* ((group gnus-newsgroup-name))
9282     (when gnus-newsgroup-kill-headers
9283       (setq gnus-newsgroup-killed
9284             (gnus-compress-sequence
9285              (nconc
9286               (gnus-set-sorted-intersection
9287                (gnus-uncompress-range gnus-newsgroup-killed)
9288                (setq gnus-newsgroup-unselected
9289                      (sort gnus-newsgroup-unselected '<)))
9290               (setq gnus-newsgroup-unreads
9291                     (sort gnus-newsgroup-unreads '<))) t)))
9292     (unless (listp (cdr gnus-newsgroup-killed))
9293       (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
9294     (let ((headers gnus-newsgroup-headers))
9295       (gnus-close-group group)
9296       (run-hooks 'gnus-exit-group-hook)
9297       (unless gnus-save-score
9298         (setq gnus-newsgroup-scored nil))
9299       ;; Set the new ranges of read articles.
9300       (gnus-update-read-articles
9301        group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
9302       ;; Set the current article marks.
9303       (gnus-update-marks)
9304       ;; Do the cross-ref thing.
9305       (when gnus-use-cross-reference
9306         (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
9307       ;; Do adaptive scoring, and possibly save score files.
9308       (when gnus-newsgroup-adaptive
9309         (gnus-score-adaptive))
9310       (when gnus-use-scoring
9311         (gnus-score-save))
9312       ;; Do not switch windows but change the buffer to work.
9313       (set-buffer gnus-group-buffer)
9314       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
9315           (gnus-group-update-group group)))))
9316
9317 (defun gnus-summary-exit (&optional temporary)
9318   "Exit reading current newsgroup, and then return to group selection mode.
9319 gnus-exit-group-hook is called with no arguments if that value is non-nil."
9320   (interactive)
9321   (gnus-set-global-variables)
9322   (gnus-kill-save-kill-buffer)
9323   (let* ((group gnus-newsgroup-name)
9324          (quit-config (gnus-group-quit-config gnus-newsgroup-name))
9325          (mode major-mode)
9326          (buf (current-buffer)))
9327     (run-hooks 'gnus-summary-prepare-exit-hook)
9328     ;; Make all changes in this group permanent.
9329     (gnus-summary-update-info)
9330     (set-buffer buf)
9331     (when gnus-use-cache
9332       (gnus-cache-possibly-remove-articles)
9333       (gnus-cache-save-buffers))
9334     (when gnus-use-trees
9335       (gnus-tree-close group))
9336     ;; Make sure where I was, and go to next newsgroup.
9337     (set-buffer gnus-group-buffer)
9338     (or quit-config
9339         (progn
9340           (gnus-group-jump-to-group group)
9341           (gnus-group-next-unread-group 1)))
9342     (run-hooks 'gnus-summary-exit-hook)
9343     (if temporary
9344         nil                             ;Nothing to do.
9345       ;; If we have several article buffers, we kill them at exit.
9346       (unless gnus-single-article-buffer
9347         (gnus-kill-buffer gnus-article-buffer)
9348         (gnus-kill-buffer gnus-original-article-buffer))
9349       (set-buffer buf)
9350       (if (not gnus-kill-summary-on-exit)
9351           (gnus-deaden-summary)
9352         ;; We set all buffer-local variables to nil.  It is unclear why
9353         ;; this is needed, but if we don't, buffer-local variables are
9354         ;; not garbage-collected, it seems.  This would the lead to en
9355         ;; ever-growing Emacs.
9356         (gnus-summary-clear-local-variables)
9357         ;; We clear the global counterparts of the buffer-local
9358         ;; variables as well, just to be on the safe side.
9359         (gnus-configure-windows 'group 'force)
9360         (gnus-summary-clear-local-variables)
9361         ;; Return to group mode buffer.
9362         (if (eq mode 'gnus-summary-mode)
9363             (gnus-kill-buffer buf)))
9364       (setq gnus-current-select-method gnus-select-method)
9365       (pop-to-buffer gnus-group-buffer)
9366       ;; Clear the current group name.
9367       (if (not quit-config)
9368           (progn
9369             (gnus-group-jump-to-group group)
9370             (gnus-group-next-unread-group 1)
9371             (gnus-configure-windows 'group 'force))
9372         (if (not (buffer-name (car quit-config)))
9373             (gnus-configure-windows 'group 'force)
9374           (set-buffer (car quit-config))
9375           (and (eq major-mode 'gnus-summary-mode)
9376                (gnus-set-global-variables))
9377           (gnus-configure-windows (cdr quit-config))))
9378       (unless quit-config
9379         (setq gnus-newsgroup-name nil)))))
9380
9381 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
9382 (defun gnus-summary-exit-no-update (&optional no-questions)
9383   "Quit reading current newsgroup without updating read article info."
9384   (interactive)
9385   (gnus-set-global-variables)
9386   (let* ((group gnus-newsgroup-name)
9387          (quit-config (gnus-group-quit-config group)))
9388     (when (or no-questions
9389               gnus-expert-user
9390               (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
9391       ;; If we have several article buffers, we kill them at exit.
9392       (unless gnus-single-article-buffer
9393         (gnus-kill-buffer gnus-article-buffer)
9394         (gnus-kill-buffer gnus-original-article-buffer))
9395       (if (not gnus-kill-summary-on-exit)
9396           (gnus-deaden-summary)
9397         (gnus-close-group group)
9398         (gnus-summary-clear-local-variables)
9399         (set-buffer gnus-group-buffer)
9400         (gnus-summary-clear-local-variables)
9401         (when (get-buffer gnus-summary-buffer)
9402           (kill-buffer gnus-summary-buffer)))
9403       (when gnus-use-trees
9404         (gnus-tree-close group))
9405       ;; Return to the group buffer.
9406       (gnus-configure-windows 'group 'force)
9407       ;; Clear the current group name.
9408       (setq gnus-newsgroup-name nil)
9409       (when (equal (gnus-group-group-name) group)
9410         (gnus-group-next-unread-group 1))
9411       (when quit-config
9412         (if (not (buffer-name (car quit-config)))
9413             (gnus-configure-windows 'group 'force)
9414           (set-buffer (car quit-config))
9415           (when (eq major-mode 'gnus-summary-mode)
9416             (gnus-set-global-variables))
9417           (gnus-configure-windows (cdr quit-config)))))))
9418
9419 ;;; Dead summaries.
9420
9421 (defvar gnus-dead-summary-mode-map nil)
9422
9423 (if gnus-dead-summary-mode-map
9424     nil
9425   (setq gnus-dead-summary-mode-map (make-keymap))
9426   (suppress-keymap gnus-dead-summary-mode-map)
9427   (substitute-key-definition
9428    'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
9429   (let ((keys '("\C-d" "\r" "\177")))
9430     (while keys
9431       (define-key gnus-dead-summary-mode-map
9432         (pop keys) 'gnus-summary-wake-up-the-dead))))
9433
9434 (defvar gnus-dead-summary-mode nil
9435   "Minor mode for Gnus summary buffers.")
9436
9437 (defun gnus-dead-summary-mode (&optional arg)
9438   "Minor mode for Gnus summary buffers."
9439   (interactive "P")
9440   (when (eq major-mode 'gnus-summary-mode)
9441     (make-local-variable 'gnus-dead-summary-mode)
9442     (setq gnus-dead-summary-mode
9443           (if (null arg) (not gnus-dead-summary-mode)
9444             (> (prefix-numeric-value arg) 0)))
9445     (when gnus-dead-summary-mode
9446       (unless (assq 'gnus-dead-summary-mode minor-mode-alist)
9447         (push '(gnus-dead-summary-mode " Dead") minor-mode-alist))
9448       (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist)
9449         (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map)
9450               minor-mode-map-alist)))))
9451
9452 (defun gnus-deaden-summary ()
9453   "Make the current summary buffer into a dead summary buffer."
9454   ;; Kill any previous dead summary buffer.
9455   (when (and gnus-dead-summary
9456              (buffer-name gnus-dead-summary))
9457     (save-excursion
9458       (set-buffer gnus-dead-summary)
9459       (when gnus-dead-summary-mode
9460         (kill-buffer (current-buffer)))))
9461   ;; Make this the current dead summary.
9462   (setq gnus-dead-summary (current-buffer))
9463   (gnus-dead-summary-mode 1)
9464   (let ((name (buffer-name)))
9465     (when (string-match "Summary" name)
9466       (rename-buffer
9467        (concat (substring name 0 (match-beginning 0)) "Dead "
9468                (substring name (match-beginning 0))) t))))
9469
9470 (defun gnus-kill-or-deaden-summary (buffer)
9471   "Kill or deaden the summary BUFFER."
9472   (cond (gnus-kill-summary-on-exit
9473          (when (and gnus-use-trees
9474                     (and (get-buffer buffer)
9475                          (buffer-name (get-buffer buffer))))
9476            (save-excursion
9477              (set-buffer (get-buffer buffer))
9478              (gnus-tree-close gnus-newsgroup-name)))
9479          (gnus-kill-buffer buffer))
9480         ((and (get-buffer buffer)
9481               (buffer-name (get-buffer buffer)))
9482          (save-excursion
9483            (set-buffer buffer)
9484            (gnus-deaden-summary)))))
9485
9486 (defun gnus-summary-wake-up-the-dead (&rest args)
9487   "Wake up the dead summary buffer."
9488   (interactive)
9489   (gnus-dead-summary-mode -1)
9490   (let ((name (buffer-name)))
9491     (when (string-match "Dead " name)
9492       (rename-buffer
9493        (concat (substring name 0 (match-beginning 0))
9494                (substring name (match-end 0))) t)))
9495   (gnus-message 3 "This dead summary is now alive again"))
9496
9497 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
9498 (defun gnus-summary-fetch-faq (&optional faq-dir)
9499   "Fetch the FAQ for the current group.
9500 If FAQ-DIR (the prefix), prompt for a directory to search for the faq
9501 in."
9502   (interactive
9503    (list
9504     (if current-prefix-arg
9505         (completing-read
9506          "Faq dir: " (and (listp gnus-group-faq-directory)
9507                           gnus-group-faq-directory)))))
9508   (let (gnus-faq-buffer)
9509     (and (setq gnus-faq-buffer
9510                (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
9511          (gnus-configure-windows 'summary-faq))))
9512
9513 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
9514 (defun gnus-summary-describe-group (&optional force)
9515   "Describe the current newsgroup."
9516   (interactive "P")
9517   (gnus-group-describe-group force gnus-newsgroup-name))
9518
9519 (defun gnus-summary-describe-briefly ()
9520   "Describe summary mode commands briefly."
9521   (interactive)
9522   (gnus-message 6
9523                 (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")))
9524
9525 ;; Walking around group mode buffer from summary mode.
9526
9527 (defun gnus-summary-next-group (&optional no-article target-group backward)
9528   "Exit current newsgroup and then select next unread newsgroup.
9529 If prefix argument NO-ARTICLE is non-nil, no article is selected
9530 initially.  If NEXT-GROUP, go to this group.  If BACKWARD, go to
9531 previous group instead."
9532   (interactive "P")
9533   (gnus-set-global-variables)
9534   (let ((current-group gnus-newsgroup-name)
9535         (current-buffer (current-buffer))
9536         entered)
9537     ;; First we semi-exit this group to update Xrefs and all variables.
9538     ;; We can't do a real exit, because the window conf must remain
9539     ;; the same in case the user is prompted for info, and we don't
9540     ;; want the window conf to change before that...
9541     (gnus-summary-exit t)
9542     (while (not entered)
9543       ;; Then we find what group we are supposed to enter.
9544       (set-buffer gnus-group-buffer)
9545       (gnus-group-jump-to-group current-group)
9546       (setq target-group
9547             (or target-group
9548                 (if (eq gnus-keep-same-level 'best)
9549                     (gnus-summary-best-group gnus-newsgroup-name)
9550                   (gnus-summary-search-group backward gnus-keep-same-level))))
9551       (if (not target-group)
9552           ;; There are no further groups, so we return to the group
9553           ;; buffer.
9554           (progn
9555             (gnus-message 5 "Returning to the group buffer")
9556             (setq entered t)
9557             (set-buffer current-buffer)
9558             (gnus-summary-exit))
9559         ;; We try to enter the target group.
9560         (gnus-group-jump-to-group target-group)
9561         (let ((unreads (gnus-group-group-unread)))
9562           (if (and (or (eq t unreads)
9563                        (and unreads (not (zerop unreads))))
9564                    (gnus-summary-read-group
9565                     target-group nil no-article current-buffer))
9566               (setq entered t)
9567             (setq current-group target-group
9568                   target-group nil)))))))
9569
9570 (defun gnus-summary-prev-group (&optional no-article)
9571   "Exit current newsgroup and then select previous unread newsgroup.
9572 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
9573   (interactive "P")
9574   (gnus-summary-next-group no-article nil t))
9575
9576 ;; Walking around summary lines.
9577
9578 (defun gnus-summary-first-subject (&optional unread)
9579   "Go to the first unread subject.
9580 If UNREAD is non-nil, go to the first unread article.
9581 Returns the article selected or nil if there are no unread articles."
9582   (interactive "P")
9583   (prog1
9584       (cond
9585        ;; Empty summary.
9586        ((null gnus-newsgroup-data)
9587         (gnus-message 3 "No articles in the group")
9588         nil)
9589        ;; Pick the first article.
9590        ((not unread)
9591         (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
9592         (gnus-data-number (car gnus-newsgroup-data)))
9593        ;; No unread articles.
9594        ((null gnus-newsgroup-unreads)
9595         (gnus-message 3 "No more unread articles")
9596         nil)
9597        ;; Find the first unread article.
9598        (t
9599         (let ((data gnus-newsgroup-data))
9600           (while (and data
9601                       (not (gnus-data-unread-p (car data))))
9602             (setq data (cdr data)))
9603           (if data
9604               (progn
9605                 (goto-char (gnus-data-pos (car data)))
9606                 (gnus-data-number (car data)))))))
9607     (gnus-summary-position-point)))
9608
9609 (defun gnus-summary-next-subject (n &optional unread dont-display)
9610   "Go to next N'th summary line.
9611 If N is negative, go to the previous N'th subject line.
9612 If UNREAD is non-nil, only unread articles are selected.
9613 The difference between N and the actual number of steps taken is
9614 returned."
9615   (interactive "p")
9616   (let ((backward (< n 0))
9617         (n (abs n)))
9618     (while (and (> n 0)
9619                 (if backward
9620                     (gnus-summary-find-prev unread)
9621                   (gnus-summary-find-next unread)))
9622       (setq n (1- n)))
9623     (if (/= 0 n) (gnus-message 7 "No more%s articles"
9624                                (if unread " unread" "")))
9625     (or dont-display
9626         (progn
9627           (gnus-summary-recenter)
9628           (gnus-summary-position-point)))
9629     n))
9630
9631 (defun gnus-summary-next-unread-subject (n)
9632   "Go to next N'th unread summary line."
9633   (interactive "p")
9634   (gnus-summary-next-subject n t))
9635
9636 (defun gnus-summary-prev-subject (n &optional unread)
9637   "Go to previous N'th summary line.
9638 If optional argument UNREAD is non-nil, only unread article is selected."
9639   (interactive "p")
9640   (gnus-summary-next-subject (- n) unread))
9641
9642 (defun gnus-summary-prev-unread-subject (n)
9643   "Go to previous N'th unread summary line."
9644   (interactive "p")
9645   (gnus-summary-next-subject (- n) t))
9646
9647 (defun gnus-summary-goto-subject (article &optional force silent)
9648   "Go the subject line of ARTICLE.
9649 If FORCE, also allow jumping to articles not currently shown."
9650   (let ((b (point))
9651         (data (gnus-data-find article)))
9652     ;; We read in the article if we have to.
9653     (and (not data)
9654          force
9655          (gnus-summary-insert-subject article)
9656          (setq data (gnus-data-find article)))
9657     (goto-char b)
9658     (if (not data)
9659         (progn
9660           (unless silent
9661             (gnus-message 3 "Can't find article %d" article))
9662           nil)
9663       (goto-char (gnus-data-pos data))
9664       article)))
9665
9666 ;; Walking around summary lines with displaying articles.
9667
9668 (defun gnus-summary-expand-window (&optional arg)
9669   "Make the summary buffer take up the entire Emacs frame.
9670 Given a prefix, will force an `article' buffer configuration."
9671   (interactive "P")
9672   (gnus-set-global-variables)
9673   (if arg
9674       (gnus-configure-windows 'article 'force)
9675     (gnus-configure-windows 'summary 'force)))
9676
9677 (defun gnus-summary-display-article (article &optional all-header)
9678   "Display ARTICLE in article buffer."
9679   (gnus-set-global-variables)
9680   (if (null article)
9681       nil
9682     (prog1
9683         (if gnus-summary-display-article-function
9684             (funcall gnus-summary-display-article-function article all-header)
9685           (gnus-article-prepare article all-header))
9686       (run-hooks 'gnus-select-article-hook)
9687       (gnus-summary-recenter)
9688       (gnus-summary-goto-subject article)
9689       (when gnus-use-trees
9690         (gnus-possibly-generate-tree article)
9691         (gnus-highlight-selected-tree article))
9692       ;; Successfully display article.
9693       (gnus-article-set-window-start
9694        (cdr (assq article gnus-newsgroup-bookmarks)))
9695       t)))
9696
9697 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
9698   "Select the current article.
9699 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
9700 non-nil, the article will be re-fetched even if it already present in
9701 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
9702 be displayed."
9703   (let ((article (or article (gnus-summary-article-number)))
9704         (all-headers (not (not all-headers))) ;Must be T or NIL.
9705         gnus-summary-display-article-function
9706         did)
9707     (and (not pseudo)
9708          (gnus-summary-article-pseudo-p article)
9709          (error "This is a pseudo-article."))
9710     (prog1
9711         (save-excursion
9712           (set-buffer gnus-summary-buffer)
9713           (if (or (and gnus-single-article-buffer
9714                        (or (null gnus-current-article)
9715                            (null gnus-article-current)
9716                            (null (get-buffer gnus-article-buffer))
9717                            (not (eq article (cdr gnus-article-current)))
9718                            (not (equal (car gnus-article-current)
9719                                        gnus-newsgroup-name))))
9720                   (and (not gnus-single-article-buffer)
9721                        (null gnus-current-article))
9722                   force)
9723               ;; The requested article is different from the current article.
9724               (prog1
9725                   (gnus-summary-display-article article all-headers)
9726                 (setq did article))
9727             (if (or all-headers gnus-show-all-headers)
9728                 (gnus-article-show-all-headers))
9729             nil))
9730       (if did
9731           (gnus-article-set-window-start
9732            (cdr (assq article gnus-newsgroup-bookmarks)))))))
9733
9734 (defun gnus-summary-set-current-mark (&optional current-mark)
9735   "Obsolete function."
9736   nil)
9737
9738 (defun gnus-summary-next-article (&optional unread subject backward)
9739   "Select the next article.
9740 If UNREAD, only unread articles are selected.
9741 If SUBJECT, only articles with SUBJECT are selected.
9742 If BACKWARD, the previous article is selected instead of the next."
9743   (interactive "P")
9744   (gnus-set-global-variables)
9745   (let (header)
9746     (cond
9747      ;; Is there such an article?
9748      ((and (gnus-summary-search-forward unread subject backward)
9749            (or (gnus-summary-display-article (gnus-summary-article-number))
9750                (eq (gnus-summary-article-mark) gnus-canceled-mark)))
9751       (gnus-summary-position-point))
9752      ;; If not, we try the first unread, if that is wanted.
9753      ((and subject
9754            gnus-auto-select-same
9755            (or (gnus-summary-first-unread-article)
9756                (eq (gnus-summary-article-mark) gnus-canceled-mark)))
9757       (gnus-summary-position-point)
9758       (gnus-message 6 "Wrapped"))
9759      ;; Try to get next/previous article not displayed in this group.
9760      ((and gnus-auto-extend-newsgroup
9761            (not unread) (not subject))
9762       (gnus-summary-goto-article
9763        (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
9764        nil t))
9765      ;; Go to next/previous group.
9766      (t
9767       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
9768           (gnus-summary-jump-to-group gnus-newsgroup-name))
9769       (let ((cmd last-command-char)
9770             (group
9771              (if (eq gnus-keep-same-level 'best)
9772                  (gnus-summary-best-group gnus-newsgroup-name)
9773                (gnus-summary-search-group backward gnus-keep-same-level))))
9774         ;; For some reason, the group window gets selected.  We change
9775         ;; it back.
9776         (select-window (get-buffer-window (current-buffer)))
9777         ;; Select next unread newsgroup automagically.
9778         (cond
9779          ((not gnus-auto-select-next)
9780           (gnus-message 7 "No more%s articles" (if unread " unread" "")))
9781          ((or (eq gnus-auto-select-next 'quietly)
9782               (and (eq gnus-auto-select-next 'almost-quietly)
9783                    (gnus-summary-last-article-p)))
9784           ;; Select quietly.
9785           (if (gnus-ephemeral-group-p gnus-newsgroup-name)
9786               (gnus-summary-exit)
9787             (gnus-message 7 "No more%s articles (%s)..."
9788                           (if unread " unread" "")
9789                           (if group (concat "selecting " group)
9790                             "exiting"))
9791             (gnus-summary-next-group nil group backward)))
9792          (t
9793           (gnus-summary-walk-group-buffer
9794            gnus-newsgroup-name cmd unread backward))))))))
9795
9796 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
9797   (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
9798                       (?\C-p (gnus-group-prev-unread-group 1))))
9799         keve key group ended)
9800     (save-excursion
9801       (set-buffer gnus-group-buffer)
9802       (gnus-summary-jump-to-group from-group)
9803       (setq group
9804             (if (eq gnus-keep-same-level 'best)
9805                 (gnus-summary-best-group gnus-newsgroup-name)
9806               (gnus-summary-search-group backward gnus-keep-same-level))))
9807     (while (not ended)
9808       (gnus-message
9809        7 "No more%s articles%s" (if unread " unread" "")
9810        (if (and group
9811                 (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
9812            (format " (Type %s for %s [%s])"
9813                    (single-key-description cmd) group
9814                    (car (gnus-gethash group gnus-newsrc-hashtb)))
9815          (format " (Type %s to exit %s)"
9816                  (single-key-description cmd)
9817                  gnus-newsgroup-name)))
9818       ;; Confirm auto selection.
9819       (setq key (car (setq keve (gnus-read-event-char))))
9820       (setq ended t)
9821       (cond
9822        ((assq key keystrokes)
9823         (let ((obuf (current-buffer)))
9824           (switch-to-buffer gnus-group-buffer)
9825           (and group
9826                (gnus-group-jump-to-group group))
9827           (eval (car (cdr (assq key keystrokes))))
9828           (setq group (gnus-group-group-name))
9829           (switch-to-buffer obuf))
9830         (setq ended nil))
9831        ((equal key cmd)
9832         (if (or (not group)
9833                 (gnus-ephemeral-group-p gnus-newsgroup-name))
9834             (gnus-summary-exit)
9835           (gnus-summary-next-group nil group backward)))
9836        (t
9837         (push (cdr keve) unread-command-events))))))
9838
9839 (defun gnus-read-event-char ()
9840   "Get the next event."
9841   (let ((event (read-event)))
9842     (cons (and (numberp event) event) event)))
9843
9844 (defun gnus-summary-next-unread-article ()
9845   "Select unread article after current one."
9846   (interactive)
9847   (gnus-summary-next-article t (and gnus-auto-select-same
9848                                     (gnus-summary-article-subject))))
9849
9850 (defun gnus-summary-prev-article (&optional unread subject)
9851   "Select the article after the current one.
9852 If UNREAD is non-nil, only unread articles are selected."
9853   (interactive "P")
9854   (gnus-summary-next-article unread subject t))
9855
9856 (defun gnus-summary-prev-unread-article ()
9857   "Select unred article before current one."
9858   (interactive)
9859   (gnus-summary-prev-article t (and gnus-auto-select-same
9860                                     (gnus-summary-article-subject))))
9861
9862 (defun gnus-summary-next-page (&optional lines circular)
9863   "Show next page of the selected article.
9864 If at the end of the current article, select the next article.
9865 LINES says how many lines should be scrolled up.
9866
9867 If CIRCULAR is non-nil, go to the start of the article instead of
9868 selecting the next article when reaching the end of the current
9869 article."
9870   (interactive "P")
9871   (setq gnus-summary-buffer (current-buffer))
9872   (gnus-set-global-variables)
9873   (let ((article (gnus-summary-article-number))
9874         (endp nil))
9875     (gnus-configure-windows 'article)
9876     (if (or (null gnus-current-article)
9877             (null gnus-article-current)
9878             (/= article (cdr gnus-article-current))
9879             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
9880         ;; Selected subject is different from current article's.
9881         (gnus-summary-display-article article)
9882       (gnus-eval-in-buffer-window
9883        gnus-article-buffer
9884        (setq endp (gnus-article-next-page lines)))
9885       (if endp
9886           (cond (circular
9887                  (gnus-summary-beginning-of-article))
9888                 (lines
9889                  (gnus-message 3 "End of message"))
9890                 ((null lines)
9891                  (if (eq gnus-summary-goto-unread 'always)
9892                      (gnus-summary-next-article)
9893                    (gnus-summary-next-unread-article))))))
9894     (gnus-summary-recenter)
9895     (gnus-summary-position-point)))
9896
9897 (defun gnus-summary-prev-page (&optional lines)
9898   "Show previous page of selected article.
9899 Argument LINES specifies lines to be scrolled down."
9900   (interactive "P")
9901   (gnus-set-global-variables)
9902   (let ((article (gnus-summary-article-number)))
9903     (gnus-configure-windows 'article)
9904     (if (or (null gnus-current-article)
9905             (null gnus-article-current)
9906             (/= article (cdr gnus-article-current))
9907             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
9908         ;; Selected subject is different from current article's.
9909         (gnus-summary-display-article article)
9910       (gnus-summary-recenter)
9911       (gnus-eval-in-buffer-window gnus-article-buffer
9912                                   (gnus-article-prev-page lines))))
9913   (gnus-summary-position-point))
9914
9915 (defun gnus-summary-scroll-up (lines)
9916   "Scroll up (or down) one line current article.
9917 Argument LINES specifies lines to be scrolled up (or down if negative)."
9918   (interactive "p")
9919   (gnus-set-global-variables)
9920   (gnus-configure-windows 'article)
9921   (or (gnus-summary-select-article nil nil 'pseudo)
9922       (gnus-eval-in-buffer-window
9923        gnus-article-buffer
9924        (cond ((> lines 0)
9925               (if (gnus-article-next-page lines)
9926                   (gnus-message 3 "End of message")))
9927              ((< lines 0)
9928               (gnus-article-prev-page (- lines))))))
9929   (gnus-summary-recenter)
9930   (gnus-summary-position-point))
9931
9932 (defun gnus-summary-next-same-subject ()
9933   "Select next article which has the same subject as current one."
9934   (interactive)
9935   (gnus-set-global-variables)
9936   (gnus-summary-next-article nil (gnus-summary-article-subject)))
9937
9938 (defun gnus-summary-prev-same-subject ()
9939   "Select previous article which has the same subject as current one."
9940   (interactive)
9941   (gnus-set-global-variables)
9942   (gnus-summary-prev-article nil (gnus-summary-article-subject)))
9943
9944 (defun gnus-summary-next-unread-same-subject ()
9945   "Select next unread article which has the same subject as current one."
9946   (interactive)
9947   (gnus-set-global-variables)
9948   (gnus-summary-next-article t (gnus-summary-article-subject)))
9949
9950 (defun gnus-summary-prev-unread-same-subject ()
9951   "Select previous unread article which has the same subject as current one."
9952   (interactive)
9953   (gnus-set-global-variables)
9954   (gnus-summary-prev-article t (gnus-summary-article-subject)))
9955
9956 (defun gnus-summary-first-unread-article ()
9957   "Select the first unread article.
9958 Return nil if there are no unread articles."
9959   (interactive)
9960   (gnus-set-global-variables)
9961   (prog1
9962       (if (gnus-summary-first-subject t)
9963           (progn
9964             (gnus-summary-show-thread)
9965             (gnus-summary-first-subject t)
9966             (gnus-summary-display-article (gnus-summary-article-number))))
9967     (gnus-summary-position-point)))
9968
9969 (defun gnus-summary-best-unread-article ()
9970   "Select the unread article with the highest score."
9971   (interactive)
9972   (gnus-set-global-variables)
9973   (let ((best -1000000)
9974         (data gnus-newsgroup-data)
9975         article score)
9976     (while data
9977       (and (gnus-data-unread-p (car data))
9978            (> (setq score
9979                     (gnus-summary-article-score (gnus-data-number (car data))))
9980               best)
9981            (setq best score
9982                  article (gnus-data-number (car data))))
9983       (setq data (cdr data)))
9984     (if article
9985         (gnus-summary-goto-article article)
9986       (error "No unread articles"))
9987     (gnus-summary-position-point)))
9988
9989 (defun gnus-summary-last-subject ()
9990   "Go to the last displayed subject line in the group."
9991   (let ((article (gnus-data-number (car (gnus-data-list t)))))
9992     (when article
9993       (gnus-summary-goto-subject article))))
9994
9995 (defun gnus-summary-goto-article (article &optional all-headers force)
9996   "Fetch ARTICLE and display it if it exists.
9997 If ALL-HEADERS is non-nil, no header lines are hidden."
9998   (interactive
9999    (list
10000     (string-to-int
10001      (completing-read
10002       "Article number: "
10003       (mapcar (lambda (number) (list (int-to-string number)))
10004               gnus-newsgroup-limit)))
10005     current-prefix-arg
10006     t))
10007   (prog1
10008       (if (gnus-summary-goto-subject article force)
10009           (gnus-summary-display-article article all-headers)
10010         (gnus-message 4 "Couldn't go to article %s" article) nil)
10011     (gnus-summary-position-point)))
10012
10013 (defun gnus-summary-goto-last-article ()
10014   "Go to the previously read article."
10015   (interactive)
10016   (prog1
10017       (and gnus-last-article
10018            (gnus-summary-goto-article gnus-last-article))
10019     (gnus-summary-position-point)))
10020
10021 (defun gnus-summary-pop-article (number)
10022   "Pop one article off the history and go to the previous.
10023 NUMBER articles will be popped off."
10024   (interactive "p")
10025   (let (to)
10026     (setq gnus-newsgroup-history
10027           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
10028     (if to
10029         (gnus-summary-goto-article (car to))
10030       (error "Article history empty")))
10031   (gnus-summary-position-point))
10032
10033 ;; Summary commands and functions for limiting the summary buffer.
10034
10035 (defun gnus-summary-limit-to-articles (n)
10036   "Limit the summary buffer to the next N articles.
10037 If not given a prefix, use the process marked articles instead."
10038   (interactive "P")
10039   (gnus-set-global-variables)
10040   (prog1
10041       (let ((articles (gnus-summary-work-articles n)))
10042         (setq gnus-newsgroup-processable nil)
10043         (gnus-summary-limit articles))
10044     (gnus-summary-position-point)))
10045
10046 (defun gnus-summary-pop-limit (&optional total)
10047   "Restore the previous limit.
10048 If given a prefix, remove all limits."
10049   (interactive "P")
10050   (gnus-set-global-variables)
10051   (prog2
10052       (if total (setq gnus-newsgroup-limits
10053                       (list (mapcar (lambda (h) (mail-header-number h))
10054                                     gnus-newsgroup-headers))))
10055       (gnus-summary-limit nil 'pop)
10056     (gnus-summary-position-point)))
10057
10058 (defun gnus-summary-limit-to-subject (subject &optional header)
10059   "Limit the summary buffer to articles that have subjects that match a regexp."
10060   (interactive "sRegexp: ")
10061   (unless header
10062     (setq header "subject"))
10063   (when (not (equal "" subject))
10064     (prog1
10065         (let ((articles (gnus-summary-find-matching "subject" subject 'all)))
10066           (or articles (error "Found no matches for \"%s\"" subject))
10067           (gnus-summary-limit articles))
10068       (gnus-summary-position-point))))
10069
10070 (defun gnus-summary-limit-to-author (from)
10071   "Limit the summary buffer to articles that have authors that match a regexp."
10072   (interactive "sRegexp: ")
10073   (gnus-summary-limit-to-subject from "from"))
10074
10075 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10076 (make-obsolete
10077  'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10078
10079 (defun gnus-summary-limit-to-unread (&optional all)
10080   "Limit the summary buffer to articles that are not marked as read.
10081 If ALL is non-nil, limit strictly to unread articles."
10082   (interactive "P")
10083   (if all
10084       (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
10085     (gnus-summary-limit-to-marks
10086      ;; Concat all the marks that say that an article is read and have
10087      ;; those removed.
10088      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
10089            gnus-killed-mark gnus-kill-file-mark
10090            gnus-low-score-mark gnus-expirable-mark
10091            gnus-canceled-mark gnus-catchup-mark)
10092      'reverse)))
10093
10094 (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10095 (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10096
10097 (defun gnus-summary-limit-to-marks (marks &optional reverse)
10098   "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
10099 If REVERSE, limit the summary buffer to articles that are not marked
10100 with MARKS.  MARKS can either be a string of marks or a list of marks.
10101 Returns how many articles were removed."
10102   (interactive "sMarks: ")
10103   (gnus-set-global-variables)
10104   (prog1
10105       (let ((data gnus-newsgroup-data)
10106             (marks (if (listp marks) marks
10107                      (append marks nil))) ; Transform to list.
10108             articles)
10109         (while data
10110           (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
10111                  (memq (gnus-data-mark (car data)) marks))
10112                (setq articles (cons (gnus-data-number (car data)) articles)))
10113           (setq data (cdr data)))
10114         (gnus-summary-limit articles))
10115     (gnus-summary-position-point)))
10116
10117 (defun gnus-summary-limit-to-score (&optional score)
10118   "Limit to articles with score at or above SCORE."
10119   (interactive "P")
10120   (gnus-set-global-variables)
10121   (setq score (if score
10122                   (prefix-numeric-value score)
10123                 (or gnus-summary-default-score 0)))
10124   (let ((data gnus-newsgroup-data)
10125         articles)
10126     (while data
10127       (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
10128                 score)
10129         (push (gnus-data-number (car data)) articles))
10130       (setq data (cdr data)))
10131     (prog1
10132         (gnus-summary-limit articles)
10133       (gnus-summary-position-point))))
10134
10135 (defun gnus-summary-limit-include-dormant ()
10136   "Display all the hidden articles that are marked as dormant."
10137   (interactive)
10138   (gnus-set-global-variables)
10139   (or gnus-newsgroup-dormant
10140       (error "There are no dormant articles in this group"))
10141   (prog1
10142       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
10143     (gnus-summary-position-point)))
10144
10145 (defun gnus-summary-limit-exclude-dormant ()
10146   "Hide all dormant articles."
10147   (interactive)
10148   (gnus-set-global-variables)
10149   (prog1
10150       (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
10151     (gnus-summary-position-point)))
10152
10153 (defun gnus-summary-limit-exclude-childless-dormant ()
10154   "Hide all dormant articles that have no children."
10155   (interactive)
10156   (gnus-set-global-variables)
10157   (let ((data gnus-newsgroup-data)
10158         articles)
10159     ;; Find all articles that are either not dormant or have
10160     ;; children.
10161     (while data
10162       (and (or (not (= (gnus-data-mark (car data)) gnus-dormant-mark))
10163                (gnus-article-parent-p (gnus-data-number (car data))))
10164            (setq articles (cons (gnus-data-number (car data))
10165                                 articles)))
10166       (setq data (cdr data)))
10167     ;; Do the limiting.
10168     (prog1
10169         (gnus-summary-limit articles)
10170       (gnus-summary-position-point))))
10171
10172 (defun gnus-summary-limit-mark-excluded-as-read (&optional all)
10173   "Mark all unread excluded articles as read.
10174 If ALL, mark even excluded ticked and dormants as read."
10175   (interactive "P")
10176   (let ((articles (gnus-sorted-complement
10177                    (sort
10178                     (mapcar (lambda (h) (mail-header-number h))
10179                             gnus-newsgroup-headers)
10180                     '<)
10181                    (sort gnus-newsgroup-limit '<)))
10182         article)
10183     (setq gnus-newsgroup-unreads nil)
10184     (if all
10185         (setq gnus-newsgroup-dormant nil
10186               gnus-newsgroup-marked nil
10187               gnus-newsgroup-reads
10188               (nconc
10189                (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
10190                gnus-newsgroup-reads))
10191       (while (setq article (pop articles))
10192         (unless (or (memq article gnus-newsgroup-dormant)
10193                     (memq article gnus-newsgroup-marked))
10194           (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
10195
10196
10197 (defun gnus-summary-limit (articles &optional pop)
10198   (if pop
10199       ;; We pop the previous limit off the stack and use that.
10200       (setq articles (car gnus-newsgroup-limits)
10201             gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
10202     ;; We use the new limit, so we push the old limit on the stack.
10203     (setq gnus-newsgroup-limits
10204           (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
10205   ;; Set the limit.
10206   (setq gnus-newsgroup-limit articles)
10207   (let ((total (length gnus-newsgroup-data))
10208         (data (gnus-data-find-list (gnus-summary-article-number)))
10209         found)
10210     ;; This will do all the work of generating the new summary buffer
10211     ;; according to the new limit.
10212     (gnus-summary-prepare)
10213     ;; Try to return to the article you were at, or on in the
10214     ;; neighborhood.
10215     (if data
10216         ;; We try to find some article after the current one.
10217         (while data
10218           (and (gnus-summary-goto-subject
10219                 (gnus-data-number (car data)) nil t)
10220                (setq data nil
10221                      found t))
10222           (setq data (cdr data))))
10223     (or found
10224         ;; If there is no data, that means that we were after the last
10225         ;; article.  The same goes when we can't find any articles
10226         ;; after the current one.
10227         (progn
10228           (goto-char (point-max))
10229           (gnus-summary-find-prev)))
10230     ;; We return how many articles were removed from the summary
10231     ;; buffer as a result of the new limit.
10232     (- total (length gnus-newsgroup-data))))
10233
10234 (defsubst gnus-cut-thread (thread)
10235   "Go forwards in the thread until we find an article that we want to display."
10236   (if (eq gnus-fetch-old-headers 'some)
10237       (while (and thread
10238                   (memq (mail-header-number (car thread)) 
10239                         gnus-newsgroup-ancient)
10240                   (<= (length (cdr thread)) 1))
10241         (setq thread (cadr thread)))
10242     (while (and thread
10243                 (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
10244                 (= (length (cdr thread)) 1))
10245       (setq thread (cadr thread))))
10246   thread)
10247
10248 (defun gnus-cut-threads (threads)
10249   "Cut off all uninteresting articles from the beginning of threads."
10250   (when (or (eq gnus-fetch-old-headers 'some)
10251             (eq gnus-build-sparse-threads 'some))
10252     (let ((th threads))
10253       (while th
10254         (setcar th (gnus-cut-thread (car th)))
10255         (setq th (cdr th)))))
10256   threads)
10257
10258 (defun gnus-summary-initial-limit (&optional show-if-empty)
10259   "Figure out what the initial limit is supposed to be on group entry.
10260 This entails weeding out unwanted dormants, low-scored articles,
10261 fetch-old-headers verbiage, and so on."
10262   ;; Most groups have nothing to remove.
10263   (if (or gnus-inhibit-limiting
10264           (and (null gnus-newsgroup-dormant)
10265                (not (eq gnus-fetch-old-headers 'some))
10266                (null gnus-summary-expunge-below)
10267                (not (eq gnus-build-sparse-threads 'some))
10268                (null gnus-thread-expunge-below)))
10269       () ; Do nothing.
10270     (push gnus-newsgroup-limit gnus-newsgroup-limits)
10271     (setq gnus-newsgroup-limit nil)
10272     (mapatoms
10273      (lambda (node)
10274        (unless (car (symbol-value node))
10275          ;; These threads have no parents -- they are roots.
10276          (let ((nodes (cdr (symbol-value node)))
10277                thread)
10278            (while nodes
10279              (if (and gnus-thread-expunge-below
10280                       (< (gnus-thread-total-score (car nodes))
10281                          gnus-thread-expunge-below))
10282                  (gnus-expunge-thread (pop nodes))
10283                (setq thread (pop nodes))
10284                ;(when (or (eq gnus-fetch-old-headers 'some)
10285                 ;        (eq gnus-build-sparse-threads 'some))
10286                 ; (setq thread (gnus-cut-thread thread)))
10287                (gnus-summary-limit-children thread))))))
10288      gnus-newsgroup-dependencies)
10289     ;; If this limitation resulted in an empty group, we might
10290     ;; pop the previous limit and use it instead.
10291     (when (and (not gnus-newsgroup-limit)
10292                show-if-empty)
10293       (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
10294     gnus-newsgroup-limit))
10295
10296 (defun gnus-summary-limit-children (thread)
10297   "Return 1 if this subthread is visible and 0 if it is not."
10298   ;; First we get the number of visible children to this thread.  This
10299   ;; is done by recursing down the thread using this function, so this
10300   ;; will really go down to a leaf article first, before slowly
10301   ;; working its way up towards the root.
10302   (when thread
10303     (let ((children
10304            (if (cdr thread)
10305                (apply '+ (mapcar 'gnus-summary-limit-children
10306                                  (cdr thread)))
10307              0))
10308           (number (mail-header-number (car thread)))
10309           score)
10310       (if (or
10311            ;; If this article is dormant and has absolutely no visible
10312            ;; children, then this article isn't visible.
10313            (and (memq number gnus-newsgroup-dormant)
10314                 (= children 0))
10315            ;; If this is a "fetch-old-headered" and there is only one
10316            ;; visible child (or less), then we don't want this article.
10317            (and (eq gnus-fetch-old-headers 'some)
10318                 (memq number gnus-newsgroup-ancient)
10319                 (zerop children))
10320            ;; If this is a sparsely inserted article with no children,
10321            ;; we don't want it.
10322            (and gnus-build-sparse-threads
10323                 (memq number gnus-newsgroup-sparse)
10324                 (zerop children))
10325            ;; If we use expunging, and this article is really
10326            ;; low-scored, then we don't want this article.
10327            (when (and gnus-summary-expunge-below
10328                       (< (setq score
10329                                (or (cdr (assq number gnus-newsgroup-scored))
10330                                    gnus-summary-default-score))
10331                          gnus-summary-expunge-below))
10332              ;; We increase the expunge-tally here, but that has
10333              ;; nothing to do with the limits, really.
10334              (incf gnus-newsgroup-expunged-tally)
10335              ;; We also mark as read here, if that's wanted.
10336              (when (and gnus-summary-mark-below
10337                         (< score gnus-summary-mark-below))
10338                (setq gnus-newsgroup-unreads
10339                      (delq number gnus-newsgroup-unreads))
10340                (if gnus-newsgroup-auto-expire
10341                    (push number gnus-newsgroup-expirable)
10342                  (push (cons number gnus-low-score-mark)
10343                        gnus-newsgroup-reads)))
10344              t))
10345           ;; Nope, invisible article.
10346           0
10347         ;; Ok, this article is to be visible, so we add it to the limit
10348         ;; and return 1.
10349         (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
10350         1))))
10351
10352 (defun gnus-expunge-thread (thread)
10353   "Mark all articles in THREAD as read."
10354   (let* ((number (mail-header-number (car thread))))
10355     (incf gnus-newsgroup-expunged-tally)
10356     ;; We also mark as read here, if that's wanted.
10357     (setq gnus-newsgroup-unreads
10358           (delq number gnus-newsgroup-unreads))
10359     (if gnus-newsgroup-auto-expire
10360         (push number gnus-newsgroup-expirable)
10361       (push (cons number gnus-low-score-mark)
10362             gnus-newsgroup-reads)))
10363   ;; Go recursively through all subthreads.
10364   (mapcar 'gnus-expunge-thread (cdr thread)))
10365
10366 ;; Summary article oriented commands
10367
10368 (defun gnus-summary-refer-parent-article (n)
10369   "Refer parent article N times.
10370 The difference between N and the number of articles fetched is returned."
10371   (interactive "p")
10372   (gnus-set-global-variables)
10373   (while
10374       (and
10375        (> n 0)
10376        (let* ((header (gnus-summary-article-header))
10377               (ref
10378                ;; If we try to find the parent of the currently
10379                ;; displayed article, then we take a look at the actual
10380                ;; References header, since this is slightly more
10381                ;; reliable than the References field we got from the
10382                ;; server.
10383                (if (and (eq (mail-header-number header)
10384                             (cdr gnus-article-current))
10385                         (equal gnus-newsgroup-name
10386                                (car gnus-article-current)))
10387                    (save-excursion
10388                      (set-buffer gnus-original-article-buffer)
10389                      (nnheader-narrow-to-headers)
10390                      (prog1
10391                          (mail-fetch-field "references")
10392                        (widen)))
10393                  ;; It's not the current article, so we take a bet on
10394                  ;; the value we got from the server.
10395                  (mail-header-references header))))
10396          (if ref
10397              (or (gnus-summary-refer-article (gnus-parent-id ref))
10398                  (gnus-message 1 "Couldn't find parent"))
10399            (gnus-message 1 "No references in article %d"
10400                          (gnus-summary-article-number))
10401            nil)))
10402     (setq n (1- n)))
10403   (gnus-summary-position-point)
10404   n)
10405
10406 (defun gnus-summary-refer-references ()
10407   "Fetch all articles mentioned in the References header.
10408 Return how many articles were fetched."
10409   (interactive)
10410   (gnus-set-global-variables)
10411   (let ((ref (mail-header-references (gnus-summary-article-header)))
10412         (current (gnus-summary-article-number))
10413         (n 0))
10414     ;; For each Message-ID in the References header...
10415     (while (string-match "<[^>]*>" ref)
10416       (incf n)
10417       ;; ... fetch that article.
10418       (gnus-summary-refer-article
10419        (prog1 (match-string 0 ref)
10420          (setq ref (substring ref (match-end 0))))))
10421     (gnus-summary-goto-subject current)
10422     (gnus-summary-position-point)
10423     n))
10424
10425 (defun gnus-summary-refer-article (message-id)
10426   "Fetch an article specified by MESSAGE-ID."
10427   (interactive "sMessage-ID: ")
10428   (when (and (stringp message-id)
10429              (not (zerop (length message-id))))
10430     ;; Construct the correct Message-ID if necessary.
10431     ;; Suggested by tale@pawl.rpi.edu.
10432     (unless (string-match "^<" message-id)
10433       (setq message-id (concat "<" message-id)))
10434     (unless (string-match ">$" message-id)
10435       (setq message-id (concat message-id ">")))
10436     (let ((header (car (gnus-gethash (downcase message-id)
10437                                      gnus-newsgroup-dependencies))))
10438       (if header
10439           ;; The article is present in the buffer, to we just go to it.
10440           (gnus-summary-goto-article (mail-header-number header) nil t)
10441         ;; We fetch the article
10442         (let ((gnus-override-method gnus-refer-article-method)
10443               number)
10444           ;; Start the special refer-article method, if necessary.
10445           (when gnus-refer-article-method
10446             (gnus-check-server gnus-refer-article-method))
10447           ;; Fetch the header, and display the article.
10448           (when (setq number (gnus-summary-insert-subject message-id))
10449             (gnus-summary-select-article nil nil nil number)))))))
10450
10451 (defun gnus-summary-enter-digest-group (&optional force)
10452   "Enter a digest group based on the current article."
10453   (interactive "P")
10454   (gnus-set-global-variables)
10455   (gnus-summary-select-article)
10456   (let ((name (format "%s-%d"
10457                       (gnus-group-prefixed-name
10458                        gnus-newsgroup-name (list 'nndoc ""))
10459                       gnus-current-article))
10460         (ogroup gnus-newsgroup-name)
10461         (buf (current-buffer)))
10462     (save-excursion
10463       (set-buffer gnus-original-article-buffer)
10464       (goto-char (point-min))
10465       (search-forward "\n\n" nil t)
10466       (narrow-to-region (point) (point-max)))
10467     (unwind-protect
10468         (if (gnus-group-read-ephemeral-group
10469              name `(nndoc ,name (nndoc-address
10470                                  ,(get-buffer gnus-original-article-buffer))
10471                           (nndoc-article-type ,(if force 'digest 'guess))) t)
10472             ;; Make all postings to this group go to the parent group.
10473             (setcdr (nthcdr 4 (gnus-get-info name))
10474                     (list (list (cons 'to-group ogroup))))
10475           ;; Couldn't select this doc group.
10476           (switch-to-buffer buf)
10477           (gnus-set-global-variables)
10478           (gnus-configure-windows 'summary)
10479           (gnus-message 3 "Article couldn't be entered?"))
10480       (save-excursion
10481         (set-buffer gnus-original-article-buffer)
10482         (widen)))))
10483
10484 (defun gnus-summary-isearch-article (&optional regexp-p)
10485   "Do incremental search forward on the current article.
10486 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
10487   (interactive "P")
10488   (gnus-set-global-variables)
10489   (gnus-summary-select-article)
10490   (gnus-configure-windows 'article)
10491   (gnus-eval-in-buffer-window
10492    gnus-article-buffer
10493    (goto-char (point-min))
10494    (isearch-forward regexp-p)))
10495
10496 (defun gnus-summary-search-article-forward (regexp &optional backward)
10497   "Search for an article containing REGEXP forward.
10498 If BACKWARD, search backward instead."
10499   (interactive
10500    (list (read-string
10501           (format "Search article %s (regexp%s): "
10502                   (if current-prefix-arg "backward" "forward")
10503                   (if gnus-last-search-regexp
10504                       (concat ", default " gnus-last-search-regexp)
10505                     "")))
10506          current-prefix-arg))
10507   (gnus-set-global-variables)
10508   (if (string-equal regexp "")
10509       (setq regexp (or gnus-last-search-regexp ""))
10510     (setq gnus-last-search-regexp regexp))
10511   (if (gnus-summary-search-article regexp backward)
10512       (gnus-article-set-window-start
10513        (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks)))
10514     (error "Search failed: \"%s\"" regexp)))
10515
10516 (defun gnus-summary-search-article-backward (regexp)
10517   "Search for an article containing REGEXP backward."
10518   (interactive
10519    (list (read-string
10520           (format "Search article backward (regexp%s): "
10521                   (if gnus-last-search-regexp
10522                       (concat ", default " gnus-last-search-regexp)
10523                     "")))))
10524   (gnus-summary-search-article-forward regexp 'backward))
10525
10526 (defun gnus-summary-search-article (regexp &optional backward)
10527   "Search for an article containing REGEXP.
10528 Optional argument BACKWARD means do search for backward.
10529 gnus-select-article-hook is not called during the search."
10530   (let ((gnus-select-article-hook nil)  ;Disable hook.
10531         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
10532         (re-search
10533          (if backward
10534              (function re-search-backward) (function re-search-forward)))
10535         (found nil)
10536         (last nil))
10537     ;; Hidden thread subtrees must be searched for ,too.
10538     (gnus-summary-show-all-threads)
10539     ;; First of all, search current article.
10540     ;; We don't want to read article again from NNTP server nor reset
10541     ;; current point.
10542     (gnus-summary-select-article)
10543     (gnus-message 9 "Searching article: %d..." gnus-current-article)
10544     (setq last gnus-current-article)
10545     (gnus-eval-in-buffer-window
10546      gnus-article-buffer
10547      (save-restriction
10548        (widen)
10549        ;; Begin search from current point.
10550        (setq found (funcall re-search regexp nil t))))
10551     ;; Then search next articles.
10552     (while (and (not found)
10553                 (gnus-summary-display-article
10554                  (if backward (gnus-summary-find-prev)
10555                    (gnus-summary-find-next))))
10556       (gnus-message 9 "Searching article: %d..." gnus-current-article)
10557       (gnus-eval-in-buffer-window
10558        gnus-article-buffer
10559        (save-restriction
10560          (widen)
10561          (goto-char (if backward (point-max) (point-min)))
10562          (setq found (funcall re-search regexp nil t)))))
10563     (message "")
10564     ;; Adjust article pointer.
10565     (or (eq last gnus-current-article)
10566         (setq gnus-last-article last))
10567     ;; Return T if found such article.
10568     found))
10569
10570 (defun gnus-summary-find-matching (header regexp &optional backward unread
10571                                           not-case-fold)
10572   "Return a list of all articles that match REGEXP on HEADER.
10573 The search stars on the current article and goes forwards unless
10574 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
10575 If UNREAD is non-nil, only unread articles will
10576 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
10577 in the comparisons."
10578   (let ((data (if (eq backward 'all) gnus-newsgroup-data
10579                 (gnus-data-find-list
10580                  (gnus-summary-article-number) (gnus-data-list backward))))
10581         (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
10582         (case-fold-search (not not-case-fold))
10583         articles d)
10584     (or (fboundp func) (error "%s is not a valid header" header))
10585     (while data
10586       (setq d (car data))
10587       (and (or (not unread)             ; We want all articles...
10588                (gnus-data-unread-p d))  ; Or just unreads.
10589            (vectorp (gnus-data-header d)) ; It's not a pseudo.
10590            (string-match regexp (funcall func (gnus-data-header d))) ; Match.
10591            (setq articles (cons (gnus-data-number d) articles))) ; Success!
10592       (setq data (cdr data)))
10593     (nreverse articles)))
10594
10595 (defun gnus-summary-execute-command (header regexp command &optional backward)
10596   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
10597 If HEADER is an empty string (or nil), the match is done on the entire
10598 article.  If BACKWARD (the prefix) is non-nil, search backward instead."
10599   (interactive
10600    (list (let ((completion-ignore-case t))
10601            (completing-read
10602             "Header name: "
10603             (mapcar (lambda (string) (list string))
10604                     '("Number" "Subject" "From" "Lines" "Date"
10605                       "Message-ID" "Xref" "References"))
10606             nil 'require-match))
10607          (read-string "Regexp: ")
10608          (read-key-sequence "Command: ")
10609          current-prefix-arg))
10610   (gnus-set-global-variables)
10611   ;; Hidden thread subtrees must be searched as well.
10612   (gnus-summary-show-all-threads)
10613   ;; We don't want to change current point nor window configuration.
10614   (save-excursion
10615     (save-window-excursion
10616       (gnus-message 6 "Executing %s..." (key-description command))
10617       ;; We'd like to execute COMMAND interactively so as to give arguments.
10618       (gnus-execute header regexp
10619                     `(lambda () (call-interactively ',(key-binding command)))
10620                     backward)
10621       (gnus-message 6 "Executing %s...done" (key-description command)))))
10622
10623 (defun gnus-summary-beginning-of-article ()
10624   "Scroll the article back to the beginning."
10625   (interactive)
10626   (gnus-set-global-variables)
10627   (gnus-summary-select-article)
10628   (gnus-configure-windows 'article)
10629   (gnus-eval-in-buffer-window
10630    gnus-article-buffer
10631    (widen)
10632    (goto-char (point-min))
10633    (and gnus-break-pages (gnus-narrow-to-page))))
10634
10635 (defun gnus-summary-end-of-article ()
10636   "Scroll to the end of the article."
10637   (interactive)
10638   (gnus-set-global-variables)
10639   (gnus-summary-select-article)
10640   (gnus-configure-windows 'article)
10641   (gnus-eval-in-buffer-window
10642    gnus-article-buffer
10643    (widen)
10644    (goto-char (point-max))
10645    (recenter -3)
10646    (and gnus-break-pages (gnus-narrow-to-page))))
10647
10648 (defun gnus-summary-show-article (&optional arg)
10649   "Force re-fetching of the current article.
10650 If ARG (the prefix) is non-nil, show the raw article without any
10651 article massaging functions being run."
10652   (interactive "P")
10653   (gnus-set-global-variables)
10654   (if (not arg)
10655       ;; Select the article the normal way.
10656       (gnus-summary-select-article nil 'force)
10657     ;; Bind the article treatment functions to nil.
10658     (let ((gnus-have-all-headers t)
10659           gnus-article-display-hook
10660           gnus-article-prepare-hook
10661           gnus-visual)
10662       (gnus-summary-select-article nil 'force)))
10663 ;  (gnus-configure-windows 'article)
10664   (gnus-summary-position-point))
10665
10666 (defun gnus-summary-verbose-headers (&optional arg)
10667   "Toggle permanent full header display.
10668 If ARG is a positive number, turn header display on.
10669 If ARG is a negative number, turn header display off."
10670   (interactive "P")
10671   (gnus-set-global-variables)
10672   (gnus-summary-toggle-header arg)
10673   (setq gnus-show-all-headers
10674         (cond ((or (not (numberp arg))
10675                    (zerop arg))
10676                (not gnus-show-all-headers))
10677               ((natnump arg)
10678                t))))
10679
10680 (defun gnus-summary-toggle-header (&optional arg)
10681   "Show the headers if they are hidden, or hide them if they are shown.
10682 If ARG is a positive number, show the entire header.
10683 If ARG is a negative number, hide the unwanted header lines."
10684   (interactive "P")
10685   (gnus-set-global-variables)
10686   (save-excursion
10687     (set-buffer gnus-article-buffer)
10688     (let* ((buffer-read-only nil)
10689            (inhibit-point-motion-hooks t)
10690            (hidden (text-property-any
10691                     (goto-char (point-min)) (search-forward "\n\n")
10692                     'invisible t))
10693            e)
10694       (goto-char (point-min))
10695       (when (search-forward "\n\n" nil t)
10696         (delete-region (point-min) (1- (point))))
10697       (goto-char (point-min))
10698       (save-excursion
10699         (set-buffer gnus-original-article-buffer)
10700         (goto-char (point-min))
10701         (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
10702       (insert-buffer-substring gnus-original-article-buffer 1 e)
10703       (let ((gnus-inhibit-hiding t))
10704         (run-hooks 'gnus-article-display-hook))
10705       (if (or (not hidden) (and (numberp arg) (< arg 0)))
10706           (gnus-article-hide-headers)))))
10707
10708 (defun gnus-summary-show-all-headers ()
10709   "Make all header lines visible."
10710   (interactive)
10711   (gnus-set-global-variables)
10712   (gnus-article-show-all-headers))
10713
10714 (defun gnus-summary-toggle-mime (&optional arg)
10715   "Toggle MIME processing.
10716 If ARG is a positive number, turn MIME processing on."
10717   (interactive "P")
10718   (gnus-set-global-variables)
10719   (setq gnus-show-mime
10720         (if (null arg) (not gnus-show-mime)
10721           (> (prefix-numeric-value arg) 0)))
10722   (gnus-summary-select-article t 'force))
10723
10724 (defun gnus-summary-caesar-message (&optional arg)
10725   "Caesar rotate the current article by 13.
10726 The numerical prefix specifies how manu places to rotate each letter
10727 forward."
10728   (interactive "P")
10729   (gnus-set-global-variables)
10730   (gnus-summary-select-article)
10731   (let ((mail-header-separator ""))
10732     (gnus-eval-in-buffer-window
10733      gnus-article-buffer
10734      (save-restriction
10735        (widen)
10736        (let ((start (window-start)))
10737          (news-caesar-buffer-body arg)
10738          (set-window-start (get-buffer-window (current-buffer)) start))))))
10739
10740 (defun gnus-summary-stop-page-breaking ()
10741   "Stop page breaking in the current article."
10742   (interactive)
10743   (gnus-set-global-variables)
10744   (gnus-summary-select-article)
10745   (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
10746
10747 (defun gnus-summary-move-article (&optional n to-newsgroup select-method action)
10748   "Move the current article to a different newsgroup.
10749 If N is a positive number, move the N next articles.
10750 If N is a negative number, move the N previous articles.
10751 If N is nil and any articles have been marked with the process mark,
10752 move those articles instead.
10753 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
10754 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
10755 re-spool using this method.
10756
10757 For this function to work, both the current newsgroup and the
10758 newsgroup that you want to move to have to support the `request-move'
10759 and `request-accept' functions."
10760   (interactive (list current-prefix-arg nil nil 'move))
10761   (gnus-set-global-variables)
10762   ;; Check whether the source group supports the required functions.
10763   (cond ((and (eq action 'move)
10764               (not (gnus-check-backend-function
10765                     'request-move-article gnus-newsgroup-name)))
10766          (error "The current group does not support article moving"))
10767         ((and (eq action 'crosspost)
10768               (not (gnus-check-backend-function
10769                     'request-replace-article gnus-newsgroup-name)))
10770          (error "The current group does not support article editing")))
10771   (let ((articles (gnus-summary-work-articles n))
10772         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
10773         (names '((move "move" "Moving")
10774                  (copy "copy" "Copying")
10775                  (crosspost "crosspost" "Crossposting")))
10776         (copy-buf (save-excursion
10777                     (nnheader-set-temp-buffer " *copy article*")))
10778         art-group to-method new-xref article)
10779     (unless (assq action names)
10780       (error "Unknown action %s" action))
10781     ;; Read the newsgroup name.
10782     (when (and (not to-newsgroup)
10783                (not select-method))
10784       (setq to-newsgroup
10785             (gnus-read-move-group-name
10786              (cadr (assq action names))
10787              gnus-current-move-group articles prefix))
10788       (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
10789     (setq to-method (if select-method (list select-method "")
10790                       (gnus-find-method-for-group to-newsgroup)))
10791     ;; Check the method we are to move this article to...
10792     (or (gnus-check-backend-function 'request-accept-article (car to-method))
10793         (error "%s does not support article copying" (car to-method)))
10794     (or (gnus-check-server to-method)
10795         (error "Can't open server %s" (car to-method)))
10796     (gnus-message 6 "%s to %s: %s..."
10797                   (caddr (assq action names))
10798                   (or select-method to-newsgroup) articles)
10799     (while articles
10800       (setq article (pop articles))
10801       (setq
10802        art-group
10803        (cond
10804         ;; Move the article.
10805         ((eq action 'move)
10806          (gnus-request-move-article
10807           article               ; Article to move
10808           gnus-newsgroup-name   ; From newsgrouo
10809           (nth 1 (gnus-find-method-for-group
10810                   gnus-newsgroup-name)) ; Server
10811           (list 'gnus-request-accept-article
10812                 (if select-method
10813                     (list 'quote select-method)
10814                   to-newsgroup)
10815                 (not articles)) ; Accept form
10816           (not articles)))      ; Only save nov last time
10817         ;; Copy the article.
10818         ((eq action 'copy)
10819          (save-excursion
10820            (set-buffer copy-buf)
10821            (gnus-request-article-this-buffer article gnus-newsgroup-name)
10822            (gnus-request-accept-article
10823             (if select-method select-method to-newsgroup)
10824             (not articles))))
10825         ;; Crosspost the article.
10826         ((eq action 'crosspost)
10827          (let ((xref (mail-header-xref (gnus-summary-article-header article))))
10828            (setq new-xref (concat gnus-newsgroup-name ":" article))
10829            (if (and xref (not (string= xref "")))
10830                (progn
10831                  (when (string-match "^Xref: " xref)
10832                    (setq xref (substring xref (match-end 0))))
10833                  (setq new-xref (concat xref " " new-xref)))
10834              (setq new-xref (concat (system-name) " " new-xref)))
10835            (save-excursion
10836              (set-buffer copy-buf)
10837              (gnus-request-article-this-buffer article gnus-newsgroup-name)
10838              (nnheader-replace-header "xref" new-xref)
10839              (gnus-request-accept-article
10840               (if select-method select-method to-newsgroup)
10841               (not articles)))))))
10842       (if (not art-group)
10843           (gnus-message 1 "Couldn't %s article %s"
10844                         (cadr (assq action names)) article)
10845         (let* ((entry
10846                 (or
10847                  (gnus-gethash (car art-group) gnus-newsrc-hashtb)
10848                  (gnus-gethash
10849                   (gnus-group-prefixed-name
10850                    (car art-group)
10851                    (if select-method (list select-method "")
10852                      (gnus-find-method-for-group to-newsgroup)))
10853                   gnus-newsrc-hashtb)))
10854                (info (nth 2 entry)))
10855           ;; Update the group that has been moved to.
10856           (when (and info
10857                      (memq action '(move copy)))
10858             (unless (memq article gnus-newsgroup-unreads)
10859               (gnus-info-set-read
10860                info (gnus-add-to-range (gnus-info-read info)
10861                                        (list (cdr art-group)))))
10862
10863             ;; Copy any marks over to the new group.
10864             (let ((marks gnus-article-mark-lists)
10865                   (to-article (cdr art-group)))
10866
10867               ;; See whether the article is to be put in the cache.
10868               (when gnus-use-cache
10869                 (gnus-cache-possibly-enter-article
10870                  (gnus-info-group info) to-article
10871                  (let ((header (copy-sequence
10872                                 (gnus-summary-article-header article))))
10873                    (mail-header-set-number header to-article)
10874                    header)
10875                  (memq article gnus-newsgroup-marked)
10876                  (memq article gnus-newsgroup-dormant)
10877                  (memq article gnus-newsgroup-unreads)))
10878
10879                 (while marks
10880                   (when (memq article (symbol-value
10881                                        (intern (format "gnus-newsgroup-%s"
10882                                                        (caar marks)))))
10883                     (gnus-add-marked-articles
10884                      (gnus-info-group info) (cadr marks)
10885                      (list to-article) info))
10886                   (setq marks (cdr marks)))))
10887
10888           ;; Update the Xref header in this article to point to
10889           ;; the new crossposted article we have just created.
10890           (when (eq action 'crosspost)
10891             (save-excursion
10892               (set-buffer copy-buf)
10893               (gnus-request-article-this-buffer article gnus-newsgroup-name)
10894               (nnheader-replace-header
10895                "xref" (concat new-xref " " (gnus-group-prefixed-name
10896                                             (car art-group) to-method)
10897                               ":" (cdr art-group)))
10898               (gnus-request-replace-article
10899                article gnus-newsgroup-name (current-buffer)))))
10900
10901         (gnus-summary-goto-subject article)
10902         (gnus-summary-mark-article article gnus-canceled-mark))
10903       (gnus-summary-remove-process-mark article))
10904     (gnus-kill-buffer copy-buf)
10905     (gnus-set-mode-line 'summary)))
10906
10907 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
10908   "Move the current article to a different newsgroup.
10909 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
10910 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
10911 re-spool using this method."
10912   (interactive "P")
10913   (gnus-summary-move-article n nil nil 'copy))
10914
10915 (defun gnus-summary-crosspost-article (&optional n)
10916   "Crosspost the current article to some other group."
10917   (interactive "P")
10918   (gnus-summary-move-article n nil nil 'crosspost))
10919
10920 (defun gnus-summary-respool-article (&optional n respool-method)
10921   "Respool the current article.
10922 The article will be squeezed through the mail spooling process again,
10923 which means that it will be put in some mail newsgroup or other
10924 depending on `nnmail-split-methods'.
10925 If N is a positive number, respool the N next articles.
10926 If N is a negative number, respool the N previous articles.
10927 If N is nil and any articles have been marked with the process mark,
10928 respool those articles instead.
10929
10930 Respooling can be done both from mail groups and \"real\" newsgroups.
10931 In the former case, the articles in question will be moved from the
10932 current group into whatever groups they are destined to.  In the
10933 latter case, they will be copied into the relevant groups."
10934   (interactive "P")
10935   (gnus-set-global-variables)
10936   (let ((respool-methods (gnus-methods-using 'respool))
10937         (methname
10938          (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name)))))
10939     (or respool-method
10940         (setq respool-method
10941               (completing-read
10942                "What method do you want to use when respooling? "
10943                respool-methods nil t methname)))
10944     (or (string= respool-method "")
10945         (if (assoc (symbol-name
10946                     (car (gnus-find-method-for-group gnus-newsgroup-name)))
10947                    respool-methods)
10948             (gnus-summary-move-article n nil (intern respool-method))
10949           (gnus-summary-copy-article n nil (intern respool-method))))))
10950
10951 (defun gnus-summary-import-article (file)
10952   "Import a random file into a mail newsgroup."
10953   (interactive "fImport file: ")
10954   (gnus-set-global-variables)
10955   (let ((group gnus-newsgroup-name)
10956         (now (current-time))
10957         atts lines)
10958     (or (gnus-check-backend-function 'request-accept-article group)
10959         (error "%s does not support article importing" group))
10960     (or (file-readable-p file)
10961         (not (file-regular-p file))
10962         (error "Can't read %s" file))
10963     (save-excursion
10964       (set-buffer (get-buffer-create " *import file*"))
10965       (buffer-disable-undo (current-buffer))
10966       (erase-buffer)
10967       (insert-file-contents file)
10968       (goto-char (point-min))
10969       (unless (nnheader-article-p)
10970         ;; This doesn't look like an article, so we fudge some headers.
10971         (setq atts (file-attributes file)
10972               lines (count-lines (point-min) (point-max)))
10973         (insert "From: " (read-string "From: ") "\n"
10974                 "Subject: " (read-string "Subject: ") "\n"
10975                 "Date: " (timezone-make-date-arpa-standard
10976                           (current-time-string (nth 5 atts))
10977                           (current-time-zone now)
10978                           (current-time-zone now)) "\n"
10979                 "Message-ID: " (gnus-inews-message-id) "\n"
10980                 "Lines: " (int-to-string lines) "\n"
10981                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
10982       (gnus-request-accept-article group t)
10983       (kill-buffer (current-buffer)))))
10984
10985 (defun gnus-summary-expire-articles ()
10986   "Expire all articles that are marked as expirable in the current group."
10987   (interactive)
10988   (gnus-set-global-variables)
10989   (when (gnus-check-backend-function
10990          'request-expire-articles gnus-newsgroup-name)
10991     ;; This backend supports expiry.
10992     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
10993            (expirable (if total
10994                           (gnus-list-of-read-articles gnus-newsgroup-name)
10995                         (setq gnus-newsgroup-expirable
10996                               (sort gnus-newsgroup-expirable '<))))
10997            (expiry-wait (gnus-group-get-parameter
10998                          gnus-newsgroup-name 'expiry-wait))
10999            es)
11000       (when expirable
11001         ;; There are expirable articles in this group, so we run them
11002         ;; through the expiry process.
11003         (gnus-message 6 "Expiring articles...")
11004         ;; The list of articles that weren't expired is returned.
11005         (if expiry-wait
11006             (let ((nnmail-expiry-wait-function nil)
11007                   (nnmail-expiry-wait expiry-wait))
11008               (setq es (gnus-request-expire-articles
11009                         expirable gnus-newsgroup-name)))
11010           (setq es (gnus-request-expire-articles
11011                     expirable gnus-newsgroup-name)))
11012         (or total (setq gnus-newsgroup-expirable es))
11013         ;; We go through the old list of expirable, and mark all
11014         ;; really expired articles as nonexistent.
11015         (unless (eq es expirable)       ;If nothing was expired, we don't mark.
11016           (let ((gnus-use-cache nil))
11017             (while expirable
11018               (unless (memq (car expirable) es)
11019                 (when (gnus-data-find (car expirable))
11020                   (gnus-summary-mark-article
11021                    (car expirable) gnus-canceled-mark)))
11022               (setq expirable (cdr expirable)))))
11023         (gnus-message 6 "Expiring articles...done")))))
11024
11025 (defun gnus-summary-expire-articles-now ()
11026   "Expunge all expirable articles in the current group.
11027 This means that *all* articles that are marked as expirable will be
11028 deleted forever, right now."
11029   (interactive)
11030   (gnus-set-global-variables)
11031   (or gnus-expert-user
11032       (gnus-y-or-n-p
11033        "Are you really, really, really sure you want to expunge? ")
11034       (error "Phew!"))
11035   (let ((nnmail-expiry-wait 'immediate)
11036         (nnmail-expiry-wait-function nil))
11037     (gnus-summary-expire-articles)))
11038
11039 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
11040 (defun gnus-summary-delete-article (&optional n)
11041   "Delete the N next (mail) articles.
11042 This command actually deletes articles.  This is not a marking
11043 command.  The article will disappear forever from your life, never to
11044 return.
11045 If N is negative, delete backwards.
11046 If N is nil and articles have been marked with the process mark,
11047 delete these instead."
11048   (interactive "P")
11049   (gnus-set-global-variables)
11050   (or (gnus-check-backend-function 'request-expire-articles
11051                                    gnus-newsgroup-name)
11052       (error "The current newsgroup does not support article deletion."))
11053   ;; Compute the list of articles to delete.
11054   (let ((articles (gnus-summary-work-articles n))
11055         not-deleted)
11056     (if (and gnus-novice-user
11057              (not (gnus-y-or-n-p
11058                    (format "Do you really want to delete %s forever? "
11059                            (if (> (length articles) 1) "these articles"
11060                              "this article")))))
11061         ()
11062       ;; Delete the articles.
11063       (setq not-deleted (gnus-request-expire-articles
11064                          articles gnus-newsgroup-name 'force))
11065       (while articles
11066         (gnus-summary-remove-process-mark (car articles))
11067         ;; The backend might not have been able to delete the article
11068         ;; after all.
11069         (or (memq (car articles) not-deleted)
11070             (gnus-summary-mark-article (car articles) gnus-canceled-mark))
11071         (setq articles (cdr articles))))
11072     (gnus-summary-position-point)
11073     (gnus-set-mode-line 'summary)
11074     not-deleted))
11075
11076 (defun gnus-summary-edit-article (&optional force)
11077   "Enter into a buffer and edit the current article.
11078 This will have permanent effect only in mail groups.
11079 If FORCE is non-nil, allow editing of articles even in read-only
11080 groups."
11081   (interactive "P")
11082   (gnus-set-global-variables)
11083   (when (and (not force)
11084              (gnus-group-read-only-p))
11085     (error "The current newsgroup does not support article editing."))
11086   (gnus-summary-select-article t nil t)
11087   (gnus-configure-windows 'article)
11088   (select-window (get-buffer-window gnus-article-buffer))
11089   (gnus-message 6 "C-c C-c to end edits")
11090   (setq buffer-read-only nil)
11091   (text-mode)
11092   (use-local-map (copy-keymap (current-local-map)))
11093   (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
11094   (buffer-enable-undo)
11095   (widen)
11096   (goto-char (point-min))
11097   (search-forward "\n\n" nil t))
11098
11099 (defun gnus-summary-edit-article-done ()
11100   "Make edits to the current article permanent."
11101   (interactive)
11102   (if (gnus-group-read-only-p)
11103       (progn
11104         (gnus-summary-edit-article-postpone)
11105         (gnus-message
11106          1 "The current newsgroup does not support article editing.")
11107         (ding))
11108     (let ((buf (buffer-substring-no-properties (point-min) (point-max))))
11109       (erase-buffer)
11110       (insert buf)
11111       (if (not (gnus-request-replace-article
11112                 (cdr gnus-article-current) (car gnus-article-current)
11113                 (current-buffer)))
11114           (error "Couldn't replace article.")
11115         (gnus-article-mode)
11116         (use-local-map gnus-article-mode-map)
11117         (setq buffer-read-only t)
11118         (buffer-disable-undo (current-buffer))
11119         (gnus-configure-windows 'summary)
11120         (gnus-summary-update-article (cdr gnus-article-current)))
11121       (run-hooks 'gnus-article-display-hook)
11122       (and (gnus-visual-p 'summary-highlight 'highlight)
11123            (run-hooks 'gnus-visual-mark-article-hook)))))
11124
11125 (defun gnus-summary-edit-article-postpone ()
11126   "Postpone changes to the current article."
11127   (interactive)
11128   (gnus-article-mode)
11129   (use-local-map gnus-article-mode-map)
11130   (setq buffer-read-only t)
11131   (buffer-disable-undo (current-buffer))
11132   (gnus-configure-windows 'summary)
11133   (and (gnus-visual-p 'summary-highlight 'highlight)
11134        (run-hooks 'gnus-visual-mark-article-hook)))
11135
11136 (defun gnus-summary-respool-query ()
11137   "Query where the respool algorithm would put this article."
11138   (interactive)
11139   (gnus-set-global-variables)
11140   (gnus-summary-select-article)
11141   (save-excursion
11142     (set-buffer gnus-article-buffer)
11143     (save-restriction
11144       (goto-char (point-min))
11145       (search-forward "\n\n")
11146       (narrow-to-region (point-min) (point))
11147       (pp-eval-expression
11148        (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
11149
11150 ;; Summary score commands.
11151
11152 ;; Suggested by boubaker@cenatls.cena.dgac.fr.
11153
11154 (defun gnus-summary-raise-score (n)
11155   "Raise the score of the current article by N."
11156   (interactive "p")
11157   (gnus-set-global-variables)
11158   (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
11159
11160 (defun gnus-summary-set-score (n)
11161   "Set the score of the current article to N."
11162   (interactive "p")
11163   (gnus-set-global-variables)
11164   (save-excursion
11165     (gnus-summary-show-thread)
11166     (let ((buffer-read-only nil))
11167       ;; Set score.
11168       (gnus-summary-update-mark
11169        (if (= n (or gnus-summary-default-score 0)) ? 
11170          (if (< n (or gnus-summary-default-score 0))
11171              gnus-score-below-mark gnus-score-over-mark)) 'score))
11172     (let* ((article (gnus-summary-article-number))
11173            (score (assq article gnus-newsgroup-scored)))
11174       (if score (setcdr score n)
11175         (setq gnus-newsgroup-scored
11176               (cons (cons article n) gnus-newsgroup-scored))))
11177     (gnus-summary-update-line)))
11178
11179 (defun gnus-summary-current-score ()
11180   "Return the score of the current article."
11181   (interactive)
11182   (gnus-set-global-variables)
11183   (message "%s" (gnus-summary-article-score)))
11184
11185 ;; Summary marking commands.
11186
11187 (defun gnus-summary-kill-same-subject-and-select (&optional unmark)
11188   "Mark articles which has the same subject as read, and then select the next.
11189 If UNMARK is positive, remove any kind of mark.
11190 If UNMARK is negative, tick articles."
11191   (interactive "P")
11192   (gnus-set-global-variables)
11193   (if unmark
11194       (setq unmark (prefix-numeric-value unmark)))
11195   (let ((count
11196          (gnus-summary-mark-same-subject
11197           (gnus-summary-article-subject) unmark)))
11198     ;; Select next unread article.  If auto-select-same mode, should
11199     ;; select the first unread article.
11200     (gnus-summary-next-article t (and gnus-auto-select-same
11201                                       (gnus-summary-article-subject)))
11202     (gnus-message 7 "%d article%s marked as %s"
11203                   count (if (= count 1) " is" "s are")
11204                   (if unmark "unread" "read"))))
11205
11206 (defun gnus-summary-kill-same-subject (&optional unmark)
11207   "Mark articles which has the same subject as read.
11208 If UNMARK is positive, remove any kind of mark.
11209 If UNMARK is negative, tick articles."
11210   (interactive "P")
11211   (gnus-set-global-variables)
11212   (if unmark
11213       (setq unmark (prefix-numeric-value unmark)))
11214   (let ((count
11215          (gnus-summary-mark-same-subject
11216           (gnus-summary-article-subject) unmark)))
11217     ;; If marked as read, go to next unread subject.
11218     (if (null unmark)
11219         ;; Go to next unread subject.
11220         (gnus-summary-next-subject 1 t))
11221     (gnus-message 7 "%d articles are marked as %s"
11222                   count (if unmark "unread" "read"))))
11223
11224 (defun gnus-summary-mark-same-subject (subject &optional unmark)
11225   "Mark articles with same SUBJECT as read, and return marked number.
11226 If optional argument UNMARK is positive, remove any kinds of marks.
11227 If optional argument UNMARK is negative, mark articles as unread instead."
11228   (let ((count 1))
11229     (save-excursion
11230       (cond
11231        ((null unmark)                   ; Mark as read.
11232         (while (and
11233                 (progn
11234                   (gnus-summary-mark-article-as-read gnus-killed-mark)
11235                   (gnus-summary-show-thread) t)
11236                 (gnus-summary-find-subject subject))
11237           (setq count (1+ count))))
11238        ((> unmark 0)                    ; Tick.
11239         (while (and
11240                 (progn
11241                   (gnus-summary-mark-article-as-unread gnus-ticked-mark)
11242                   (gnus-summary-show-thread) t)
11243                 (gnus-summary-find-subject subject))
11244           (setq count (1+ count))))
11245        (t                               ; Mark as unread.
11246         (while (and
11247                 (progn
11248                   (gnus-summary-mark-article-as-unread gnus-unread-mark)
11249                   (gnus-summary-show-thread) t)
11250                 (gnus-summary-find-subject subject))
11251           (setq count (1+ count)))))
11252       (gnus-set-mode-line 'summary)
11253       ;; Return the number of marked articles.
11254       count)))
11255
11256 (defun gnus-summary-mark-as-processable (n &optional unmark)
11257   "Set the process mark on the next N articles.
11258 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
11259 the process mark instead.  The difference between N and the actual
11260 number of articles marked is returned."
11261   (interactive "p")
11262   (gnus-set-global-variables)
11263   (let ((backward (< n 0))
11264         (n (abs n)))
11265     (while (and
11266             (> n 0)
11267             (if unmark
11268                 (gnus-summary-remove-process-mark
11269                  (gnus-summary-article-number))
11270               (gnus-summary-set-process-mark (gnus-summary-article-number)))
11271             (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
11272       (setq n (1- n)))
11273     (if (/= 0 n) (gnus-message 7 "No more articles"))
11274     (gnus-summary-recenter)
11275     (gnus-summary-position-point)
11276     n))
11277
11278 (defun gnus-summary-unmark-as-processable (n)
11279   "Remove the process mark from the next N articles.
11280 If N is negative, mark backward instead.  The difference between N and
11281 the actual number of articles marked is returned."
11282   (interactive "p")
11283   (gnus-set-global-variables)
11284   (gnus-summary-mark-as-processable n t))
11285
11286 (defun gnus-summary-unmark-all-processable ()
11287   "Remove the process mark from all articles."
11288   (interactive)
11289   (gnus-set-global-variables)
11290   (save-excursion
11291     (while gnus-newsgroup-processable
11292       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
11293   (gnus-summary-position-point))
11294
11295 (defun gnus-summary-mark-as-expirable (n)
11296   "Mark N articles forward as expirable.
11297 If N is negative, mark backward instead.  The difference between N and
11298 the actual number of articles marked is returned."
11299   (interactive "p")
11300   (gnus-set-global-variables)
11301   (gnus-summary-mark-forward n gnus-expirable-mark))
11302
11303 (defun gnus-summary-mark-article-as-replied (article)
11304   "Mark ARTICLE replied and update the summary line."
11305   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
11306   (let ((buffer-read-only nil))
11307     (when (gnus-summary-goto-subject article)
11308       (gnus-summary-update-secondary-mark article))))
11309
11310 (defun gnus-summary-set-bookmark (article)
11311   "Set a bookmark in current article."
11312   (interactive (list (gnus-summary-article-number)))
11313   (gnus-set-global-variables)
11314   (if (or (not (get-buffer gnus-article-buffer))
11315           (not gnus-current-article)
11316           (not gnus-article-current)
11317           (not (equal gnus-newsgroup-name (car gnus-article-current))))
11318       (error "No current article selected"))
11319   ;; Remove old bookmark, if one exists.
11320   (let ((old (assq article gnus-newsgroup-bookmarks)))
11321     (if old (setq gnus-newsgroup-bookmarks
11322                   (delq old gnus-newsgroup-bookmarks))))
11323   ;; Set the new bookmark, which is on the form
11324   ;; (article-number . line-number-in-body).
11325   (setq gnus-newsgroup-bookmarks
11326         (cons
11327          (cons article
11328                (save-excursion
11329                  (set-buffer gnus-article-buffer)
11330                  (count-lines
11331                   (min (point)
11332                        (save-excursion
11333                          (goto-char (point-min))
11334                          (search-forward "\n\n" nil t)
11335                          (point)))
11336                   (point))))
11337          gnus-newsgroup-bookmarks))
11338   (gnus-message 6 "A bookmark has been added to the current article."))
11339
11340 (defun gnus-summary-remove-bookmark (article)
11341   "Remove the bookmark from the current article."
11342   (interactive (list (gnus-summary-article-number)))
11343   (gnus-set-global-variables)
11344   ;; Remove old bookmark, if one exists.
11345   (let ((old (assq article gnus-newsgroup-bookmarks)))
11346     (if old
11347         (progn
11348           (setq gnus-newsgroup-bookmarks
11349                 (delq old gnus-newsgroup-bookmarks))
11350           (gnus-message 6 "Removed bookmark."))
11351       (gnus-message 6 "No bookmark in current article."))))
11352
11353 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
11354 (defun gnus-summary-mark-as-dormant (n)
11355   "Mark N articles forward as dormant.
11356 If N is negative, mark backward instead.  The difference between N and
11357 the actual number of articles marked is returned."
11358   (interactive "p")
11359   (gnus-set-global-variables)
11360   (gnus-summary-mark-forward n gnus-dormant-mark))
11361
11362 (defun gnus-summary-set-process-mark (article)
11363   "Set the process mark on ARTICLE and update the summary line."
11364   (setq gnus-newsgroup-processable
11365         (cons article
11366               (delq article gnus-newsgroup-processable)))
11367   (when (gnus-summary-goto-subject article)
11368     (gnus-summary-show-thread)
11369     (gnus-summary-update-secondary-mark article)))
11370
11371 (defun gnus-summary-remove-process-mark (article)
11372   "Remove the process mark from ARTICLE and update the summary line."
11373   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
11374   (when (gnus-summary-goto-subject article)
11375     (gnus-summary-show-thread)
11376     (gnus-summary-update-secondary-mark article)))
11377
11378 (defun gnus-summary-set-saved-mark (article)
11379   "Set the process mark on ARTICLE and update the summary line."
11380   (push article gnus-newsgroup-saved)
11381   (when (gnus-summary-goto-subject article)
11382     (gnus-summary-update-secondary-mark article)))
11383
11384 (defun gnus-summary-mark-forward (n &optional mark no-expire)
11385   "Mark N articles as read forwards.
11386 If N is negative, mark backwards instead.
11387 Mark with MARK.  If MARK is ? , ?! or ??, articles will be
11388 marked as unread.
11389 The difference between N and the actual number of articles marked is
11390 returned."
11391   (interactive "p")
11392   (gnus-set-global-variables)
11393   (let ((backward (< n 0))
11394         (gnus-summary-goto-unread
11395          (and gnus-summary-goto-unread
11396               (not (eq gnus-summary-goto-unread 'never))
11397               (not (memq mark (list gnus-unread-mark
11398                                     gnus-ticked-mark gnus-dormant-mark)))))
11399         (n (abs n))
11400         (mark (or mark gnus-del-mark)))
11401     (while (and (> n 0)
11402                 (gnus-summary-mark-article nil mark no-expire)
11403                 (zerop (gnus-summary-next-subject
11404                         (if backward -1 1)
11405                         (and gnus-summary-goto-unread
11406                              (not (eq gnus-summary-goto-unread 'never)))
11407                         t)))
11408       (setq n (1- n)))
11409     (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
11410     (gnus-summary-recenter)
11411     (gnus-summary-position-point)
11412     (gnus-set-mode-line 'summary)
11413     n))
11414
11415 (defun gnus-summary-mark-article-as-read (mark)
11416   "Mark the current article quickly as read with MARK."
11417   (let ((article (gnus-summary-article-number)))
11418     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11419     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11420     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11421     (setq gnus-newsgroup-reads
11422           (cons (cons article mark) gnus-newsgroup-reads))
11423     ;; Possibly remove from cache, if that is used.
11424     (and gnus-use-cache (gnus-cache-enter-remove-article article))
11425     ;; Allow the backend to change the mark.
11426     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
11427     ;; Check for auto-expiry.
11428     (when (and gnus-newsgroup-auto-expire
11429                (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
11430                    (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
11431                    (= mark gnus-ancient-mark)
11432                    (= mark gnus-read-mark) (= mark gnus-souped-mark)))
11433       (setq mark gnus-expirable-mark)
11434       (push article gnus-newsgroup-expirable))
11435     ;; Set the mark in the buffer.
11436     (gnus-summary-update-mark mark 'unread)
11437     t))
11438
11439 (defun gnus-summary-mark-article-as-unread (mark)
11440   "Mark the current article quickly as unread with MARK."
11441   (let ((article (gnus-summary-article-number)))
11442     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11443     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11444     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
11445     (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
11446     (cond ((= mark gnus-ticked-mark)
11447            (push article gnus-newsgroup-marked))
11448           ((= mark gnus-dormant-mark)
11449            (push article gnus-newsgroup-dormant))
11450           (t
11451            (push article gnus-newsgroup-unreads)))
11452     (setq gnus-newsgroup-reads
11453           (delq (assq article gnus-newsgroup-reads)
11454                 gnus-newsgroup-reads))
11455
11456     ;; See whether the article is to be put in the cache.
11457     (and gnus-use-cache
11458          (vectorp (gnus-summary-article-header article))
11459          (save-excursion
11460            (gnus-cache-possibly-enter-article
11461             gnus-newsgroup-name article
11462             (gnus-summary-article-header article)
11463             (= mark gnus-ticked-mark)
11464             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
11465
11466     ;; Fix the mark.
11467     (gnus-summary-update-mark mark 'unread)
11468     t))
11469
11470 (defun gnus-summary-mark-article (&optional article mark no-expire)
11471   "Mark ARTICLE with MARK.  MARK can be any character.
11472 Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
11473 `??' (dormant) and `?E' (expirable).
11474 If MARK is nil, then the default character `?D' is used.
11475 If ARTICLE is nil, then the article on the current line will be
11476 marked."
11477   ;; The mark might be a string.
11478   (and (stringp mark)
11479        (setq mark (aref mark 0)))
11480   ;; If no mark is given, then we check auto-expiring.
11481   (and (not no-expire)
11482        gnus-newsgroup-auto-expire
11483        (or (not mark)
11484            (and (numberp mark)
11485                 (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
11486                     (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
11487                     (= mark gnus-read-mark) (= mark gnus-souped-mark))))
11488        (setq mark gnus-expirable-mark))
11489   (let* ((mark (or mark gnus-del-mark))
11490          (article (or article (gnus-summary-article-number))))
11491     (or article (error "No article on current line"))
11492     (if (or (= mark gnus-unread-mark)
11493             (= mark gnus-ticked-mark)
11494             (= mark gnus-dormant-mark))
11495         (gnus-mark-article-as-unread article mark)
11496       (gnus-mark-article-as-read article mark))
11497
11498     ;; See whether the article is to be put in the cache.
11499     (and gnus-use-cache
11500          (not (= mark gnus-canceled-mark))
11501          (vectorp (gnus-summary-article-header article))
11502          (save-excursion
11503            (gnus-cache-possibly-enter-article
11504             gnus-newsgroup-name article
11505             (gnus-summary-article-header article)
11506             (= mark gnus-ticked-mark)
11507             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
11508
11509     (if (gnus-summary-goto-subject article nil t)
11510         (let ((buffer-read-only nil))
11511           (gnus-summary-show-thread)
11512           ;; Fix the mark.
11513           (gnus-summary-update-mark mark 'unread)
11514           t))))
11515
11516 (defun gnus-summary-update-secondary-mark (article)
11517   "Update the secondary (read, process, cache) mark."
11518   (gnus-summary-update-mark
11519    (cond ((memq article gnus-newsgroup-processable)
11520           gnus-process-mark)
11521          ((memq article gnus-newsgroup-cached)
11522           gnus-cached-mark)
11523          ((memq article gnus-newsgroup-replied)
11524           gnus-replied-mark)
11525          ((memq article gnus-newsgroup-saved)
11526           gnus-saved-mark)
11527          (t gnus-unread-mark))
11528    'replied)
11529   (when (gnus-visual-p 'summary-highlight 'highlight)
11530     (run-hooks 'gnus-summary-update-hook))
11531   t)
11532
11533 (defun gnus-summary-update-mark (mark type)
11534   (beginning-of-line)
11535   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
11536         (buffer-read-only nil))
11537     (when forward
11538       ;; Go to the right position on the line.
11539       (forward-char forward)
11540       ;; Replace the old mark with the new mark.
11541       (subst-char-in-region (point) (1+ (point)) (following-char) mark)
11542       ;; Optionally update the marks by some user rule.
11543       (when (eq type 'unread)
11544         (gnus-data-set-mark
11545          (gnus-data-find (gnus-summary-article-number)) mark)
11546         (gnus-summary-update-line (eq mark gnus-unread-mark))))))
11547
11548 (defun gnus-mark-article-as-read (article &optional mark)
11549   "Enter ARTICLE in the pertinent lists and remove it from others."
11550   ;; Make the article expirable.
11551   (let ((mark (or mark gnus-del-mark)))
11552     (if (= mark gnus-expirable-mark)
11553         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
11554       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
11555     ;; Remove from unread and marked lists.
11556     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11557     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11558     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11559     (push (cons article mark) gnus-newsgroup-reads)
11560     ;; Possibly remove from cache, if that is used.
11561     (when gnus-use-cache
11562       (gnus-cache-enter-remove-article article))))
11563
11564 (defun gnus-mark-article-as-unread (article &optional mark)
11565   "Enter ARTICLE in the pertinent lists and remove it from others."
11566   (let ((mark (or mark gnus-ticked-mark)))
11567     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11568     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11569     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
11570     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11571     (cond ((= mark gnus-ticked-mark)
11572            (push article gnus-newsgroup-marked))
11573           ((= mark gnus-dormant-mark)
11574            (push article gnus-newsgroup-dormant))
11575           (t
11576            (push article gnus-newsgroup-unreads)))
11577     (setq gnus-newsgroup-reads
11578           (delq (assq article gnus-newsgroup-reads)
11579                 gnus-newsgroup-reads))))
11580
11581 (defalias 'gnus-summary-mark-as-unread-forward
11582   'gnus-summary-tick-article-forward)
11583 (make-obsolete 'gnus-summary-mark-as-unread-forward
11584                'gnus-summary-tick-article-forward)
11585 (defun gnus-summary-tick-article-forward (n)
11586   "Tick N articles forwards.
11587 If N is negative, tick backwards instead.
11588 The difference between N and the number of articles ticked is returned."
11589   (interactive "p")
11590   (gnus-summary-mark-forward n gnus-ticked-mark))
11591
11592 (defalias 'gnus-summary-mark-as-unread-backward
11593   'gnus-summary-tick-article-backward)
11594 (make-obsolete 'gnus-summary-mark-as-unread-backward
11595                'gnus-summary-tick-article-backward)
11596 (defun gnus-summary-tick-article-backward (n)
11597   "Tick N articles backwards.
11598 The difference between N and the number of articles ticked is returned."
11599   (interactive "p")
11600   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
11601
11602 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
11603 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
11604 (defun gnus-summary-tick-article (&optional article clear-mark)
11605   "Mark current article as unread.
11606 Optional 1st argument ARTICLE specifies article number to be marked as unread.
11607 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
11608   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
11609                                        gnus-ticked-mark)))
11610
11611 (defun gnus-summary-mark-as-read-forward (n)
11612   "Mark N articles as read forwards.
11613 If N is negative, mark backwards instead.
11614 The difference between N and the actual number of articles marked is
11615 returned."
11616   (interactive "p")
11617   (gnus-summary-mark-forward n gnus-del-mark t))
11618
11619 (defun gnus-summary-mark-as-read-backward (n)
11620   "Mark the N articles as read backwards.
11621 The difference between N and the actual number of articles marked is
11622 returned."
11623   (interactive "p")
11624   (gnus-summary-mark-forward (- n) gnus-del-mark t))
11625
11626 (defun gnus-summary-mark-as-read (&optional article mark)
11627   "Mark current article as read.
11628 ARTICLE specifies the article to be marked as read.
11629 MARK specifies a string to be inserted at the beginning of the line."
11630   (gnus-summary-mark-article article mark))
11631
11632 (defun gnus-summary-clear-mark-forward (n)
11633   "Clear marks from N articles forward.
11634 If N is negative, clear backward instead.
11635 The difference between N and the number of marks cleared is returned."
11636   (interactive "p")
11637   (gnus-summary-mark-forward n gnus-unread-mark))
11638
11639 (defun gnus-summary-clear-mark-backward (n)
11640   "Clear marks from N articles backward.
11641 The difference between N and the number of marks cleared is returned."
11642   (interactive "p")
11643   (gnus-summary-mark-forward (- n) gnus-unread-mark))
11644
11645 (defun gnus-summary-mark-unread-as-read ()
11646   "Intended to be used by `gnus-summary-mark-article-hook'."
11647   (when (memq gnus-current-article gnus-newsgroup-unreads)
11648     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
11649
11650 (defun gnus-summary-mark-region-as-read (point mark all)
11651   "Mark all unread articles between point and mark as read.
11652 If given a prefix, mark all articles between point and mark as read,
11653 even ticked and dormant ones."
11654   (interactive "r\nP")
11655   (save-excursion
11656     (let (article)
11657       (goto-char point)
11658       (beginning-of-line)
11659       (while (and
11660               (< (point) mark)
11661               (progn
11662                 (when (or all
11663                           (memq (setq article (gnus-summary-article-number))
11664                                 gnus-newsgroup-unreads))
11665                   (gnus-summary-mark-article article gnus-del-mark))
11666                 t)
11667               (gnus-summary-find-next))))))
11668
11669 (defun gnus-summary-mark-below (score mark)
11670   "Mark articles with score less than SCORE with MARK."
11671   (interactive "P\ncMark: ")
11672   (gnus-set-global-variables)
11673   (setq score (if score
11674                   (prefix-numeric-value score)
11675                 (or gnus-summary-default-score 0)))
11676   (save-excursion
11677     (set-buffer gnus-summary-buffer)
11678     (goto-char (point-min))
11679     (while 
11680         (progn
11681           (and (< (gnus-summary-article-score) score)
11682                (gnus-summary-mark-article nil mark))
11683           (gnus-summary-find-next)))))
11684
11685 (defun gnus-summary-kill-below (&optional score)
11686   "Mark articles with score below SCORE as read."
11687   (interactive "P")
11688   (gnus-set-global-variables)
11689   (gnus-summary-mark-below score gnus-killed-mark))
11690
11691 (defun gnus-summary-clear-above (&optional score)
11692   "Clear all marks from articles with score above SCORE."
11693   (interactive "P")
11694   (gnus-set-global-variables)
11695   (gnus-summary-mark-above score gnus-unread-mark))
11696
11697 (defun gnus-summary-tick-above (&optional score)
11698   "Tick all articles with score above SCORE."
11699   (interactive "P")
11700   (gnus-set-global-variables)
11701   (gnus-summary-mark-above score gnus-ticked-mark))
11702
11703 (defun gnus-summary-mark-above (score mark)
11704   "Mark articles with score over SCORE with MARK."
11705   (interactive "P\ncMark: ")
11706   (gnus-set-global-variables)
11707   (setq score (if score
11708                   (prefix-numeric-value score)
11709                 (or gnus-summary-default-score 0)))
11710   (save-excursion
11711     (set-buffer gnus-summary-buffer)
11712     (goto-char (point-min))
11713     (while (and (progn
11714                   (if (> (gnus-summary-article-score) score)
11715                       (gnus-summary-mark-article nil mark))
11716                   t)
11717                 (gnus-summary-find-next)))))
11718
11719 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
11720 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
11721 (defun gnus-summary-limit-include-expunged ()
11722   "Display all the hidden articles that were expunged for low scores."
11723   (interactive)
11724   (gnus-set-global-variables)
11725   (let ((buffer-read-only nil))
11726     (let ((scored gnus-newsgroup-scored)
11727           headers h)
11728       (while scored
11729         (or (gnus-summary-goto-subject (car (car scored)))
11730             (and (setq h (gnus-summary-article-header (car (car scored))))
11731                  (< (cdr (car scored)) gnus-summary-expunge-below)
11732                  (setq headers (cons h headers))))
11733         (setq scored (cdr scored)))
11734       (or headers (error "No expunged articles hidden."))
11735       (goto-char (point-min))
11736       (gnus-summary-prepare-unthreaded (nreverse headers)))
11737     (goto-char (point-min))
11738     (gnus-summary-position-point)))
11739
11740 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
11741   "Mark all articles not marked as unread in this newsgroup as read.
11742 If prefix argument ALL is non-nil, all articles are marked as read.
11743 If QUIETLY is non-nil, no questions will be asked.
11744 If TO-HERE is non-nil, it should be a point in the buffer.  All
11745 articles before this point will be marked as read.
11746 The number of articles marked as read is returned."
11747   (interactive "P")
11748   (gnus-set-global-variables)
11749   (prog1
11750       (if (or quietly
11751               (not gnus-interactive-catchup) ;Without confirmation?
11752               gnus-expert-user
11753               (gnus-y-or-n-p
11754                (if all
11755                    "Mark absolutely all articles as read? "
11756                  "Mark all unread articles as read? ")))
11757           (if (and not-mark
11758                    (not gnus-newsgroup-adaptive)
11759                    (not gnus-newsgroup-auto-expire))
11760               (progn
11761                 (when all
11762                   (setq gnus-newsgroup-marked nil
11763                         gnus-newsgroup-dormant nil))
11764                 (setq gnus-newsgroup-unreads nil))
11765             ;; We actually mark all articles as canceled, which we
11766             ;; have to do when using auto-expiry or adaptive scoring.
11767             (gnus-summary-show-all-threads)
11768             (if (gnus-summary-first-subject (not all))
11769                 (while (and
11770                         (if to-here (< (point) to-here) t)
11771                         (gnus-summary-mark-article-as-read gnus-catchup-mark)
11772                         (gnus-summary-find-next (not all)))))
11773             (unless to-here
11774               (setq gnus-newsgroup-unreads nil))
11775             (gnus-set-mode-line 'summary)))
11776     (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
11777       (if (and (not to-here) (eq 'nnvirtual (car method)))
11778           (nnvirtual-catchup-group
11779            (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
11780     (gnus-summary-position-point)))
11781
11782 (defun gnus-summary-catchup-to-here (&optional all)
11783   "Mark all unticked articles before the current one as read.
11784 If ALL is non-nil, also mark ticked and dormant articles as read."
11785   (interactive "P")
11786   (gnus-set-global-variables)
11787   (save-excursion
11788     (let ((beg (point)))
11789       ;; We check that there are unread articles.
11790       (when (or all (gnus-summary-find-prev))
11791         (gnus-summary-catchup all t beg))))
11792   (gnus-summary-position-point))
11793
11794 (defun gnus-summary-catchup-all (&optional quietly)
11795   "Mark all articles in this newsgroup as read."
11796   (interactive "P")
11797   (gnus-set-global-variables)
11798   (gnus-summary-catchup t quietly))
11799
11800 (defun gnus-summary-catchup-and-exit (&optional all quietly)
11801   "Mark all articles not marked as unread in this newsgroup as read, then exit.
11802 If prefix argument ALL is non-nil, all articles are marked as read."
11803   (interactive "P")
11804   (gnus-set-global-variables)
11805   (gnus-summary-catchup all quietly nil 'fast)
11806   ;; Select next newsgroup or exit.
11807   (if (eq gnus-auto-select-next 'quietly)
11808       (gnus-summary-next-group nil)
11809     (gnus-summary-exit)))
11810
11811 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
11812   "Mark all articles in this newsgroup as read, and then exit."
11813   (interactive "P")
11814   (gnus-set-global-variables)
11815   (gnus-summary-catchup-and-exit t quietly))
11816
11817 ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
11818 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
11819   "Mark all articles in this group as read and select the next group.
11820 If given a prefix, mark all articles, unread as well as ticked, as
11821 read."
11822   (interactive "P")
11823   (gnus-set-global-variables)
11824   (save-excursion
11825     (gnus-summary-catchup all))
11826   (gnus-summary-next-article t))
11827
11828 ;; Thread-based commands.
11829
11830 (defun gnus-summary-articles-in-thread (&optional article)
11831   "Return a list of all articles in the current thread.
11832 If ARTICLE is non-nil, return all articles in the thread that starts
11833 with that article."
11834   (let* ((article (or article (gnus-summary-article-number)))
11835          (data (gnus-data-find-list article))
11836          (top-level (gnus-data-level (car data)))
11837          (top-subject
11838           (cond ((null gnus-thread-operation-ignore-subject)
11839                  (gnus-simplify-subject-re
11840                   (mail-header-subject (gnus-data-header (car data)))))
11841                 ((eq gnus-thread-operation-ignore-subject 'fuzzy)
11842                  (gnus-simplify-subject-fuzzy
11843                   (mail-header-subject (gnus-data-header (car data)))))
11844                 (t nil)))
11845          articles)
11846     (if (not data)
11847         ()                              ; This article doesn't exist.
11848       (while data
11849         (and (or (not top-subject)
11850                  (string= top-subject
11851                           (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
11852                               (gnus-simplify-subject-fuzzy
11853                                (mail-header-subject
11854                                 (gnus-data-header (car data))))
11855                             (gnus-simplify-subject-re
11856                              (mail-header-subject
11857                               (gnus-data-header (car data)))))))
11858              (setq articles (cons (gnus-data-number (car data)) articles)))
11859         (if (and (setq data (cdr data))
11860                  (> (gnus-data-level (car data)) top-level))
11861             ()
11862           (setq data nil)))
11863       ;; Return the list of articles.
11864       (nreverse articles))))
11865
11866 (defun gnus-summary-rethread-current ()
11867   "Rethread the thread the current article is part of."
11868   (interactive)
11869   (gnus-set-global-variables)
11870   (let* ((gnus-show-threads t)
11871          (article (gnus-summary-article-number))
11872          (id (mail-header-id (gnus-summary-article-header)))
11873          (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id)))))
11874     (unless id
11875       (error "No article on the current line"))
11876     (gnus-rebuild-thread id)
11877     (gnus-summary-goto-subject article)))
11878
11879 (defun gnus-summary-toggle-threads (&optional arg)
11880   "Toggle showing conversation threads.
11881 If ARG is positive number, turn showing conversation threads on."
11882   (interactive "P")
11883   (gnus-set-global-variables)
11884   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
11885     (setq gnus-show-threads
11886           (if (null arg) (not gnus-show-threads)
11887             (> (prefix-numeric-value arg) 0)))
11888     (gnus-summary-prepare)
11889     (gnus-summary-goto-subject current)
11890     (gnus-summary-position-point)))
11891
11892 (defun gnus-summary-show-all-threads ()
11893   "Show all threads."
11894   (interactive)
11895   (gnus-set-global-variables)
11896   (save-excursion
11897     (let ((buffer-read-only nil))
11898       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
11899   (gnus-summary-position-point))
11900
11901 (defun gnus-summary-show-thread ()
11902   "Show thread subtrees.
11903 Returns nil if no thread was there to be shown."
11904   (interactive)
11905   (gnus-set-global-variables)
11906   (let ((buffer-read-only nil)
11907         (orig (point))
11908         ;; first goto end then to beg, to have point at beg after let
11909         (end (progn (end-of-line) (point)))
11910         (beg (progn (beginning-of-line) (point))))
11911     (prog1
11912         ;; Any hidden lines here?
11913         (search-forward "\r" end t)
11914       (subst-char-in-region beg end ?\^M ?\n t)
11915       (goto-char orig)
11916       (gnus-summary-position-point))))
11917
11918 (defun gnus-summary-hide-all-threads ()
11919   "Hide all thread subtrees."
11920   (interactive)
11921   (gnus-set-global-variables)
11922   (save-excursion
11923     (goto-char (point-min))
11924     (gnus-summary-hide-thread)
11925     (while (zerop (gnus-summary-next-thread 1 t))
11926       (gnus-summary-hide-thread)))
11927   (gnus-summary-position-point))
11928
11929 (defun gnus-summary-hide-thread ()
11930   "Hide thread subtrees.
11931 Returns nil if no threads were there to be hidden."
11932   (interactive)
11933   (gnus-set-global-variables)
11934   (let ((buffer-read-only nil)
11935         (start (point))
11936         (article (gnus-summary-article-number))
11937         end)
11938     ;; Go forward until either the buffer ends or the subthread
11939     ;; ends.
11940     (when (and (not (eobp))
11941                (or (and (zerop (gnus-summary-next-thread 1 t))
11942                         (gnus-summary-find-prev))
11943                    (goto-char (gnus-data-pos (car (gnus-data-list 'rev))))))
11944       (setq end (point))
11945       (prog1
11946           (if (and (> (point) start)
11947                    (search-backward "\n" start t))
11948               (progn
11949                 (subst-char-in-region start end ?\n ?\^M)
11950                 (gnus-summary-goto-subject article))
11951             (goto-char start)
11952             nil)
11953         (gnus-summary-position-point)))))
11954
11955 (defun gnus-summary-go-to-next-thread (&optional previous)
11956   "Go to the same level (or less) next thread.
11957 If PREVIOUS is non-nil, go to previous thread instead.
11958 Return the article number moved to, or nil if moving was impossible."
11959   (let* ((level (gnus-summary-thread-level))
11960          (article (gnus-summary-article-number))
11961          (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
11962          oart)
11963     (while data
11964       (if (<= (gnus-data-level (car data)) level)
11965           (setq oart (gnus-data-number (car data))
11966                 data nil)
11967         (setq data (cdr data))))
11968     (and oart
11969          (gnus-summary-goto-subject oart))))
11970
11971 (defun gnus-summary-next-thread (n &optional silent)
11972   "Go to the same level next N'th thread.
11973 If N is negative, search backward instead.
11974 Returns the difference between N and the number of skips actually
11975 done.
11976
11977 If SILENT, don't output messages."
11978   (interactive "p")
11979   (gnus-set-global-variables)
11980   (let ((backward (< n 0))
11981         (n (abs n))
11982         old dum)
11983     (while (and (> n 0)
11984                 (setq old (save-excursion (forward-line 1) (point)))
11985                 (gnus-summary-go-to-next-thread backward))
11986       (when (and (eq gnus-summary-make-false-root 'dummy)
11987                  (setq dum (text-property-not-all
11988                             old (point) 'gnus-intangible nil)))
11989         (goto-char dum))
11990       (decf n))
11991     (gnus-summary-position-point)
11992     (when (and (not silent) (/= 0 n))
11993       (gnus-message 7 "No more threads"))
11994     n))
11995
11996 (defun gnus-summary-prev-thread (n)
11997   "Go to the same level previous N'th thread.
11998 Returns the difference between N and the number of skips actually
11999 done."
12000   (interactive "p")
12001   (gnus-set-global-variables)
12002   (gnus-summary-next-thread (- n)))
12003
12004 (defun gnus-summary-go-down-thread ()
12005   "Go down one level in the current thread."
12006   (let ((children (gnus-summary-article-children)))
12007     (and children
12008          (gnus-summary-goto-subject (car children)))))
12009
12010 (defun gnus-summary-go-up-thread ()
12011   "Go up one level in the current thread."
12012   (let ((parent (gnus-summary-article-parent)))
12013     (and parent
12014          (gnus-summary-goto-subject parent))))
12015
12016 (defun gnus-summary-down-thread (n)
12017   "Go down thread N steps.
12018 If N is negative, go up instead.
12019 Returns the difference between N and how many steps down that were
12020 taken."
12021   (interactive "p")
12022   (gnus-set-global-variables)
12023   (let ((up (< n 0))
12024         (n (abs n)))
12025     (while (and (> n 0)
12026                 (if up (gnus-summary-go-up-thread)
12027                   (gnus-summary-go-down-thread)))
12028       (setq n (1- n)))
12029     (gnus-summary-position-point)
12030     (if (/= 0 n) (gnus-message 7 "Can't go further"))
12031     n))
12032
12033 (defun gnus-summary-up-thread (n)
12034   "Go up thread N steps.
12035 If N is negative, go up instead.
12036 Returns the difference between N and how many steps down that were
12037 taken."
12038   (interactive "p")
12039   (gnus-set-global-variables)
12040   (gnus-summary-down-thread (- n)))
12041
12042 (defun gnus-summary-top-thread ()
12043   "Go to the top of the thread."
12044   (interactive)
12045   (gnus-set-global-variables)
12046   (while (gnus-summary-go-up-thread))
12047   (gnus-summary-article-number))
12048
12049 (defun gnus-summary-kill-thread (&optional unmark)
12050   "Mark articles under current thread as read.
12051 If the prefix argument is positive, remove any kinds of marks.
12052 If the prefix argument is negative, tick articles instead."
12053   (interactive "P")
12054   (gnus-set-global-variables)
12055   (if unmark
12056       (setq unmark (prefix-numeric-value unmark)))
12057   (let ((articles (gnus-summary-articles-in-thread)))
12058     (save-excursion
12059       ;; Expand the thread.
12060       (gnus-summary-show-thread)
12061       ;; Mark all the articles.
12062       (while articles
12063         (gnus-summary-goto-subject (car articles))
12064         (cond ((null unmark)
12065                (gnus-summary-mark-article-as-read gnus-killed-mark))
12066               ((> unmark 0)
12067                (gnus-summary-mark-article-as-unread gnus-unread-mark))
12068               (t
12069                (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
12070         (setq articles (cdr articles))))
12071     ;; Hide killed subtrees.
12072     (and (null unmark)
12073          gnus-thread-hide-killed
12074          (gnus-summary-hide-thread))
12075     ;; If marked as read, go to next unread subject.
12076     (if (null unmark)
12077         ;; Go to next unread subject.
12078         (gnus-summary-next-subject 1 t)))
12079   (gnus-set-mode-line 'summary))
12080
12081 ;; Summary sorting commands
12082
12083 (defun gnus-summary-sort-by-number (&optional reverse)
12084   "Sort summary buffer by article number.
12085 Argument REVERSE means reverse order."
12086   (interactive "P")
12087   (gnus-summary-sort 'number reverse))
12088
12089 (defun gnus-summary-sort-by-author (&optional reverse)
12090   "Sort summary buffer by author name alphabetically.
12091 If case-fold-search is non-nil, case of letters is ignored.
12092 Argument REVERSE means reverse order."
12093   (interactive "P")
12094   (gnus-summary-sort 'author reverse))
12095
12096 (defun gnus-summary-sort-by-subject (&optional reverse)
12097   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
12098 If case-fold-search is non-nil, case of letters is ignored.
12099 Argument REVERSE means reverse order."
12100   (interactive "P")
12101   (gnus-summary-sort 'subject reverse))
12102
12103 (defun gnus-summary-sort-by-date (&optional reverse)
12104   "Sort summary buffer by date.
12105 Argument REVERSE means reverse order."
12106   (interactive "P")
12107   (gnus-summary-sort 'date reverse))
12108
12109 (defun gnus-summary-sort-by-score (&optional reverse)
12110   "Sort summary buffer by score.
12111 Argument REVERSE means reverse order."
12112   (interactive "P")
12113   (gnus-summary-sort 'score reverse))
12114
12115 (defun gnus-summary-sort (predicate reverse)
12116   "Sort summary buffer by PREDICATE.  REVERSE means reverse order."
12117   (gnus-set-global-variables)
12118   (let* ((gnus-thread-sort-functions
12119           (list (intern (format "gnus-thread-sort-by-%s" predicate))))
12120          (gnus-article-sort-functions
12121           (list (intern (format "gnus-article-sort-by-%s" predicate))))
12122          (buffer-read-only)
12123          (gnus-summary-prepare-hook nil))
12124     ;; We do the sorting by regenerating the threads.
12125     (gnus-summary-prepare)
12126     ;; Hide subthreads if needed.
12127     (when (and gnus-show-threads gnus-thread-hide-subtree)
12128       (gnus-summary-hide-all-threads)))
12129   ;; If in async mode, we send some info to the backend.
12130   (when gnus-newsgroup-async
12131     (gnus-request-asynchronous
12132      gnus-newsgroup-name gnus-newsgroup-data)))
12133
12134 (defun gnus-sortable-date (date)
12135   "Make sortable string by string-lessp from DATE.
12136 Timezone package is used."
12137   (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S]
12138          (year (aref date 0))
12139          (month (aref date 1))
12140          (day (aref date 2)))
12141     (timezone-make-sortable-date
12142      year month day
12143      (timezone-make-time-string
12144       (aref date 3) (aref date 4) (aref date 5)))))
12145
12146
12147 ;; Summary saving commands.
12148
12149 (defun gnus-summary-save-article (&optional n not-saved)
12150   "Save the current article using the default saver function.
12151 If N is a positive number, save the N next articles.
12152 If N is a negative number, save the N previous articles.
12153 If N is nil and any articles have been marked with the process mark,
12154 save those articles instead.
12155 The variable `gnus-default-article-saver' specifies the saver function."
12156   (interactive "P")
12157   (gnus-set-global-variables)
12158   (let ((articles (gnus-summary-work-articles n))
12159         file header article)
12160     (while articles
12161       (setq header (gnus-summary-article-header
12162                     (setq article (pop articles))))
12163       (if (not (vectorp header))
12164           ;; This is a pseudo-article.
12165           (if (assq 'name header)
12166               (gnus-copy-file (cdr (assq 'name header)))
12167             (gnus-message 1 "Article %d is unsaveable" article))
12168         ;; This is a real article.
12169         (save-window-excursion
12170           (gnus-summary-select-article t nil nil article))
12171         (unless gnus-save-all-headers
12172           ;; Remove headers accoring to `gnus-saved-headers'.
12173           (let ((gnus-visible-headers
12174                  (or gnus-saved-headers gnus-visible-headers)))
12175             (gnus-article-hide-headers nil t)))
12176         ;; Remove any X-Gnus lines.
12177         (save-excursion
12178           (set-buffer gnus-article-buffer)
12179           (save-restriction
12180             (let ((buffer-read-only nil))
12181               (nnheader-narrow-to-headers)
12182               (while (re-search-forward "^X-Gnus" nil t)
12183                 (gnus-delete-line)))))
12184         (save-window-excursion
12185           (if (not gnus-default-article-saver)
12186               (error "No default saver is defined.")
12187             (setq file (funcall
12188                         gnus-default-article-saver
12189                         (cond
12190                          ((not gnus-prompt-before-saving)
12191                           'default)
12192                          ((eq gnus-prompt-before-saving 'always)
12193                           nil)
12194                          (t file))))))
12195         (gnus-summary-remove-process-mark article)
12196         (unless not-saved
12197           (gnus-summary-set-saved-mark article))))
12198     (gnus-summary-position-point)
12199     n))
12200
12201 (defun gnus-summary-pipe-output (&optional arg)
12202   "Pipe the current article to a subprocess.
12203 If N is a positive number, pipe the N next articles.
12204 If N is a negative number, pipe the N previous articles.
12205 If N is nil and any articles have been marked with the process mark,
12206 pipe those articles instead."
12207   (interactive "P")
12208   (gnus-set-global-variables)
12209   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
12210     (gnus-summary-save-article arg t))
12211   (gnus-configure-windows 'pipe))
12212
12213 (defun gnus-summary-save-article-mail (&optional arg)
12214   "Append the current article to an mail file.
12215 If N is a positive number, save the N next articles.
12216 If N is a negative number, save the N previous articles.
12217 If N is nil and any articles have been marked with the process mark,
12218 save those articles instead."
12219   (interactive "P")
12220   (gnus-set-global-variables)
12221   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
12222     (gnus-summary-save-article arg)))
12223
12224 (defun gnus-summary-save-article-rmail (&optional arg)
12225   "Append the current article to an rmail file.
12226 If N is a positive number, save the N next articles.
12227 If N is a negative number, save the N previous articles.
12228 If N is nil and any articles have been marked with the process mark,
12229 save those articles instead."
12230   (interactive "P")
12231   (gnus-set-global-variables)
12232   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
12233     (gnus-summary-save-article arg)))
12234
12235 (defun gnus-summary-save-article-file (&optional arg)
12236   "Append the current article to a file.
12237 If N is a positive number, save the N next articles.
12238 If N is a negative number, save the N previous articles.
12239 If N is nil and any articles have been marked with the process mark,
12240 save those articles instead."
12241   (interactive "P")
12242   (gnus-set-global-variables)
12243   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
12244     (gnus-summary-save-article arg)))
12245
12246 (defun gnus-summary-save-article-body-file (&optional arg)
12247   "Append the current article body to a file.
12248 If N is a positive number, save the N next articles.
12249 If N is a negative number, save the N previous articles.
12250 If N is nil and any articles have been marked with the process mark,
12251 save those articles instead."
12252   (interactive "P")
12253   (gnus-set-global-variables)
12254   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
12255     (gnus-summary-save-article arg)))
12256
12257 (defun gnus-get-split-value (methods)
12258   "Return a value based on the split METHODS."
12259   (let (split-name method result match)
12260     (when methods
12261       (save-excursion
12262         (set-buffer gnus-original-article-buffer)
12263         (save-restriction
12264           (nnheader-narrow-to-headers)
12265           (while methods
12266             (goto-char (point-min))
12267             (setq method (pop methods))
12268             (setq match (pop method))
12269             (when (cond
12270                    ((stringp match)
12271                     ;; Regular expression.
12272                     (condition-case ()
12273                         (re-search-forward match nil t)
12274                       (error nil)))
12275                    ((gnus-functionp match)
12276                     ;; Function.
12277                     (save-restriction
12278                       (widen)
12279                       (setq result (funcall match gnus-newsgroup-name))))
12280                    ((consp match)
12281                     ;; Form.
12282                     (save-restriction
12283                       (widen)
12284                       (setq result (eval match)))))
12285               (setq split-name (append (cdr methods) split-name))
12286               (cond ((stringp result)
12287                      (push result split-name))
12288                     ((consp result)
12289                      (setq split-name (append result split-name)))))))))
12290     split-name))
12291
12292 (defun gnus-read-move-group-name (prompt default articles prefix)
12293   "Read a group name."
12294   (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
12295          (prom
12296           (format "Where do you want to %s %s? "
12297                   prompt
12298                   (if (> (length articles) 1)
12299                       (format "these %d articles" (length articles))
12300                     "this article")))
12301          (to-newsgroup
12302           (cond
12303            ((null split-name)
12304             (completing-read
12305              (concat prom
12306                      (if default
12307                          (format "(default %s) " default)
12308                        ""))
12309              gnus-active-hashtb nil nil prefix))
12310            ((= 1 (length split-name))
12311             (completing-read prom gnus-active-hashtb
12312                              nil nil (cons (car split-name) 0)))
12313            (t
12314             (completing-read
12315              prom (mapcar (lambda (el) (list el)) (nreverse split-name)))))))
12316
12317     (when to-newsgroup
12318       (if (or (string= to-newsgroup "")
12319               (string= to-newsgroup prefix))
12320           (setq to-newsgroup (or default "")))
12321       (or (gnus-active to-newsgroup)
12322           (gnus-activate-group to-newsgroup)
12323           (error "No such group: %s" to-newsgroup)))
12324     to-newsgroup))
12325
12326 (defun gnus-read-save-file-name (prompt default-name)
12327   (let* ((split-name (gnus-get-split-value gnus-split-methods))
12328          (file
12329           ;; Let the split methods have their say.
12330           (cond
12331            ;; No split name was found.
12332            ((null split-name)
12333             (read-file-name
12334              (concat prompt " (default "
12335                      (file-name-nondirectory default-name) ") ")
12336              (file-name-directory default-name)
12337              default-name))
12338            ;; A single split name was found
12339            ((= 1 (length split-name))
12340             (read-file-name
12341              (concat prompt " (default " (car split-name) ") ")
12342              gnus-article-save-directory
12343              (concat gnus-article-save-directory (car split-name))))
12344            ;; A list of splits was found.
12345            (t
12346             (setq split-name (mapcar (lambda (el) (list el))
12347                                      (nreverse split-name)))
12348             (let ((result (completing-read
12349                            (concat prompt " ") split-name nil nil)))
12350               (concat gnus-article-save-directory
12351                       (if (string= result "")
12352                           (car (car split-name))
12353                         result)))))))
12354     ;; If we have read a directory, we append the default file name.
12355     (when (file-directory-p file)
12356       (setq file (concat (file-name-as-directory file)
12357                          (file-name-nondirectory default-name))))
12358     ;; Possibly translate some charaters.
12359     (nnheader-translate-file-chars file)))
12360
12361 (defun gnus-article-archive-name (group)
12362   "Return the first instance of an \"Archive-name\" in the current buffer."
12363   (let ((case-fold-search t))
12364     (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
12365       (match-string 1))))
12366
12367 (defun gnus-summary-save-in-rmail (&optional filename)
12368   "Append this article to Rmail file.
12369 Optional argument FILENAME specifies file name.
12370 Directory to save to is default to `gnus-article-save-directory' which
12371 is initialized from the SAVEDIR environment variable."
12372   (interactive)
12373   (gnus-set-global-variables)
12374   (let ((default-name
12375           (funcall gnus-rmail-save-name gnus-newsgroup-name
12376                    gnus-current-headers gnus-newsgroup-last-rmail)))
12377     (setq filename
12378           (cond ((eq filename 'default)
12379                  default-name)
12380                 (filename filename)
12381                 (t (gnus-read-save-file-name
12382                     "Save in rmail file:" default-name))))
12383     (gnus-make-directory (file-name-directory filename))
12384     (gnus-eval-in-buffer-window
12385      gnus-original-article-buffer
12386      (save-excursion
12387        (save-restriction
12388          (widen)
12389          (gnus-output-to-rmail filename))))
12390     ;; Remember the directory name to save articles
12391     (setq gnus-newsgroup-last-rmail filename)))
12392
12393 (defun gnus-summary-save-in-mail (&optional filename)
12394   "Append this article to Unix mail file.
12395 Optional argument FILENAME specifies file name.
12396 Directory to save to is default to `gnus-article-save-directory' which
12397 is initialized from the SAVEDIR environment variable."
12398   (interactive)
12399   (gnus-set-global-variables)
12400   (let ((default-name
12401           (funcall gnus-mail-save-name gnus-newsgroup-name
12402                    gnus-current-headers gnus-newsgroup-last-mail)))
12403     (setq filename
12404           (cond ((eq filename 'default)
12405                  default-name)
12406                 (filename filename)
12407                 (t (gnus-read-save-file-name
12408                     "Save in Unix mail file:" default-name))))
12409     (setq filename
12410           (expand-file-name filename
12411                             (and default-name
12412                                  (file-name-directory default-name))))
12413     (gnus-make-directory (file-name-directory filename))
12414     (gnus-eval-in-buffer-window
12415      gnus-original-article-buffer
12416      (save-excursion
12417        (save-restriction
12418          (widen)
12419          (if (and (file-readable-p filename) (mail-file-babyl-p filename))
12420              (gnus-output-to-rmail filename)
12421            (let ((mail-use-rfc822 t))
12422              (rmail-output filename 1 t t))))))
12423     ;; Remember the directory name to save articles.
12424     (setq gnus-newsgroup-last-mail filename)))
12425
12426 (defun gnus-summary-save-in-file (&optional filename)
12427   "Append this article to file.
12428 Optional argument FILENAME specifies file name.
12429 Directory to save to is default to `gnus-article-save-directory' which
12430 is initialized from the SAVEDIR environment variable."
12431   (interactive)
12432   (gnus-set-global-variables)
12433   (let ((default-name
12434           (funcall gnus-file-save-name gnus-newsgroup-name
12435                    gnus-current-headers gnus-newsgroup-last-file)))
12436     (setq filename
12437           (cond ((eq filename 'default)
12438                  default-name)
12439                 (filename filename)
12440                 (t (gnus-read-save-file-name
12441                     "Save in file:" default-name))))
12442     (gnus-make-directory (file-name-directory filename))
12443     (gnus-eval-in-buffer-window
12444      gnus-article-buffer
12445      (save-excursion
12446        (save-restriction
12447          (widen)
12448          (gnus-output-to-file filename))))
12449     ;; Remember the directory name to save articles.
12450     (setq gnus-newsgroup-last-file filename)))
12451
12452 (defun gnus-summary-save-body-in-file (&optional filename)
12453   "Append this article body to a file.
12454 Optional argument FILENAME specifies file name.
12455 The directory to save in defaults to `gnus-article-save-directory' which
12456 is initialized from the SAVEDIR environment variable."
12457   (interactive)
12458   (gnus-set-global-variables)
12459   (let ((default-name
12460           (funcall gnus-file-save-name gnus-newsgroup-name
12461                    gnus-current-headers gnus-newsgroup-last-file)))
12462     (setq filename
12463           (cond ((eq filename 'default)
12464                  default-name)
12465                 (filename filename)
12466                 (t (gnus-read-save-file-name
12467                     "Save body in file:" default-name))))
12468     (gnus-make-directory (file-name-directory filename))
12469     (gnus-eval-in-buffer-window
12470      gnus-article-buffer
12471      (save-excursion
12472        (save-restriction
12473          (widen)
12474          (goto-char (point-min))
12475          (and (search-forward "\n\n" nil t)
12476               (narrow-to-region (point) (point-max)))
12477          (gnus-output-to-file filename))))
12478     ;; Remember the directory name to save articles.
12479     (setq gnus-newsgroup-last-file filename)))
12480
12481 (defun gnus-summary-save-in-pipe (&optional command)
12482   "Pipe this article to subprocess."
12483   (interactive)
12484   (gnus-set-global-variables)
12485   (setq command
12486         (cond ((eq command 'default)
12487                gnus-last-shell-command)
12488               (command command)
12489               (t (read-string "Shell command on article: "
12490                               gnus-last-shell-command))))
12491   (if (string-equal command "")
12492       (setq command gnus-last-shell-command))
12493   (gnus-eval-in-buffer-window
12494    gnus-article-buffer
12495    (save-restriction
12496      (widen)
12497      (shell-command-on-region (point-min) (point-max) command nil)))
12498   (setq gnus-last-shell-command command))
12499
12500 ;; Summary extract commands
12501
12502 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
12503   (let ((buffer-read-only nil)
12504         (article (gnus-summary-article-number))
12505         after-article b e)
12506     (or (gnus-summary-goto-subject article)
12507         (error (format "No such article: %d" article)))
12508     (gnus-summary-position-point)
12509     ;; If all commands are to be bunched up on one line, we collect
12510     ;; them here.
12511     (if gnus-view-pseudos-separately
12512         ()
12513       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
12514             files action)
12515         (while ps
12516           (setq action (cdr (assq 'action (car ps))))
12517           (setq files (list (cdr (assq 'name (car ps)))))
12518           (while (and ps (cdr ps)
12519                       (string= (or action "1")
12520                                (or (cdr (assq 'action (car (cdr ps)))) "2")))
12521             (setq files (cons (cdr (assq 'name (car (cdr ps)))) files))
12522             (setcdr ps (cdr (cdr ps))))
12523           (if (not files)
12524               ()
12525             (if (not (string-match "%s" action))
12526                 (setq files (cons " " files)))
12527             (setq files (cons " " files))
12528             (and (assq 'execute (car ps))
12529                  (setcdr (assq 'execute (car ps))
12530                          (funcall (if (string-match "%s" action)
12531                                       'format 'concat)
12532                                   action
12533                                   (mapconcat (lambda (f) f) files " ")))))
12534           (setq ps (cdr ps)))))
12535     (if (and gnus-view-pseudos (not not-view))
12536         (while pslist
12537           (and (assq 'execute (car pslist))
12538                (gnus-execute-command (cdr (assq 'execute (car pslist)))
12539                                      (eq gnus-view-pseudos 'not-confirm)))
12540           (setq pslist (cdr pslist)))
12541       (save-excursion
12542         (while pslist
12543           (setq after-article (or (cdr (assq 'article (car pslist)))
12544                                   (gnus-summary-article-number)))
12545           (gnus-summary-goto-subject after-article)
12546           (forward-line 1)
12547           (setq b (point))
12548           (insert "          " (file-name-nondirectory
12549                                 (cdr (assq 'name (car pslist))))
12550                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
12551           (setq e (point))
12552           (forward-line -1)             ; back to `b'
12553           (add-text-properties
12554            b e (list 'gnus-number gnus-reffed-article-number
12555                      gnus-mouse-face-prop gnus-mouse-face))
12556           (gnus-data-enter after-article
12557                            gnus-reffed-article-number
12558                            gnus-unread-mark
12559                            b
12560                            (car pslist)
12561                            0
12562                            (- e b))
12563           (setq gnus-newsgroup-unreads
12564                 (cons gnus-reffed-article-number gnus-newsgroup-unreads))
12565           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
12566           (setq pslist (cdr pslist)))))))
12567
12568 (defun gnus-pseudos< (p1 p2)
12569   (let ((c1 (cdr (assq 'action p1)))
12570         (c2 (cdr (assq 'action p2))))
12571     (and c1 c2 (string< c1 c2))))
12572
12573 (defun gnus-request-pseudo-article (props)
12574   (cond ((assq 'execute props)
12575          (gnus-execute-command (cdr (assq 'execute props)))))
12576   (let ((gnus-current-article (gnus-summary-article-number)))
12577     (run-hooks 'gnus-mark-article-hook)))
12578
12579 (defun gnus-execute-command (command &optional automatic)
12580   (save-excursion
12581     (gnus-article-setup-buffer)
12582     (set-buffer gnus-article-buffer)
12583     (let ((command (if automatic command (read-string "Command: " command)))
12584           (buffer-read-only nil))
12585       (erase-buffer)
12586       (insert "$ " command "\n\n")
12587       (if gnus-view-pseudo-asynchronously
12588           (start-process "gnus-execute" nil "sh" "-c" command)
12589         (call-process "sh" nil t nil "-c" command)))))
12590
12591 (defun gnus-copy-file (file &optional to)
12592   "Copy FILE to TO."
12593   (interactive
12594    (list (read-file-name "Copy file: " default-directory)
12595          (read-file-name "Copy file to: " default-directory)))
12596   (gnus-set-global-variables)
12597   (or to (setq to (read-file-name "Copy file to: " default-directory)))
12598   (and (file-directory-p to)
12599        (setq to (concat (file-name-as-directory to)
12600                         (file-name-nondirectory file))))
12601   (copy-file file to))
12602
12603 ;; Summary kill commands.
12604
12605 (defun gnus-summary-edit-global-kill (article)
12606   "Edit the \"global\" kill file."
12607   (interactive (list (gnus-summary-article-number)))
12608   (gnus-set-global-variables)
12609   (gnus-group-edit-global-kill article))
12610
12611 (defun gnus-summary-edit-local-kill ()
12612   "Edit a local kill file applied to the current newsgroup."
12613   (interactive)
12614   (gnus-set-global-variables)
12615   (setq gnus-current-headers (gnus-summary-article-header))
12616   (gnus-set-global-variables)
12617   (gnus-group-edit-local-kill
12618    (gnus-summary-article-number) gnus-newsgroup-name))
12619
12620 \f
12621 ;;;
12622 ;;; Gnus article mode
12623 ;;;
12624
12625 (put 'gnus-article-mode 'mode-class 'special)
12626
12627 (if gnus-article-mode-map
12628     nil
12629   (setq gnus-article-mode-map (make-keymap))
12630   (suppress-keymap gnus-article-mode-map)
12631
12632   (gnus-define-keys
12633    gnus-article-mode-map
12634    " " gnus-article-goto-next-page
12635    "\177" gnus-article-goto-prev-page
12636    "\C-c^" gnus-article-refer-article
12637    "h" gnus-article-show-summary
12638    "s" gnus-article-show-summary
12639    "\C-c\C-m" gnus-article-mail
12640    "?" gnus-article-describe-briefly
12641    gnus-mouse-2 gnus-article-push-button
12642    "\r" gnus-article-press-button
12643    "\t" gnus-article-next-button
12644    "\M-\t" gnus-article-prev-button
12645    "\C-c\C-b" gnus-bug)
12646
12647   (substitute-key-definition
12648    'undefined 'gnus-article-read-summary-keys gnus-article-mode-map))
12649
12650
12651 (defun gnus-article-mode ()
12652   "Major mode for displaying an article.
12653
12654 All normal editing commands are switched off.
12655
12656 The following commands are available:
12657
12658 \\<gnus-article-mode-map>
12659 \\[gnus-article-next-page]\t Scroll the article one page forwards
12660 \\[gnus-article-prev-page]\t Scroll the article one page backwards
12661 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
12662 \\[gnus-article-show-summary]\t Display the summary buffer
12663 \\[gnus-article-mail]\t Send a reply to the address near point
12664 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
12665 \\[gnus-info-find-node]\t Go to the Gnus info node"
12666   (interactive)
12667   (when (and menu-bar-mode
12668              (gnus-visual-p 'article-menu 'menu))
12669     (gnus-article-make-menu-bar))
12670   (kill-all-local-variables)
12671   (gnus-simplify-mode-line)
12672   (setq mode-name "Article")
12673   (setq major-mode 'gnus-article-mode)
12674   (make-local-variable 'minor-mode-alist)
12675   (or (assq 'gnus-show-mime minor-mode-alist)
12676       (setq minor-mode-alist
12677             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
12678   (use-local-map gnus-article-mode-map)
12679   (make-local-variable 'page-delimiter)
12680   (setq page-delimiter gnus-page-delimiter)
12681   (buffer-disable-undo (current-buffer))
12682   (setq buffer-read-only t)             ;Disable modification
12683   (run-hooks 'gnus-article-mode-hook))
12684
12685 (defun gnus-article-setup-buffer ()
12686   "Initialize the article buffer."
12687   (let* ((name (if gnus-single-article-buffer "*Article*"
12688                  (concat "*Article " gnus-newsgroup-name "*")))
12689          (original
12690           (progn (string-match "\\*Article" name)
12691                  (concat " *Original Article"
12692                          (substring name (match-end 0))))))
12693     (setq gnus-article-buffer name)
12694     (setq gnus-original-article-buffer original)
12695     ;; This might be a variable local to the summary buffer.
12696     (unless gnus-single-article-buffer
12697       (save-excursion
12698         (set-buffer gnus-summary-buffer)
12699         (setq gnus-article-buffer name)
12700         (setq gnus-original-article-buffer original))
12701       (make-local-variable 'gnus-summary-buffer))
12702     (if (get-buffer name)
12703         (save-excursion
12704           (set-buffer name)
12705           (buffer-disable-undo (current-buffer))
12706           (setq buffer-read-only t)
12707           (gnus-add-current-to-buffer-list)
12708           (or (eq major-mode 'gnus-article-mode)
12709               (gnus-article-mode))
12710           (current-buffer))
12711       (save-excursion
12712         (set-buffer (get-buffer-create name))
12713         (gnus-add-current-to-buffer-list)
12714         (gnus-article-mode)
12715         (current-buffer)))))
12716
12717 ;; Set article window start at LINE, where LINE is the number of lines
12718 ;; from the head of the article.
12719 (defun gnus-article-set-window-start (&optional line)
12720   (set-window-start
12721    (get-buffer-window gnus-article-buffer)
12722    (save-excursion
12723      (set-buffer gnus-article-buffer)
12724      (goto-char (point-min))
12725      (if (not line)
12726          (point-min)
12727        (gnus-message 6 "Moved to bookmark")
12728        (search-forward "\n\n" nil t)
12729        (forward-line line)
12730        (point)))))
12731
12732 (defun gnus-kill-all-overlays ()
12733   "Delete all overlays in the current buffer."
12734   (when (fboundp 'overlay-lists)
12735     (let* ((overlayss (overlay-lists))
12736            (buffer-read-only nil)
12737            (overlays (nconc (car overlayss) (cdr overlayss))))
12738       (while overlays
12739         (delete-overlay (pop overlays))))))
12740
12741 (defun gnus-request-article-this-buffer (article group)
12742   "Get an article and insert it into this buffer."
12743   (let (sparse)
12744     (prog1
12745         (save-excursion
12746           (if (get-buffer gnus-original-article-buffer)
12747               (set-buffer (get-buffer gnus-original-article-buffer))
12748             (set-buffer (get-buffer-create gnus-original-article-buffer))
12749             (buffer-disable-undo (current-buffer))
12750             (setq major-mode 'gnus-original-article-mode)
12751             (setq buffer-read-only t)
12752             (gnus-add-current-to-buffer-list))
12753
12754           (setq group (or group gnus-newsgroup-name))
12755
12756           ;; Open server if it has closed.
12757           (gnus-check-server (gnus-find-method-for-group group))
12758
12759           ;; Using `gnus-request-article' directly will insert the article into
12760           ;; `nntp-server-buffer' - so we'll save some time by not having to
12761           ;; copy it from the server buffer into the article buffer.
12762
12763           ;; We only request an article by message-id when we do not have the
12764           ;; headers for it, so we'll have to get those.
12765           (and (stringp article)
12766                (let ((gnus-override-method gnus-refer-article-method))
12767                  (gnus-read-header article)))
12768
12769           ;; If the article number is negative, that means that this article
12770           ;; doesn't belong in this newsgroup (possibly), so we find its
12771           ;; message-id and request it by id instead of number.
12772           (if (not (numberp article))
12773               ()
12774             (save-excursion
12775               (set-buffer gnus-summary-buffer)
12776               (let ((header (gnus-summary-article-header article)))
12777                 (if (< article 0)
12778                     (cond 
12779                      ((memq article gnus-newsgroup-sparse)
12780                       ;; This is a sparse gap article.
12781                       (setq article (mail-header-id header)))
12782                      ((vectorp header)
12783                       ;; It's a real article.
12784                       (setq article (mail-header-id header)))
12785                      (t
12786                       ;; It is an extracted pseudo-article.
12787                       (setq article 'pseudo)
12788                       (gnus-request-pseudo-article header))))
12789                 
12790                 (let ((method (gnus-find-method-for-group 
12791                                gnus-newsgroup-name)))
12792                   (if (not (eq (car method) 'nneething))
12793                       ()
12794                     (let ((dir (concat (file-name-as-directory (nth 1 method))
12795                                        (mail-header-subject header))))
12796                       (if (file-directory-p dir)
12797                           (progn
12798                             (setq article 'nneething)
12799                             (gnus-group-enter-directory dir)))))))))
12800
12801           (cond
12802            ;; We first check `gnus-original-article-buffer'.
12803            ((and (equal (car gnus-original-article) group)
12804                  (eq (cdr gnus-original-article) article))
12805             ;; We don't have to do anything, since it's already where we
12806             ;; want it.
12807             'article)
12808            ;; Check the backlog.
12809            ((and gnus-keep-backlog
12810                  (gnus-backlog-request-article group article (current-buffer)))
12811             'article)
12812            ;; Check the cache.
12813            ((and gnus-use-cache
12814                  (numberp article)
12815                  (gnus-cache-request-article article group))
12816             'article)
12817            ;; Get the article and put into the article buffer.
12818            ((or (stringp article) (numberp article))
12819             (let ((gnus-override-method
12820                    (and (stringp article) gnus-refer-article-method))
12821                   (buffer-read-only nil))
12822               (erase-buffer)
12823               (gnus-kill-all-overlays)
12824               (if (gnus-request-article article group (current-buffer))
12825                   (progn
12826                     (and gnus-keep-backlog
12827                          (gnus-backlog-enter-article
12828                           group article (current-buffer)))
12829                     'article))))
12830            ;; It was a pseudo.
12831            (t article)))
12832       (unless sparse
12833         (setq gnus-original-article (cons group article))
12834         (unless (equal (buffer-name (current-buffer))
12835                        (buffer-name (get-buffer gnus-original-article-buffer)))
12836           (let (buffer-read-only)
12837             (erase-buffer)
12838             (gnus-kill-all-overlays)
12839             (insert-buffer-substring gnus-original-article-buffer)))))))
12840
12841 (defun gnus-read-header (id)
12842   "Read the headers of article ID and enter them into the Gnus system."
12843   (let ((group gnus-newsgroup-name)
12844         (headers gnus-newsgroup-headers)
12845         header where)
12846     ;; First we check to see whether the header in question is already
12847     ;; fetched.
12848     (if (stringp id)
12849         ;; This is a Message-ID.
12850         (setq header (gnus-id-to-header id))
12851       ;; This is an article number.
12852       (setq header (gnus-summary-article-header id)))
12853     (if header
12854         ;; We have found the header.
12855         header
12856       ;; We have to really fetch the header to this article.
12857       (when (setq where
12858                   (if (gnus-check-backend-function 'request-head group)
12859                       (gnus-request-head id group)
12860                     (gnus-request-article id group)))
12861         (save-excursion
12862           (set-buffer nntp-server-buffer)
12863           (and (search-forward "\n\n" nil t)
12864                (delete-region (1- (point)) (point-max)))
12865           (goto-char (point-max))
12866           (insert ".\n")
12867           (goto-char (point-min))
12868           (insert "211 "
12869                   (int-to-string
12870                    (cond
12871                     ((numberp id)
12872                      id)
12873                     ((cdr where)
12874                      (cdr where))
12875                     (t
12876                      gnus-reffed-article-number)))
12877                   " Article retrieved.\n"))
12878         (if (not (setq header (car (gnus-get-newsgroup-headers))))
12879             () ; Malformed head.
12880           (if (and (stringp id)
12881                    (not (string= (gnus-group-real-name group)
12882                                  (car where))))
12883               ;; If we fetched by Message-ID and the article came
12884               ;; from a different group, we fudge some bogus article
12885               ;; numbers for this article.
12886               (mail-header-set-number header gnus-reffed-article-number))
12887           (decf gnus-reffed-article-number)
12888           (push header gnus-newsgroup-headers)
12889           (setq gnus-current-headers header)
12890           (push (mail-header-number header) gnus-newsgroup-limit)
12891           header)))))
12892
12893 (defun gnus-article-prepare (article &optional all-headers header)
12894   "Prepare ARTICLE in article mode buffer.
12895 ARTICLE should either be an article number or a Message-ID.
12896 If ARTICLE is an id, HEADER should be the article headers.
12897 If ALL-HEADERS is non-nil, no headers are hidden."
12898   (save-excursion
12899     ;; Make sure we start in a summary buffer.
12900     (unless (eq major-mode 'gnus-summary-mode)
12901       (set-buffer gnus-summary-buffer))
12902     (setq gnus-summary-buffer (current-buffer))
12903     ;; Make sure the connection to the server is alive.
12904     (unless (gnus-server-opened
12905              (gnus-find-method-for-group gnus-newsgroup-name))
12906       (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
12907       (gnus-request-group gnus-newsgroup-name t))
12908     (let* ((article (if header (mail-header-number header) article))
12909            (summary-buffer (current-buffer))
12910            (internal-hook gnus-article-internal-prepare-hook)
12911            (group gnus-newsgroup-name)
12912            result)
12913       (save-excursion
12914         (gnus-article-setup-buffer)
12915         (set-buffer gnus-article-buffer)
12916         ;; Deactivate active regions.
12917         (when (and (boundp 'transient-mark-mode)
12918                    transient-mark-mode)
12919           (setq mark-active nil))
12920         (if (not (setq result (let ((buffer-read-only nil))
12921                                 (gnus-request-article-this-buffer
12922                                  article group))))
12923             ;; There is no such article.
12924             (save-excursion
12925               (when (and (numberp article)
12926                          (not (memq article gnus-newsgroup-sparse)))
12927                 (setq gnus-article-current
12928                       (cons gnus-newsgroup-name article))
12929                 (set-buffer gnus-summary-buffer)
12930                 (setq gnus-current-article article)
12931                 (gnus-summary-mark-article article gnus-canceled-mark))
12932               (unless (memq article gnus-newsgroup-sparse)
12933                 (gnus-message
12934                  1 "No such article (may have expired or been canceled)")
12935                 (ding)
12936                 nil))
12937           (if (or (eq result 'pseudo) (eq result 'nneething))
12938               (progn
12939                 (save-excursion
12940                   (set-buffer summary-buffer)
12941                   (setq gnus-last-article gnus-current-article
12942                         gnus-newsgroup-history (cons gnus-current-article
12943                                                      gnus-newsgroup-history)
12944                         gnus-current-article 0
12945                         gnus-current-headers nil
12946                         gnus-article-current nil)
12947                   (if (eq result 'nneething)
12948                       (gnus-configure-windows 'summary)
12949                     (gnus-configure-windows 'article))
12950                   (gnus-set-global-variables))
12951                 (gnus-set-mode-line 'article))
12952             ;; The result from the `request' was an actual article -
12953             ;; or at least some text that is now displayed in the
12954             ;; article buffer.
12955             (if (and (numberp article)
12956                      (not (eq article gnus-current-article)))
12957                 ;; Seems like a new article has been selected.
12958                 ;; `gnus-current-article' must be an article number.
12959                 (save-excursion
12960                   (set-buffer summary-buffer)
12961                   (setq gnus-last-article gnus-current-article
12962                         gnus-newsgroup-history (cons gnus-current-article
12963                                                      gnus-newsgroup-history)
12964                         gnus-current-article article
12965                         gnus-current-headers
12966                         (gnus-summary-article-header gnus-current-article)
12967                         gnus-article-current
12968                         (cons gnus-newsgroup-name gnus-current-article))
12969                   (unless (vectorp gnus-current-headers)
12970                     (setq gnus-current-headers nil))
12971                   (gnus-summary-show-thread)
12972                   (run-hooks 'gnus-mark-article-hook)
12973                   (gnus-set-mode-line 'summary)
12974                   (and (gnus-visual-p 'article-highlight 'highlight)
12975                        (run-hooks 'gnus-visual-mark-article-hook))
12976                   ;; Set the global newsgroup variables here.
12977                   ;; Suggested by Jim Sisolak
12978                   ;; <sisolak@trans4.neep.wisc.edu>.
12979                   (gnus-set-global-variables)
12980                   (setq gnus-have-all-headers
12981                         (or all-headers gnus-show-all-headers))
12982                   (and gnus-use-cache
12983                        (vectorp (gnus-summary-article-header article))
12984                        (gnus-cache-possibly-enter-article
12985                         group article
12986                         (gnus-summary-article-header article)
12987                         (memq article gnus-newsgroup-marked)
12988                         (memq article gnus-newsgroup-dormant)
12989                         (memq article gnus-newsgroup-unreads)))))
12990             ;; Hooks for getting information from the article.
12991             ;; This hook must be called before being narrowed.
12992             (let (buffer-read-only)
12993               (run-hooks 'internal-hook)
12994               (run-hooks 'gnus-article-prepare-hook)
12995               ;; Decode MIME message.
12996               (if gnus-show-mime
12997                   (if (or (not gnus-strict-mime)
12998                           (gnus-fetch-field "Mime-Version"))
12999                       (funcall gnus-show-mime-method)
13000                     (funcall gnus-decode-encoded-word-method)))
13001               ;; Perform the article display hooks.
13002               (run-hooks 'gnus-article-display-hook))
13003             ;; Do page break.
13004             (goto-char (point-min))
13005             (and gnus-break-pages (gnus-narrow-to-page))
13006             (gnus-set-mode-line 'article)
13007             (gnus-configure-windows 'article)
13008             (goto-char (point-min))
13009             t))))))
13010
13011 (defun gnus-article-show-all-headers ()
13012   "Show all article headers in article mode buffer."
13013   (save-excursion
13014     (gnus-article-setup-buffer)
13015     (set-buffer gnus-article-buffer)
13016     (let ((buffer-read-only nil))
13017       (remove-text-properties (point-min) (point-max)
13018                               gnus-hidden-properties))))
13019
13020 (defun gnus-article-hide-headers-if-wanted ()
13021   "Hide unwanted headers if `gnus-have-all-headers' is nil.
13022 Provided for backwards compatibility."
13023   (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
13024       gnus-inhibit-hiding
13025       (gnus-article-hide-headers)))
13026
13027 (defun gnus-article-hide-headers (&optional arg delete)
13028   "Toggle whether to hide unwanted headers and possibly sort them as well.
13029 If given a negative prefix, always show; if given a positive prefix,
13030 always hide."
13031   (interactive "P")
13032   (unless (gnus-article-check-hidden-text 'headers arg)
13033     ;; This function might be inhibited.
13034     (unless gnus-inhibit-hiding
13035       (save-excursion
13036         (set-buffer gnus-article-buffer)
13037         (save-restriction
13038           (let ((buffer-read-only nil)
13039                 (ignored (when (not (stringp gnus-visible-headers))
13040                            (cond ((stringp gnus-ignored-headers)
13041                                   gnus-ignored-headers)
13042                                  ((listp gnus-ignored-headers)
13043                                   (mapconcat 'identity gnus-ignored-headers
13044                                              "\\|")))))
13045                 (visible (cond ((stringp gnus-visible-headers)
13046                                 gnus-visible-headers)
13047                                ((listp gnus-visible-headers)
13048                                 (mapconcat 'identity gnus-visible-headers
13049                                            "\\|"))))
13050                 want-list beg want-l)
13051             ;; First we narrow to just the headers.
13052             (widen)
13053             (goto-char (point-min))
13054             ;; Hide any "From " lines at the beginning of (mail) articles.
13055             (while (looking-at "From ")
13056               (forward-line 1))
13057             (unless (bobp)
13058               (add-text-properties
13059                (point-min) (point)
13060                (nconc (list 'gnus-type 'headers) gnus-hidden-properties)))
13061             ;; Then treat the rest of the header lines.
13062             (narrow-to-region
13063              (point)
13064              (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
13065             ;; Then we use the two regular expressions
13066             ;; `gnus-ignored-headers' and `gnus-visible-headers' to
13067             ;; select which header lines is to remain visible in the
13068             ;; article buffer.
13069             (goto-char (point-min))
13070             (while (re-search-forward "^[^ \t]*:" nil t)
13071               (beginning-of-line)
13072               ;; We add the headers we want to keep to a list and delete
13073               ;; them from the buffer.
13074               (if (or (and visible (looking-at visible))
13075                       (and ignored (not (looking-at ignored))))
13076                   (progn
13077                     (push (buffer-substring
13078                            (setq beg (point))
13079                            (progn
13080                              (forward-line 1)
13081                              ;; Be sure to get multi-line headers...
13082                              (re-search-forward "^[^ \t]*:" nil t)
13083                              (beginning-of-line)
13084                              (point)))
13085                           want-list)
13086                     (delete-region beg (point)))
13087                 (forward-line 1)))
13088             ;; Sort the headers that we want to display.
13089             (setq want-list (sort want-list 'gnus-article-header-less))
13090             (goto-char (point-min))
13091             (while want-list
13092               (insert (pop want-list)))
13093             ;; We make the unwanted headers invisible.
13094             (if delete
13095                 (delete-region (point-min) (point-max))
13096               ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
13097               (add-text-properties
13098                (point) (point-max)
13099                (nconc (list 'gnus-type 'headers)
13100                       gnus-hidden-properties)))))))))
13101
13102 (defsubst gnus-article-header-rank (header)
13103   "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
13104   (let ((list gnus-sorted-header-list)
13105         (i 0))
13106     (while list
13107       (when (string-match (car list) header)
13108         (setq list nil))
13109       (setq list (cdr list))
13110       (incf i))
13111     i))
13112
13113 (defun gnus-article-header-less (h1 h2)
13114   "Say whether string H1 is \"less\" than string H2."
13115   (< (gnus-article-header-rank h1)
13116      (gnus-article-header-rank h2)))
13117
13118 (defun gnus-article-hide-boring-headers (&optional arg)
13119   "Toggle hiding of headers that aren't very interesting.
13120 If given a negative prefix, always show; if given a positive prefix,
13121 always hide."
13122   (interactive "P")
13123   (unless (gnus-article-check-hidden-text 'boring-headers arg)
13124     (save-excursion
13125       (set-buffer gnus-article-buffer)
13126       (save-restriction
13127         (let ((buffer-read-only nil)
13128               (list gnus-boring-article-headers)
13129               (inhibit-point-motion-hooks t)
13130               elem)
13131           (nnheader-narrow-to-headers)
13132           (while list
13133             (setq elem (pop list))
13134             (goto-char (point-min))
13135             (cond
13136              ;; Hide empty headers.
13137              ((eq elem 'empty)
13138               (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t)
13139                 (forward-line -1)
13140                 (gnus-article-hide-header)))
13141              ;; Hide boring Newsgroups header.
13142              ((eq elem 'newsgroups)
13143               (when (equal (mail-fetch-field "newsgroups")
13144                            (gnus-group-real-name gnus-newsgroup-name))
13145                 (gnus-article-hide-header "newsgroups")))
13146              ((eq elem 'followup-to)
13147               (when (equal (mail-fetch-field "followup-to")
13148                            (mail-fetch-field "newsgroups"))
13149                 (gnus-article-hide-header "followup-to")))
13150              ((eq elem 'reply-to)
13151               (let ((from (mail-fetch-field "from"))
13152                     (reply-to (mail-fetch-field "reply-to")))
13153                 (when (and
13154                        from reply-to
13155                        (equal 
13156                         (nth 1 (mail-extract-address-components from))
13157                         (nth 1 (mail-extract-address-components reply-to))))
13158                   (gnus-article-hide-header "reply-to"))))
13159              ((eq elem 'date)
13160               (let ((date (mail-fetch-field "date")))
13161                 (when (and date
13162                            (< (gnus-days-between date (current-time-string))
13163                               4))
13164                   (gnus-article-hide-header "date")))))))))))
13165
13166 (defun gnus-article-hide-header (header)
13167   (save-excursion
13168     (goto-char (point-min))
13169     (when (re-search-forward (concat "^" header ":") nil t)
13170       (add-text-properties
13171        (progn (beginning-of-line) (point))
13172        (progn 
13173          (end-of-line)
13174          (if (re-search-forward "^[^ \t]" nil t)
13175              (match-beginning 0)
13176            (point-max)))
13177        (nconc (list 'gnus-type 'boring-headers)
13178               gnus-hidden-properties)))))
13179
13180 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
13181 (defun gnus-article-treat-overstrike ()
13182   "Translate overstrikes into bold text."
13183   (interactive)
13184   (save-excursion
13185     (set-buffer gnus-article-buffer)
13186     (let ((buffer-read-only nil))
13187       (while (search-forward "\b" nil t)
13188         (let ((next (following-char))
13189               (previous (char-after (- (point) 2))))
13190           (cond ((eq next previous)
13191                  (put-text-property (- (point) 2) (point) 'invisible t)
13192                  (put-text-property (point) (1+ (point)) 'face 'bold))
13193                 ((eq next ?_)
13194                  (put-text-property (1- (point)) (1+ (point)) 'invisible t)
13195                  (put-text-property
13196                   (- (point) 2) (1- (point)) 'face 'underline))
13197                 ((eq previous ?_)
13198                  (put-text-property (- (point) 2) (point) 'invisible t)
13199                  (put-text-property
13200                   (point) (1+ (point))  'face 'underline))))))))
13201
13202 (defun gnus-article-word-wrap ()
13203   "Format too long lines."
13204   (interactive)
13205   (save-excursion
13206     (set-buffer gnus-article-buffer)
13207     (let ((buffer-read-only nil)
13208           p)
13209       (widen)
13210       (goto-char (point-min))
13211       (search-forward "\n\n" nil t)
13212       (end-of-line 1)
13213       (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
13214             (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
13215             (adaptive-fill-mode t))
13216         (while (not (eobp))
13217           (and (>= (current-column) (min fill-column (window-width)))
13218                (/= (preceding-char) ?:)
13219                (fill-paragraph nil))
13220           (end-of-line 2))))))
13221
13222 (defun gnus-article-remove-cr ()
13223   "Remove carriage returns from an article."
13224   (interactive)
13225   (save-excursion
13226     (set-buffer gnus-article-buffer)
13227     (let ((buffer-read-only nil))
13228       (goto-char (point-min))
13229       (while (search-forward "\r" nil t)
13230         (replace-match "" t t)))))
13231
13232 (defun gnus-article-remove-trailing-blank-lines ()
13233   "Remove all trailing blank lines from the article."
13234   (interactive)
13235   (save-excursion
13236     (set-buffer gnus-article-buffer)
13237     (let ((buffer-read-only nil))
13238       (goto-char (point-max))
13239       (delete-region
13240        (point)
13241        (progn
13242          (while (looking-at "^[ \t]*$")
13243            (forward-line -1))
13244          (forward-line 1)
13245          (point))))))
13246
13247 (defun gnus-article-display-x-face (&optional force)
13248   "Look for an X-Face header and display it if present."
13249   (interactive (list 'force))
13250   (save-excursion
13251     (set-buffer gnus-article-buffer)
13252     ;; Delete the old process, if any.
13253     (when (process-status "gnus-x-face")
13254       (delete-process "gnus-x-face"))
13255     (let ((inhibit-point-motion-hooks t)
13256           (case-fold-search nil)
13257           from)
13258       (save-restriction
13259         (nnheader-narrow-to-headers)
13260         (setq from (mail-fetch-field "from"))
13261         (goto-char (point-min))
13262         (when (and gnus-article-x-face-command
13263                    (or force
13264                        ;; Check whether this face is censored.
13265                        (not gnus-article-x-face-too-ugly)
13266                        (and gnus-article-x-face-too-ugly from
13267                             (not (string-match gnus-article-x-face-too-ugly
13268                                                from))))
13269                    ;; Has to be present.
13270                    (re-search-forward "^X-Face: " nil t))
13271           ;; We now have the area of the buffer where the X-Face is stored.
13272           (let ((beg (point))
13273                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
13274             ;; We display the face.
13275             (if (symbolp gnus-article-x-face-command)
13276                 ;; The command is a lisp function, so we call it.
13277                 (if (gnus-functionp gnus-article-x-face-command)
13278                     (funcall gnus-article-x-face-command beg end)
13279                   (error "%s is not a function" gnus-article-x-face-command))
13280               ;; The command is a string, so we interpret the command
13281               ;; as a, well, command, and fork it off.
13282               (let ((process-connection-type nil))
13283                 (process-kill-without-query
13284                  (start-process
13285                   "gnus-x-face" nil "sh" "-c" gnus-article-x-face-command))
13286                 (process-send-region "gnus-x-face" beg end)
13287                 (process-send-eof "gnus-x-face")))))))))
13288
13289 (defun gnus-headers-decode-quoted-printable ()
13290   "Hack to remove QP encoding from headers."
13291   (let ((case-fold-search t)
13292         (inhibit-point-motion-hooks t)
13293         string)
13294     (goto-char (point-min))
13295     (while (re-search-forward "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
13296       (setq string (match-string 1))
13297       (narrow-to-region (match-beginning 0) (match-end 0))
13298       (delete-region (point-min) (point-max))
13299       (insert string)
13300       (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
13301       (subst-char-in-region (point-min) (point-max) ?_ ? )
13302       (widen)
13303       (goto-char (point-min)))))
13304
13305 (defun gnus-article-de-quoted-unreadable (&optional force)
13306   "Do a naive translation of a quoted-printable-encoded article.
13307 This is in no way, shape or form meant as a replacement for real MIME
13308 processing, but is simply a stop-gap measure until MIME support is
13309 written.
13310 If FORCE, decode the article whether it is marked as quoted-printable
13311 or not."
13312   (interactive (list 'force))
13313   (save-excursion
13314     (set-buffer gnus-article-buffer)
13315     (let ((case-fold-search t)
13316           (buffer-read-only nil)
13317           (type (gnus-fetch-field "content-transfer-encoding")))
13318       (when (or force
13319                 (and type (string-match "quoted-printable" type)))
13320         (goto-char (point-min))
13321         (search-forward "\n\n" nil 'move)
13322         (gnus-mime-decode-quoted-printable (point) (point-max))
13323         (gnus-headers-decode-quoted-printable)))))
13324
13325 (defun gnus-mime-decode-quoted-printable (from to)
13326   "Decode Quoted-Printable in the region between FROM and TO."
13327   (goto-char from)
13328   (while (search-forward "=" to t)
13329     (cond ((eq (following-char) ?\n)
13330            (delete-char -1)
13331            (delete-char 1))
13332           ((looking-at "[0-9A-F][0-9A-F]")
13333            (delete-char -1)
13334            (insert (hexl-hex-string-to-integer
13335                     (buffer-substring (point) (+ 2 (point)))))
13336            (delete-char 2))
13337           ((looking-at "=")
13338            (delete-char 1))
13339           ((gnus-message 3 "Malformed MIME quoted-printable message")))))
13340
13341 (defun gnus-article-hide-pgp (&optional arg)
13342   "Toggle hiding of any PGP headers and signatures in the current article.
13343 If given a negative prefix, always show; if given a positive prefix,
13344 always hide."
13345   (interactive "P")
13346   (unless (gnus-article-check-hidden-text 'pgp arg)
13347     (save-excursion
13348       (set-buffer gnus-article-buffer)
13349       (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties))
13350             buffer-read-only beg end)
13351         (widen)
13352         (goto-char (point-min))
13353         ;; Hide the "header".
13354         (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
13355              (add-text-properties (match-beginning 0) (match-end 0) props))
13356         (setq beg (point))
13357         ;; Hide the actual signature.
13358         (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
13359              (setq end (match-beginning 0))
13360              (add-text-properties
13361               (match-beginning 0)
13362               (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
13363                   (match-end 0)
13364                 ;; Perhaps we shouldn't hide to the end of the buffer
13365                 ;; if there is no end to the signature?
13366                 (point-max))
13367               props))
13368         ;; Hide "- " PGP quotation markers.
13369         (when (and beg end)
13370           (narrow-to-region beg end)
13371           (goto-char (point-min))
13372           (while (re-search-forward "^- " nil t)
13373             (add-text-properties (match-beginning 0) (match-end 0) props))
13374           (widen))))))
13375
13376 (defun gnus-article-hide-signature (&optional arg)
13377   "Hide the signature in the current article.
13378 If given a negative prefix, always show; if given a positive prefix,
13379 always hide."
13380   (interactive "P")
13381   (unless (gnus-article-check-hidden-text 'signature arg)
13382     (save-excursion
13383       (set-buffer gnus-article-buffer)
13384       (let ((buffer-read-only nil))
13385         (goto-char (point-max))
13386         (and (re-search-backward gnus-signature-separator nil t)
13387              gnus-signature-face
13388              (add-text-properties
13389               (match-end 0) (point-max)
13390               (nconc (list 'gnus-type 'signature)
13391                      gnus-hidden-properties)))))))
13392
13393 (defun gnus-article-check-hidden-text (type arg)
13394   "Return nil if hiding is necessary."
13395   (let ((hide (gnus-article-hidden-text-p 'signature)))
13396     (cond ((or (and (null arg) (eq hide 'hidden))
13397                (and arg (< 0 (prefix-numeric-value arg))))
13398            (gnus-article-show-hidden-text 'signature))
13399           ((eq hide 'shown)
13400            (gnus-article-show-hidden-text 'signature t))
13401           (t nil))))
13402
13403 (defun gnus-article-hidden-text-p (type)
13404   "Say whether the current buffer contains hidden text of type TYPE."
13405   (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type))
13406         prop)
13407     (when pos
13408       (if (get-text-property pos 'invisible)
13409           'hidden
13410         'shown))))
13411
13412 (defun gnus-article-hide (&optional arg force)
13413   "Hide all the gruft in the current article.
13414 This means that PGP stuff, signatures, cited text and (some)
13415 headers will be hidden.
13416 If given a prefix, show the hidden text instead."
13417   (interactive (list current-prefix-arg 'force))
13418   (gnus-article-hide-headers arg)
13419   (gnus-article-hide-pgp arg)
13420   (gnus-article-hide-citation-maybe arg force)
13421   (gnus-article-hide-signature arg))
13422
13423 (defun gnus-article-show-hidden-text (type &optional hide)
13424   "Show all hidden text of type TYPE.
13425 If HIDE, hide the text instead."
13426   (save-excursion
13427     (set-buffer gnus-article-buffer)
13428     (let ((buffer-read-only nil)
13429           (inhibit-point-motion-hooks t)
13430           (beg (point)))
13431       (while (gnus-goto-char (text-property-any
13432                               beg (point-max) 'gnus-type type))
13433         (if hide
13434             (add-text-properties (point) (setq beg (1+ (point)))
13435                                  gnus-hidden-properties)
13436           (remove-text-properties (point) (setq beg (1+ (point)))
13437                                   gnus-hidden-properties)))
13438       t)))
13439
13440 (defvar gnus-article-time-units
13441   `((year . ,(* 365.25 24 60 60))
13442     (week . ,(* 7 24 60 60))
13443     (day . ,(* 24 60 60))
13444     (hour . ,(* 60 60))
13445     (minute . 60)
13446     (second . 1))
13447   "Mapping from time units to seconds.")
13448
13449 (defun gnus-article-date-ut (&optional type highlight)
13450   "Convert DATE date to universal time in the current article.
13451 If TYPE is `local', convert to local time; if it is `lapsed', output
13452 how much time has lapsed since DATE."
13453   (interactive (list 'ut t))
13454   (let* ((header (or gnus-current-headers
13455                      (gnus-summary-article-header) ""))
13456          (date (and (vectorp header) (mail-header-date header)))
13457          (date-regexp "^Date: \\|^X-Sent: ")
13458          (now (current-time))
13459          (inhibit-point-motion-hooks t))
13460     (when (and date (not (string= date "")))
13461       (save-excursion
13462         (set-buffer gnus-article-buffer)
13463         (save-restriction
13464           (nnheader-narrow-to-headers)
13465           (let ((buffer-read-only nil))
13466             ;; Delete any old Date headers.
13467             (if (zerop (nnheader-remove-header date-regexp t))
13468                 (beginning-of-line)
13469               (goto-char (point-max)))
13470             (insert
13471              (cond
13472               ;; Convert to the local timezone.  We have to slap a
13473               ;; `condition-case' round the calls to the timezone
13474               ;; functions since they aren't particularly resistant to
13475               ;; buggy dates.
13476               ((eq type 'local)
13477                (concat "Date: " (condition-case ()
13478                                     (timezone-make-date-arpa-standard date)
13479                                   (error date))
13480                        "\n"))
13481               ;; Convert to Universal Time.
13482               ((eq type 'ut)
13483                (concat "Date: "
13484                        (condition-case ()
13485                            (timezone-make-date-arpa-standard date nil "UT")
13486                          (error date))
13487                        "\n"))
13488               ;; Get the original date from the article.
13489               ((eq type 'original)
13490                (concat "Date: " date "\n"))
13491               ;; Do an X-Sent lapsed format.
13492               ((eq type 'lapsed)
13493                ;; If the date is seriously mangled, the timezone
13494                ;; functions are liable to bug out, so we condition-case
13495                ;; the entire thing.
13496                (let* ((real-time
13497                        (condition-case ()
13498                            (gnus-time-minus
13499                             (gnus-encode-date
13500                              (timezone-make-date-arpa-standard
13501                               (current-time-string now)
13502                               (current-time-zone now) "UT"))
13503                             (gnus-encode-date
13504                              (timezone-make-date-arpa-standard
13505                               date nil "UT")))
13506                          (error '(0 0))))
13507                       (real-sec (+ (* (float (car real-time)) 65536)
13508                                    (cadr real-time)))
13509                       (sec (abs real-sec))
13510                       num prev)
13511                  (if (zerop sec)
13512                      "X-Sent: Now\n"
13513                    (concat
13514                     "X-Sent: "
13515                     ;; This is a bit convoluted, but basically we go
13516                     ;; through the time units for years, weeks, etc,
13517                     ;; and divide things to see whether that results
13518                     ;; in positive answers.
13519                     (mapconcat
13520                      (lambda (unit)
13521                        (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
13522                            ;; The (remaining) seconds are too few to
13523                            ;; be divided into this time unit.
13524                            ""
13525                          ;; It's big enough, so we output it.
13526                          (setq sec (- sec (* num (cdr unit))))
13527                          (prog1
13528                              (concat (if prev ", " "") (int-to-string
13529                                                         (floor num))
13530                                      " " (symbol-name (car unit))
13531                                      (if (> num 1) "s" ""))
13532                            (setq prev t))))
13533                      gnus-article-time-units "")
13534                     ;; If dates are odd, then it might appear like the
13535                     ;; article was sent in the future.
13536                     (if (> real-sec 0)
13537                         " ago\n"
13538                       " in the future\n")))))
13539               (t
13540                (error "Unknown conversion type: %s" type)))))
13541           ;; Do highlighting.
13542           (when (and highlight (gnus-visual-p 'article-highlight 'highlight))
13543             (gnus-article-highlight-headers)))))))
13544
13545 (defun gnus-article-date-local (&optional highlight)
13546   "Convert the current article date to the local timezone."
13547   (interactive (list t))
13548   (gnus-article-date-ut 'local highlight))
13549
13550 (defun gnus-article-date-original (&optional highlight)
13551   "Convert the current article date to what it was originally.
13552 This is only useful if you have used some other date conversion
13553 function and want to see what the date was before converting."
13554   (interactive (list t))
13555   (gnus-article-date-ut 'original highlight))
13556
13557 (defun gnus-article-date-lapsed (&optional highlight)
13558   "Convert the current article date to time lapsed since it was sent."
13559   (interactive (list t))
13560   (gnus-article-date-ut 'lapsed highlight))
13561
13562 (defun gnus-article-maybe-highlight ()
13563   "Do some article highlighting if `gnus-visual' is non-nil."
13564   (if (gnus-visual-p 'article-highlight 'highlight)
13565       (gnus-article-highlight-some)))
13566
13567 ;; Article savers.
13568
13569 (defun gnus-output-to-rmail (file-name)
13570   "Append the current article to an Rmail file named FILE-NAME."
13571   (require 'rmail)
13572   ;; Most of these codes are borrowed from rmailout.el.
13573   (setq file-name (expand-file-name file-name))
13574   (setq rmail-default-rmail-file file-name)
13575   (let ((artbuf (current-buffer))
13576         (tmpbuf (get-buffer-create " *Gnus-output*")))
13577     (save-excursion
13578       (or (get-file-buffer file-name)
13579           (file-exists-p file-name)
13580           (if (gnus-yes-or-no-p
13581                (concat "\"" file-name "\" does not exist, create it? "))
13582               (let ((file-buffer (create-file-buffer file-name)))
13583                 (save-excursion
13584                   (set-buffer file-buffer)
13585                   (rmail-insert-rmail-file-header)
13586                   (let ((require-final-newline nil))
13587                     (write-region (point-min) (point-max) file-name t 1)))
13588                 (kill-buffer file-buffer))
13589             (error "Output file does not exist")))
13590       (set-buffer tmpbuf)
13591       (buffer-disable-undo (current-buffer))
13592       (erase-buffer)
13593       (insert-buffer-substring artbuf)
13594       (gnus-convert-article-to-rmail)
13595       ;; Decide whether to append to a file or to an Emacs buffer.
13596       (let ((outbuf (get-file-buffer file-name)))
13597         (if (not outbuf)
13598             (append-to-file (point-min) (point-max) file-name)
13599           ;; File has been visited, in buffer OUTBUF.
13600           (set-buffer outbuf)
13601           (let ((buffer-read-only nil)
13602                 (msg (and (boundp 'rmail-current-message)
13603                           (symbol-value 'rmail-current-message))))
13604             ;; If MSG is non-nil, buffer is in RMAIL mode.
13605             (if msg
13606                 (progn (widen)
13607                        (narrow-to-region (point-max) (point-max))))
13608             (insert-buffer-substring tmpbuf)
13609             (if msg
13610                 (progn
13611                   (goto-char (point-min))
13612                   (widen)
13613                   (search-backward "\^_")
13614                   (narrow-to-region (point) (point-max))
13615                   (goto-char (1+ (point-min)))
13616                   (rmail-count-new-messages t)
13617                   (rmail-show-message msg)))))))
13618     (kill-buffer tmpbuf)))
13619
13620 (defun gnus-output-to-file (file-name)
13621   "Append the current article to a file named FILE-NAME."
13622   (setq file-name (expand-file-name file-name))
13623   (let ((artbuf (current-buffer))
13624         (tmpbuf (get-buffer-create " *Gnus-output*")))
13625     (save-excursion
13626       (set-buffer tmpbuf)
13627       (buffer-disable-undo (current-buffer))
13628       (erase-buffer)
13629       (insert-buffer-substring artbuf)
13630       ;; Append newline at end of the buffer as separator, and then
13631       ;; save it to file.
13632       (goto-char (point-max))
13633       (insert "\n")
13634       (append-to-file (point-min) (point-max) file-name))
13635     (kill-buffer tmpbuf)))
13636
13637 (defun gnus-convert-article-to-rmail ()
13638   "Convert article in current buffer to Rmail message format."
13639   (let ((buffer-read-only nil))
13640     ;; Convert article directly into Babyl format.
13641     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
13642     (goto-char (point-min))
13643     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
13644     (while (search-forward "\n\^_" nil t) ;single char
13645       (replace-match "\n^_" t t))       ;2 chars: "^" and "_"
13646     (goto-char (point-max))
13647     (insert "\^_")))
13648
13649 (defun gnus-narrow-to-page (&optional arg)
13650   "Narrow the article buffer to a page.
13651 If given a numerical ARG, move forward ARG pages."
13652   (interactive "P")
13653   (setq arg (if arg (prefix-numeric-value arg) 0))
13654   (save-excursion
13655     (set-buffer gnus-article-buffer)
13656     (goto-char (point-min))
13657     (widen)
13658     (when (gnus-visual-p 'page-marker)
13659       (let ((buffer-read-only nil))
13660         (gnus-remove-text-with-property 'gnus-prev)
13661         (gnus-remove-text-with-property 'gnus-next)))
13662     (when
13663         (cond ((< arg 0)
13664                (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
13665               ((> arg 0)
13666                (re-search-forward page-delimiter nil 'move arg)))
13667       (goto-char (match-end 0)))
13668     (narrow-to-region
13669      (point)
13670      (if (re-search-forward page-delimiter nil 'move)
13671          (match-beginning 0)
13672        (point)))
13673     (when (and (gnus-visual-p 'page-marker)
13674                (not (= (point-min) 1)))
13675       (save-excursion
13676         (goto-char (point-min))
13677         (gnus-insert-prev-page-button)))
13678     (when (and (gnus-visual-p 'page-marker)
13679                (not (= (1- (point-max)) (buffer-size))))
13680       (save-excursion
13681         (goto-char (point-max))
13682         (gnus-insert-next-page-button)))))
13683
13684
13685 ;; Article mode commands
13686
13687 (defun gnus-article-goto-next-page ()
13688   "Show the next page of the article."
13689   (interactive)
13690   (when (gnus-article-next-page)
13691     (gnus-article-read-summary-keys nil ?n)))
13692
13693 (defun gnus-article-goto-prev-page ()
13694   "Show the next page of the article."
13695   (interactive)
13696   (if (bobp) (gnus-article-read-summary-keys nil ?n)
13697     (gnus-article-prev-page nil)))
13698
13699 (defun gnus-article-next-page (&optional lines)
13700   "Show the next page of the current article.
13701 If end of article, return non-nil.  Otherwise return nil.
13702 Argument LINES specifies lines to be scrolled up."
13703   (interactive "p")
13704   (move-to-window-line -1)
13705   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
13706   (if (save-excursion
13707         (end-of-line)
13708         (and (pos-visible-in-window-p)  ;Not continuation line.
13709              (eobp)))
13710       ;; Nothing in this page.
13711       (if (or (not gnus-break-pages)
13712               (save-excursion
13713                 (save-restriction
13714                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
13715           t                             ;Nothing more.
13716         (gnus-narrow-to-page 1)         ;Go to next page.
13717         nil)
13718     ;; More in this page.
13719     (condition-case ()
13720         (scroll-up lines)
13721       (end-of-buffer
13722        ;; Long lines may cause an end-of-buffer error.
13723        (goto-char (point-max))))
13724     nil))
13725
13726 (defun gnus-article-prev-page (&optional lines)
13727   "Show previous page of current article.
13728 Argument LINES specifies lines to be scrolled down."
13729   (interactive "p")
13730   (move-to-window-line 0)
13731   (if (and gnus-break-pages
13732            (bobp)
13733            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
13734       (progn
13735         (gnus-narrow-to-page -1)        ;Go to previous page.
13736         (goto-char (point-max))
13737         (recenter -1))
13738     (condition-case ()
13739         (scroll-down lines)
13740       (error nil))))
13741
13742 (defun gnus-article-refer-article ()
13743   "Read article specified by message-id around point."
13744   (interactive)
13745   (search-forward ">" nil t)            ;Move point to end of "<....>".
13746   (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
13747       (let ((message-id (match-string 1)))
13748         (set-buffer gnus-summary-buffer)
13749         (gnus-summary-refer-article message-id))
13750     (error "No references around point")))
13751
13752 (defun gnus-article-show-summary ()
13753   "Reconfigure windows to show summary buffer."
13754   (interactive)
13755   (gnus-configure-windows 'article)
13756   (gnus-summary-goto-subject gnus-current-article))
13757
13758 (defun gnus-article-describe-briefly ()
13759   "Describe article mode commands briefly."
13760   (interactive)
13761   (gnus-message 6
13762                 (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-next-page]:Next page  \\[gnus-article-prev-page]:Prev page  \\[gnus-article-show-summary]:Show summary  \\[gnus-info-find-node]:Run Info  \\[gnus-article-describe-briefly]:This help")))
13763
13764 (defun gnus-article-summary-command ()
13765   "Execute the last keystroke in the summary buffer."
13766   (interactive)
13767   (let ((obuf (current-buffer))
13768         (owin (current-window-configuration))
13769         func)
13770     (switch-to-buffer gnus-summary-buffer 'norecord)
13771     (setq func (lookup-key (current-local-map) (this-command-keys)))
13772     (call-interactively func)
13773     (set-buffer obuf)
13774     (set-window-configuration owin)
13775     (set-window-point (get-buffer-window (current-buffer)) (point))))
13776
13777 (defun gnus-article-summary-command-nosave ()
13778   "Execute the last keystroke in the summary buffer."
13779   (interactive)
13780   (let (func)
13781     (pop-to-buffer gnus-summary-buffer 'norecord)
13782     (setq func (lookup-key (current-local-map) (this-command-keys)))
13783     (call-interactively func)))
13784
13785 (defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
13786   "Read a summary buffer key sequence and execute it from the article buffer."
13787   (interactive "P")
13788   (let ((nosaves
13789          '("q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F"
13790            "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
13791            "=" "^" "\M-^"))
13792         keys)
13793     (save-excursion
13794       (set-buffer gnus-summary-buffer)
13795       (push (or key last-command-event) unread-command-events)
13796       (setq keys (read-key-sequence nil)))
13797     (message "")
13798
13799     (if (member keys nosaves)
13800         (let (func)
13801           (pop-to-buffer gnus-summary-buffer 'norecord)
13802           (if (setq func (lookup-key (current-local-map) keys))
13803               (call-interactively func)
13804             (ding)))
13805       (let ((obuf (current-buffer))
13806             (owin (current-window-configuration))
13807             (opoint (point))
13808             func in-buffer)
13809         (if not-restore-window
13810             (pop-to-buffer gnus-summary-buffer 'norecord)
13811           (switch-to-buffer gnus-summary-buffer 'norecord))
13812         (setq in-buffer (current-buffer))
13813         (if (setq func (lookup-key (current-local-map) keys))
13814             (call-interactively func)
13815           (ding))
13816         (when (eq in-buffer (current-buffer))
13817           (set-buffer obuf)
13818           (unless not-restore-window
13819             (set-window-configuration owin))
13820           (set-window-point (get-buffer-window (current-buffer)) opoint))))))
13821
13822 \f
13823 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
13824
13825 ;;;###autoload
13826 (defalias 'gnus-batch-kill 'gnus-batch-score)
13827 ;;;###autoload
13828 (defun gnus-batch-score ()
13829   "Run batched scoring.
13830 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
13831 Newsgroups is a list of strings in Bnews format.  If you want to score
13832 the comp hierarchy, you'd say \"comp.all\".  If you would not like to
13833 score the alt hierarchy, you'd say \"!alt.all\"."
13834   (interactive)
13835   (let* ((yes-and-no
13836           (gnus-newsrc-parse-options
13837            (apply (function concat)
13838                   (mapcar (lambda (g) (concat g " "))
13839                           command-line-args-left))))
13840          (gnus-expert-user t)
13841          (nnmail-spool-file nil)
13842          (gnus-use-dribble-file nil)
13843          (yes (car yes-and-no))
13844          (no (cdr yes-and-no))
13845          group newsrc entry
13846          ;; Disable verbose message.
13847          gnus-novice-user gnus-large-newsgroup)
13848     ;; Eat all arguments.
13849     (setq command-line-args-left nil)
13850     ;; Start Gnus.
13851     (gnus)
13852     ;; Apply kills to specified newsgroups in command line arguments.
13853     (setq newsrc (cdr gnus-newsrc-alist))
13854     (while newsrc
13855       (setq group (car (car newsrc)))
13856       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
13857       (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
13858                (and (car entry)
13859                     (or (eq (car entry) t)
13860                         (not (zerop (car entry)))))
13861                (if yes (string-match yes group) t)
13862                (or (null no) (not (string-match no group))))
13863           (progn
13864             (gnus-summary-read-group group nil t nil t)
13865             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
13866                  (gnus-summary-exit))))
13867       (setq newsrc (cdr newsrc)))
13868     ;; Exit Emacs.
13869     (switch-to-buffer gnus-group-buffer)
13870     (gnus-group-save-newsrc)))
13871
13872 (defun gnus-apply-kill-file ()
13873   "Apply a kill file to the current newsgroup.
13874 Returns the number of articles marked as read."
13875   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
13876           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
13877       (gnus-apply-kill-file-internal)
13878     0))
13879
13880 (defun gnus-kill-save-kill-buffer ()
13881   (save-excursion
13882     (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
13883       (if (get-file-buffer file)
13884           (progn
13885             (set-buffer (get-file-buffer file))
13886             (and (buffer-modified-p) (save-buffer))
13887             (kill-buffer (current-buffer)))))))
13888
13889 (defvar gnus-kill-file-name "KILL"
13890   "Suffix of the kill files.")
13891
13892 (defun gnus-newsgroup-kill-file (newsgroup)
13893   "Return the name of a kill file name for NEWSGROUP.
13894 If NEWSGROUP is nil, return the global kill file name instead."
13895   (cond ((or (null newsgroup)
13896              (string-equal newsgroup ""))
13897          ;; The global KILL file is placed at top of the directory.
13898          (expand-file-name gnus-kill-file-name
13899                            (or gnus-kill-files-directory "~/News")))
13900         ((gnus-use-long-file-name 'not-kill)
13901          ;; Append ".KILL" to newsgroup name.
13902          (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
13903                                    "." gnus-kill-file-name)
13904                            (or gnus-kill-files-directory "~/News")))
13905         (t
13906          ;; Place "KILL" under the hierarchical directory.
13907          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
13908                                    "/" gnus-kill-file-name)
13909                            (or gnus-kill-files-directory "~/News")))))
13910
13911 \f
13912 ;;;
13913 ;;; Dribble file
13914 ;;;
13915
13916 (defvar gnus-dribble-ignore nil)
13917 (defvar gnus-dribble-eval-file nil)
13918
13919 (defun gnus-dribble-file-name ()
13920   (concat
13921    (if gnus-dribble-directory
13922        (concat (file-name-as-directory gnus-dribble-directory)
13923                (file-name-nondirectory gnus-current-startup-file))
13924      gnus-current-startup-file)
13925    "-dribble"))
13926
13927 (defun gnus-dribble-enter (string)
13928   (if (and (not gnus-dribble-ignore)
13929            (or gnus-dribble-buffer
13930                gnus-slave)
13931            (buffer-name gnus-dribble-buffer))
13932       (let ((obuf (current-buffer)))
13933         (set-buffer gnus-dribble-buffer)
13934         (insert string "\n")
13935         (set-window-point (get-buffer-window (current-buffer)) (point-max))
13936         (set-buffer obuf))))
13937
13938 (defun gnus-dribble-read-file ()
13939   (let ((dribble-file (gnus-dribble-file-name)))
13940     (save-excursion
13941       (set-buffer (setq gnus-dribble-buffer
13942                         (get-buffer-create
13943                          (file-name-nondirectory dribble-file))))
13944       (gnus-add-current-to-buffer-list)
13945       (erase-buffer)
13946       (setq buffer-file-name dribble-file)
13947       (auto-save-mode t)
13948       (buffer-disable-undo (current-buffer))
13949       (bury-buffer (current-buffer))
13950       (set-buffer-modified-p nil)
13951       (let ((auto (make-auto-save-file-name))
13952             (gnus-dribble-ignore t))
13953         (if (or (file-exists-p auto) (file-exists-p dribble-file))
13954             (progn
13955               (if (file-newer-than-file-p auto dribble-file)
13956                   (setq dribble-file auto))
13957               (insert-file-contents dribble-file)
13958               (if (not (zerop (buffer-size)))
13959                   (set-buffer-modified-p t))
13960               (if (gnus-y-or-n-p
13961                    "Auto-save file exists.  Do you want to read it? ")
13962                   (setq gnus-dribble-eval-file t))))))))
13963
13964 (defun gnus-dribble-eval-file ()
13965   (if (not gnus-dribble-eval-file)
13966       ()
13967     (setq gnus-dribble-eval-file nil)
13968     (save-excursion
13969       (let ((gnus-dribble-ignore t))
13970         (set-buffer gnus-dribble-buffer)
13971         (eval-buffer (current-buffer))))))
13972
13973 (defun gnus-dribble-delete-file ()
13974   (if (file-exists-p (gnus-dribble-file-name))
13975       (delete-file (gnus-dribble-file-name)))
13976   (if gnus-dribble-buffer
13977       (save-excursion
13978         (set-buffer gnus-dribble-buffer)
13979         (let ((auto (make-auto-save-file-name)))
13980           (if (file-exists-p auto)
13981               (delete-file auto))
13982           (erase-buffer)
13983           (set-buffer-modified-p nil)))))
13984
13985 (defun gnus-dribble-save ()
13986   (if (and gnus-dribble-buffer
13987            (buffer-name gnus-dribble-buffer))
13988       (save-excursion
13989         (set-buffer gnus-dribble-buffer)
13990         (save-buffer))))
13991
13992 (defun gnus-dribble-clear ()
13993   (save-excursion
13994     (if (gnus-buffer-exists-p gnus-dribble-buffer)
13995         (progn
13996           (set-buffer gnus-dribble-buffer)
13997           (erase-buffer)
13998           (set-buffer-modified-p nil)
13999           (setq buffer-saved-size (buffer-size))))))
14000
14001 ;;;
14002 ;;; Server Communication
14003 ;;;
14004
14005 (defun gnus-start-news-server (&optional confirm)
14006   "Open a method for getting news.
14007 If CONFIRM is non-nil, the user will be asked for an NNTP server."
14008   (let (how)
14009     (if gnus-current-select-method
14010         ;; Stream is already opened.
14011         nil
14012       ;; Open NNTP server.
14013       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
14014       (if confirm
14015           (progn
14016             ;; Read server name with completion.
14017             (setq gnus-nntp-server
14018                   (completing-read "NNTP server: "
14019                                    (mapcar (lambda (server) (list server))
14020                                            (cons (list gnus-nntp-server)
14021                                                  gnus-secondary-servers))
14022                                    nil nil gnus-nntp-server))))
14023
14024       (if (and gnus-nntp-server
14025                (stringp gnus-nntp-server)
14026                (not (string= gnus-nntp-server "")))
14027           (setq gnus-select-method
14028                 (cond ((or (string= gnus-nntp-server "")
14029                            (string= gnus-nntp-server "::"))
14030                        (list 'nnspool (system-name)))
14031                       ((string-match "^:" gnus-nntp-server)
14032                        (list 'nnmh gnus-nntp-server
14033                              (list 'nnmh-directory
14034                                    (file-name-as-directory
14035                                     (expand-file-name
14036                                      (concat "~/" (substring
14037                                                    gnus-nntp-server 1)))))
14038                              (list 'nnmh-get-new-mail nil)))
14039                       (t
14040                        (list 'nntp gnus-nntp-server)))))
14041
14042       (setq how (car gnus-select-method))
14043       (cond ((eq how 'nnspool)
14044              (require 'nnspool)
14045              (gnus-message 5 "Looking up local news spool..."))
14046             ((eq how 'nnmh)
14047              (require 'nnmh)
14048              (gnus-message 5 "Looking up mh spool..."))
14049             (t
14050              (require 'nntp)))
14051       (setq gnus-current-select-method gnus-select-method)
14052       (run-hooks 'gnus-open-server-hook)
14053       (or
14054        ;; gnus-open-server-hook might have opened it
14055        (gnus-server-opened gnus-select-method)
14056        (gnus-open-server gnus-select-method)
14057        (gnus-y-or-n-p
14058         (format
14059          "%s open error: '%s'.  Continue? "
14060          (nth 1 gnus-select-method)
14061          (gnus-status-message gnus-select-method)))
14062        (progn
14063          (gnus-message 1 "Couldn't open server on %s"
14064                        (nth 1 gnus-select-method))
14065          (ding)
14066          nil)))))
14067
14068 (defun gnus-check-group (group)
14069   "Try to make sure that the server where GROUP exists is alive."
14070   (let ((method (gnus-find-method-for-group group)))
14071     (or (gnus-server-opened method)
14072         (gnus-open-server method))))
14073
14074 (defun gnus-check-server (&optional method)
14075   "Check whether the connection to METHOD is down.
14076 If METHOD is nil, use `gnus-select-method'.
14077 If it is down, start it up (again)."
14078   (let ((method (or method gnus-select-method)))
14079     ;; Transform virtual server names into select methods.
14080     (when (stringp method)
14081       (setq method (gnus-server-to-method method)))
14082     (if (gnus-server-opened method)
14083         ;; The stream is already opened.
14084         t
14085       ;; Open the server.
14086       (gnus-message 5 "Opening %s server on %s..." (car method) (nth 1 method))
14087       (run-hooks 'gnus-open-server-hook)
14088       (prog1
14089           (gnus-open-server method)
14090         (message "")))))
14091
14092 (defun gnus-get-function (method function)
14093   "Return a function symbol based on METHOD and FUNCTION."
14094   ;; Translate server names into methods.
14095   (unless method
14096     (error "Attempted use of a nil select method"))
14097   (when (stringp method)
14098     (setq method (gnus-server-to-method method)))
14099   (let ((func (intern (format "%s-%s" (car method) function))))
14100     ;; If the functions isn't bound, we require the backend in
14101     ;; question.
14102     (unless (fboundp func)
14103       (require (car method))
14104       (unless (fboundp func)
14105         ;; This backend doesn't implement this function.
14106         (error "No such function: %s" func)))
14107     func))
14108
14109 ;;; Interface functions to the backends.
14110
14111 (defun gnus-open-server (method)
14112   "Open a connection to METHOD."
14113   (let ((elem (assoc method gnus-opened-servers)))
14114     ;; If this method was previously denied, we just return nil.
14115     (if (eq (nth 1 elem) 'denied)
14116         (progn
14117           (gnus-message 1 "Denied server")
14118           nil)
14119       ;; Open the server.
14120       (let ((result
14121              (funcall (gnus-get-function method 'open-server)
14122                       (nth 1 method) (nthcdr 2 method))))
14123         ;; If this hasn't been opened before, we add it to the list.
14124         (unless elem
14125           (setq elem (list method nil)
14126                 gnus-opened-servers (cons elem gnus-opened-servers)))
14127         ;; Set the status of this server.
14128         (setcar (cdr elem) (if result 'ok 'denied))
14129         ;; Return the result from the "open" call.
14130         result))))
14131
14132 (defun gnus-close-server (method)
14133   "Close the connection to METHOD."
14134   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
14135
14136 (defun gnus-request-list (method)
14137   "Request the active file from METHOD."
14138   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
14139
14140 (defun gnus-request-list-newsgroups (method)
14141   "Request the newsgroups file from METHOD."
14142   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
14143
14144 (defun gnus-request-newgroups (date method)
14145   "Request all new groups since DATE from METHOD."
14146   (funcall (gnus-get-function method 'request-newgroups)
14147            date (nth 1 method)))
14148
14149 (defun gnus-server-opened (method)
14150   "Check whether a connection to METHOD has been opened."
14151   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
14152
14153 (defun gnus-status-message (method)
14154   "Return the status message from METHOD.
14155 If METHOD is a string, it is interpreted as a group name.   The method
14156 this group uses will be queried."
14157   (let ((method (if (stringp method) (gnus-find-method-for-group method)
14158                   method)))
14159     (funcall (gnus-get-function method 'status-message) (nth 1 method))))
14160
14161 (defun gnus-request-group (group &optional dont-check method)
14162   "Request GROUP.  If DONT-CHECK, no information is required."
14163   (let ((method (or method (gnus-find-method-for-group group))))
14164     (funcall (gnus-get-function method 'request-group)
14165              (gnus-group-real-name group) (nth 1 method) dont-check)))
14166
14167 (defun gnus-request-asynchronous (group &optional articles)
14168   "Request that GROUP behave asynchronously.
14169 ARTICLES is the `data' of the group."
14170   (let ((method (gnus-find-method-for-group group)))
14171     (funcall (gnus-get-function method 'request-asynchronous)
14172              (gnus-group-real-name group) (nth 1 method) articles)))
14173
14174 (defun gnus-list-active-group (group)
14175   "Request active information on GROUP."
14176   (let ((method (gnus-find-method-for-group group))
14177         (func 'list-active-group))
14178     (when (gnus-check-backend-function func group)
14179       (funcall (gnus-get-function method func)
14180                (gnus-group-real-name group) (nth 1 method)))))
14181
14182 (defun gnus-request-group-description (group)
14183   "Request a description of GROUP."
14184   (let ((method (gnus-find-method-for-group group))
14185         (func 'request-group-description))
14186     (when (gnus-check-backend-function func group)
14187       (funcall (gnus-get-function method func)
14188                (gnus-group-real-name group) (nth 1 method)))))
14189
14190 (defun gnus-close-group (group)
14191   "Request the GROUP be closed."
14192   (let ((method (gnus-find-method-for-group group)))
14193     (funcall (gnus-get-function method 'close-group)
14194              (gnus-group-real-name group) (nth 1 method))))
14195
14196 (defun gnus-retrieve-headers (articles group &optional fetch-old)
14197   "Request headers for ARTICLES in GROUP.
14198 If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
14199   (let ((method (gnus-find-method-for-group group)))
14200     (if (and gnus-use-cache (numberp (car articles)))
14201         (gnus-cache-retrieve-headers articles group fetch-old)
14202       (funcall (gnus-get-function method 'retrieve-headers)
14203                articles (gnus-group-real-name group) (nth 1 method)
14204                fetch-old))))
14205
14206 (defun gnus-retrieve-groups (groups method)
14207   "Request active information on GROUPS from METHOD."
14208   (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
14209
14210 (defun gnus-request-type (group &optional article)
14211   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
14212   (let ((method (gnus-find-method-for-group group)))
14213     (if (not (gnus-check-backend-function 'request-type (car method)))
14214         'unknown
14215       (funcall (gnus-get-function method 'request-type)
14216                (gnus-group-real-name group) article))))
14217
14218 (defun gnus-request-update-mark (group article mark)
14219   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
14220   (let ((method (gnus-find-method-for-group group)))
14221     (if (not (gnus-check-backend-function 'request-update-mark (car method)))
14222         mark
14223       (funcall (gnus-get-function method 'request-update-mark)
14224                (gnus-group-real-name group) article))))
14225
14226 (defun gnus-request-article (article group &optional buffer)
14227   "Request the ARTICLE in GROUP.
14228 ARTICLE can either be an article number or an article Message-ID.
14229 If BUFFER, insert the article in that group."
14230   (let ((method (gnus-find-method-for-group group)))
14231     (funcall (gnus-get-function method 'request-article)
14232              article (gnus-group-real-name group) (nth 1 method) buffer)))
14233
14234 (defun gnus-request-head (article group)
14235   "Request the head of ARTICLE in GROUP."
14236   (let ((method (gnus-find-method-for-group group)))
14237     (funcall (gnus-get-function method 'request-head)
14238              article (gnus-group-real-name group) (nth 1 method))))
14239
14240 (defun gnus-request-body (article group)
14241   "Request the body of ARTICLE in GROUP."
14242   (let ((method (gnus-find-method-for-group group)))
14243     (funcall (gnus-get-function method 'request-body)
14244              article (gnus-group-real-name group) (nth 1 method))))
14245
14246 (defun gnus-request-post (method)
14247   "Post the current buffer using METHOD."
14248   (funcall (gnus-get-function method 'request-post) (nth 1 method)))
14249
14250 (defun gnus-request-scan (group method)
14251   "Request a SCAN being performed in GROUP from METHOD.
14252 If GROUP is nil, all groups on METHOD are scanned."
14253   (let ((method (if group (gnus-find-method-for-group group) method)))
14254     (funcall (gnus-get-function method 'request-scan)
14255              (and group (gnus-group-real-name group)) (nth 1 method))))
14256
14257 (defsubst gnus-request-update-info (info method)
14258   "Request that METHOD update INFO."
14259   (when (gnus-check-backend-function 'request-update-info (car method))
14260     (funcall (gnus-get-function method 'request-update-info)
14261              (gnus-group-real-name (gnus-info-group info))
14262              info (nth 1 method))))
14263
14264 (defun gnus-request-expire-articles (articles group &optional force)
14265   (let ((method (gnus-find-method-for-group group)))
14266     (funcall (gnus-get-function method 'request-expire-articles)
14267              articles (gnus-group-real-name group) (nth 1 method)
14268              force)))
14269
14270 (defun gnus-request-move-article
14271   (article group server accept-function &optional last)
14272   (let ((method (gnus-find-method-for-group group)))
14273     (funcall (gnus-get-function method 'request-move-article)
14274              article (gnus-group-real-name group)
14275              (nth 1 method) accept-function last)))
14276
14277 (defun gnus-request-accept-article (group &optional last method)
14278   (let ((func (if (symbolp group) group
14279                 (car (or method (gnus-find-method-for-group group))))))
14280     (funcall (intern (format "%s-request-accept-article" func))
14281              (if (stringp group) (gnus-group-real-name group) group)
14282              last)))
14283
14284 (defun gnus-request-replace-article (article group buffer)
14285   (let ((func (car (gnus-find-method-for-group group))))
14286     (funcall (intern (format "%s-request-replace-article" func))
14287              article (gnus-group-real-name group) buffer)))
14288
14289 (defun gnus-request-associate-buffer (group)
14290   (let ((method (gnus-find-method-for-group group)))
14291     (funcall (gnus-get-function method 'request-associate-buffer)
14292              (gnus-group-real-name group))))
14293
14294 (defun gnus-request-restore-buffer (article group)
14295   "Request a new buffer restored to the state of ARTICLE."
14296   (let ((method (gnus-find-method-for-group group)))
14297     (funcall (gnus-get-function method 'request-restore-buffer)
14298              article (gnus-group-real-name group) (nth 1 method))))
14299
14300 (defun gnus-request-create-group (group &optional method)
14301   (let ((method (or method (gnus-find-method-for-group group))))
14302     (funcall (gnus-get-function method 'request-create-group)
14303              (gnus-group-real-name group) (nth 1 method))))
14304
14305 (defun gnus-request-delete-group (group &optional force)
14306   (let ((method (gnus-find-method-for-group group)))
14307     (funcall (gnus-get-function method 'request-delete-group)
14308              (gnus-group-real-name group) force (nth 1 method))))
14309
14310 (defun gnus-request-rename-group (group new-name)
14311   (let ((method (gnus-find-method-for-group group)))
14312     (funcall (gnus-get-function method 'request-rename-group)
14313              (gnus-group-real-name group)
14314              (gnus-group-real-name new-name) (nth 1 method))))
14315
14316 (defun gnus-member-of-valid (symbol group)
14317   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
14318   (memq symbol (assoc
14319                 (symbol-name (car (gnus-find-method-for-group group)))
14320                 gnus-valid-select-methods)))
14321
14322 (defun gnus-method-option-p (method option)
14323   "Return non-nil if select METHOD has OPTION as a parameter."
14324   (memq option (assoc (format "%s" (car method))
14325                       gnus-valid-select-methods)))
14326
14327 (defun gnus-server-extend-method (group method)
14328   ;; This function "extends" a virtual server.  If the server is
14329   ;; "hello", and the select method is ("hello" (my-var "something"))
14330   ;; in the group "alt.alt", this will result in a new virtual server
14331   ;; called "hello+alt.alt".
14332   (let ((entry
14333          (gnus-copy-sequence
14334           (if (equal (car method) "native") gnus-select-method
14335             (cdr (assoc (car method) gnus-server-alist))))))
14336     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
14337     (nconc entry (cdr method))))
14338
14339 (defun gnus-find-method-for-group (group &optional info)
14340   "Find the select method that GROUP uses."
14341   (or gnus-override-method
14342       (and (not group)
14343            gnus-select-method)
14344       (let ((info (or info (gnus-get-info group)))
14345             method)
14346         (if (or (not info)
14347                 (not (setq method (gnus-info-method info))))
14348             (setq method gnus-select-method)
14349           (setq method
14350                 (cond ((stringp method)
14351                        (gnus-server-to-method method))
14352                       ((stringp (car method))
14353                        (gnus-server-extend-method group method))
14354                       (t
14355                        method))))
14356         (gnus-server-add-address method))))
14357
14358 (defun gnus-check-backend-function (func group)
14359   "Check whether GROUP supports function FUNC."
14360   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
14361                   group)))
14362     (fboundp (intern (format "%s-%s" method func)))))
14363
14364 (defun gnus-methods-using (feature)
14365   "Find all methods that have FEATURE."
14366   (let ((valids gnus-valid-select-methods)
14367         outs)
14368     (while valids
14369       (if (memq feature (car valids))
14370           (setq outs (cons (car valids) outs)))
14371       (setq valids (cdr valids)))
14372     outs))
14373
14374 ;;;
14375 ;;; Active & Newsrc File Handling
14376 ;;;
14377
14378 (defun gnus-setup-news (&optional rawfile level)
14379   "Setup news information.
14380 If RAWFILE is non-nil, the .newsrc file will also be read.
14381 If LEVEL is non-nil, the news will be set up at level LEVEL."
14382   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
14383     ;; Clear some variables to re-initialize news information.
14384     (if init (setq gnus-newsrc-alist nil
14385                    gnus-active-hashtb nil))
14386
14387     ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
14388     (if init (gnus-read-newsrc-file rawfile))
14389
14390     ;; If we don't read the complete active file, we fill in the
14391     ;; hashtb here.
14392     (if (or (null gnus-read-active-file)
14393             (eq gnus-read-active-file 'some))
14394         (gnus-update-active-hashtb-from-killed))
14395
14396     ;; Read the active file and create `gnus-active-hashtb'.
14397     ;; If `gnus-read-active-file' is nil, then we just create an empty
14398     ;; hash table.  The partial filling out of the hash table will be
14399     ;; done in `gnus-get-unread-articles'.
14400     (and gnus-read-active-file
14401          (not level)
14402          (gnus-read-active-file))
14403
14404     (or gnus-active-hashtb
14405         (setq gnus-active-hashtb (make-vector 4095 0)))
14406
14407     ;; Initialize the cache.
14408     (when gnus-use-cache
14409       (gnus-cache-open))
14410
14411     ;; Possibly eval the dribble file.
14412     (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
14413
14414     (gnus-update-format-specifications)
14415
14416     ;; Find new newsgroups and treat them.
14417     (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level)
14418              (gnus-check-server gnus-select-method))
14419         (gnus-find-new-newsgroups))
14420
14421     ;; Find the number of unread articles in each non-dead group.
14422     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
14423       (gnus-get-unread-articles level))
14424
14425     (if (and init gnus-check-bogus-newsgroups
14426              gnus-read-active-file (not level)
14427              (gnus-server-opened gnus-select-method))
14428         (gnus-check-bogus-newsgroups))))
14429
14430 (defun gnus-find-new-newsgroups (&optional arg)
14431   "Search for new newsgroups and add them.
14432 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
14433 The `-n' option line from .newsrc is respected.
14434 If ARG (the prefix), use the `ask-server' method to query
14435 the server for new groups."
14436   (interactive "P")
14437   (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups)))
14438                        (null gnus-read-active-file)
14439                        (eq gnus-read-active-file 'some))
14440                    'ask-server gnus-check-new-newsgroups)))
14441     (unless (gnus-check-first-time-used)
14442       (if (or (consp check)
14443               (eq check 'ask-server))
14444           (gnus-ask-server-for-new-groups)
14445         (let ((groups 0)
14446               group new-newsgroups)
14447           (gnus-message 5 "Looking for new newsgroups...")
14448           (or gnus-have-read-active-file (gnus-read-active-file))
14449           (setq gnus-newsrc-last-checked-date (current-time-string))
14450           (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed))
14451           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
14452           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
14453           (mapatoms
14454            (lambda (sym)
14455              (if (or (null (setq group (symbol-name sym)))
14456                      (not (boundp sym))
14457                      (null (symbol-value sym))
14458                      (gnus-gethash group gnus-killed-hashtb)
14459                      (gnus-gethash group gnus-newsrc-hashtb))
14460                  ()
14461                (let ((do-sub (gnus-matches-options-n group)))
14462                  (cond
14463                   ((eq do-sub 'subscribe)
14464                    (setq groups (1+ groups))
14465                    (gnus-sethash group group gnus-killed-hashtb)
14466                    (funcall gnus-subscribe-options-newsgroup-method group))
14467                   ((eq do-sub 'ignore)
14468                    nil)
14469                   (t
14470                    (setq groups (1+ groups))
14471                    (gnus-sethash group group gnus-killed-hashtb)
14472                    (if gnus-subscribe-hierarchical-interactive
14473                        (setq new-newsgroups (cons group new-newsgroups))
14474                      (funcall gnus-subscribe-newsgroup-method group)))))))
14475            gnus-active-hashtb)
14476           (if new-newsgroups
14477               (gnus-subscribe-hierarchical-interactive new-newsgroups))
14478           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
14479           (if (> groups 0)
14480               (gnus-message 6 "%d new newsgroup%s arrived."
14481                             groups (if (> groups 1) "s have" " has"))
14482             (gnus-message 6 "No new newsgroups.")))))))
14483
14484 (defun gnus-matches-options-n (group)
14485   ;; Returns `subscribe' if the group is to be unconditionally
14486   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
14487   ;; no match for the group.
14488
14489   ;; First we check the two user variables.
14490   (cond
14491    ((and gnus-options-subscribe
14492          (string-match gnus-options-subscribe group))
14493     'subscribe)
14494    ((and gnus-auto-subscribed-groups
14495          (string-match gnus-auto-subscribed-groups group))
14496     'subscribe)
14497    ((and gnus-options-not-subscribe
14498          (string-match gnus-options-not-subscribe group))
14499     'ignore)
14500    ;; Then we go through the list that was retrieved from the .newsrc
14501    ;; file.  This list has elements on the form
14502    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
14503    ;; is in the reverse order of the options line) is returned.
14504    (t
14505     (let ((regs gnus-newsrc-options-n))
14506       (while (and regs
14507                   (not (string-match (car (car regs)) group)))
14508         (setq regs (cdr regs)))
14509       (and regs (cdr (car regs)))))))
14510
14511 (defun gnus-ask-server-for-new-groups ()
14512   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
14513          (methods (cons gnus-select-method
14514                         (cons
14515                          gnus-message-archive-method
14516                          (append
14517                           (and (consp gnus-check-new-newsgroups)
14518                                gnus-check-new-newsgroups)
14519                           gnus-secondary-select-methods))))
14520          (groups 0)
14521          (new-date (current-time-string))
14522          group new-newsgroups got-new method hashtb
14523          gnus-override-subscribe-method)
14524     ;; Go through both primary and secondary select methods and
14525     ;; request new newsgroups.
14526     (while (setq method (gnus-server-get-method nil (pop methods)))
14527       (setq gnus-override-subscribe-method method)
14528       (when (and (gnus-check-server method)
14529                  (gnus-request-newgroups date method))
14530         (save-excursion
14531           (setq got-new t)
14532           (setq hashtb (gnus-make-hashtable 100))
14533           (set-buffer nntp-server-buffer)
14534           ;; Enter all the new groups into a hashtable.
14535           (gnus-active-to-gnus-format method hashtb 'ignore)))
14536       ;; Now all new groups from `method' are in `hashtb'.
14537       (mapatoms
14538        (lambda (group-sym)
14539          (if (or (null (setq group (symbol-name group-sym)))
14540                  (null (symbol-value group-sym))
14541                  (gnus-gethash group gnus-newsrc-hashtb)
14542                  (member group gnus-zombie-list)
14543                  (member group gnus-killed-list))
14544              ;; The group is already known.
14545              ()
14546            ;; Make this group active.
14547            (when (symbol-value group-sym)
14548              (gnus-set-active group (symbol-value group-sym)))
14549            ;; Check whether we want it or not.
14550            (let ((do-sub (gnus-matches-options-n group)))
14551              (cond
14552               ((eq do-sub 'subscribe)
14553                (incf groups)
14554                (gnus-sethash group group gnus-killed-hashtb)
14555                (funcall gnus-subscribe-options-newsgroup-method group))
14556               ((eq do-sub 'ignore)
14557                nil)
14558               (t
14559                (incf groups)
14560                (gnus-sethash group group gnus-killed-hashtb)
14561                (if gnus-subscribe-hierarchical-interactive
14562                    (push group new-newsgroups)
14563                  (funcall gnus-subscribe-newsgroup-method group)))))))
14564        hashtb)
14565       (when new-newsgroups
14566         (gnus-subscribe-hierarchical-interactive new-newsgroups)))
14567     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
14568     (when (> groups 0)
14569       (gnus-message 6 "%d new newsgroup%s arrived."
14570                     groups (if (> groups 1) "s have" " has")))
14571     (and got-new (setq gnus-newsrc-last-checked-date new-date))
14572     got-new))
14573
14574 (defun gnus-check-first-time-used ()
14575   (if (or (> (length gnus-newsrc-alist) 1)
14576           (file-exists-p gnus-startup-file)
14577           (file-exists-p (concat gnus-startup-file ".el"))
14578           (file-exists-p (concat gnus-startup-file ".eld")))
14579       nil
14580     (gnus-message 6 "First time user; subscribing you to default groups")
14581     (or gnus-have-read-active-file (gnus-read-active-file))
14582     (setq gnus-newsrc-last-checked-date (current-time-string))
14583     (let ((groups gnus-default-subscribed-newsgroups)
14584           group)
14585       (if (eq groups t)
14586           nil
14587         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
14588         (mapatoms
14589          (lambda (sym)
14590            (if (null (setq group (symbol-name sym)))
14591                ()
14592              (let ((do-sub (gnus-matches-options-n group)))
14593                (cond
14594                 ((eq do-sub 'subscribe)
14595                  (gnus-sethash group group gnus-killed-hashtb)
14596                  (funcall gnus-subscribe-options-newsgroup-method group))
14597                 ((eq do-sub 'ignore)
14598                  nil)
14599                 (t
14600                  (setq gnus-killed-list (cons group gnus-killed-list)))))))
14601          gnus-active-hashtb)
14602         (while groups
14603           (if (gnus-active (car groups))
14604               (gnus-group-change-level
14605                (car groups) gnus-level-default-subscribed gnus-level-killed))
14606           (setq groups (cdr groups)))
14607         (gnus-group-make-help-group)
14608         (and gnus-novice-user
14609              (gnus-message 7 "`A k' to list killed groups"))))))
14610
14611 (defun gnus-subscribe-group (group previous &optional method)
14612   (gnus-group-change-level
14613    (if method
14614        (list t group gnus-level-default-subscribed nil nil method)
14615      group)
14616    gnus-level-default-subscribed gnus-level-killed previous t))
14617
14618 ;; `gnus-group-change-level' is the fundamental function for changing
14619 ;; subscription levels of newsgroups.  This might mean just changing
14620 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
14621 ;; again, which subscribes/unsubscribes a group, which is equally
14622 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
14623 ;; from 8-9 to 1-7 means that you remove the group from the list of
14624 ;; killed (or zombie) groups and add them to the (kinda) subscribed
14625 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
14626 ;; which is trivial.
14627 ;; ENTRY can either be a string (newsgroup name) or a list (if
14628 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
14629 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
14630 ;; entries.
14631 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
14632 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
14633 ;; after.
14634 (defun gnus-group-change-level (entry level &optional oldlevel
14635                                       previous fromkilled)
14636   (let (group info active num)
14637     ;; Glean what info we can from the arguments
14638     (if (consp entry)
14639         (if fromkilled (setq group (nth 1 entry))
14640           (setq group (car (nth 2 entry))))
14641       (setq group entry))
14642     (if (and (stringp entry)
14643              oldlevel
14644              (< oldlevel gnus-level-zombie))
14645         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
14646     (if (and (not oldlevel)
14647              (consp entry))
14648         (setq oldlevel (car (cdr (nth 2 entry)))))
14649     (if (stringp previous)
14650         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
14651
14652     (if (and (>= oldlevel gnus-level-zombie)
14653              (gnus-gethash group gnus-newsrc-hashtb))
14654         ;; We are trying to subscribe a group that is already
14655         ;; subscribed.
14656         ()                              ; Do nothing.
14657
14658       (or (gnus-ephemeral-group-p group)
14659           (gnus-dribble-enter
14660            (format "(gnus-group-change-level %S %S %S %S %S)"
14661                    group level oldlevel (car (nth 2 previous)) fromkilled)))
14662
14663       ;; Then we remove the newgroup from any old structures, if needed.
14664       ;; If the group was killed, we remove it from the killed or zombie
14665       ;; list.  If not, and it is in fact going to be killed, we remove
14666       ;; it from the newsrc hash table and assoc.
14667       (cond ((>= oldlevel gnus-level-zombie)
14668              (if (= oldlevel gnus-level-zombie)
14669                  (setq gnus-zombie-list (delete group gnus-zombie-list))
14670                (setq gnus-killed-list (delete group gnus-killed-list))))
14671             (t
14672              (if (and (>= level gnus-level-zombie)
14673                       entry)
14674                  (progn
14675                    (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
14676                    (if (nth 3 entry)
14677                        (setcdr (gnus-gethash (car (nth 3 entry))
14678                                              gnus-newsrc-hashtb)
14679                                (cdr entry)))
14680                    (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
14681
14682       ;; Finally we enter (if needed) the list where it is supposed to
14683       ;; go, and change the subscription level.  If it is to be killed,
14684       ;; we enter it into the killed or zombie list.
14685       (cond ((>= level gnus-level-zombie)
14686              ;; Remove from the hash table.
14687              (gnus-sethash group nil gnus-newsrc-hashtb)
14688              ;; We do not enter foreign groups into the list of dead
14689              ;; groups.
14690              (unless (gnus-group-foreign-p group)
14691                (if (= level gnus-level-zombie)
14692                    (setq gnus-zombie-list (cons group gnus-zombie-list))
14693                  (setq gnus-killed-list (cons group gnus-killed-list)))))
14694             (t
14695              ;; If the list is to be entered into the newsrc assoc, and
14696              ;; it was killed, we have to create an entry in the newsrc
14697              ;; hashtb format and fix the pointers in the newsrc assoc.
14698              (if (>= oldlevel gnus-level-zombie)
14699                  (progn
14700                    (if (listp entry)
14701                        (progn
14702                          (setq info (cdr entry))
14703                          (setq num (car entry)))
14704                      (setq active (gnus-active group))
14705                      (setq num
14706                            (if active (- (1+ (cdr active)) (car active)) t))
14707                      ;; Check whether the group is foreign.  If so, the
14708                      ;; foreign select method has to be entered into the
14709                      ;; info.
14710                      (let ((method (or gnus-override-subscribe-method
14711                                        (gnus-group-method-name group))))
14712                        (if (eq method gnus-select-method)
14713                            (setq info (list group level nil))
14714                          (setq info (list group level nil nil method)))))
14715                    (or previous
14716                        (setq previous
14717                              (let ((p gnus-newsrc-alist))
14718                                (while (cdr (cdr p))
14719                                  (setq p (cdr p)))
14720                                p)))
14721                    (setq entry (cons info (cdr (cdr previous))))
14722                    (if (cdr previous)
14723                        (progn
14724                          (setcdr (cdr previous) entry)
14725                          (gnus-sethash group (cons num (cdr previous))
14726                                        gnus-newsrc-hashtb))
14727                      (setcdr previous entry)
14728                      (gnus-sethash group (cons num previous)
14729                                    gnus-newsrc-hashtb))
14730                    (if (cdr entry)
14731                        (setcdr (gnus-gethash (car (car (cdr entry)))
14732                                              gnus-newsrc-hashtb)
14733                                entry)))
14734                ;; It was alive, and it is going to stay alive, so we
14735                ;; just change the level and don't change any pointers or
14736                ;; hash table entries.
14737                (setcar (cdr (car (cdr (cdr entry)))) level))))
14738       (when gnus-group-change-level-function
14739         (funcall gnus-group-change-level-function group level oldlevel)))))
14740
14741 (defun gnus-kill-newsgroup (newsgroup)
14742   "Obsolete function.  Kills a newsgroup."
14743   (gnus-group-change-level
14744    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
14745
14746 (defun gnus-check-bogus-newsgroups (&optional confirm)
14747   "Remove bogus newsgroups.
14748 If CONFIRM is non-nil, the user has to confirm the deletion of every
14749 newsgroup."
14750   (let ((newsrc (cdr gnus-newsrc-alist))
14751         bogus group entry info)
14752     (gnus-message 5 "Checking bogus newsgroups...")
14753     (unless gnus-have-read-active-file
14754       (gnus-read-active-file))
14755     (when (member gnus-select-method gnus-have-read-active-file)
14756       ;; Find all bogus newsgroup that are subscribed.
14757       (while newsrc
14758         (setq info (pop newsrc)
14759               group (gnus-info-group info))
14760         (unless (or (gnus-active group) ; Active
14761                     (gnus-info-method info) ; Foreign
14762                     (and confirm
14763                          (not (gnus-y-or-n-p
14764                                (format "Remove bogus newsgroup: %s " group)))))
14765           ;; Found a bogus newsgroup.
14766           (push group bogus)))
14767       ;; Remove all bogus subscribed groups by first killing them, and
14768       ;; then removing them from the list of killed groups.
14769       (while bogus
14770         (when (setq entry (gnus-gethash (setq group (pop bogus))
14771                                         gnus-newsrc-hashtb))
14772           (gnus-group-change-level entry gnus-level-killed)
14773           (setq gnus-killed-list (delete group gnus-killed-list))))
14774       ;; Then we remove all bogus groups from the list of killed and
14775       ;; zombie groups.  They are are removed without confirmation.
14776       (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
14777             killed)
14778         (while dead-lists
14779           (setq killed (symbol-value (car dead-lists)))
14780           (while killed
14781             (unless (gnus-active (setq group (pop killed)))
14782               ;; The group is bogus.
14783               ;; !!!Slow as hell.
14784               (set (car dead-lists)
14785                    (delete group (symbol-value (car dead-lists))))))
14786           (setq dead-lists (cdr dead-lists))))
14787       (gnus-message 5 "Checking bogus newsgroups...done"))))
14788
14789 (defun gnus-check-duplicate-killed-groups ()
14790   "Remove duplicates from the list of killed groups."
14791   (interactive)
14792   (let ((killed gnus-killed-list))
14793     (while killed
14794       (gnus-message 9 "%d" (length killed))
14795       (setcdr killed (delete (car killed) (cdr killed)))
14796       (setq killed (cdr killed)))))
14797
14798 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
14799 ;; and compute how many unread articles there are in each group.
14800 (defun gnus-get-unread-articles (&optional level)
14801   (let* ((newsrc (cdr gnus-newsrc-alist))
14802          (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
14803          (foreign-level
14804           (min
14805            (cond ((and gnus-activate-foreign-newsgroups
14806                        (not (numberp gnus-activate-foreign-newsgroups)))
14807                   (1+ gnus-level-subscribed))
14808                  ((numberp gnus-activate-foreign-newsgroups)
14809                   gnus-activate-foreign-newsgroups)
14810                  (t 0))
14811            level))
14812          info group active virtuals method fmethod)
14813     (gnus-message 5 "Checking new news...")
14814
14815     (while newsrc
14816       (setq info (car newsrc)
14817             group (gnus-info-group info)
14818             active (gnus-active group))
14819
14820       ;; Check newsgroups.  If the user doesn't want to check them, or
14821       ;; they can't be checked (for instance, if the news server can't
14822       ;; be reached) we just set the number of unread articles in this
14823       ;; newsgroup to t.  This means that Gnus thinks that there are
14824       ;; unread articles, but it has no idea how many.
14825       (if (and (setq method (gnus-info-method info))
14826                (not (gnus-server-equal
14827                      gnus-select-method
14828                      (setq fmethod (gnus-server-get-method nil method))))
14829                (not (gnus-secondary-method-p method)))
14830           ;; These groups are foreign.  Check the level.
14831           (if (<= (gnus-info-level info) foreign-level)
14832               (setq active (gnus-activate-group (gnus-info-group info) 'scan)))
14833
14834         ;; These groups are native or secondary.
14835         (if (<= (gnus-info-level info) level)
14836             (or gnus-read-active-file
14837                 (setq active (gnus-activate-group
14838                               (gnus-info-group info) 'scan)))))
14839
14840       (if active
14841           (gnus-get-unread-articles-in-group info active t)
14842         ;; The group couldn't be reached, so we nix out the number of
14843         ;; unread articles and stuff.
14844         (gnus-set-active group nil)
14845         (setcar (gnus-gethash group gnus-newsrc-hashtb) t))
14846
14847       (setq newsrc (cdr newsrc)))
14848
14849     (gnus-message 5 "Checking new news...done")))
14850
14851 ;; Create a hash table out of the newsrc alist.  The `car's of the
14852 ;; alist elements are used as keys.
14853 (defun gnus-make-hashtable-from-newsrc-alist ()
14854   (let ((alist gnus-newsrc-alist)
14855         (ohashtb gnus-newsrc-hashtb)
14856         prev)
14857     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
14858     (setq alist
14859           (setq prev (setq gnus-newsrc-alist
14860                            (if (equal (car (car gnus-newsrc-alist))
14861                                       "dummy.group")
14862                                gnus-newsrc-alist
14863                              (cons (list "dummy.group" 0 nil) alist)))))
14864     (while alist
14865       (gnus-sethash
14866        (car (car alist))
14867        (cons (and ohashtb (car (gnus-gethash (car (car alist)) ohashtb)))
14868              prev)
14869        gnus-newsrc-hashtb)
14870       (setq prev alist
14871             alist (cdr alist)))))
14872
14873 (defun gnus-make-hashtable-from-killed ()
14874   "Create a hash table from the killed and zombie lists."
14875   (let ((lists '(gnus-killed-list gnus-zombie-list))
14876         list)
14877     (setq gnus-killed-hashtb
14878           (gnus-make-hashtable
14879            (+ (length gnus-killed-list) (length gnus-zombie-list))))
14880     (while lists
14881       (setq list (symbol-value (car lists)))
14882       (setq lists (cdr lists))
14883       (while list
14884         (gnus-sethash (car list) (car list) gnus-killed-hashtb)
14885         (setq list (cdr list))))))
14886
14887 (defun gnus-get-unread-articles-in-group (info active &optional update)
14888   ;; Allow the backend to update the info in the group.
14889   (when update
14890     (gnus-request-update-info
14891      info (gnus-find-method-for-group (gnus-info-group info))))
14892   (let* ((range (gnus-info-read info))
14893          (num 0)
14894          (marked (gnus-info-marks info)))
14895     ;; If a cache is present, we may have to alter the active info.
14896     (and gnus-use-cache
14897          (gnus-cache-possibly-alter-active (gnus-info-group info) active))
14898     ;; Modify the list of read articles according to what articles
14899     ;; are available; then tally the unread articles and add the
14900     ;; number to the group hash table entry.
14901     (cond
14902      ((zerop (cdr active))
14903       (setq num 0))
14904      ((not range)
14905       (setq num (- (1+ (cdr active)) (car active))))
14906      ((not (listp (cdr range)))
14907       ;; Fix a single (num . num) range according to the
14908       ;; active hash table.
14909       ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
14910       (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
14911       (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
14912       ;; Compute number of unread articles.
14913       (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
14914      (t
14915       ;; The read list is a list of ranges.  Fix them according to
14916       ;; the active hash table.
14917       ;; First peel off any elements that are below the lower
14918       ;; active limit.
14919       (while (and (cdr range)
14920                   (>= (car active)
14921                       (or (and (atom (car (cdr range))) (car (cdr range)))
14922                           (car (car (cdr range))))))
14923         (if (numberp (car range))
14924             (setcar range
14925                     (cons (car range)
14926                           (or (and (numberp (car (cdr range)))
14927                                    (car (cdr range)))
14928                               (cdr (car (cdr range))))))
14929           (setcdr (car range)
14930                   (or (and (numberp (nth 1 range)) (nth 1 range))
14931                       (cdr (car (cdr range))))))
14932         (setcdr range (cdr (cdr range))))
14933       ;; Adjust the first element to be the same as the lower limit.
14934       (if (and (not (atom (car range)))
14935                (< (cdr (car range)) (car active)))
14936           (setcdr (car range) (1- (car active))))
14937       ;; Then we want to peel off any elements that are higher
14938       ;; than the upper active limit.
14939       (let ((srange range))
14940         ;; Go past all legal elements.
14941         (while (and (cdr srange)
14942                     (<= (or (and (atom (car (cdr srange)))
14943                                  (car (cdr srange)))
14944                             (car (car (cdr srange)))) (cdr active)))
14945           (setq srange (cdr srange)))
14946         (if (cdr srange)
14947             ;; Nuke all remaining illegal elements.
14948             (setcdr srange nil))
14949
14950         ;; Adjust the final element.
14951         (if (and (not (atom (car srange)))
14952                  (> (cdr (car srange)) (cdr active)))
14953             (setcdr (car srange) (cdr active))))
14954       ;; Compute the number of unread articles.
14955       (while range
14956         (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
14957                                     (cdr (car range))))
14958                             (or (and (atom (car range)) (car range))
14959                                 (car (car range))))))
14960         (setq range (cdr range)))
14961       (setq num (max 0 (- (cdr active) num)))))
14962     ;; Set the number of unread articles.
14963     (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)
14964     num))
14965
14966 (defun gnus-activate-group (group &optional scan)
14967   ;; Check whether a group has been activated or not.
14968   ;; If SCAN, request a scan of that group as well.
14969   (let ((method (gnus-find-method-for-group group))
14970         active)
14971     (and (gnus-check-server method)
14972          ;; We escape all bugs and quit here to make it possible to
14973          ;; continue if a group is so out-there that it reports bugs
14974          ;; and stuff.
14975          (progn
14976            (and scan
14977                 (gnus-check-backend-function 'request-scan (car method))
14978                 (gnus-request-scan group method))
14979            t)
14980          (condition-case ()
14981              (gnus-request-group group)
14982         ;   (error nil)
14983            (quit nil))
14984          (save-excursion
14985            (set-buffer nntp-server-buffer)
14986            (goto-char (point-min))
14987            ;; Parse the result we got from `gnus-request-group'.
14988            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
14989                 (progn
14990                   (goto-char (match-beginning 1))
14991                   (gnus-set-active
14992                    group (setq active (cons (read (current-buffer))
14993                                             (read (current-buffer)))))
14994                   ;; Return the new active info.
14995                   active))))))
14996
14997 (defun gnus-update-read-articles (group unread)
14998   "Update the list of read and ticked articles in GROUP using the
14999 UNREAD and TICKED lists.
15000 Note: UNSELECTED has to be sorted over `<'.
15001 Returns whether the updating was successful."
15002   (let* ((active (or gnus-newsgroup-active (gnus-active group)))
15003          (entry (gnus-gethash group gnus-newsrc-hashtb))
15004          (info (nth 2 entry))
15005          (marked (gnus-info-marks info))
15006          (prev 1)
15007          (unread (sort (copy-sequence unread) '<))
15008          read)
15009     (if (or (not info) (not active))
15010         ;; There is no info on this group if it was, in fact,
15011         ;; killed.  Gnus stores no information on killed groups, so
15012         ;; there's nothing to be done.
15013         ;; One could store the information somewhere temporarily,
15014         ;; perhaps...  Hmmm...
15015         ()
15016       ;; Remove any negative articles numbers.
15017       (while (and unread (< (car unread) 0))
15018         (setq unread (cdr unread)))
15019       ;; Remove any expired article numbers
15020       (while (and unread (< (car unread) (car active)))
15021         (setq unread (cdr unread)))
15022       ;; Compute the ranges of read articles by looking at the list of
15023       ;; unread articles.
15024       (while unread
15025         (if (/= (car unread) prev)
15026             (setq read (cons (if (= prev (1- (car unread))) prev
15027                                (cons prev (1- (car unread)))) read)))
15028         (setq prev (1+ (car unread)))
15029         (setq unread (cdr unread)))
15030       (when (<= prev (cdr active))
15031         (setq read (cons (cons prev (cdr active)) read)))
15032       ;; Enter this list into the group info.
15033       (gnus-info-set-read
15034        info (if (> (length read) 1) (nreverse read) read))
15035       ;; Set the number of unread articles in gnus-newsrc-hashtb.
15036       (gnus-get-unread-articles-in-group info (gnus-active group))
15037       t)))
15038
15039 (defun gnus-make-articles-unread (group articles)
15040   "Mark ARTICLES in GROUP as unread."
15041   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
15042                           (gnus-gethash (gnus-group-real-name group)
15043                                         gnus-newsrc-hashtb))))
15044          (ranges (gnus-info-read info))
15045          news article)
15046     (while articles
15047       (when (gnus-member-of-range
15048              (setq article (pop articles)) ranges)
15049         (setq news (cons article news))))
15050     (when news
15051       (gnus-info-set-read
15052        info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
15053       (gnus-group-update-group group t))))
15054
15055 ;; Enter all dead groups into the hashtb.
15056 (defun gnus-update-active-hashtb-from-killed ()
15057   (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
15058         (lists (list gnus-killed-list gnus-zombie-list))
15059         killed)
15060     (while lists
15061       (setq killed (car lists))
15062       (while killed
15063         (gnus-sethash (car killed) nil hashtb)
15064         (setq killed (cdr killed)))
15065       (setq lists (cdr lists)))))
15066
15067 ;; Get the active file(s) from the backend(s).
15068 (defun gnus-read-active-file ()
15069   (gnus-group-set-mode-line)
15070   (let ((methods (cons gnus-message-archive-method
15071                        (if (gnus-check-server gnus-select-method)
15072                            ;; The native server is available.
15073                            (cons gnus-select-method 
15074                                  gnus-secondary-select-methods)
15075                          ;; The native server is down, so we just do the
15076                          ;; secondary ones.
15077                          gnus-secondary-select-methods)))
15078         list-type)
15079     (setq gnus-have-read-active-file nil)
15080     (save-excursion
15081       (set-buffer nntp-server-buffer)
15082       (while methods
15083         (let* ((method (gnus-server-get-method nil (car methods)))
15084                (where (nth 1 method))
15085                (mesg (format "Reading active file%s via %s..."
15086                              (if (and where (not (zerop (length where))))
15087                                  (concat " from " where) "")
15088                              (car method))))
15089           (gnus-message 5 mesg)
15090           (if (not (gnus-check-server method))
15091               ()
15092             ;; Request that the backend scan its incoming messages.
15093             (and (gnus-check-backend-function 'request-scan (car method))
15094                  (gnus-request-scan nil method))
15095             (cond
15096              ((and (eq gnus-read-active-file 'some)
15097                    (gnus-check-backend-function 'retrieve-groups (car method)))
15098               (let ((newsrc (cdr gnus-newsrc-alist))
15099                     (gmethod (gnus-server-get-method nil method))
15100                     groups)
15101                 (while newsrc
15102                   (and (gnus-server-equal
15103                         (gnus-find-method-for-group
15104                          (car (car newsrc)) (car newsrc))
15105                         gmethod)
15106                        (setq groups (cons (gnus-group-real-name
15107                                            (car (car newsrc))) groups)))
15108                   (setq newsrc (cdr newsrc)))
15109                 (gnus-check-server method)
15110                 (setq list-type (gnus-retrieve-groups groups method))
15111                 (cond
15112                  ((not list-type)
15113                   (gnus-message
15114                    1 "Cannot read partial active file from %s server."
15115                    (car method))
15116                   (ding)
15117                   (sit-for 2))
15118                  ((eq list-type 'active)
15119                   (gnus-active-to-gnus-format method gnus-active-hashtb))
15120                  (t
15121                   (gnus-groups-to-gnus-format method gnus-active-hashtb)))))
15122              (t
15123               (if (not (gnus-request-list method))
15124                   (progn
15125                     (gnus-message 1 "Cannot read active file from %s server."
15126                                   (car method))
15127                     (ding))
15128                 (gnus-active-to-gnus-format method)
15129                 ;; We mark this active file as read.
15130                 (setq gnus-have-read-active-file
15131                       (cons method gnus-have-read-active-file))
15132                 (gnus-message 5 "%sdone" mesg))))))
15133         (setq methods (cdr methods))))))
15134
15135 ;; Read an active file and place the results in `gnus-active-hashtb'.
15136 (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors)
15137   (unless method
15138     (setq method gnus-select-method))
15139   (let ((cur (current-buffer))
15140         (hashtb (or hashtb
15141                     (if (and gnus-active-hashtb
15142                              (not (equal method gnus-select-method)))
15143                         gnus-active-hashtb
15144                       (setq gnus-active-hashtb
15145                             (if (equal method gnus-select-method)
15146                                 (gnus-make-hashtable
15147                                  (count-lines (point-min) (point-max)))
15148                               (gnus-make-hashtable 4096))))))
15149         (flag-hashtb (gnus-make-hashtable 60)))
15150     ;; Delete unnecessary lines.
15151     (goto-char (point-min))
15152     (while (search-forward "\nto." nil t)
15153       (delete-region (1+ (match-beginning 0))
15154                      (progn (forward-line 1) (point))))
15155     (or (string= gnus-ignored-newsgroups "")
15156         (progn
15157           (goto-char (point-min))
15158           (delete-matching-lines gnus-ignored-newsgroups)))
15159     ;; Make the group names readable as a lisp expression even if they
15160     ;; contain special characters.
15161     ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
15162     (goto-char (point-max))
15163     (while (re-search-backward "[][';?()#]" nil t)
15164       (insert ?\\))
15165     ;; If these are groups from a foreign select method, we insert the
15166     ;; group prefix in front of the group names.
15167     (and method (not (gnus-server-equal
15168                       (gnus-server-get-method nil method)
15169                       (gnus-server-get-method nil gnus-select-method)))
15170          (let ((prefix (gnus-group-prefixed-name "" method)))
15171            (goto-char (point-min))
15172            (while (and (not (eobp))
15173                        (progn (insert prefix)
15174                               (zerop (forward-line 1)))))))
15175     ;; Store the active file in a hash table.
15176     (goto-char (point-min))
15177     (if (string-match "%[oO]" gnus-group-line-format)
15178         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
15179         ;; If we want information on moderated groups, we use this
15180         ;; loop...
15181         (let* ((mod-hashtb (make-vector 7 0))
15182                (m (intern "m" mod-hashtb))
15183                group max min)
15184           (while (not (eobp))
15185             (condition-case nil
15186                 (progn
15187                   (narrow-to-region (point) (gnus-point-at-eol))
15188                   (setq group (let ((obarray hashtb)) (read cur)))
15189                   (if (and (numberp (setq max (read cur)))
15190                            (numberp (setq min (read cur)))
15191                            (progn
15192                              (skip-chars-forward " \t")
15193                              (not
15194                               (or (= (following-char) ?=)
15195                                   (= (following-char) ?x)
15196                                   (= (following-char) ?j)))))
15197                       (set group (cons min max))
15198                     (set group nil))
15199                   ;; Enter moderated groups into a list.
15200                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
15201                       (setq gnus-moderated-list
15202                             (cons (symbol-name group) gnus-moderated-list))))
15203               (error
15204                (and group
15205                     (symbolp group)
15206                     (set group nil))))
15207             (widen)
15208             (forward-line 1)))
15209       ;; And if we do not care about moderation, we use this loop,
15210       ;; which is faster.
15211       (let (group max min)
15212         (while (not (eobp))
15213           (condition-case ()
15214               (progn
15215                 (narrow-to-region (point) (gnus-point-at-eol))
15216                 ;; group gets set to a symbol interned in the hash table
15217                 ;; (what a hack!!) - jwz
15218                 (setq group (let ((obarray hashtb)) (read cur)))
15219                 (if (and (numberp (setq max (read cur)))
15220                          (numberp (setq min (read cur)))
15221                          (progn
15222                            (skip-chars-forward " \t")
15223                            (not
15224                             (or (= (following-char) ?=)
15225                                 (= (following-char) ?x)
15226                                 (= (following-char) ?j)))))
15227                     (set group (cons min max))
15228                   (set group nil)))
15229             (error
15230              (progn
15231                (and group
15232                     (symbolp group)
15233                     (set group nil))
15234                (or ignore-errors
15235                    (gnus-message 3 "Warning - illegal active: %s"
15236                                  (buffer-substring
15237                                   (gnus-point-at-bol) (gnus-point-at-eol)))))))
15238           (widen)
15239           (forward-line 1))))))
15240
15241 (defun gnus-groups-to-gnus-format (method &optional hashtb)
15242   ;; Parse a "groups" active file.
15243   (let ((cur (current-buffer))
15244         (hashtb (or hashtb
15245                     (if (and method gnus-active-hashtb)
15246                         gnus-active-hashtb
15247                       (setq gnus-active-hashtb
15248                             (gnus-make-hashtable
15249                              (count-lines (point-min) (point-max)))))))
15250         (prefix (and method
15251                      (not (gnus-server-equal
15252                            (gnus-server-get-method nil method)
15253                            (gnus-server-get-method nil gnus-select-method)))
15254                      (gnus-group-prefixed-name "" method))))
15255
15256     (goto-char (point-min))
15257     ;; We split this into to separate loops, one with the prefix
15258     ;; and one without to speed the reading up somewhat.
15259     (if prefix
15260         (let (min max opoint group)
15261           (while (not (eobp))
15262             (condition-case ()
15263                 (progn
15264                   (read cur) (read cur)
15265                   (setq min (read cur)
15266                         max (read cur)
15267                         opoint (point))
15268                   (skip-chars-forward " \t")
15269                   (insert prefix)
15270                   (goto-char opoint)
15271                   (set (let ((obarray hashtb)) (read cur))
15272                        (cons min max)))
15273               (error (and group (symbolp group) (set group nil))))
15274             (forward-line 1)))
15275       (let (min max group)
15276         (while (not (eobp))
15277           (condition-case ()
15278               (if (= (following-char) ?2)
15279                   (progn
15280                     (read cur) (read cur)
15281                     (setq min (read cur)
15282                           max (read cur))
15283                     (set (setq group (let ((obarray hashtb)) (read cur)))
15284                          (cons min max))))
15285             (error (and group (symbolp group) (set group nil))))
15286           (forward-line 1))))))
15287
15288 (defun gnus-read-newsrc-file (&optional force)
15289   "Read startup file.
15290 If FORCE is non-nil, the .newsrc file is read."
15291   ;; Reset variables that might be defined in the .newsrc.eld file.
15292   (let ((variables gnus-variable-list))
15293     (while variables
15294       (set (car variables) nil)
15295       (setq variables (cdr variables))))
15296   (let* ((newsrc-file gnus-current-startup-file)
15297          (quick-file (concat newsrc-file ".el")))
15298     (save-excursion
15299       ;; We always load the .newsrc.eld file.  If always contains
15300       ;; much information that can not be gotten from the .newsrc
15301       ;; file (ticked articles, killed groups, foreign methods, etc.)
15302       (gnus-read-newsrc-el-file quick-file)
15303
15304       (if (or force
15305               (and (file-newer-than-file-p newsrc-file quick-file)
15306                    (file-newer-than-file-p newsrc-file
15307                                            (concat quick-file "d")))
15308               (not gnus-newsrc-alist))
15309           ;; We read the .newsrc file.  Note that if there if a
15310           ;; .newsrc.eld file exists, it has already been read, and
15311           ;; the `gnus-newsrc-hashtb' has been created.  While reading
15312           ;; the .newsrc file, Gnus will only use the information it
15313           ;; can find there for changing the data already read -
15314           ;; ie. reading the .newsrc file will not trash the data
15315           ;; already read (except for read articles).
15316           (save-excursion
15317             (gnus-message 5 "Reading %s..." newsrc-file)
15318             (set-buffer (find-file-noselect newsrc-file))
15319             (buffer-disable-undo (current-buffer))
15320             (gnus-newsrc-to-gnus-format)
15321             (kill-buffer (current-buffer))
15322             (gnus-message 5 "Reading %s...done" newsrc-file)))
15323
15324       ;; Read any slave files.
15325       (or gnus-slave
15326           (gnus-master-read-slave-newsrc)))))
15327
15328 (defun gnus-read-newsrc-el-file (file)
15329   (let ((ding-file (concat file "d")))
15330     ;; We always, always read the .eld file.
15331     (gnus-message 5 "Reading %s..." ding-file)
15332     (let (gnus-newsrc-assoc)
15333       (condition-case nil
15334           (load ding-file t t t)
15335         (error
15336          (gnus-message 1 "Error in %s" ding-file)
15337          (ding)))
15338       (when gnus-newsrc-assoc
15339         (setq gnus-newsrc-alist gnus-newsrc-assoc)))
15340     (gnus-make-hashtable-from-newsrc-alist)
15341     (when (file-newer-than-file-p file ding-file)
15342       ;; Old format quick file
15343       (gnus-message 5 "Reading %s..." file)
15344       ;; The .el file is newer than the .eld file, so we read that one
15345       ;; as well.
15346       (gnus-read-old-newsrc-el-file file))))
15347
15348 ;; Parse the old-style quick startup file
15349 (defun gnus-read-old-newsrc-el-file (file)
15350   (let (newsrc killed marked group m)
15351     (prog1
15352         (let ((gnus-killed-assoc nil)
15353               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
15354           (prog1
15355               (condition-case nil
15356                   (load file t t t)
15357                 (error nil))
15358             (setq newsrc gnus-newsrc-assoc
15359                   killed gnus-killed-assoc
15360                   marked gnus-marked-assoc)))
15361       (setq gnus-newsrc-alist nil)
15362       (while newsrc
15363         (setq group (car newsrc))
15364         (let ((info (gnus-get-info (car group))))
15365           (if info
15366               (progn
15367                 (gnus-info-set-read info (cdr (cdr group)))
15368                 (gnus-info-set-level
15369                  info (if (nth 1 group) gnus-level-default-subscribed
15370                         gnus-level-default-unsubscribed))
15371                 (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
15372             (setq gnus-newsrc-alist
15373                   (cons
15374                    (setq info
15375                          (list (car group)
15376                                (if (nth 1 group) gnus-level-default-subscribed
15377                                  gnus-level-default-unsubscribed)
15378                                (cdr (cdr group))))
15379                    gnus-newsrc-alist)))
15380           (if (setq m (assoc (car group) marked))
15381               (gnus-info-set-marks
15382                info (cons (list (cons 'tick (gnus-compress-sequence
15383                                              (sort (cdr m) '<) t)))
15384                           nil))))
15385         (setq newsrc (cdr newsrc)))
15386       (setq newsrc killed)
15387       (while newsrc
15388         (setcar newsrc (car (car newsrc)))
15389         (setq newsrc (cdr newsrc)))
15390       (setq gnus-killed-list killed))
15391     ;; The .el file version of this variable does not begin with
15392     ;; "options", while the .eld version does, so we just add it if it
15393     ;; isn't there.
15394     (and
15395      gnus-newsrc-options
15396      (progn
15397        (and (not (string-match "^ *options" gnus-newsrc-options))
15398             (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
15399        (and (not (string-match "\n$" gnus-newsrc-options))
15400             (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
15401        ;; Finally, if we read some options lines, we parse them.
15402        (or (string= gnus-newsrc-options "")
15403            (gnus-newsrc-parse-options gnus-newsrc-options))))
15404
15405     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
15406     (gnus-make-hashtable-from-newsrc-alist)))
15407
15408 (defun gnus-make-newsrc-file (file)
15409   "Make server dependent file name by catenating FILE and server host name."
15410   (let* ((file (expand-file-name file nil))
15411          (real-file (concat file "-" (nth 1 gnus-select-method))))
15412     (if (or (file-exists-p real-file)
15413             (file-exists-p (concat real-file ".el"))
15414             (file-exists-p (concat real-file ".eld")))
15415         real-file file)))
15416
15417 (defun gnus-newsrc-to-gnus-format ()
15418   (setq gnus-newsrc-options "")
15419   (setq gnus-newsrc-options-n nil)
15420
15421   (or gnus-active-hashtb
15422       (setq gnus-active-hashtb (make-vector 4095 0)))
15423   (let ((buf (current-buffer))
15424         (already-read (> (length gnus-newsrc-alist) 1))
15425         group subscribed options-symbol newsrc Options-symbol
15426         symbol reads num1)
15427     (goto-char (point-min))
15428     ;; We intern the symbol `options' in the active hashtb so that we
15429     ;; can `eq' against it later.
15430     (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
15431     (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
15432
15433     (while (not (eobp))
15434       ;; We first read the first word on the line by narrowing and
15435       ;; then reading into `gnus-active-hashtb'.  Most groups will
15436       ;; already exist in that hashtb, so this will save some string
15437       ;; space.
15438       (narrow-to-region
15439        (point)
15440        (progn (skip-chars-forward "^ \t!:\n") (point)))
15441       (goto-char (point-min))
15442       (setq symbol
15443             (and (/= (point-min) (point-max))
15444                  (let ((obarray gnus-active-hashtb)) (read buf))))
15445       (widen)
15446       ;; Now, the symbol we have read is either `options' or a group
15447       ;; name.  If it is an options line, we just add it to a string.
15448       (cond
15449        ((or (eq symbol options-symbol)
15450             (eq symbol Options-symbol))
15451         (setq gnus-newsrc-options
15452               ;; This concating is quite inefficient, but since our
15453               ;; thorough studies show that approx 99.37% of all
15454               ;; .newsrc files only contain a single options line, we
15455               ;; don't give a damn, frankly, my dear.
15456               (concat gnus-newsrc-options
15457                       (buffer-substring
15458                        (gnus-point-at-bol)
15459                        ;; Options may continue on the next line.
15460                        (or (and (re-search-forward "^[^ \t]" nil 'move)
15461                                 (progn (beginning-of-line) (point)))
15462                            (point)))))
15463         (forward-line -1))
15464        (symbol
15465         ;; Group names can be just numbers.  
15466         (when (numberp symbol) 
15467           (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
15468         (or (boundp symbol) (set symbol nil))
15469         ;; It was a group name.
15470         (setq subscribed (= (following-char) ?:)
15471               group (symbol-name symbol)
15472               reads nil)
15473         (if (eolp)
15474             ;; If the line ends here, this is clearly a buggy line, so
15475             ;; we put point a the beginning of line and let the cond
15476             ;; below do the error handling.
15477             (beginning-of-line)
15478           ;; We skip to the beginning of the ranges.
15479           (skip-chars-forward "!: \t"))
15480         ;; We are now at the beginning of the list of read articles.
15481         ;; We read them range by range.
15482         (while
15483             (cond
15484              ((looking-at "[0-9]+")
15485               ;; We narrow and read a number instead of buffer-substring/
15486               ;; string-to-int because it's faster.  narrow/widen is
15487               ;; faster than save-restriction/narrow, and save-restriction
15488               ;; produces a garbage object.
15489               (setq num1 (progn
15490                            (narrow-to-region (match-beginning 0) (match-end 0))
15491                            (read buf)))
15492               (widen)
15493               ;; If the next character is a dash, then this is a range.
15494               (if (= (following-char) ?-)
15495                   (progn
15496                     ;; We read the upper bound of the range.
15497                     (forward-char 1)
15498                     (if (not (looking-at "[0-9]+"))
15499                         ;; This is a buggy line, by we pretend that
15500                         ;; it's kinda OK.  Perhaps the user should be
15501                         ;; dinged?
15502                         (setq reads (cons num1 reads))
15503                       (setq reads
15504                             (cons
15505                              (cons num1
15506                                    (progn
15507                                      (narrow-to-region (match-beginning 0)
15508                                                        (match-end 0))
15509                                      (read buf)))
15510                              reads))
15511                       (widen)))
15512                 ;; It was just a simple number, so we add it to the
15513                 ;; list of ranges.
15514                 (setq reads (cons num1 reads)))
15515               ;; If the next char in ?\n, then we have reached the end
15516               ;; of the line and return nil.
15517               (/= (following-char) ?\n))
15518              ((= (following-char) ?\n)
15519               ;; End of line, so we end.
15520               nil)
15521              (t
15522               ;; Not numbers and not eol, so this might be a buggy
15523               ;; line...
15524               (or (eobp)
15525                   ;; If it was eob instead of ?\n, we allow it.
15526                   (progn
15527                     ;; The line was buggy.
15528                     (setq group nil)
15529                     (gnus-message 3 "Mangled line: %s"
15530                                   (buffer-substring (gnus-point-at-bol)
15531                                                     (gnus-point-at-eol)))
15532                     (ding)
15533                     (sit-for 1)))
15534               nil))
15535           ;; Skip past ", ".  Spaces are illegal in these ranges, but
15536           ;; we allow them, because it's a common mistake to put a
15537           ;; space after the comma.
15538           (skip-chars-forward ", "))
15539
15540         ;; We have already read .newsrc.eld, so we gently update the
15541         ;; data in the hash table with the information we have just
15542         ;; read.
15543         (when group
15544           (let ((info (gnus-get-info group))
15545                 level)
15546             (if info
15547                 ;; There is an entry for this file in the alist.
15548                 (progn
15549                   (gnus-info-set-read info (nreverse reads))
15550                   ;; We update the level very gently.  In fact, we
15551                   ;; only change it if there's been a status change
15552                   ;; from subscribed to unsubscribed, or vice versa.
15553                   (setq level (gnus-info-level info))
15554                   (cond ((and (<= level gnus-level-subscribed)
15555                               (not subscribed))
15556                          (setq level (if reads
15557                                          gnus-level-default-unsubscribed
15558                                        (1+ gnus-level-default-unsubscribed))))
15559                         ((and (> level gnus-level-subscribed) subscribed)
15560                          (setq level gnus-level-default-subscribed)))
15561                   (gnus-info-set-level info level))
15562               ;; This is a new group.
15563               (setq info (list group
15564                                (if subscribed
15565                                    gnus-level-default-subscribed
15566                                  (if reads
15567                                      (1+ gnus-level-subscribed)
15568                                    gnus-level-default-unsubscribed))
15569                                (nreverse reads))))
15570             (setq newsrc (cons info newsrc))))))
15571       (forward-line 1))
15572
15573     (setq newsrc (nreverse newsrc))
15574
15575     (if (not already-read)
15576         ()
15577       ;; We now have two newsrc lists - `newsrc', which is what we
15578       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
15579       ;; what we've read from .newsrc.eld.  We have to merge these
15580       ;; lists.  We do this by "attaching" any (foreign) groups in the
15581       ;; gnus-newsrc-alist to the (native) group that precedes them.
15582       (let ((rc (cdr gnus-newsrc-alist))
15583             (prev gnus-newsrc-alist)
15584             entry mentry)
15585         (while rc
15586           (or (null (nth 4 (car rc)))   ; It's a native group.
15587               (assoc (car (car rc)) newsrc) ; It's already in the alist.
15588               (if (setq entry (assoc (car (car prev)) newsrc))
15589                   (setcdr (setq mentry (memq entry newsrc))
15590                           (cons (car rc) (cdr mentry)))
15591                 (setq newsrc (cons (car rc) newsrc))))
15592           (setq prev rc
15593                 rc (cdr rc)))))
15594
15595     (setq gnus-newsrc-alist newsrc)
15596     ;; We make the newsrc hashtb.
15597     (gnus-make-hashtable-from-newsrc-alist)
15598
15599     ;; Finally, if we read some options lines, we parse them.
15600     (or (string= gnus-newsrc-options "")
15601         (gnus-newsrc-parse-options gnus-newsrc-options))))
15602
15603 ;; Parse options lines to find "options -n !all rec.all" and stuff.
15604 ;; The return value will be a list on the form
15605 ;; ((regexp1 . ignore)
15606 ;;  (regexp2 . subscribe)...)
15607 ;; When handling new newsgroups, groups that match a `ignore' regexp
15608 ;; will be ignored, and groups that match a `subscribe' regexp will be
15609 ;; subscribed.  A line like
15610 ;; options -n !all rec.all
15611 ;; will lead to a list that looks like
15612 ;; (("^rec\\..+" . subscribe)
15613 ;;  ("^.+" . ignore))
15614 ;; So all "rec.*" groups will be subscribed, while all the other
15615 ;; groups will be ignored.  Note that "options -n !all rec.all" is very
15616 ;; different from "options -n rec.all !all".
15617 (defun gnus-newsrc-parse-options (options)
15618   (let (out eol)
15619     (save-excursion
15620       (gnus-set-work-buffer)
15621       (insert (regexp-quote options))
15622       ;; First we treat all continuation lines.
15623       (goto-char (point-min))
15624       (while (re-search-forward "\n[ \t]+" nil t)
15625         (replace-match " " t t))
15626       ;; Then we transform all "all"s into ".+"s.
15627       (goto-char (point-min))
15628       (while (re-search-forward "\\ball\\b" nil t)
15629         (replace-match ".+" t t))
15630       (goto-char (point-min))
15631       ;; We remove all other options than the "-n" ones.
15632       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
15633         (replace-match " ")
15634         (forward-char -1))
15635       (goto-char (point-min))
15636
15637       ;; We are only interested in "options -n" lines - we
15638       ;; ignore the other option lines.
15639       (while (re-search-forward "[ \t]-n" nil t)
15640         (setq eol
15641               (or (save-excursion
15642                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
15643                          (- (point) 2)))
15644                   (gnus-point-at-eol)))
15645         ;; Search for all "words"...
15646         (while (re-search-forward "[^ \t,\n]+" eol t)
15647           (if (= (char-after (match-beginning 0)) ?!)
15648               ;; If the word begins with a bang (!), this is a "not"
15649               ;; spec.  We put this spec (minus the bang) and the
15650               ;; symbol `ignore' into the list.
15651               (setq out (cons (cons (concat
15652                                      "^" (buffer-substring
15653                                           (1+ (match-beginning 0))
15654                                           (match-end 0)))
15655                                     'ignore) out))
15656             ;; There was no bang, so this is a "yes" spec.
15657             (setq out (cons (cons (concat "^" (match-string 0))
15658                                   'subscribe) out)))))
15659
15660       (setq gnus-newsrc-options-n out))))
15661
15662 (defun gnus-save-newsrc-file (&optional force)
15663   "Save .newsrc file."
15664   ;; Note: We cannot save .newsrc file if all newsgroups are removed
15665   ;; from the variable gnus-newsrc-alist.
15666   (when (and (or gnus-newsrc-alist gnus-killed-list)
15667              gnus-current-startup-file)
15668     (save-excursion
15669       (if (and (or gnus-use-dribble-file gnus-slave)
15670                (not force)
15671                (or (not gnus-dribble-buffer)
15672                    (not (buffer-name gnus-dribble-buffer))
15673                    (zerop (save-excursion
15674                             (set-buffer gnus-dribble-buffer)
15675                             (buffer-size)))))
15676           (gnus-message 4 "(No changes need to be saved)")
15677         (run-hooks 'gnus-save-newsrc-hook)
15678         (if gnus-slave
15679             (gnus-slave-save-newsrc)
15680           ;; Save .newsrc.
15681           (when gnus-save-newsrc-file
15682             (gnus-message 5 "Saving %s..." gnus-current-startup-file)
15683             (gnus-gnus-to-newsrc-format)
15684             (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
15685           ;; Save .newsrc.eld.
15686           (set-buffer (get-buffer-create " *Gnus-newsrc*"))
15687           (make-local-variable 'version-control)
15688           (setq version-control 'never)
15689           (setq buffer-file-name
15690                 (concat gnus-current-startup-file ".eld"))
15691           (gnus-add-current-to-buffer-list)
15692           (buffer-disable-undo (current-buffer))
15693           (erase-buffer)
15694           (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
15695           (gnus-gnus-to-quick-newsrc-format)
15696           (run-hooks 'gnus-save-quick-newsrc-hook)
15697           (save-buffer)
15698           (kill-buffer (current-buffer))
15699           (gnus-message
15700            5 "Saving %s.eld...done" gnus-current-startup-file))
15701         (gnus-dribble-delete-file)))))
15702
15703 (defun gnus-gnus-to-quick-newsrc-format ()
15704   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
15705   (insert ";; Gnus startup file.\n")
15706   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
15707   (insert ";; to read .newsrc.\n")
15708   (insert "(setq gnus-newsrc-file-version "
15709           (prin1-to-string gnus-version) ")\n")
15710   (let ((variables
15711          (if gnus-save-killed-list gnus-variable-list
15712            ;; Remove the `gnus-killed-list' from the list of variables
15713            ;; to be saved, if required.
15714            (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
15715         ;; Peel off the "dummy" group.
15716         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
15717         variable)
15718     ;; Insert the variables into the file.
15719     (while variables
15720       (when (and (boundp (setq variable (pop variables)))
15721                  (symbol-value variable))
15722         (insert "(setq " (symbol-name variable) " '"
15723                 (prin1-to-string (symbol-value variable)) ")\n")))))
15724
15725 (defun gnus-gnus-to-newsrc-format ()
15726   ;; Generate and save the .newsrc file.
15727   (let ((newsrc (cdr gnus-newsrc-alist))
15728         info ranges range)
15729     (save-excursion
15730       (set-buffer (create-file-buffer gnus-current-startup-file))
15731       (setq buffer-file-name gnus-current-startup-file)
15732       (buffer-disable-undo (current-buffer))
15733       (erase-buffer)
15734       ;; Write options.
15735       (if gnus-newsrc-options (insert gnus-newsrc-options))
15736       ;; Write subscribed and unsubscribed.
15737       (while newsrc
15738         (setq info (car newsrc))
15739         (if (not (gnus-info-method info))
15740             ;; Don't write foreign groups to .newsrc.
15741             (progn
15742               (insert (gnus-info-group info)
15743                       (if (> (gnus-info-level info) gnus-level-subscribed)
15744                           "!" ":"))
15745               (if (setq ranges (gnus-info-read info))
15746                   (progn
15747                     (insert " ")
15748                     (if (not (listp (cdr ranges)))
15749                         (if (= (car ranges) (cdr ranges))
15750                             (insert (int-to-string (car ranges)))
15751                           (insert (int-to-string (car ranges)) "-"
15752                                   (int-to-string (cdr ranges))))
15753                       (while ranges
15754                         (setq range (car ranges)
15755                               ranges (cdr ranges))
15756                         (if (or (atom range) (= (car range) (cdr range)))
15757                             (insert (int-to-string
15758                                      (or (and (atom range) range)
15759                                          (car range))))
15760                           (insert (int-to-string (car range)) "-"
15761                                   (int-to-string (cdr range))))
15762                         (if ranges (insert ","))))))
15763               (insert "\n")))
15764         (setq newsrc (cdr newsrc)))
15765       (make-local-variable 'version-control)
15766       (setq version-control 'never)
15767       ;; It has been reported that sometime the modtime on the .newsrc
15768       ;; file seems to be off.  We really do want to overwrite it, so
15769       ;; we clear the modtime here before saving.  It's a bit odd,
15770       ;; though...
15771       ;; sometimes the modtime clear isn't sufficient.  most brute force:
15772       ;; delete the silly thing entirely first.  but this fails to provide
15773       ;; such niceties as .newsrc~ creation.
15774       (if gnus-modtime-botch
15775           (delete-file gnus-startup-file)
15776         (clear-visited-file-modtime))
15777       (run-hooks 'gnus-save-standard-newsrc-hook)
15778       (save-buffer)
15779       (kill-buffer (current-buffer)))))
15780
15781
15782 ;;; Slave functions.
15783
15784 (defun gnus-slave-save-newsrc ()
15785   (save-excursion
15786     (set-buffer gnus-dribble-buffer)
15787     (let ((slave-name
15788            (make-temp-name (concat gnus-current-startup-file "-slave-"))))
15789       (write-region (point-min) (point-max) slave-name nil 'nomesg))))
15790
15791 (defun gnus-master-read-slave-newsrc ()
15792   (let ((slave-files
15793          (directory-files
15794           (file-name-directory gnus-current-startup-file)
15795           t (concat
15796              "^" (regexp-quote
15797                   (concat
15798                    (file-name-nondirectory gnus-current-startup-file)
15799                    "-slave-")))
15800           t))
15801         file)
15802     (if (not slave-files)
15803         ()                              ; There are no slave files to read.
15804       (gnus-message 7 "Reading slave newsrcs...")
15805       (save-excursion
15806         (set-buffer (get-buffer-create " *gnus slave*"))
15807         (buffer-disable-undo (current-buffer))
15808         (setq slave-files
15809               (sort (mapcar (lambda (file)
15810                               (list (nth 5 (file-attributes file)) file))
15811                             slave-files)
15812                     (lambda (f1 f2)
15813                       (or (< (car (car f1)) (car (car f2)))
15814                           (< (nth 1 (car f1)) (nth 1 (car f2)))))))
15815         (while slave-files
15816           (erase-buffer)
15817           (setq file (nth 1 (car slave-files)))
15818           (insert-file-contents file)
15819           (if (condition-case ()
15820                   (progn
15821                     (eval-buffer (current-buffer))
15822                     t)
15823                 (error
15824                  (gnus-message 3 "Possible error in %s" file)
15825                  (ding)
15826                  (sit-for 2)
15827                  nil))
15828               (or gnus-slave ; Slaves shouldn't delete these files.
15829                   (condition-case ()
15830                       (delete-file file)
15831                     (error nil))))
15832           (setq slave-files (cdr slave-files))))
15833       (gnus-message 7 "Reading slave newsrcs...done"))))
15834
15835
15836 ;;; Group description.
15837
15838 (defun gnus-read-all-descriptions-files ()
15839   (let ((methods (cons gnus-select-method 
15840                        (cons gnus-message-archive-method
15841                              gnus-secondary-select-methods))))
15842     (while methods
15843       (gnus-read-descriptions-file (car methods))
15844       (setq methods (cdr methods)))
15845     t))
15846
15847 (defun gnus-read-descriptions-file (&optional method)
15848   (let ((method (or method gnus-select-method)))
15849     ;; We create the hashtable whether we manage to read the desc file
15850     ;; to avoid trying to re-read after a failed read.
15851     (or gnus-description-hashtb
15852         (setq gnus-description-hashtb
15853               (gnus-make-hashtable (length gnus-active-hashtb))))
15854     ;; Mark this method's desc file as read.
15855     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
15856                   gnus-description-hashtb)
15857
15858     (gnus-message 5 "Reading descriptions file via %s..." (car method))
15859     (cond
15860      ((not (gnus-check-server method))
15861       (gnus-message 1 "Couldn't open server")
15862       nil)
15863      ((not (gnus-request-list-newsgroups method))
15864       (gnus-message 1 "Couldn't read newsgroups descriptions")
15865       nil)
15866      (t
15867       (let (group)
15868         (save-excursion
15869           (save-restriction
15870             (set-buffer nntp-server-buffer)
15871             (goto-char (point-min))
15872             (if (or (search-forward "\n.\n" nil t)
15873                     (goto-char (point-max)))
15874                 (progn
15875                   (beginning-of-line)
15876                   (narrow-to-region (point-min) (point))))
15877             (goto-char (point-min))
15878             (while (not (eobp))
15879               ;; If we get an error, we set group to 0, which is not a
15880               ;; symbol...
15881               (setq group
15882                     (condition-case ()
15883                         (let ((obarray gnus-description-hashtb))
15884                           ;; Group is set to a symbol interned in this
15885                           ;; hash table.
15886                           (read nntp-server-buffer))
15887                       (error 0)))
15888               (skip-chars-forward " \t")
15889               ;; ...  which leads to this line being effectively ignored.
15890               (and (symbolp group)
15891                    (set group (buffer-substring
15892                                (point) (progn (end-of-line) (point)))))
15893               (forward-line 1))))
15894         (gnus-message 5 "Reading descriptions file...done")
15895         t)))))
15896
15897 (defun gnus-group-get-description (group)
15898   "Get the description of a group by sending XGTITLE to the server."
15899   (when (gnus-request-group-description group)
15900     (save-excursion
15901       (set-buffer nntp-server-buffer)
15902       (goto-char (point-min))
15903       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
15904         (match-string 1)))))
15905
15906 ;;;
15907 ;;; Buffering of read articles.
15908 ;;;
15909
15910 (defvar gnus-backlog-buffer " *Gnus Backlog*")
15911 (defvar gnus-backlog-articles nil)
15912 (defvar gnus-backlog-hashtb nil)
15913
15914 (defun gnus-backlog-buffer ()
15915   "Return the backlog buffer."
15916   (or (get-buffer gnus-backlog-buffer)
15917       (save-excursion
15918         (set-buffer (get-buffer-create gnus-backlog-buffer))
15919         (buffer-disable-undo (current-buffer))
15920         (setq buffer-read-only t)
15921         (gnus-add-current-to-buffer-list)
15922         (get-buffer gnus-backlog-buffer))))
15923
15924 (defun gnus-backlog-setup ()
15925   "Initialize backlog variables."
15926   (unless gnus-backlog-hashtb
15927     (setq gnus-backlog-hashtb (make-vector 1023 0))))
15928
15929 (defun gnus-backlog-shutdown ()
15930   "Clear all backlog variables and buffers."
15931   (when (get-buffer gnus-backlog-buffer)
15932     (kill-buffer gnus-backlog-buffer))
15933   (setq gnus-backlog-hashtb nil
15934         gnus-backlog-articles nil))
15935
15936 (defun gnus-backlog-enter-article (group number buffer)
15937   (gnus-backlog-setup)
15938   (let ((ident (intern (concat group ":" (int-to-string number))
15939                        gnus-backlog-hashtb))
15940         b)
15941     (if (memq ident gnus-backlog-articles)
15942         () ; It's already kept.
15943       ;; Remove the oldest article, if necessary.
15944       (and (numberp gnus-keep-backlog)
15945            (>= (length gnus-backlog-articles) gnus-keep-backlog)
15946            (gnus-backlog-remove-oldest-article))
15947       (setq gnus-backlog-articles (cons ident gnus-backlog-articles))
15948       ;; Insert the new article.
15949       (save-excursion
15950         (set-buffer (gnus-backlog-buffer))
15951         (let (buffer-read-only)
15952           (goto-char (point-max))
15953           (or (bolp) (insert "\n"))
15954           (setq b (point))
15955           (insert-buffer-substring buffer)
15956           ;; Tag the beginning of the article with the ident.
15957           (put-text-property b (1+ b) 'gnus-backlog ident))))))
15958
15959 (defun gnus-backlog-remove-oldest-article ()
15960   (save-excursion
15961     (set-buffer (gnus-backlog-buffer))
15962     (goto-char (point-min))
15963     (if (zerop (buffer-size))
15964         () ; The buffer is empty.
15965       (let ((ident (get-text-property (point) 'gnus-backlog))
15966             buffer-read-only)
15967         ;; Remove the ident from the list of articles.
15968         (when ident
15969           (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
15970         ;; Delete the article itself.
15971         (delete-region
15972          (point) (next-single-property-change
15973                   (1+ (point)) 'gnus-backlog nil (point-max)))))))
15974
15975 (defun gnus-backlog-request-article (group number buffer)
15976   (gnus-backlog-setup)
15977   (let ((ident (intern (concat group ":" (int-to-string number))
15978                        gnus-backlog-hashtb))
15979         beg end)
15980     (when (memq ident gnus-backlog-articles)
15981       ;; It was in the backlog.
15982       (save-excursion
15983         (set-buffer (gnus-backlog-buffer))
15984         (if (not (setq beg (text-property-any
15985                             (point-min) (point-max) 'gnus-backlog
15986                             ident)))
15987             ;; It wasn't in the backlog after all.
15988             (progn
15989               (setq gnus-backlog-articles (delq ident gnus-backlog-articles))
15990               nil)
15991           ;; Find the end (i. e., the beginning of the next article).
15992           (setq end
15993                 (next-single-property-change
15994                  (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
15995       (let ((buffer-read-only nil))
15996         (erase-buffer)
15997         (insert-buffer-substring gnus-backlog-buffer beg end)
15998         t))))
15999
16000 ;; Allow redefinition of Gnus functions.
16001
16002 (gnus-ems-redefine)
16003
16004 (provide 'gnus)
16005
16006 ;;; gnus.el ends here