*** empty log message ***
[gnus] / lisp / gnus.el
1 ;;; gnus.el --- a newsreader for GNU Emacs
2 ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
3
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Keywords: news
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
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@src.doc.ic.ac.uk:/usenet/news-FAQS/"
191     "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
192     "/ftp@rtfm.mit.edu:/pub/usenet/news.answers/"
193     "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
194 ;    "/ftp@ftp.Germany.EU.net:/pub/newsarchive/news.answers/"
195     "/ftp@ftp.sunet.se:/pub/usenet/"
196     "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
197     "/ftp@hwarang.postech.ac.kr:/pub/usenet/news.answers/"
198     "/ftp@ftp.hk.super.net:/mirror/faqs/")
199   "*Directory where the group FAQs are stored.
200 This will most commonly be on a remote machine, and the file will be
201 fetched by ange-ftp.
202
203 This variable can also be a list of directories.  In that case, the
204 first element in the list will be used by default, and the others will
205 be used as backup sites.
206
207 Note that Gnus uses an aol machine as the default directory.  If this
208 feels fundamentally unclean, just think of it as a way to finally get
209 something of value back from them.
210
211 If the default site is too slow, try one of these:
212
213    North America: mirrors.aol.com                /pub/rtfm/usenet
214                   ftp.seas.gwu.edu               /pub/rtfm
215                   rtfm.mit.edu                   /pub/usenet/news.answers
216    Europe:        ftp.uni-paderborn.de           /pub/FAQ
217                   src.doc.ic.ac.uk               /usenet/news-FAQS
218                   ftp.sunet.se                   /pub/usenet
219    Asia:          nctuccca.edu.tw                /USENET/FAQ
220                   hwarang.postech.ac.kr          /pub/usenet/news.answers
221                   ftp.hk.super.net               /mirror/faqs")
222
223 (defvar gnus-group-archive-directory
224   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
225   "*The address of the (ding) archives.")
226
227 (defvar gnus-group-recent-archive-directory
228   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
229   "*The address of the most recent (ding) articles.")
230
231 (defvar gnus-default-subscribed-newsgroups nil
232   "*This variable lists what newsgroups should be subscribed the first time Gnus is used.
233 It should be a list of strings.
234 If it is `t', Gnus will not do anything special the first time it is
235 started; it'll just use the normal newsgroups subscription methods.")
236
237 (defvar gnus-use-cross-reference t
238   "*Non-nil means that cross referenced articles will be marked as read.
239 If nil, ignore cross references.  If t, mark articles as read in
240 subscribed newsgroups.  If neither t nor nil, mark as read in all
241 newsgroups.")
242
243 (defvar gnus-single-article-buffer t
244   "*If non-nil, display all articles in the same buffer.
245 If nil, each group will get its own article buffer.")
246
247 (defvar gnus-use-dribble-file t
248   "*Non-nil means that Gnus will use a dribble file to store user updates.
249 If Emacs should crash without saving the .newsrc files, complete
250 information can be restored from the dribble file.")
251
252 (defvar gnus-dribble-directory nil
253   "*The directory where dribble files will be saved.
254 If this variable is nil, the directory where the .newsrc files are
255 saved will be used.")
256
257 (defvar gnus-asynchronous nil
258   "*If non-nil, Gnus will supply backends with data needed for async article fetching.")
259
260 (defvar gnus-kill-summary-on-exit t
261   "*If non-nil, kill the summary buffer when you exit from it.
262 If nil, the summary will become a \"*Dead Summary*\" buffer, and
263 it will be killed sometime later.")
264
265 (defvar gnus-large-newsgroup 200
266   "*The number of articles which indicates a large newsgroup.
267 If the number of articles in a newsgroup is greater than this value,
268 confirmation is required for selecting the newsgroup.")
269
270 ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
271 (defvar gnus-no-groups-message "No news is horrible news"
272   "*Message displayed by Gnus when no groups are available.")
273
274 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
275   "*Non-nil means that the default name of a file to save articles in is the group name.
276 If it's nil, the directory form of the group name is used instead.
277
278 If this variable is a list, and the list contains the element
279 `not-score', long file names will not be used for score files; if it
280 contains the element `not-save', long file names will not be used for
281 saving; and if it contains the element `not-kill', long file names
282 will not be used for kill files.")
283
284 (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
285   "*Name of the directory articles will be saved in (default \"~/News\").
286 Initialized from the SAVEDIR environment variable.")
287
288 (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
289   "*Name of the directory where kill files will be stored (default \"~/News\").
290 Initialized from the SAVEDIR environment variable.")
291
292 (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
293   "*A function to save articles in your favorite format.
294 The function must be interactively callable (in other words, it must
295 be an Emacs command).
296
297 Gnus provides the following functions:
298
299 * gnus-summary-save-in-rmail (Rmail format)
300 * gnus-summary-save-in-mail (Unix mail format)
301 * gnus-summary-save-in-folder (MH folder)
302 * gnus-summary-save-in-file (article format).
303 * gnus-summary-save-in-vm (use VM's folder format).")
304
305 (defvar gnus-prompt-before-saving 'always
306   "*This variable says how much prompting is to be done when saving articles.
307 If it is nil, no prompting will be done, and the articles will be
308 saved to the default files.  If this variable is `always', each and
309 every article that is saved will be preceded by a prompt, even when
310 saving large batches of articles.  If this variable is neither nil not
311 `always', there the user will be prompted once for a file name for
312 each invocation of the saving commands.")
313
314 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
315   "*A function generating a file name to save articles in Rmail format.
316 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
317
318 (defvar gnus-mail-save-name (function gnus-plain-save-name)
319   "*A function generating a file name to save articles in Unix mail format.
320 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
321
322 (defvar gnus-folder-save-name (function gnus-folder-save-name)
323   "*A function generating a file name to save articles in MH folder.
324 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
325
326 (defvar gnus-file-save-name (function gnus-numeric-save-name)
327   "*A function generating a file name to save articles in article format.
328 The function is called with NEWSGROUP, HEADERS, and optional
329 LAST-FILE.")
330
331 (defvar gnus-split-methods
332   '((gnus-article-archive-name))
333   "*Variable used to suggest where articles are to be saved.
334 For instance, if you would like to save articles related to Gnus in
335 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
336 you could set this variable to something like:
337
338  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
339    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
340
341 This variable is an alist where the where the key is the match and the
342 value is a list of possible files to save in if the match is non-nil.
343
344 If the match is a string, it is used as a regexp match on the
345 article.  If the match is a symbol, that symbol will be funcalled
346 from the buffer of the article to be saved with the newsgroup as the
347 parameter.  If it is a list, it will be evaled in the same buffer.
348
349 If this form or function returns a string, this string will be used as
350 a possible file name; and if it returns a non-nil list, that list will
351 be used as possible file names.")
352
353 (defvar gnus-move-split-methods nil
354   "*Variable used to suggest where articles are to be moved to.
355 It uses the same syntax as the `gnus-split-methods' variable.")
356
357 (defvar gnus-save-score nil
358   "*If non-nil, save group scoring info.")
359
360 (defvar gnus-use-adaptive-scoring nil
361   "*If non-nil, use some adaptive scoring scheme.")
362
363 (defvar gnus-use-cache nil
364   "*If nil, Gnus will ignore the article cache.
365 If `passive', it will allow entering (and reading) articles
366 explicitly entered into the cache.  If anything else, use the
367 cache to the full extent of the law.")
368
369 (defvar gnus-use-trees nil
370   "*If non-nil, display a thread tree buffer.")
371
372 (defvar gnus-keep-backlog nil
373   "*If non-nil, Gnus will keep read articles for later re-retrieval.
374 If it is a number N, then Gnus will only keep the last N articles
375 read.  If it is neither nil nor a number, Gnus will keep all read
376 articles.  This is not a good idea.")
377
378 (defvar gnus-use-nocem nil
379   "*If non-nil, Gnus will read NoCeM cancel messages.")
380
381 (defvar gnus-use-demon nil
382   "If non-nil, Gnus might use some demons.")
383
384 (defvar gnus-use-scoring t
385   "*If non-nil, enable scoring.")
386
387 (defvar gnus-use-picons nil
388   "*If non-nil, display picons.")
389
390 (defvar gnus-fetch-old-headers nil
391   "*Non-nil means that Gnus will try to build threads by grabbing old headers.
392 If an unread article in the group refers to an older, already read (or
393 just marked as read) article, the old article will not normally be
394 displayed in the Summary buffer.  If this variable is non-nil, Gnus
395 will attempt to grab the headers to the old articles, and thereby
396 build complete threads.  If it has the value `some', only enough
397 headers to connect otherwise loose threads will be displayed.
398 This variable can also be a number.  In that case, no more than that
399 number of old headers will be fetched.
400
401 The server has to support NOV for any of this to work.")
402
403 ;see gnus-cus.el
404 ;(defvar gnus-visual t
405 ;  "*If non-nil, will do various highlighting.
406 ;If nil, no mouse highlights (or any other highlights) will be
407 ;performed.  This might speed up Gnus some when generating large group
408 ;and summary buffers.")
409
410 (defvar gnus-novice-user t
411   "*Non-nil means that you are a usenet novice.
412 If non-nil, verbose messages may be displayed and confirmations may be
413 required.")
414
415 (defvar gnus-expert-user nil
416   "*Non-nil means that you will never be asked for confirmation about anything.
417 And that means *anything*.")
418
419 (defvar gnus-verbose 7
420   "*Integer that says how verbose Gnus should be.
421 The higher the number, the more messages Gnus will flash to say what
422 it's doing.  At zero, Gnus will be totally mute; at five, Gnus will
423 display most important messages; and at ten, Gnus will keep on
424 jabbering all the time.")
425
426 (defvar gnus-keep-same-level nil
427   "*Non-nil means that the next newsgroup after the current will be on the same level.
428 When you type, for instance, `n' after reading the last article in the
429 current newsgroup, you will go to the next newsgroup.  If this variable
430 is nil, the next newsgroup will be the next from the group
431 buffer.
432 If this variable is non-nil, Gnus will either put you in the
433 next newsgroup with the same level, or, if no such newsgroup is
434 available, the next newsgroup with the lowest possible level higher
435 than the current level.
436 If this variable is `best', Gnus will make the next newsgroup the one
437 with the best level.")
438
439 (defvar gnus-summary-make-false-root 'adopt
440   "*nil means that Gnus won't gather loose threads.
441 If the root of a thread has expired or been read in a previous
442 session, the information necessary to build a complete thread has been
443 lost.  Instead of having many small sub-threads from this original thread
444 scattered all over the summary buffer, Gnus can gather them.
445
446 If non-nil, Gnus will try to gather all loose sub-threads from an
447 original thread into one large thread.
448
449 If this variable is non-nil, it should be one of `none', `adopt',
450 `dummy' or `empty'.
451
452 If this variable is `none', Gnus will not make a false root, but just
453 present the sub-threads after another.
454 If this variable is `dummy', Gnus will create a dummy root that will
455 have all the sub-threads as children.
456 If this variable is `adopt', Gnus will make one of the \"children\"
457 the parent and mark all the step-children as such.
458 If this variable is `empty', the \"children\" are printed with empty
459 subject fields.  (Or rather, they will be printed with a string
460 given by the `gnus-summary-same-subject' variable.)")
461
462 (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
463   "*A regexp to match subjects to be excluded from loose thread gathering.
464 As loose thread gathering is done on subjects only, that means that
465 there can be many false gatherings performed.  By rooting out certain
466 common subjects, gathering might become saner.")
467
468 (defvar gnus-summary-gather-subject-limit nil
469   "*Maximum length of subject comparisons when gathering loose threads.
470 Use nil to compare full subjects.  Setting this variable to a low
471 number will help gather threads that have been corrupted by
472 newsreaders chopping off subject lines, but it might also mean that
473 unrelated articles that have subject that happen to begin with the
474 same few characters will be incorrectly gathered.
475
476 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
477 comparing subjects.")
478
479 (defvar gnus-simplify-ignored-prefixes nil
480   "*Regexp, matches for which are removed from subject lines when simplifying.")
481
482 (defvar gnus-build-sparse-threads nil
483   "*If non-nil, fill in the gaps in threads.
484 If `some', only fill in the gaps that are needed to tie loose threads
485 together.  If `more', fill in all leaf nodes that Gnus can find.  If
486 non-nil and non-`some', fill in all gaps that Gnus manages to guess.")
487
488 (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
489   "Function used for gathering loose threads.
490 There are two pre-defined functions: `gnus-gather-threads-by-subject',
491 which only takes Subjects into consideration; and
492 `gnus-gather-threads-by-references', which compared the References
493 headers of the articles to find matches.")
494
495 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
496 (defvar gnus-summary-same-subject ""
497   "*String indicating that the current article has the same subject as the previous.
498 This variable will only be used if the value of
499 `gnus-summary-make-false-root' is `empty'.")
500
501 (defvar gnus-summary-goto-unread t
502   "*If non-nil, marking commands will go to the next unread article.
503 If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article,
504 whether it is read or not.")
505
506 (defvar gnus-group-goto-unread t
507   "*If non-nil, movement commands will go to the next unread and subscribed group.")
508
509 (defvar gnus-goto-next-group-when-activating t
510   "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.")
511
512 (defvar gnus-check-new-newsgroups t
513   "*Non-nil means that Gnus will add new newsgroups at startup.
514 If this variable is `ask-server', Gnus will ask the server for new
515 groups since the last time it checked.  This means that the killed list
516 is no longer necessary, so you could set `gnus-save-killed-list' to
517 nil.
518
519 A variant is to have this variable be a list of select methods.  Gnus
520 will then use the `ask-server' method on all these select methods to
521 query for new groups from all those servers.
522
523 Eg.
524   (setq gnus-check-new-newsgroups
525         '((nntp \"some.server\") (nntp \"other.server\")))
526
527 If this variable is nil, then you have to tell Gnus explicitly to
528 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
529
530 (defvar gnus-check-bogus-newsgroups nil
531   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
532 If this variable is nil, then you have to tell Gnus explicitly to
533 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
534
535 (defvar gnus-read-active-file t
536   "*Non-nil means that Gnus will read the entire active file at startup.
537 If this variable is nil, Gnus will only know about the groups in your
538 `.newsrc' file.
539
540 If this variable is `some', Gnus will try to only read the relevant
541 parts of the active file from the server.  Not all servers support
542 this, and it might be quite slow with other servers, but this should
543 generally be faster than both the t and nil value.
544
545 If you set this variable to nil or `some', you probably still want to
546 be told about new newsgroups that arrive.  To do that, set
547 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
548 properly with all servers.")
549
550 (defvar gnus-level-subscribed 5
551   "*Groups with levels less than or equal to this variable are subscribed.")
552
553 (defvar gnus-level-unsubscribed 7
554   "*Groups with levels less than or equal to this variable are unsubscribed.
555 Groups with levels less than `gnus-level-subscribed', which should be
556 less than this variable, are subscribed.")
557
558 (defvar gnus-level-zombie 8
559   "*Groups with this level are zombie groups.")
560
561 (defvar gnus-level-killed 9
562   "*Groups with this level are killed.")
563
564 (defvar gnus-level-default-subscribed 3
565   "*New subscribed groups will be subscribed at this level.")
566
567 (defvar gnus-level-default-unsubscribed 6
568   "*New unsubscribed groups will be unsubscribed at this level.")
569
570 (defvar gnus-activate-level (1+ gnus-level-subscribed)
571   "*Groups higher than this level won't be activated on startup.
572 Setting this variable to something log might save lots of time when
573 you have many groups that you aren't interested in.")
574
575 (defvar gnus-activate-foreign-newsgroups 4
576   "*If nil, Gnus will not check foreign newsgroups at startup.
577 If it is non-nil, it should be a number between one and nine.  Foreign
578 newsgroups that have a level lower or equal to this number will be
579 activated on startup.  For instance, if you want to active all
580 subscribed newsgroups, but not the rest, you'd set this variable to
581 `gnus-level-subscribed'.
582
583 If you subscribe to lots of newsgroups from different servers, startup
584 might take a while.  By setting this variable to nil, you'll save time,
585 but you won't be told how many unread articles there are in the
586 groups.")
587
588 (defvar gnus-save-newsrc-file t
589   "*Non-nil means that Gnus will save the `.newsrc' file.
590 Gnus always saves its own startup file, which is called
591 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
592 be readily understood by other newsreaders.  If you don't plan on
593 using other newsreaders, set this variable to nil to save some time on
594 exit.")
595
596 (defvar gnus-save-killed-list t
597   "*If non-nil, save the list of killed groups to the startup file.
598 If you set this variable to nil, you'll save both time (when starting
599 and quitting) and space (both memory and disk), but it will also mean
600 that Gnus has no record of which groups are new and which are old, so
601 the automatic new newsgroups subscription methods become meaningless.
602
603 You should always set `gnus-check-new-newsgroups' to `ask-server' or
604 nil if you set this variable to nil.")
605
606 (defvar gnus-interactive-catchup t
607   "*If non-nil, require your confirmation when catching up a group.")
608
609 (defvar gnus-interactive-post t
610   "*If non-nil, group name will be asked for when posting.")
611
612 (defvar gnus-interactive-exit t
613   "*If non-nil, require your confirmation when exiting Gnus.")
614
615 (defvar gnus-kill-killed t
616   "*If non-nil, Gnus will apply kill files to already killed articles.
617 If it is nil, Gnus will never apply kill files to articles that have
618 already been through the scoring process, which might very well save lots
619 of time.")
620
621 (defvar gnus-extract-address-components 'gnus-extract-address-components
622   "*Function for extracting address components from a From header.
623 Two pre-defined function exist: `gnus-extract-address-components',
624 which is the default, quite fast, and too simplistic solution, and
625 `mail-extract-address-components', which works much better, but is
626 slower.")
627
628 (defvar gnus-summary-default-score 0
629   "*Default article score level.
630 If this variable is nil, scoring will be disabled.")
631
632 (defvar gnus-summary-zcore-fuzz 0
633   "*Fuzziness factor for the zcore in the summary buffer.
634 Articles with scores closer than this to `gnus-summary-default-score'
635 will not be marked.")
636
637 (defvar gnus-simplify-subject-fuzzy-regexp nil
638   "*Strings to be removed when doing fuzzy matches.
639 This can either be a regular expression or list of regular expressions
640 that will be removed from subject strings if fuzzy subject
641 simplification is selected.")
642
643 (defvar gnus-permanently-visible-groups nil
644   "*Regexp to match groups that should always be listed in the group buffer.
645 This means that they will still be listed when there are no unread
646 articles in the groups.")
647
648 (defvar gnus-list-groups-with-ticked-articles t
649   "*If non-nil, list groups that have only ticked articles.
650 If nil, only list groups that have unread articles.")
651
652 (defvar gnus-group-default-list-level gnus-level-subscribed
653   "*Default listing level.
654 Ignored if `gnus-group-use-permanent-levels' is non-nil.")
655
656 (defvar gnus-group-use-permanent-levels nil
657   "*If non-nil, once you set a level, Gnus will use this level.")
658
659 (defvar gnus-group-list-inactive-groups t
660   "*If non-nil, inactive groups will be listed.")
661
662 (defvar gnus-show-mime nil
663   "*If non-nil, do mime processing of articles.
664 The articles will simply be fed to the function given by
665 `gnus-show-mime-method'.")
666
667 (defvar gnus-strict-mime t
668   "*If nil, MIME-decode even if there is no Mime-Version header in the article.")
669
670 (defvar gnus-show-mime-method 'metamail-buffer
671   "*Function to process a MIME message.
672 The function is called from the article buffer.")
673
674 (defvar gnus-decode-encoded-word-method (lambda ())
675   "*Function to decode a MIME encoded-words.
676 The function is called from the article buffer.")
677
678 (defvar gnus-show-threads t
679   "*If non-nil, display threads in summary mode.")
680
681 (defvar gnus-thread-hide-subtree nil
682   "*If non-nil, hide all threads initially.
683 If threads are hidden, you have to run the command
684 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
685 to expose hidden threads.")
686
687 (defvar gnus-thread-hide-killed t
688   "*If non-nil, hide killed threads automatically.")
689
690 (defvar gnus-thread-ignore-subject nil
691   "*If non-nil, ignore subjects and do all threading based on the Reference header.
692 If nil, which is the default, articles that have different subjects
693 from their parents will start separate threads.")
694
695 (defvar gnus-thread-operation-ignore-subject t
696   "*If non-nil, subjects will be ignored when doing thread commands.
697 This affects commands like `gnus-summary-kill-thread' and
698 `gnus-summary-lower-thread'.
699
700 If this variable is nil, articles in the same thread with different
701 subjects will not be included in the operation in question.  If this
702 variable is `fuzzy', only articles that have subjects that are fuzzily
703 equal will be included.")
704
705 (defvar gnus-thread-indent-level 4
706   "*Number that says how much each sub-thread should be indented.")
707
708 (defvar gnus-ignored-newsgroups
709   (purecopy (mapconcat 'identity
710                        '("^to\\."       ; not "real" groups
711                          "^[0-9. \t]+ " ; all digits in name
712                          "[][\"#'()]"   ; bogus characters
713                          )
714                        "\\|"))
715   "*A regexp to match uninteresting newsgroups in the active file.
716 Any lines in the active file matching this regular expression are
717 removed from the newsgroup list before anything else is done to it,
718 thus making them effectively non-existent.")
719
720 (defvar gnus-ignored-headers
721   "^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:"
722   "*All headers that match this regexp will be hidden.
723 This variable can also be a list of regexps of headers to be ignored.
724 If `gnus-visible-headers' is non-nil, this variable will be ignored.")
725
726 (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-"
727   "*All headers that do not match this regexp will be hidden.
728 This variable can also be a list of regexp of headers to remain visible.
729 If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
730
731 (defvar gnus-sorted-header-list
732   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
733     "^Cc:" "^Date:" "^Organization:")
734   "*This variable is a list of regular expressions.
735 If it is non-nil, headers that match the regular expressions will
736 be placed first in the article buffer in the sequence specified by
737 this list.")
738
739 (defvar gnus-boring-article-headers
740   '(empty followup-to reply-to)
741   "*Headers that are only to be displayed if they have interesting data.
742 Possible values in this list are `empty', `newsgroups', `followup-to',
743 `reply-to', and `date'.")
744
745 (defvar gnus-show-all-headers nil
746   "*If non-nil, don't hide any headers.")
747
748 (defvar gnus-save-all-headers t
749   "*If non-nil, don't remove any headers before saving.")
750
751 (defvar gnus-saved-headers gnus-visible-headers
752   "*Headers to keep if `gnus-save-all-headers' is nil.
753 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
754 If that variable is nil, however, all headers that match this regexp
755 will be kept while the rest will be deleted before saving.")
756
757 (defvar gnus-inhibit-startup-message nil
758   "*If non-nil, the startup message will not be displayed.")
759
760 (defvar gnus-signature-separator "^-- *$"
761   "Regexp matching signature separator.")
762
763 (defvar gnus-auto-extend-newsgroup t
764   "*If non-nil, extend newsgroup forward and backward when requested.")
765
766 (defvar gnus-auto-select-first t
767   "*If nil, don't select the first unread article when entering a group.
768 If this variable is `best', select the highest-scored unread article
769 in the group.  If neither nil nor `best', select the first unread
770 article.
771
772 If you want to prevent automatic selection of the first unread article
773 in some newsgroups, set the variable to nil in
774 `gnus-select-group-hook'.")
775
776 (defvar gnus-auto-select-next t
777   "*If non-nil, offer to go to the next group from the end of the previous.
778 If the value is t and the next newsgroup is empty, Gnus will exit
779 summary mode and go back to group mode.  If the value is neither nil
780 nor t, Gnus will select the following unread newsgroup.  In
781 particular, if the value is the symbol `quietly', the next unread
782 newsgroup will be selected without any confirmation, and if it is
783 `almost-quietly', the next group will be selected without any
784 confirmation if you are located on the last article in the group.
785 Finally, if this variable is `slightly-quietly', the `Z n' command
786 will go to the next group without confirmation.")
787
788 (defvar gnus-auto-select-same nil
789   "*If non-nil, select the next article with the same subject.")
790
791 (defvar gnus-summary-check-current nil
792   "*If non-nil, consider the current article when moving.
793 The \"unread\" movement commands will stay on the same line if the
794 current article is unread.")
795
796 (defvar gnus-auto-center-summary t
797   "*If non-nil, always center the current summary buffer.")
798
799 (defvar gnus-break-pages t
800   "*If non-nil, do page breaking on articles.
801 The page delimiter is specified by the `gnus-page-delimiter'
802 variable.")
803
804 (defvar gnus-page-delimiter "^\^L"
805   "*Regexp describing what to use as article page delimiters.
806 The default value is \"^\^L\", which is a form linefeed at the
807 beginning of a line.")
808
809 (defvar gnus-use-full-window t
810   "*If non-nil, use the entire Emacs screen.")
811
812 (defvar gnus-window-configuration nil
813   "Obsolete variable.  See `gnus-buffer-configuration'.")
814
815 (defvar gnus-window-min-width 2
816   "*Minimum width of Gnus buffers.")
817
818 (defvar gnus-window-min-height 1
819   "*Minimum height of Gnus buffers.")
820
821 (defvar gnus-buffer-configuration
822   '((group
823      (vertical 1.0
824                (group 1.0 point)
825                (if gnus-carpal '(group-carpal 4))))
826     (summary
827      (vertical 1.0
828                (summary 1.0 point)
829                (if gnus-carpal '(summary-carpal 4))))
830     (article
831      (cond 
832       (gnus-use-picons
833        '(frame 1.0
834                (vertical 1.0
835                          (summary 0.25 point)
836                          (if gnus-carpal '(summary-carpal 4))
837                          (article 1.0))
838                (vertical '((height . 5) (width . 15)
839                            (user-position . t)
840                            (left . -1) (top . 1))
841                          (picons 1.0))))
842       (gnus-use-trees
843        '(vertical 1.0
844                   (summary 0.25 point)
845                   (tree 0.25)
846                   (article 1.0)))
847       (t
848        '(vertical 1.0
849                  (summary 0.25 point)
850                  (if gnus-carpal '(summary-carpal 4))
851                  (if gnus-use-trees '(tree 0.25))
852                  (article 1.0)))))
853     (server
854      (vertical 1.0
855                (server 1.0 point)
856                (if gnus-carpal '(server-carpal 2))))
857     (browse
858      (vertical 1.0
859                (browse 1.0 point)
860                (if gnus-carpal '(browse-carpal 2))))
861     (group-mail
862      (vertical 1.0
863                (mail 1.0 point)))
864     (summary-mail
865      (vertical 1.0
866                (mail 1.0 point)))
867     (summary-reply
868      (vertical 1.0
869                (article 0.5)
870                (mail 1.0 point)))
871     (pick
872      (vertical 1.0
873                (article 1.0 point)))
874     (info
875      (vertical 1.0
876                (info 1.0 point)))
877     (summary-faq
878      (vertical 1.0
879                (summary 0.25)
880                (faq 1.0 point)))
881     (edit-group
882      (vertical 1.0
883                (group 0.5)
884                (edit-group 1.0 point)))
885     (edit-server
886      (vertical 1.0
887                (server 0.5)
888                (edit-server 1.0 point)))
889     (edit-score
890      (vertical 1.0
891                (summary 0.25)
892                (edit-score 1.0 point)))
893     (post
894      (vertical 1.0
895                (post 1.0 point)))
896     (reply
897      (vertical 1.0
898                (article 0.5)
899                (mail 1.0 point)))
900     (mail-forward
901      (vertical 1.0
902                (mail 1.0 point)))
903     (post-forward
904      (vertical 1.0
905                (post 1.0 point)))
906     (reply-yank
907      (vertical 1.0
908                (mail 1.0 point)))
909     (mail-bounce
910      (vertical 1.0
911                (article 0.5)
912                (mail 1.0 point)))
913     (draft
914      (vertical 1.0
915                (draft 1.0 point)))
916     (pipe
917      (vertical 1.0
918                (summary 0.25 point)
919                (if gnus-carpal '(summary-carpal 4))
920                ("*Shell Command Output*" 1.0)))
921     (followup
922      (vertical 1.0
923                (article 0.5)
924                (post 1.0 point)))
925     (followup-yank
926      (vertical 1.0
927                (post 1.0 point))))
928   "Window configuration for all possible Gnus buffers.
929 This variable is a list of lists.  Each of these lists has a NAME and
930 a RULE.  The NAMEs are commonsense names like `group', which names a
931 rule used when displaying the group buffer; `summary', which names a
932 rule for what happens when you enter a group and do not display an
933 article buffer; and so on.  See the value of this variable for a
934 complete list of NAMEs.
935
936 Each RULE is a list of vectors.  The first element in this vector is
937 the name of the buffer to be displayed; the second element is the
938 percentage of the screen this buffer is to occupy (a number in the
939 0.0-0.99 range); the optional third element is `point', which should
940 be present to denote which buffer point is to go to after making this
941 buffer configuration.")
942
943 (defvar gnus-window-to-buffer
944   '((group . gnus-group-buffer)
945     (summary . gnus-summary-buffer)
946     (article . gnus-article-buffer)
947     (server . gnus-server-buffer)
948     (browse . "*Gnus Browse Server*")
949     (edit-group . gnus-group-edit-buffer)
950     (edit-server . gnus-server-edit-buffer)
951     (group-carpal . gnus-carpal-group-buffer)
952     (summary-carpal . gnus-carpal-summary-buffer)
953     (server-carpal . gnus-carpal-server-buffer)
954     (browse-carpal . gnus-carpal-browse-buffer)
955     (edit-score . gnus-score-edit-buffer)
956     (mail . gnus-mail-buffer)
957     (post . gnus-post-news-buffer)
958     (faq . gnus-faq-buffer)
959     (picons . "*Picons*")
960     (tree . gnus-tree-buffer)
961     (info . gnus-info-buffer)
962     (draft . gnus-draft-buffer))
963   "Mapping from short symbols to buffer names or buffer variables.")
964
965 (defvar gnus-carpal nil
966   "*If non-nil, display clickable icons.")
967
968 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
969   "*Function called with a group name when new group is detected.
970 A few pre-made functions are supplied: `gnus-subscribe-randomly'
971 inserts new groups at the beginning of the list of groups;
972 `gnus-subscribe-alphabetically' inserts new groups in strict
973 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
974 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
975 for your decision; `gnus-subscribe-killed' kills all new groups.")
976
977 ;; Suggested by a bug report by Hallvard B Furuseth.
978 ;; <h.b.furuseth@usit.uio.no>.
979 (defvar gnus-subscribe-options-newsgroup-method
980   (function gnus-subscribe-alphabetically)
981   "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
982 If, for instance, you want to subscribe to all newsgroups in the
983 \"no\" and \"alt\" hierarchies, you'd put the following in your
984 .newsrc file:
985
986 options -n no.all alt.all
987
988 Gnus will the subscribe all new newsgroups in these hierarchies with
989 the subscription method in this variable.")
990
991 (defvar gnus-subscribe-hierarchical-interactive nil
992   "*If non-nil, Gnus will offer to subscribe hierarchically.
993 When a new hierarchy appears, Gnus will ask the user:
994
995 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
996
997 If the user pressed `d', Gnus will descend the hierarchy, `y' will
998 subscribe to all newsgroups in the hierarchy and `s' will skip this
999 hierarchy in its entirety.")
1000
1001 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
1002   "*Function used for sorting the group buffer.
1003 This function will be called with group info entries as the arguments
1004 for the groups to be sorted.  Pre-made functions include
1005 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
1006 `gnus-group-sort-by-level', `gnus-group-sort-by-score', and
1007 `gnus-group-sort-by-rank'.
1008
1009 This variable can also be a list of sorting functions.  In that case,
1010 the most significant sort function should be the last function in the
1011 list.")
1012
1013 ;; Mark variables suggested by Thomas Michanek
1014 ;; <Thomas.Michanek@telelogic.se>.
1015 (defvar gnus-unread-mark ? 
1016   "*Mark used for unread articles.")
1017 (defvar gnus-ticked-mark ?!
1018   "*Mark used for ticked articles.")
1019 (defvar gnus-dormant-mark ??
1020   "*Mark used for dormant articles.")
1021 (defvar gnus-del-mark ?r
1022   "*Mark used for del'd articles.")
1023 (defvar gnus-read-mark ?R
1024   "*Mark used for read articles.")
1025 (defvar gnus-expirable-mark ?E
1026   "*Mark used for expirable articles.")
1027 (defvar gnus-killed-mark ?K
1028   "*Mark used for killed articles.")
1029 (defvar gnus-souped-mark ?F
1030   "*Mark used for killed articles.")
1031 (defvar gnus-kill-file-mark ?X
1032   "*Mark used for articles killed by kill files.")
1033 (defvar gnus-low-score-mark ?Y
1034   "*Mark used for articles with a low score.")
1035 (defvar gnus-catchup-mark ?C
1036   "*Mark used for articles that are caught up.")
1037 (defvar gnus-replied-mark ?A
1038   "*Mark used for articles that have been replied to.")
1039 (defvar gnus-cached-mark ?*
1040   "*Mark used for articles that are in the cache.")
1041 (defvar gnus-saved-mark ?S
1042   "*Mark used for articles that have been saved to.")
1043 (defvar gnus-process-mark ?#
1044   "*Process mark.")
1045 (defvar gnus-ancient-mark ?O
1046   "*Mark used for ancient articles.")
1047 (defvar gnus-sparse-mark ?Q
1048   "*Mark used for sparsely reffed articles.")
1049 (defvar gnus-canceled-mark ?G
1050   "*Mark used for canceled articles.")
1051 (defvar gnus-score-over-mark ?+
1052   "*Score mark used for articles with high scores.")
1053 (defvar gnus-score-below-mark ?-
1054   "*Score mark used for articles with low scores.")
1055 (defvar gnus-empty-thread-mark ? 
1056   "*There is no thread under the article.")
1057 (defvar gnus-not-empty-thread-mark ?=
1058   "*There is a thread under the article.")
1059
1060 (defvar gnus-view-pseudo-asynchronously nil
1061   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
1062
1063 (defvar gnus-view-pseudos nil
1064   "*If `automatic', pseudo-articles will be viewed automatically.
1065 If `not-confirm', pseudos will be viewed automatically, and the user
1066 will not be asked to confirm the command.")
1067
1068 (defvar gnus-view-pseudos-separately t
1069   "*If non-nil, one pseudo-article will be created for each file to be viewed.
1070 If nil, all files that use the same viewing command will be given as a
1071 list of parameters to that command.")
1072
1073 (defvar gnus-insert-pseudo-articles t
1074   "*If non-nil, insert pseudo-articles when decoding articles.")
1075
1076 (defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)\n"
1077   "*Format of group lines.
1078 It works along the same lines as a normal formatting string,
1079 with some simple extensions.
1080
1081 %M    Only marked articles (character, \"*\" or \" \")
1082 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
1083 %L    Level of subscribedness (integer)
1084 %N    Number of unread articles (integer)
1085 %I    Number of dormant articles (integer)
1086 %i    Number of ticked and dormant (integer)
1087 %T    Number of ticked articles (integer)
1088 %R    Number of read articles (integer)
1089 %t    Total number of articles (integer)
1090 %y    Number of unread, unticked articles (integer)
1091 %G    Group name (string)
1092 %g    Qualified group name (string)
1093 %D    Group description (string)
1094 %s    Select method (string)
1095 %o    Moderated group (char, \"m\")
1096 %p    Process mark (char)
1097 %O    Moderated group (string, \"(m)\" or \"\")
1098 %P    Topic indentation (string)
1099 %n    Select from where (string)
1100 %z    A string that look like `<%s:%n>' if a foreign select method is used
1101 %u    User defined specifier.  The next character in the format string should
1102       be a letter.  Gnus will call the function gnus-user-format-function-X,
1103       where X is the letter following %u.  The function will be passed the
1104       current header as argument.  The function should return a string, which
1105       will be inserted into the buffer just like information from any other
1106       group specifier.
1107
1108 Text between %( and %) will be highlighted with `gnus-mouse-face' when
1109 the mouse point move inside the area.  There can only be one such area.
1110
1111 Note that this format specification is not always respected.  For
1112 reasons of efficiency, when listing killed groups, this specification
1113 is ignored altogether.  If the spec is changed considerably, your
1114 output may end up looking strange when listing both alive and killed
1115 groups.
1116
1117 If you use %o or %O, reading the active file will be slower and quite
1118 a bit of extra memory will be used. %D will also worsen performance.
1119 Also note that if you change the format specification to include any
1120 of these specs, you must probably re-start Gnus to see them go into
1121 effect.")
1122
1123 (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
1124   "*The format specification of the lines in the summary buffer.
1125
1126 It works along the same lines as a normal formatting string,
1127 with some simple extensions.
1128
1129 %N   Article number, left padded with spaces (string)
1130 %S   Subject (string)
1131 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
1132 %n   Name of the poster (string)
1133 %a   Extracted name of the poster (string)
1134 %A   Extracted address of the poster (string)
1135 %F   Contents of the From: header (string)
1136 %x   Contents of the Xref: header (string)
1137 %D   Date of the article (string)
1138 %d   Date of the article (string) in DD-MMM format
1139 %M   Message-id of the article (string)
1140 %r   References of the article (string)
1141 %c   Number of characters in the article (integer)
1142 %L   Number of lines in the article (integer)
1143 %I   Indentation based on thread level (a string of spaces)
1144 %T   A string with two possible values: 80 spaces if the article
1145      is on thread level two or larger and 0 spaces on level one
1146 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
1147 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
1148 %[   Opening bracket (character, \"[\" or \"<\")
1149 %]   Closing bracket (character, \"]\" or \">\")
1150 %>   Spaces of length thread-level (string)
1151 %<   Spaces of length (- 20 thread-level) (string)
1152 %i   Article score (number)
1153 %z   Article zcore (character)
1154 %t   Number of articles under the current thread (number).
1155 %e   Whether the thread is empty or not (character).
1156 %u   User defined specifier.  The next character in the format string should
1157      be a letter.  Gnus will call the function gnus-user-format-function-X,
1158      where X is the letter following %u.  The function will be passed the
1159      current header as argument.  The function should return a string, which
1160      will be inserted into the summary just like information from any other
1161      summary specifier.
1162
1163 Text between %( and %) will be highlighted with `gnus-mouse-face'
1164 when the mouse point is placed inside the area.  There can only be one
1165 such area.
1166
1167 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1168 with care.  For reasons of efficiency, Gnus will compute what column
1169 these characters will end up in, and \"hard-code\" that.  This means that
1170 it is illegal to have these specs after a variable-length spec.  Well,
1171 you might not be arrested, but your summary buffer will look strange,
1172 which is bad enough.
1173
1174 The smart choice is to have these specs as for to the left as
1175 possible.
1176
1177 This restriction may disappear in later versions of Gnus.")
1178
1179 (defvar gnus-summary-dummy-line-format
1180   "*  %(:                          :%) %S\n"
1181   "*The format specification for the dummy roots in the summary buffer.
1182 It works along the same lines as a normal formatting string,
1183 with some simple extensions.
1184
1185 %S  The subject")
1186
1187 (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
1188   "*The format specification for the summary mode line.
1189 It works along the same lines as a normal formatting string,
1190 with some simple extensions:
1191
1192 %G  Group name
1193 %p  Unprefixed group name
1194 %A  Current article number
1195 %V  Gnus version
1196 %U  Number of unread articles in the group
1197 %e  Number of unselected articles in the group
1198 %Z  A string with unread/unselected article counts
1199 %g  Shortish group name
1200 %S  Subject of the current article
1201 %u  User-defined spec
1202 %s  Current score file name
1203 %d  Number of dormant articles
1204 %r  Number of articles that have been marked as read in this session
1205 %E  Number of articles expunged by the score files")
1206
1207 (defvar gnus-article-mode-line-format "Gnus: %%b %S"
1208   "*The format specification for the article mode line.
1209 See `gnus-summary-mode-line-format' for a closer description.")
1210
1211 (defvar gnus-group-mode-line-format "Gnus: %%b {%M:%S}"
1212   "*The format specification for the group mode line.
1213 It works along the same lines as a normal formatting string,
1214 with some simple extensions:
1215
1216 %S   The native news server.
1217 %M   The native select method.")
1218
1219 (defvar gnus-valid-select-methods
1220   '(("nntp" post address prompt-address)
1221     ("nnspool" post)
1222     ("nnvirtual" post-mail virtual prompt-address)
1223     ("nnmbox" mail respool)
1224     ("nnml" mail respool)
1225     ("nnmh" mail respool)
1226     ("nndir" post-mail prompt-address address)
1227     ("nneething" none prompt-address)
1228     ("nndoc" none prompt-address)
1229     ("nnbabyl" mail respool)
1230     ("nnkiboze" post virtual)
1231     ("nnsoup" post-mail)
1232     ("nnfolder" mail respool))
1233   "An alist of valid select methods.
1234 The first element of each list lists should be a string with the name
1235 of the select method.  The other elements may be be the category of
1236 this method (ie. `post', `mail', `none' or whatever) or other
1237 properties that this method has (like being respoolable).
1238 If you implement a new select method, all you should have to change is
1239 this variable.  I think.")
1240
1241 (defvar gnus-updated-mode-lines '(group article summary tree)
1242   "*List of buffers that should update their mode lines.
1243 The list may contain the symbols `group', `article' and `summary'.  If
1244 the corresponding symbol is present, Gnus will keep that mode line
1245 updated with information that may be pertinent.
1246 If this variable is nil, screen refresh may be quicker.")
1247
1248 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1249 (defvar gnus-mode-non-string-length nil
1250   "*Max length of mode-line non-string contents.
1251 If this is nil, Gnus will take space as is needed, leaving the rest
1252 of the modeline intact.")
1253
1254 ;see gnus-cus.el
1255 ;(defvar gnus-mouse-face 'highlight
1256 ;  "*Face used for mouse highlighting in Gnus.
1257 ;No mouse highlights will be done if `gnus-visual' is nil.")
1258
1259 (defvar gnus-summary-mark-below nil
1260   "*Mark all articles with a score below this variable as read.
1261 This variable is local to each summary buffer and usually set by the
1262 score file.")
1263
1264 (defvar gnus-article-sort-functions '(gnus-article-sort-by-number)
1265   "*List of functions used for sorting articles in the summary buffer.
1266 This variable is only used when not using a threaded display.")
1267
1268 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
1269   "*List of functions used for sorting threads in the summary buffer.
1270 By default, threads are sorted by article number.
1271
1272 Each function takes two threads and return non-nil if the first thread
1273 should be sorted before the other.  If you use more than one function,
1274 the primary sort function should be the last.  You should probably
1275 always include `gnus-thread-sort-by-number' in the list of sorting
1276 functions -- preferably first.
1277
1278 Ready-mady functions include `gnus-thread-sort-by-number',
1279 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
1280 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
1281 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
1282
1283 (defvar gnus-thread-score-function '+
1284   "*Function used for calculating the total score of a thread.
1285
1286 The function is called with the scores of the article and each
1287 subthread and should then return the score of the thread.
1288
1289 Some functions you can use are `+', `max', or `min'.")
1290
1291 (defvar gnus-summary-expunge-below nil
1292   "All articles that have a score less than this variable will be expunged.")
1293
1294 (defvar gnus-thread-expunge-below nil
1295   "All threads that have a total score less than this variable will be expunged.
1296 See `gnus-thread-score-function' for en explanation of what a
1297 \"thread score\" is.")
1298
1299 (defvar gnus-auto-subscribed-groups
1300   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
1301   "*All new groups that match this regexp will be subscribed automatically.
1302 Note that this variable only deals with new groups.  It has no effect
1303 whatsoever on old groups.")
1304
1305 (defvar gnus-options-subscribe nil
1306   "*All new groups matching this regexp will be subscribed unconditionally.
1307 Note that this variable deals only with new newsgroups.  This variable
1308 does not affect old newsgroups.")
1309
1310 (defvar gnus-options-not-subscribe nil
1311   "*All new groups matching this regexp will be ignored.
1312 Note that this variable deals only with new newsgroups.  This variable
1313 does not affect old (already subscribed) newsgroups.")
1314
1315 (defvar gnus-auto-expirable-newsgroups nil
1316   "*Groups in which to automatically mark read articles as expirable.
1317 If non-nil, this should be a regexp that should match all groups in
1318 which to perform auto-expiry.  This only makes sense for mail groups.")
1319
1320 (defvar gnus-total-expirable-newsgroups nil
1321   "*Groups in which to perform expiry of all read articles.
1322 Use with extreme caution.  All groups that match this regexp will be
1323 expiring - which means that all read articles will be deleted after
1324 (say) one week.  (This only goes for mail groups and the like, of
1325 course.)")
1326
1327 (defvar gnus-group-uncollapsed-levels 1
1328   "Number of group name elements to leave alone when making a short group name.")
1329
1330 (defvar gnus-hidden-properties '(invisible t intangible t)
1331   "Property list to use for hiding text.")
1332
1333 (defvar gnus-modtime-botch nil
1334   "*Non-nil means .newsrc should be deleted prior to save.  Its use is
1335 due to the bogus appearance that .newsrc was modified on disc.")
1336
1337 ;; Hooks.
1338
1339 (defvar gnus-group-mode-hook nil
1340   "*A hook for Gnus group mode.")
1341
1342 (defvar gnus-summary-mode-hook nil
1343   "*A hook for Gnus summary mode.
1344 This hook is run before any variables are set in the summary buffer.")
1345
1346 (defvar gnus-article-mode-hook nil
1347   "*A hook for Gnus article mode.")
1348
1349 (defvar gnus-summary-prepare-exit-hook nil
1350   "*A hook called when preparing to exit from the summary buffer.
1351 It calls `gnus-summary-expire-articles' by default.")
1352 (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
1353
1354 (defvar gnus-summary-exit-hook nil
1355   "*A hook called on exit from the summary buffer.")
1356
1357 (defvar gnus-group-catchup-group-hook nil
1358   "*A hook run when catching up a group from the group buffer.")
1359
1360 (defvar gnus-open-server-hook nil
1361   "*A hook called just before opening connection to the news server.")
1362
1363 (defvar gnus-load-hook nil
1364   "*A hook run while Gnus is loaded.")
1365
1366 (defvar gnus-startup-hook nil
1367   "*A hook called at startup.
1368 This hook is called after Gnus is connected to the NNTP server.")
1369
1370 (defvar gnus-get-new-news-hook nil
1371   "*A hook run just before Gnus checks for new news.")
1372
1373 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
1374   "*A function that is called to generate the group buffer.
1375 The function is called with three arguments: The first is a number;
1376 all group with a level less or equal to that number should be listed,
1377 if the second is non-nil, empty groups should also be displayed.  If
1378 the third is non-nil, it is a number.  No groups with a level lower
1379 than this number should be displayed.
1380
1381 The only current function implemented is `gnus-group-prepare-flat'.")
1382
1383 (defvar gnus-group-prepare-hook nil
1384   "*A hook called after the group buffer has been generated.
1385 If you want to modify the group buffer, you can use this hook.")
1386
1387 (defvar gnus-summary-prepare-hook nil
1388   "*A hook called after the summary buffer has been generated.
1389 If you want to modify the summary buffer, you can use this hook.")
1390
1391 (defvar gnus-summary-generate-hook nil
1392   "*A hook run just before generating the summary buffer.
1393 This hook is commonly used to customize threading variables and the
1394 like.")
1395
1396 (defvar gnus-article-prepare-hook nil
1397   "*A hook called after an article has been prepared in the article buffer.
1398 If you want to run a special decoding program like nkf, use this hook.")
1399
1400 ;(defvar gnus-article-display-hook nil
1401 ;  "*A hook called after the article is displayed in the article buffer.
1402 ;The hook is designed to change the contents of the article
1403 ;buffer.  Typical functions that this hook may contain are
1404 ;`gnus-article-hide-headers' (hide selected headers),
1405 ;`gnus-article-maybe-highlight' (perform fancy article highlighting),
1406 ;`gnus-article-hide-signature' (hide signature) and
1407 ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
1408 ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
1409 ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
1410 ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight)
1411
1412 (defvar gnus-article-x-face-command
1413   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
1414   "String or function to be executed to display an X-Face header.
1415 If it is a string, the command will be executed in a sub-shell
1416 asynchronously.  The compressed face will be piped to this command.")
1417
1418 (defvar gnus-article-x-face-too-ugly nil
1419   "Regexp matching posters whose face shouldn't be shown automatically.")
1420
1421 (defvar gnus-select-group-hook nil
1422   "*A hook called when a newsgroup is selected.
1423
1424 If you'd like to simplify subjects like the
1425 `gnus-summary-next-same-subject' command does, you can use the
1426 following hook:
1427
1428  (setq gnus-select-group-hook
1429       (list
1430         (lambda ()
1431           (mapcar (lambda (header)
1432                      (mail-header-set-subject
1433                       header
1434                       (gnus-simplify-subject
1435                        (mail-header-subject header) 're-only)))
1436                   gnus-newsgroup-headers))))")
1437
1438 (defvar gnus-select-article-hook nil
1439   "*A hook called when an article is selected.")
1440
1441 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
1442   "*A hook called to apply kill files to a group.
1443 This hook is intended to apply a kill file to the selected newsgroup.
1444 The function `gnus-apply-kill-file' is called by default.
1445
1446 Since a general kill file is too heavy to use only for a few
1447 newsgroups, I recommend you to use a lighter hook function.  For
1448 example, if you'd like to apply a kill file to articles which contains
1449 a string `rmgroup' in subject in newsgroup `control', you can use the
1450 following hook:
1451
1452  (setq gnus-apply-kill-hook
1453       (list
1454         (lambda ()
1455           (cond ((string-match \"control\" gnus-newsgroup-name)
1456                  (gnus-kill \"Subject\" \"rmgroup\")
1457                  (gnus-expunge \"X\"))))))")
1458
1459 (defvar gnus-visual-mark-article-hook
1460   (list 'gnus-highlight-selected-summary)
1461   "*Hook run after selecting an article in the summary buffer.
1462 It is meant to be used for highlighting the article in some way.  It
1463 is not run if `gnus-visual' is nil.")
1464
1465 (defvar gnus-parse-headers-hook nil
1466   "*A hook called before parsing the headers.")
1467
1468 (defvar gnus-exit-group-hook nil
1469   "*A hook called when exiting (not quitting) summary mode.")
1470
1471 (defvar gnus-suspend-gnus-hook nil
1472   "*A hook called when suspending (not exiting) Gnus.")
1473
1474 (defvar gnus-exit-gnus-hook nil
1475   "*A hook called when exiting Gnus.")
1476
1477 (defvar gnus-save-newsrc-hook nil
1478   "*A hook called before saving any of the newsrc files.")
1479
1480 (defvar gnus-save-quick-newsrc-hook nil
1481   "*A hook called just before saving the quick newsrc file.
1482 Can be used to turn version control on or off.")
1483
1484 (defvar gnus-save-standard-newsrc-hook nil
1485   "*A hook called just before saving the standard newsrc file.
1486 Can be used to turn version control on or off.")
1487
1488 (defvar gnus-summary-update-hook
1489   (list 'gnus-summary-highlight-line)
1490   "*A hook called when a summary line is changed.
1491 The hook will not be called if `gnus-visual' is nil.
1492
1493 The default function `gnus-summary-highlight-line' will
1494 highlight the line according to the `gnus-summary-highlight'
1495 variable.")
1496
1497 (defvar gnus-group-update-hook '(gnus-group-highlight-line)
1498   "*A hook called when a group line is changed.
1499 The hook will not be called if `gnus-visual' is nil.
1500
1501 The default function `gnus-group-highlight-line' will
1502 highlight the line according to the `gnus-group-highlight'
1503 variable.")
1504
1505 (defvar gnus-mark-article-hook (list 'gnus-summary-mark-unread-as-read)
1506   "*A hook called when an article is selected for the first time.
1507 The hook is intended to mark an article as read (or unread)
1508 automatically when it is selected.")
1509
1510 (defvar gnus-group-change-level-function nil
1511   "Function run when a group level is changed.
1512 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.")
1513
1514 ;; Remove any hilit infestation.
1515 (add-hook 'gnus-startup-hook
1516           (lambda ()
1517             (remove-hook 'gnus-summary-prepare-hook
1518                          'hilit-rehighlight-buffer-quietly)
1519             (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
1520             (setq gnus-mark-article-hook '(gnus-summary-mark-unread-as-read))
1521             (remove-hook 'gnus-article-prepare-hook
1522                          'hilit-rehighlight-buffer-quietly)))
1523
1524
1525 \f
1526 ;; Internal variables
1527
1528 (defvar gnus-topic-indentation "") ;; Obsolete variable.
1529
1530 (defvar gnus-override-subscribe-method nil)
1531
1532 (defvar gnus-group-goto-next-group-function nil
1533   "Function to override finding the next group after listing groups.")
1534
1535 (defconst gnus-article-mark-lists
1536   '((marked . tick) (replied . reply)
1537     (expirable . expire) (killed . killed)
1538     (bookmarks . bookmark) (dormant . dormant)
1539     (scored . score) (saved . save)
1540     (cached . cache)))
1541
1542 ;; Avoid highlighting in kill files.
1543 (defvar gnus-summary-inhibit-highlight nil)
1544 (defvar gnus-newsgroup-selected-overlay nil)
1545
1546 (defvar gnus-inhibit-hiding nil)
1547 (defvar gnus-group-indentation "")
1548 (defvar gnus-inhibit-limiting nil)
1549
1550 (defvar gnus-article-mode-map nil)
1551 (defvar gnus-dribble-buffer nil)
1552 (defvar gnus-headers-retrieved-by nil)
1553 (defvar gnus-article-reply nil)
1554 (defvar gnus-override-method nil)
1555 (defvar gnus-article-check-size nil)
1556
1557 (defvar gnus-nocem-hashtb nil)
1558
1559 (defvar gnus-current-score-file nil)
1560 (defvar gnus-newsgroup-adaptive-score-file nil)
1561 (defvar gnus-scores-exclude-files nil)
1562
1563 (defvar gnus-opened-servers nil)
1564
1565 (defvar gnus-current-move-group nil)
1566
1567 (defvar gnus-newsgroup-dependencies nil)
1568 (defvar gnus-newsgroup-async nil)
1569 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1570
1571 (defvar gnus-newsgroup-adaptive nil)
1572
1573 (defvar gnus-summary-display-table nil)
1574 (defvar gnus-summary-display-article-function nil)
1575
1576 (defvar gnus-summary-highlight-line-function nil
1577   "Function called after highlighting a summary line.")
1578
1579 (defvar gnus-group-line-format-alist
1580   `((?M gnus-tmp-marked-mark ?c)
1581     (?S gnus-tmp-subscribed ?c)
1582     (?L gnus-tmp-level ?d)
1583     (?N (cond ((eq number t) "*" )
1584               ((numberp number) 
1585                (int-to-string
1586                 (+ number
1587                    (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1588                    (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
1589               (t number)) ?s)
1590     (?R gnus-tmp-number-of-read ?s)
1591     (?t gnus-tmp-number-total ?d)
1592     (?y gnus-tmp-number-of-unread ?s)
1593     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
1594     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
1595     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1596            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
1597     (?g gnus-tmp-group ?s)
1598     (?G gnus-tmp-qualified-group ?s)
1599     (?c (gnus-short-group-name gnus-tmp-group) ?s)
1600     (?D gnus-tmp-newsgroup-description ?s)
1601     (?o gnus-tmp-moderated ?c)
1602     (?O gnus-tmp-moderated-string ?s)
1603     (?p gnus-tmp-process-marked ?c)
1604     (?s gnus-tmp-news-server ?s)
1605     (?n gnus-tmp-news-method ?s)
1606     (?P gnus-group-indentation ?s)
1607     (?z gnus-tmp-news-method-string ?s)
1608     (?u gnus-tmp-user-defined ?s)))
1609
1610 (defvar gnus-summary-line-format-alist
1611   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1612     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1613     (?s gnus-tmp-subject-or-nil ?s)
1614     (?n gnus-tmp-name ?s)
1615     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1616         ?s)
1617     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
1618             gnus-tmp-from) ?s)
1619     (?F gnus-tmp-from ?s)
1620     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1621     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1622     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1623     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1624     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1625     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1626     (?L gnus-tmp-lines ?d)
1627     (?I gnus-tmp-indentation ?s)
1628     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1629     (?R gnus-tmp-replied ?c)
1630     (?\[ gnus-tmp-opening-bracket ?c)
1631     (?\] gnus-tmp-closing-bracket ?c)
1632     (?\> (make-string gnus-tmp-level ? ) ?s)
1633     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1634     (?i gnus-tmp-score ?d)
1635     (?z gnus-tmp-score-char ?c)
1636     (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
1637     (?U gnus-tmp-unread ?c)
1638     (?t (gnus-summary-number-of-articles-in-thread
1639          (and (boundp 'thread) (car thread)) gnus-tmp-level)
1640         ?d)
1641     (?e (gnus-summary-number-of-articles-in-thread
1642          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1643         ?c)
1644     (?u gnus-tmp-user-defined ?s))
1645   "An alist of format specifications that can appear in summary lines,
1646 and what variables they correspond with, along with the type of the
1647 variable (string, integer, character, etc).")
1648
1649 (defvar gnus-summary-dummy-line-format-alist
1650   (` ((?S gnus-tmp-subject ?s)
1651       (?N gnus-tmp-number ?d)
1652       (?u gnus-tmp-user-defined ?s))))
1653
1654 (defvar gnus-summary-mode-line-format-alist
1655   (` ((?G gnus-tmp-group-name ?s)
1656       (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1657       (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1658       (?A gnus-tmp-article-number ?d)
1659       (?Z gnus-tmp-unread-and-unselected ?s)
1660       (?V gnus-version ?s)
1661       (?U gnus-tmp-unread ?d)
1662       (?S gnus-tmp-subject ?s)
1663       (?e gnus-tmp-unselected ?d)
1664       (?u gnus-tmp-user-defined ?s)
1665       (?d (length gnus-newsgroup-dormant) ?d)
1666       (?t (length gnus-newsgroup-marked) ?d)
1667       (?r (length gnus-newsgroup-reads) ?d)
1668       (?E gnus-newsgroup-expunged-tally ?d)
1669       (?s (gnus-current-score-file-nondirectory) ?s))))
1670
1671 (defvar gnus-article-mode-line-format-alist
1672   gnus-summary-mode-line-format-alist)
1673
1674 (defvar gnus-group-mode-line-format-alist
1675   (` ((?S gnus-tmp-news-server ?s)
1676       (?M gnus-tmp-news-method ?s)
1677       (?u gnus-tmp-user-defined ?s))))
1678
1679 (defvar gnus-have-read-active-file nil)
1680
1681 (defconst gnus-maintainer
1682   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1683   "The mail address of the Gnus maintainers.")
1684
1685 (defconst gnus-version "September Gnus v0.36"
1686   "Version number for this version of Gnus.")
1687
1688 (defvar gnus-info-nodes
1689   '((gnus-group-mode            "(gnus)The Group Buffer")
1690     (gnus-summary-mode          "(gnus)The Summary Buffer")
1691     (gnus-article-mode          "(gnus)The Article Buffer"))
1692   "Assoc list of major modes and related Info nodes.")
1693
1694 (defvar gnus-group-buffer "*Group*")
1695 (defvar gnus-summary-buffer "*Summary*")
1696 (defvar gnus-article-buffer "*Article*")
1697 (defvar gnus-server-buffer "*Server*")
1698
1699 (defvar gnus-work-buffer " *gnus work*")
1700
1701 (defvar gnus-original-article-buffer " *Original Article*")
1702 (defvar gnus-original-article nil)
1703
1704 (defvar gnus-buffer-list nil
1705   "Gnus buffers that should be killed on exit.")
1706
1707 (defvar gnus-server-alist nil
1708   "List of available servers.")
1709
1710 (defvar gnus-slave nil
1711   "Whether this Gnus is a slave or not.")
1712
1713 (defvar gnus-variable-list
1714   '(gnus-newsrc-options gnus-newsrc-options-n
1715     gnus-newsrc-last-checked-date
1716     gnus-newsrc-alist gnus-server-alist
1717     gnus-killed-list gnus-zombie-list
1718     gnus-topic-topology gnus-topic-alist
1719     gnus-format-specs)
1720   "Gnus variables saved in the quick startup file.")
1721
1722 (defvar gnus-newsrc-options nil
1723   "Options line in the .newsrc file.")
1724
1725 (defvar gnus-newsrc-options-n nil
1726   "List of regexps representing groups to be subscribed/ignored unconditionally.")
1727
1728 (defvar gnus-newsrc-last-checked-date nil
1729   "Date Gnus last asked server for new newsgroups.")
1730
1731 (defvar gnus-topic-topology nil
1732   "The complete topic hierarchy.")
1733
1734 (defvar gnus-topic-alist nil
1735   "The complete topic-group alist.")
1736
1737 (defvar gnus-newsrc-alist nil
1738   "Assoc list of read articles.
1739 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1740
1741 (defvar gnus-newsrc-hashtb nil
1742   "Hashtable of gnus-newsrc-alist.")
1743
1744 (defvar gnus-killed-list nil
1745   "List of killed newsgroups.")
1746
1747 (defvar gnus-killed-hashtb nil
1748   "Hash table equivalent of gnus-killed-list.")
1749
1750 (defvar gnus-zombie-list nil
1751   "List of almost dead newsgroups.")
1752
1753 (defvar gnus-description-hashtb nil
1754   "Descriptions of newsgroups.")
1755
1756 (defvar gnus-list-of-killed-groups nil
1757   "List of newsgroups that have recently been killed by the user.")
1758
1759 (defvar gnus-active-hashtb nil
1760   "Hashtable of active articles.")
1761
1762 (defvar gnus-moderated-list nil
1763   "List of moderated newsgroups.")
1764
1765 (defvar gnus-group-marked nil)
1766
1767 (defvar gnus-current-startup-file nil
1768   "Startup file for the current host.")
1769
1770 (defvar gnus-last-search-regexp nil
1771   "Default regexp for article search command.")
1772
1773 (defvar gnus-last-shell-command nil
1774   "Default shell command on article.")
1775
1776 (defvar gnus-current-select-method nil
1777   "The current method for selecting a newsgroup.")
1778
1779 (defvar gnus-group-list-mode nil)
1780
1781 (defvar gnus-article-internal-prepare-hook nil)
1782
1783 (defvar gnus-newsgroup-name nil)
1784 (defvar gnus-newsgroup-begin nil)
1785 (defvar gnus-newsgroup-end nil)
1786 (defvar gnus-newsgroup-last-rmail nil)
1787 (defvar gnus-newsgroup-last-mail nil)
1788 (defvar gnus-newsgroup-last-folder nil)
1789 (defvar gnus-newsgroup-last-file nil)
1790 (defvar gnus-newsgroup-auto-expire nil)
1791 (defvar gnus-newsgroup-active nil)
1792
1793 (defvar gnus-newsgroup-data nil)
1794 (defvar gnus-newsgroup-data-reverse nil)
1795 (defvar gnus-newsgroup-limit nil)
1796 (defvar gnus-newsgroup-limits nil)
1797
1798 (defvar gnus-newsgroup-unreads nil
1799   "List of unread articles in the current newsgroup.")
1800
1801 (defvar gnus-newsgroup-unselected nil
1802   "List of unselected unread articles in the current newsgroup.")
1803
1804 (defvar gnus-newsgroup-reads nil
1805   "Alist of read articles and article marks in the current newsgroup.")
1806
1807 (defvar gnus-newsgroup-expunged-tally nil)
1808
1809 (defvar gnus-newsgroup-marked nil
1810   "List of ticked articles in the current newsgroup (a subset of unread art).")
1811
1812 (defvar gnus-newsgroup-killed nil
1813   "List of ranges of articles that have been through the scoring process.")
1814
1815 (defvar gnus-newsgroup-cached nil
1816   "List of articles that come from the article cache.")
1817
1818 (defvar gnus-newsgroup-saved nil
1819   "List of articles that have been saved.")
1820
1821 (defvar gnus-newsgroup-kill-headers nil)
1822
1823 (defvar gnus-newsgroup-replied nil
1824   "List of articles that have been replied to in the current newsgroup.")
1825
1826 (defvar gnus-newsgroup-expirable nil
1827   "List of articles in the current newsgroup that can be expired.")
1828
1829 (defvar gnus-newsgroup-processable nil
1830   "List of articles in the current newsgroup that can be processed.")
1831
1832 (defvar gnus-newsgroup-bookmarks nil
1833   "List of articles in the current newsgroup that have bookmarks.")
1834
1835 (defvar gnus-newsgroup-dormant nil
1836   "List of dormant articles in the current newsgroup.")
1837
1838 (defvar gnus-newsgroup-scored nil
1839   "List of scored articles in the current newsgroup.")
1840
1841 (defvar gnus-newsgroup-headers nil
1842   "List of article headers in the current newsgroup.")
1843
1844 (defvar gnus-newsgroup-threads nil)
1845
1846 (defvar gnus-newsgroup-prepared nil
1847   "Whether the current group has been prepared properly.")
1848
1849 (defvar gnus-newsgroup-ancient nil
1850   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1851
1852 (defvar gnus-newsgroup-sparse nil)
1853
1854 (defvar gnus-current-article nil)
1855 (defvar gnus-article-current nil)
1856 (defvar gnus-current-headers nil)
1857 (defvar gnus-have-all-headers nil)
1858 (defvar gnus-last-article nil)
1859 (defvar gnus-newsgroup-history nil)
1860 (defvar gnus-current-kill-article nil)
1861
1862 ;; Save window configuration.
1863 (defvar gnus-prev-winconf nil)
1864
1865 (defvar gnus-summary-mark-positions nil)
1866 (defvar gnus-group-mark-positions nil)
1867
1868 (defvar gnus-reffed-article-number nil)
1869
1870 ;;; Let the byte-compiler know that we know about this variable.
1871 (defvar rmail-default-rmail-file)
1872
1873 (defvar gnus-cache-removable-articles nil)
1874
1875 (defvar gnus-dead-summary nil)
1876
1877 (defconst gnus-summary-local-variables
1878   '(gnus-newsgroup-name
1879     gnus-newsgroup-begin gnus-newsgroup-end
1880     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1881     gnus-newsgroup-last-folder gnus-newsgroup-last-file
1882     gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1883     gnus-newsgroup-unselected gnus-newsgroup-marked
1884     gnus-newsgroup-reads gnus-newsgroup-saved
1885     gnus-newsgroup-replied gnus-newsgroup-expirable
1886     gnus-newsgroup-processable gnus-newsgroup-killed
1887     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1888     gnus-newsgroup-headers gnus-newsgroup-threads
1889     gnus-newsgroup-prepared gnus-summary-highlight-line-function
1890     gnus-current-article gnus-current-headers gnus-have-all-headers
1891     gnus-last-article gnus-article-internal-prepare-hook
1892     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1893     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1894     gnus-newsgroup-async 
1895     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
1896     gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
1897     gnus-newsgroup-history gnus-newsgroup-ancient
1898     gnus-newsgroup-sparse
1899     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1900     gnus-newsgroup-adaptive-score-file
1901     (gnus-newsgroup-expunged-tally . 0)
1902     gnus-cache-removeable-articles gnus-newsgroup-cached
1903     gnus-newsgroup-data gnus-newsgroup-data-reverse
1904     gnus-newsgroup-limit gnus-newsgroup-limits)
1905   "Variables that are buffer-local to the summary buffers.")
1906
1907 (defconst gnus-bug-message
1908   "Sending a bug report to the Gnus Towers.
1909 ========================================
1910
1911 The buffer below is a mail buffer.  When you press `C-c C-c', it will
1912 be sent to the Gnus Bug Exterminators.
1913
1914 At the bottom of the buffer you'll see lots of variable settings.
1915 Please do not delete those.  They will tell the Bug People what your
1916 environment is, so that it will be easier to locate the bugs.
1917
1918 If you have found a bug that makes Emacs go \"beep\", set
1919 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
1920 and include the backtrace in your bug report.
1921
1922 Please describe the bug in annoying, painstaking detail.
1923
1924 Thank you for your help in stamping out bugs.
1925 ")
1926
1927 ;;; End of variables.
1928
1929 ;; Define some autoload functions Gnus might use.
1930 (eval-and-compile
1931
1932   ;; This little mapcar goes through the list below and marks the
1933   ;; symbols in question as autoloaded functions.
1934   (mapcar
1935    (lambda (package)
1936      (let ((interactive (nth 1 (memq ':interactive package))))
1937        (mapcar
1938         (lambda (function)
1939           (let (keymap)
1940             (when (consp function)
1941               (setq keymap (car (memq 'keymap function)))
1942               (setq function (car function)))
1943             (autoload function (car package) nil interactive keymap)))
1944         (if (eq (nth 1 package) ':interactive)
1945             (cdddr package)
1946           (cdr package)))))
1947    '(("metamail" metamail-buffer)
1948      ("info" Info-goto-node)
1949      ("hexl" hexl-hex-string-to-integer)
1950      ("pp" pp pp-to-string pp-eval-expression)
1951      ("mail-extr" mail-extract-address-components)
1952      ("nnmail" nnmail-split-fancy nnmail-article-group)
1953      ("nnvirtual" nnvirtual-catchup-group)
1954      ("timezone" timezone-make-date-arpa-standard timezone-fix-time
1955       timezone-make-sortable-date timezone-make-time-string)
1956      ("sendmail" mail-position-on-field mail-setup)
1957      ("rmailout" rmail-output)
1958      ("rnewspost" news-mail-other-window news-reply-yank-original
1959       news-caesar-buffer-body)
1960      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
1961       rmail-show-message)
1962      ("gnus-soup" :interactive t
1963       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
1964       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1965      ("nnsoup" nnsoup-pack-replies)
1966      ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
1967       gnus-Folder-save-name gnus-folder-save-name)
1968      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
1969      ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
1970       gnus-server-make-menu-bar gnus-article-make-menu-bar
1971       gnus-browse-make-menu-bar gnus-highlight-selected-summary
1972       gnus-summary-highlight-line gnus-carpal-setup-buffer
1973       gnus-group-highlight-line
1974       gnus-article-add-button gnus-insert-next-page-button
1975       gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu)
1976      ("gnus-vis" :interactive t
1977       gnus-article-push-button gnus-article-press-button
1978       gnus-article-highlight gnus-article-highlight-some
1979       gnus-article-highlight-headers gnus-article-highlight-signature
1980       gnus-article-add-buttons gnus-article-add-buttons-to-head
1981       gnus-article-next-button gnus-article-prev-button)
1982      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
1983       gnus-demon-add-disconnection gnus-demon-add-handler
1984       gnus-demon-remove-handler)
1985      ("gnus-demon" :interactive t
1986       gnus-demon-init gnus-demon-cancel)
1987      ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
1988       gnus-tree-open gnus-tree-close)
1989      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close)
1990      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
1991      ("gnus-srvr" gnus-browse-foreign-server)
1992      ("gnus-cite" :interactive t
1993       gnus-article-highlight-citation gnus-article-hide-citation-maybe
1994       gnus-article-hide-citation gnus-article-fill-cited-article)
1995      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
1996       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
1997       gnus-execute gnus-expunge)
1998      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
1999       gnus-cache-possibly-remove-articles gnus-cache-request-article
2000       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
2001       gnus-cache-enter-remove-article gnus-cached-article-p
2002       gnus-cache-open gnus-cache-close)
2003      ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
2004       gnus-cache-remove-article)
2005      ("gnus-score" :interactive t
2006       gnus-summary-increase-score gnus-summary-lower-score
2007       gnus-score-flush-cache gnus-score-close
2008       gnus-score-raise-same-subject-and-select
2009       gnus-score-raise-same-subject gnus-score-default
2010       gnus-score-raise-thread gnus-score-lower-same-subject-and-select
2011       gnus-score-lower-same-subject gnus-score-lower-thread
2012       gnus-possibly-score-headers)
2013      ("gnus-score"
2014       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
2015       gnus-current-score-file-nondirectory gnus-score-adaptive
2016       gnus-score-find-trace gnus-score-file-name)
2017      ("gnus-edit" :interactive t gnus-score-customize)
2018      ("gnus-topic" :interactive t gnus-topic-mode)
2019      ("gnus-topic" gnus-topic-remove-group)
2020      ("gnus-salt" :interactive t gnus-pick-mode)
2021      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
2022      ("gnus-uu" :interactive t
2023       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
2024       gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
2025       gnus-uu-mark-by-regexp gnus-uu-mark-all
2026       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
2027       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
2028       gnus-uu-decode-unshar-and-save gnus-uu-decode-save
2029       gnus-uu-decode-binhex gnus-uu-decode-uu-view
2030       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
2031       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
2032       gnus-uu-decode-binhex-view)
2033      ("gnus-msg" (gnus-summary-send-map keymap)
2034       gnus-mail-yank-original gnus-mail-send-and-exit
2035       gnus-sendmail-setup-mail gnus-article-mail
2036       gnus-inews-message-id gnus-new-mail gnus-mail-reply)
2037      ("gnus-msg" :interactive t
2038       gnus-group-post-news gnus-group-mail gnus-summary-post-news
2039       gnus-summary-followup gnus-summary-followup-with-original
2040       gnus-summary-followup-and-reply
2041       gnus-summary-followup-and-reply-with-original
2042       gnus-summary-cancel-article gnus-summary-supersede-article
2043       gnus-post-news gnus-inews-news gnus-cancel-news
2044       gnus-summary-reply gnus-summary-reply-with-original
2045       gnus-summary-mail-forward gnus-summary-mail-other-window
2046       gnus-bug)
2047      ("gnus-picon" :interactive t gnus-article-display-picons
2048       gnus-group-display-picons)
2049      ("gnus-vm" gnus-vm-mail-setup)
2050      ("gnus-vm" :interactive t gnus-summary-save-in-vm
2051       gnus-summary-save-article-vm gnus-yank-article))))
2052
2053 \f
2054
2055 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2056 ;; If you want the cursor to go somewhere else, set these two
2057 ;; functions in some startup hook to whatever you want.
2058 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
2059 (defalias 'gnus-group-position-point 'gnus-goto-colon)
2060
2061 ;;; Various macros and substs.
2062
2063 (defun gnus-header-from (header)
2064   (mail-header-from header))
2065
2066 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
2067   "Pop to BUFFER, evaluate FORMS, and then return to the original window."
2068   `(let ((GnusStartBufferWindow (selected-window)))
2069      (unwind-protect
2070          (progn
2071            (pop-to-buffer ,buffer)
2072            ,@forms)
2073        (select-window GnusStartBufferWindow))))
2074
2075 (defmacro gnus-gethash (string hashtable)
2076   "Get hash value of STRING in HASHTABLE."
2077   `(symbol-value (intern-soft ,string ,hashtable)))
2078
2079 (defmacro gnus-sethash (string value hashtable)
2080   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2081   `(set (intern ,string ,hashtable) ,value))
2082
2083 (defmacro gnus-intern-safe (string hashtable)
2084   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2085   `(let ((symbol (intern ,string ,hashtable)))
2086      (or (boundp symbol)
2087          (set symbol nil))
2088      symbol))
2089
2090 (defmacro gnus-group-unread (group)
2091   "Get the currently computed number of unread articles in GROUP."
2092   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
2093
2094 (defmacro gnus-group-entry (group)
2095   "Get the newsrc entry for GROUP."
2096   `(gnus-gethash ,group gnus-newsrc-hashtb))
2097
2098 (defmacro gnus-active (group)
2099   "Get active info on GROUP."
2100   `(gnus-gethash ,group gnus-active-hashtb))
2101
2102 (defmacro gnus-set-active (group active)
2103   "Set GROUP's active info."
2104   `(gnus-sethash ,group ,active gnus-active-hashtb))
2105
2106 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2107 ;;   function `substring' might cut on a middle of multi-octet
2108 ;;   character.
2109 (defun gnus-truncate-string (str width)
2110   (substring str 0 width))
2111
2112 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
2113 ;; to limit the length of a string.  This function is necessary since
2114 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
2115 (defsubst gnus-limit-string (str width)
2116   (if (> (length str) width)
2117       (substring str 0 width)
2118     str))
2119
2120 (defsubst gnus-simplify-subject-re (subject)
2121   "Remove \"Re:\" from subject lines."
2122   (if (string-match "^[Rr][Ee]: *" subject)
2123       (substring subject (match-end 0))
2124     subject))
2125
2126 (defsubst gnus-goto-char (point)
2127   (and point (goto-char point)))
2128
2129 (defmacro gnus-buffer-exists-p (buffer)
2130   `(and ,buffer
2131         (funcall (if (stringp ,buffer) 'get-buffer 'buffer-name)
2132                  ,buffer)))
2133
2134 (defmacro gnus-kill-buffer (buffer)
2135   `(let ((buf ,buffer))
2136      (if (gnus-buffer-exists-p buf)
2137          (kill-buffer buf))))
2138
2139 (defsubst gnus-point-at-bol ()
2140   "Return point at the beginning of the line."
2141   (let ((p (point)))
2142     (beginning-of-line)
2143     (prog1
2144         (point)
2145       (goto-char p))))
2146
2147 (defsubst gnus-point-at-eol ()
2148   "Return point at the end of the line."
2149   (let ((p (point)))
2150     (end-of-line)
2151     (prog1
2152         (point)
2153       (goto-char p))))
2154
2155 ;; Delete the current line (and the next N lines.);
2156 (defmacro gnus-delete-line (&optional n)
2157   `(delete-region (progn (beginning-of-line) (point))
2158                   (progn (forward-line ,(or n 1)) (point))))
2159
2160 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
2161 (defvar gnus-init-inhibit nil)
2162 (defun gnus-read-init-file (&optional inhibit-next)
2163   (if gnus-init-inhibit
2164       (setq gnus-init-inhibit nil)
2165     (setq gnus-init-inhibit inhibit-next)
2166     (and gnus-init-file
2167          (or (and (file-exists-p gnus-init-file)
2168                   ;; Don't try to load a directory.
2169                   (not (file-directory-p gnus-init-file)))
2170              (file-exists-p (concat gnus-init-file ".el"))
2171              (file-exists-p (concat gnus-init-file ".elc")))
2172          (condition-case var
2173              (load gnus-init-file nil t)
2174            (error
2175             (error "Error in %s: %s" gnus-init-file var))))))
2176
2177 ;; Info access macros.
2178
2179 (defmacro gnus-info-group (info)
2180   `(nth 0 ,info))
2181 (defmacro gnus-info-rank (info)
2182   `(nth 1 ,info))
2183 (defmacro gnus-info-read (info)
2184   `(nth 2 ,info))
2185 (defmacro gnus-info-marks (info)
2186   `(nth 3 ,info))
2187 (defmacro gnus-info-method (info)
2188   `(nth 4 ,info))
2189 (defmacro gnus-info-params (info)
2190   `(nth 5 ,info))
2191
2192 (defmacro gnus-info-level (info)
2193   `(let ((rank (gnus-info-rank ,info)))
2194      (if (consp rank)
2195          (car rank)
2196        rank)))
2197 (defmacro gnus-info-score (info)
2198   `(let ((rank (gnus-info-rank ,info)))
2199      (or (and (consp rank) (cdr rank)) 0)))
2200
2201 (defmacro gnus-info-set-group (info group)
2202   `(setcar ,info ,group))
2203 (defmacro gnus-info-set-rank (info rank)
2204   `(setcar (nthcdr 1 ,info) ,rank))
2205 (defmacro gnus-info-set-read (info read)
2206   `(setcar (nthcdr 2 ,info) ,read))
2207 (defmacro gnus-info-set-marks (info marks)
2208   `(setcar (nthcdr 3 ,info) ,marks))
2209 (defmacro gnus-info-set-method (info method)
2210   `(setcar (nthcdr 4 ,info) ,method))
2211 (defmacro gnus-info-set-params (info params)
2212   `(setcar (nthcdr 5 ,info) ,params))
2213
2214 (defmacro gnus-info-set-level (info level)
2215   `(let ((rank (cdr ,info)))
2216      (if (consp (car rank))
2217          (setcar (car rank) ,level)
2218        (setcar rank ,level))))
2219 (defmacro gnus-info-set-score (info score)
2220   `(let ((rank (cdr ,info)))
2221      (if (consp (car rank))
2222          (setcdr (car rank) ,score)
2223        (setcar rank (cons (car rank) ,score)))))
2224
2225 (defmacro gnus-get-info (group)
2226   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2227
2228 (defun gnus-byte-code (func)
2229   "Return a form that can be `eval'ed based on FUNC."
2230   (let ((fval (symbol-function func)))
2231     (if (byte-code-function-p fval)
2232         (let ((flist (append fval nil)))
2233           (setcar flist 'byte-code)
2234           flist)
2235       (cons 'progn (cdr (cdr fval))))))
2236
2237 ;;; Load the compatability functions.
2238
2239 (require 'gnus-cus)
2240 (require 'gnus-ems)
2241
2242 \f
2243
2244 ;; Format specs.  The chunks below are the machine-generated forms
2245 ;; that are to be evaled as the result of the default format strings.
2246 ;; We write them in here to get them byte-compiled.  That way the
2247 ;; default actions will be quite fast, while still retaining the full
2248 ;; flexibility of the user-defined format specs.
2249
2250 ;; First we have lots of dummy defvars to let the compiler know these
2251 ;; are really dynamic variables.
2252
2253 (defvar gnus-tmp-unread)
2254 (defvar gnus-tmp-replied)
2255 (defvar gnus-tmp-score-char)
2256 (defvar gnus-tmp-indentation)
2257 (defvar gnus-tmp-opening-bracket)
2258 (defvar gnus-tmp-lines)
2259 (defvar gnus-tmp-name)
2260 (defvar gnus-tmp-closing-bracket)
2261 (defvar gnus-tmp-subject-or-nil)
2262 (defvar gnus-tmp-subject)
2263 (defvar gnus-tmp-marked)
2264 (defvar gnus-tmp-marked-mark)
2265 (defvar gnus-tmp-subscribed)
2266 (defvar gnus-tmp-process-marked)
2267 (defvar gnus-tmp-number-of-unread)
2268 (defvar gnus-tmp-group-name)
2269 (defvar gnus-tmp-group)
2270 (defvar gnus-tmp-article-number)
2271 (defvar gnus-tmp-unread-and-unselected)
2272 (defvar gnus-tmp-news-method)
2273 (defvar gnus-tmp-news-server)
2274 (defvar gnus-tmp-article-number)
2275 (defvar gnus-mouse-face)
2276 (defvar gnus-mouse-face-prop)
2277
2278 (defun gnus-summary-line-format-spec ()
2279   (insert gnus-tmp-unread gnus-tmp-replied
2280           gnus-tmp-score-char gnus-tmp-indentation)
2281   (put-text-property
2282    (point)
2283    (progn
2284      (insert
2285       gnus-tmp-opening-bracket
2286       (format "%4d: %-20s"
2287               gnus-tmp-lines
2288               (if (> (length gnus-tmp-name) 20)
2289                   (substring gnus-tmp-name 0 20)
2290                 gnus-tmp-name))
2291       gnus-tmp-closing-bracket)
2292      (point))
2293    gnus-mouse-face-prop gnus-mouse-face)
2294   (insert " " gnus-tmp-subject-or-nil "\n"))
2295
2296 (defvar gnus-summary-line-format-spec
2297   (gnus-byte-code 'gnus-summary-line-format-spec))
2298
2299 (defun gnus-summary-dummy-line-format-spec ()
2300   (insert "*  ")
2301   (put-text-property
2302    (point)
2303    (progn
2304      (insert ":                          :")
2305      (point))
2306    gnus-mouse-face-prop gnus-mouse-face)
2307   (insert " " gnus-tmp-subject "\n"))
2308
2309 (defvar gnus-summary-dummy-line-format-spec
2310   (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
2311
2312 (defun gnus-group-line-format-spec ()
2313   (insert gnus-tmp-marked-mark gnus-tmp-subscribed
2314           gnus-tmp-process-marked
2315           gnus-group-indentation
2316           (format "%5s: " gnus-tmp-number-of-unread))
2317   (put-text-property
2318    (point)
2319    (progn
2320      (insert gnus-tmp-group "\n")
2321      (1- (point)))
2322    gnus-mouse-face-prop gnus-mouse-face))
2323 (defvar gnus-group-line-format-spec
2324   (gnus-byte-code 'gnus-group-line-format-spec))
2325
2326 (defvar gnus-format-specs
2327   `((version . ,emacs-version)
2328     (group ,gnus-group-line-format ,gnus-group-line-format-spec)
2329     (summary-dummy ,gnus-summary-dummy-line-format
2330                    ,gnus-summary-dummy-line-format-spec)
2331     (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec)))
2332
2333 (defvar gnus-article-mode-line-format-spec nil)
2334 (defvar gnus-summary-mode-line-format-spec nil)
2335 (defvar gnus-group-mode-line-format-spec nil)
2336
2337 ;;; Phew.  All that gruft is over, fortunately.
2338
2339 \f
2340 ;;;
2341 ;;; Gnus Utility Functions
2342 ;;;
2343
2344 (defun gnus-extract-address-components (from)
2345   (let (name address)
2346     ;; First find the address - the thing with the @ in it.  This may
2347     ;; not be accurate in mail addresses, but does the trick most of
2348     ;; the time in news messages.
2349     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
2350         (setq address (substring from (match-beginning 0) (match-end 0))))
2351     ;; Then we check whether the "name <address>" format is used.
2352     (and address
2353          ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2354          ;; Linear white space is not required.
2355          (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
2356          (and (setq name (substring from 0 (match-beginning 0)))
2357               ;; Strip any quotes from the name.
2358               (string-match "\".*\"" name)
2359               (setq name (substring name 1 (1- (match-end 0))))))
2360     ;; If not, then "address (name)" is used.
2361     (or name
2362         (and (string-match "(.+)" from)
2363              (setq name (substring from (1+ (match-beginning 0))
2364                                    (1- (match-end 0)))))
2365         (and (string-match "()" from)
2366              (setq name address))
2367         ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
2368         ;; XOVER might not support folded From headers.
2369         (and (string-match "(.*" from)
2370              (setq name (substring from (1+ (match-beginning 0))
2371                                    (match-end 0)))))
2372     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2373     (list (or name from) (or address from))))
2374
2375 (defun gnus-fetch-field (field)
2376   "Return the value of the header FIELD of current article."
2377   (save-excursion
2378     (save-restriction
2379       (let ((case-fold-search t))
2380         (nnheader-narrow-to-headers)
2381         (mail-fetch-field field)))))
2382
2383 (defun gnus-goto-colon ()
2384   (beginning-of-line)
2385   (search-forward ":" (gnus-point-at-eol) t))
2386
2387 ;;;###autoload
2388 (defun gnus-update-format (var)
2389   "Update the format specification near point."
2390   (interactive
2391    (list
2392     (save-excursion
2393       (eval-defun nil)
2394       ;; Find the end of the current word.
2395       (re-search-forward "[ \t\n]" nil t)
2396       ;; Search backward.
2397       (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
2398         (match-string 1)))))
2399   (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
2400                               (match-string 1 var))))
2401          (entry (assq type gnus-format-specs))
2402          value spec)
2403     (when entry
2404       (setq gnus-format-specs (delq entry gnus-format-specs)))
2405     (set
2406      (intern (format "%s-spec" var))
2407      (gnus-parse-format (setq value (symbol-value (intern var)))
2408                         (symbol-value (intern (format "%s-alist" var)))
2409                         (not (string-match "mode" var))))
2410     (setq spec (symbol-value (intern (format "%s-spec" var))))
2411     (push (list type value spec) gnus-format-specs)
2412
2413     (pop-to-buffer "*Gnus Format*")
2414     (erase-buffer)
2415     (lisp-interaction-mode)
2416     (insert (pp-to-string spec))))
2417
2418
2419 (defun gnus-update-format-specifications (&optional force)
2420   "Update all (necessary) format specifications."
2421   ;; Make the indentation array.
2422   (gnus-make-thread-indent-array)
2423
2424   (when (or force
2425             (and (assq 'version gnus-format-specs)
2426                  (not (equal emacs-version
2427                              (cdr (assq 'version gnus-format-specs))))))
2428     (setq gnus-format-specs nil))
2429
2430   (let ((types '(summary summary-dummy group
2431                            summary-mode group-mode article-mode))
2432         old-format new-format entry type val)
2433     (while types
2434       (setq type (pop types))
2435       (setq new-format (symbol-value
2436                         (intern (format "gnus-%s-line-format" type))))
2437       (setq entry (cdr (assq type gnus-format-specs)))
2438       (if (and entry
2439                (equal (car entry) new-format))
2440           (set (intern (format "gnus-%s-line-format-spec" type))
2441                (car (cdr entry)))
2442         (setq val
2443               (if (not (stringp new-format))
2444                   ;; This is a function call or something.
2445                   new-format
2446                 ;; This is a "real" format.
2447                 (gnus-parse-format
2448                  new-format
2449                  (symbol-value
2450                   (intern (format "gnus-%s-line-format-alist"
2451                                   (if (eq type 'article-mode)
2452                                       'summary-mode type))))
2453                  (not (string-match "mode$" (symbol-name type))))))
2454         (set (intern (format "gnus-%s-line-format-spec" type)) val)
2455         (if entry
2456             (setcar (cdr entry) val)
2457           (push (list type new-format val) gnus-format-specs)))))
2458
2459   (gnus-update-group-mark-positions)
2460   (gnus-update-summary-mark-positions)
2461
2462   (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
2463            (not gnus-description-hashtb)
2464            gnus-read-active-file)
2465       (gnus-read-all-descriptions-files)))
2466
2467 (defun gnus-update-summary-mark-positions ()
2468   (save-excursion
2469     (let ((gnus-replied-mark 129)
2470           (gnus-score-below-mark 130)
2471           (gnus-score-over-mark 130)
2472           (thread nil)
2473           (gnus-visual nil)
2474           pos)
2475       (gnus-set-work-buffer)
2476       (gnus-summary-insert-line
2477        [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
2478       (goto-char (point-min))
2479       (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
2480                                          (- (point) 2)))))
2481       (goto-char (point-min))
2482       (setq pos (cons (cons 'replied (and (search-forward "\201" nil t)
2483                                           (- (point) 2))) pos))
2484       (goto-char (point-min))
2485       (setq pos (cons (cons 'score (and (search-forward "\202" nil t)
2486                                         (- (point) 2))) pos))
2487       (setq gnus-summary-mark-positions pos))))
2488
2489 (defun gnus-update-group-mark-positions ()
2490   (save-excursion
2491     (let ((gnus-process-mark 128)
2492           (gnus-group-marked '("dummy.group")))
2493       (gnus-set-active "dummy.group" '(0 . 0))
2494       (gnus-set-work-buffer)
2495       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
2496       (goto-char (point-min))
2497       (setq gnus-group-mark-positions
2498             (list (cons 'process (and (search-forward "\200" nil t)
2499                                       (- (point) 2))))))))
2500
2501 (defvar gnus-mouse-face-0 'highlight)
2502 (defvar gnus-mouse-face-1 'highlight)
2503 (defvar gnus-mouse-face-2 'highlight)
2504 (defvar gnus-mouse-face-3 'highlight)
2505 (defvar gnus-mouse-face-4 'highlight)
2506
2507 (defun gnus-mouse-face-function (form type)
2508   `(put-text-property
2509     (point) (progn ,@form (point))
2510     gnus-mouse-face-prop
2511     ,(if (equal type 0)
2512          'gnus-mouse-face
2513        `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
2514
2515 (defvar gnus-face-0 'bold)
2516 (defvar gnus-face-1 'italic)
2517 (defvar gnus-face-2 'bold-italic)
2518 (defvar gnus-face-3 'bold)
2519 (defvar gnus-face-4 'bold)
2520
2521 (defun gnus-face-face-function (form type)
2522   `(put-text-property
2523     (point) (progn ,@form (point))
2524     'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
2525
2526 (defun gnus-max-width-function (el max-width)
2527   (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
2528   (if (symbolp el)
2529       `(if (> (length ,el) ,max-width)
2530            (substring ,el 0 ,max-width)
2531          ,el)
2532     `(let ((val (eval ,el)))
2533        (if (numberp val)
2534            (setq val (int-to-string val)))
2535        (if (> (length val) ,max-width)
2536            (substring val 0 ,max-width)
2537          val))))
2538
2539 (defun gnus-parse-format (format spec-alist &optional insert)
2540   ;; This function parses the FORMAT string with the help of the
2541   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
2542   ;; string.  If the FORMAT string contains the specifiers %( and %)
2543   ;; the text between them will have the mouse-face text property.
2544   (if (string-match
2545        "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
2546        format)
2547       (gnus-parse-complex-format format spec-alist)
2548     ;; This is a simple format.
2549     (gnus-parse-simple-format format spec-alist insert)))
2550
2551 (defun gnus-parse-complex-format (format spec-alist)
2552   (save-excursion
2553     (gnus-set-work-buffer)
2554     (insert format)
2555     (goto-char (point-min))
2556     (while (re-search-forward "\"" nil t)
2557       (replace-match "\\\"" nil t))
2558     (goto-char (point-min))
2559     (insert "(\"")
2560     (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
2561       (let ((number (if (match-beginning 1)
2562                         (match-string 1) "0"))
2563             (delim (aref (match-string 2) 0)))
2564         (if (or (= delim ?\() (= delim ?\{))
2565             (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
2566                                    " " number " \""))
2567           (replace-match "\")\""))))
2568     (goto-char (point-max))
2569     (insert "\")")
2570     (goto-char (point-min))
2571     (let ((form (read (current-buffer))))
2572       (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
2573
2574 (defun gnus-complex-form-to-spec (form spec-alist)
2575   (delq nil
2576         (mapcar
2577          (lambda (sform)
2578            (if (stringp sform)
2579                (gnus-parse-simple-format sform spec-alist t)
2580              (funcall (intern (format "gnus-%s-face-function"
2581                                       (car sform)))
2582                       (gnus-complex-form-to-spec
2583                        (cdr (cdr sform)) spec-alist)
2584                       (nth 1 sform))))
2585          form)))
2586
2587 (defun gnus-parse-simple-format (format spec-alist &optional insert)
2588   ;; This function parses the FORMAT string with the help of the
2589   ;; SPEC-ALIST and returns a list that can be eval'ed to return a
2590   ;; string.
2591   (let ((max-width 0)
2592         spec flist fstring newspec elem beg result dontinsert)
2593     (save-excursion
2594       (gnus-set-work-buffer)
2595       (insert format)
2596       (goto-char (point-min))
2597       (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
2598                                 nil t)
2599         (if (= (setq spec (string-to-char (match-string 2))) ?%)
2600               (setq newspec "%"
2601                     beg (1+ (match-beginning 0)))
2602           ;; First check if there are any specs that look anything like
2603           ;; "%12,12A", ie. with a "max width specification".  These have
2604           ;; to be treated specially.
2605           (if (setq beg (match-beginning 1))
2606               (setq max-width
2607                     (string-to-int
2608                      (buffer-substring
2609                       (1+ (match-beginning 1)) (match-end 1))))
2610             (setq max-width 0)
2611             (setq beg (match-beginning 2)))
2612           ;; Find the specification from `spec-alist'.
2613           (unless (setq elem (cdr (assq spec spec-alist)))
2614             (setq elem '("*" ?s)))
2615           ;; Treat user defined format specifiers specially.
2616           (when (eq (car elem) 'gnus-tmp-user-defined)
2617             (setq elem
2618                   (list
2619                    (list (intern (concat "gnus-user-format-function-"
2620                                          (match-string 3)))
2621                          'gnus-tmp-header) ?s))
2622             (delete-region (match-beginning 3) (match-end 3)))
2623           (if (not (zerop max-width))
2624               (let ((el (car elem)))
2625                 (cond ((= (car (cdr elem)) ?c)
2626                        (setq el (list 'char-to-string el)))
2627                       ((= (car (cdr elem)) ?d)
2628                        (setq el (list 'int-to-string el))))
2629                 (setq flist (cons (gnus-max-width-function el max-width)
2630                                   flist))
2631                 (setq newspec ?s))
2632             (progn
2633               (setq flist (cons (car elem) flist))
2634               (setq newspec (car (cdr elem))))))
2635         ;; Remove the old specification (and possibly a ",12" string).
2636         (delete-region beg (match-end 2))
2637         ;; Insert the new specification.
2638         (goto-char beg)
2639         (insert newspec))
2640       (setq fstring (buffer-substring 1 (point-max))))
2641     ;; Do some postprocessing to increase efficiency.
2642     (setq
2643      result
2644      (cond
2645       ;; Emptyness.
2646       ((string= fstring "")
2647        nil)
2648       ;; Not a format string.
2649       ((not (string-match "%" fstring))
2650        (list fstring))
2651       ;; A format string with just a single string spec.
2652       ((string= fstring "%s")
2653        (list (car flist)))
2654       ;; A single character.
2655       ((string= fstring "%c")
2656        (list (car flist)))
2657       ;; A single number.
2658       ((string= fstring "%d")
2659        (setq dontinsert)
2660        (if insert
2661            (list `(princ ,(car flist)))
2662          (list `(int-to-string ,(car flist)))))
2663       ;; Just lots of chars and strings.
2664       ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
2665        (nreverse flist))
2666       ;; A single string spec at the beginning of the spec.
2667       ((string-match "\\`%[sc][^%]+\\'" fstring)
2668        (list (car flist) (substring fstring 2)))
2669       ;; A single string spec in the middle of the spec.
2670       ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
2671        (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
2672       ;; A single string spec in the end of the spec.
2673       ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
2674        (list (match-string 1 fstring) (car flist)))
2675       ;; A more complex spec.
2676       (t
2677        (list (cons 'format (cons fstring (nreverse flist)))))))
2678
2679     (if insert
2680         (when result
2681           (if dontinsert
2682               result
2683             (cons 'insert result)))
2684       (cond ((stringp result)
2685              result)
2686             ((consp result)
2687              (cons 'concat result))
2688             (t "")))))
2689
2690 (defun gnus-eval-format (format &optional alist props)
2691   "Eval the format variable FORMAT, using ALIST.
2692 If PROPS, insert the result."
2693   (let ((form (gnus-parse-format format alist props)))
2694     (if props
2695         (add-text-properties (point) (progn (eval form) (point)) props)
2696       (eval form))))
2697
2698 (defun gnus-remove-text-with-property (prop)
2699   "Delete all text in the current buffer with text property PROP."
2700   (save-excursion
2701     (goto-char (point-min))
2702     (while (not (eobp))
2703       (while (get-text-property (point) prop)
2704         (delete-char 1))
2705       (goto-char (next-single-property-change (point) prop nil (point-max))))))
2706
2707 (defun gnus-set-work-buffer ()
2708   (if (get-buffer gnus-work-buffer)
2709       (progn
2710         (set-buffer gnus-work-buffer)
2711         (erase-buffer))
2712     (set-buffer (get-buffer-create gnus-work-buffer))
2713     (kill-all-local-variables)
2714     (buffer-disable-undo (current-buffer))
2715     (gnus-add-current-to-buffer-list)))
2716
2717 ;; Article file names when saving.
2718
2719 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
2720   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2721 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
2722 Otherwise, it is like ~/News/news/group/num."
2723   (let ((default
2724           (expand-file-name
2725            (concat (if (gnus-use-long-file-name 'not-save)
2726                        (gnus-capitalize-newsgroup newsgroup)
2727                      (gnus-newsgroup-directory-form newsgroup))
2728                    "/" (int-to-string (mail-header-number headers)))
2729            (or gnus-article-save-directory "~/News"))))
2730     (if (and last-file
2731              (string-equal (file-name-directory default)
2732                            (file-name-directory last-file))
2733              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2734         default
2735       (or last-file default))))
2736
2737 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
2738   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2739 If variable `gnus-use-long-file-name' is non-nil, it is
2740 ~/News/news.group/num.  Otherwise, it is like ~/News/news/group/num."
2741   (let ((default
2742           (expand-file-name
2743            (concat (if (gnus-use-long-file-name 'not-save)
2744                        newsgroup
2745                      (gnus-newsgroup-directory-form newsgroup))
2746                    "/" (int-to-string (mail-header-number headers)))
2747            (or gnus-article-save-directory "~/News"))))
2748     (if (and last-file
2749              (string-equal (file-name-directory default)
2750                            (file-name-directory last-file))
2751              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2752         default
2753       (or last-file default))))
2754
2755 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
2756   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2757 If variable `gnus-use-long-file-name' is non-nil, it is
2758 ~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
2759   (or last-file
2760       (expand-file-name
2761        (if (gnus-use-long-file-name 'not-save)
2762            (gnus-capitalize-newsgroup newsgroup)
2763          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2764        (or gnus-article-save-directory "~/News"))))
2765
2766 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2767   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2768 If variable `gnus-use-long-file-name' is non-nil, it is
2769 ~/News/news.group.  Otherwise, it is like ~/News/news/group/news."
2770   (or last-file
2771       (expand-file-name
2772        (if (gnus-use-long-file-name 'not-save)
2773            newsgroup
2774          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2775        (or gnus-article-save-directory "~/News"))))
2776
2777 ;; For subscribing new newsgroup
2778
2779 (defun gnus-subscribe-hierarchical-interactive (groups)
2780   (let ((groups (sort groups 'string<))
2781         prefixes prefix start ans group starts)
2782     (while groups
2783       (setq prefixes (list "^"))
2784       (while (and groups prefixes)
2785         (while (not (string-match (car prefixes) (car groups)))
2786           (setq prefixes (cdr prefixes)))
2787         (setq prefix (car prefixes))
2788         (setq start (1- (length prefix)))
2789         (if (and (string-match "[^\\.]\\." (car groups) start)
2790                  (cdr groups)
2791                  (setq prefix
2792                        (concat "^" (substring (car groups) 0 (match-end 0))))
2793                  (string-match prefix (car (cdr groups))))
2794             (progn
2795               (setq prefixes (cons prefix prefixes))
2796               (message "Descend hierarchy %s? ([y]nsq): "
2797                        (substring prefix 1 (1- (length prefix))))
2798               (setq ans (read-char))
2799               (cond ((= ans ?n)
2800                      (while (and groups
2801                                  (string-match prefix
2802                                                (setq group (car groups))))
2803                        (setq gnus-killed-list
2804                              (cons group gnus-killed-list))
2805                        (gnus-sethash group group gnus-killed-hashtb)
2806                        (setq groups (cdr groups)))
2807                      (setq starts (cdr starts)))
2808                     ((= ans ?s)
2809                      (while (and groups
2810                                  (string-match prefix
2811                                                (setq group (car groups))))
2812                        (gnus-sethash group group gnus-killed-hashtb)
2813                        (gnus-subscribe-alphabetically (car groups))
2814                        (setq groups (cdr groups)))
2815                      (setq starts (cdr starts)))
2816                     ((= ans ?q)
2817                      (while groups
2818                        (setq group (car groups))
2819                        (setq gnus-killed-list (cons group gnus-killed-list))
2820                        (gnus-sethash group group gnus-killed-hashtb)
2821                        (setq groups (cdr groups))))
2822                     (t nil)))
2823           (message "Subscribe %s? ([n]yq)" (car groups))
2824           (setq ans (read-char))
2825           (setq group (car groups))
2826           (cond ((= ans ?y)
2827                  (gnus-subscribe-alphabetically (car groups))
2828                  (gnus-sethash group group gnus-killed-hashtb))
2829                 ((= ans ?q)
2830                  (while groups
2831                    (setq group (car groups))
2832                    (setq gnus-killed-list (cons group gnus-killed-list))
2833                    (gnus-sethash group group gnus-killed-hashtb)
2834                    (setq groups (cdr groups))))
2835                 (t
2836                  (setq gnus-killed-list (cons group gnus-killed-list))
2837                  (gnus-sethash group group gnus-killed-hashtb)))
2838           (setq groups (cdr groups)))))))
2839
2840 (defun gnus-subscribe-randomly (newsgroup)
2841   "Subscribe new NEWSGROUP by making it the first newsgroup."
2842   (gnus-subscribe-newsgroup newsgroup))
2843
2844 (defun gnus-subscribe-alphabetically (newgroup)
2845   "Subscribe new NEWSGROUP and insert it in alphabetical order."
2846   (let ((groups (cdr gnus-newsrc-alist))
2847         before)
2848     (while (and (not before) groups)
2849       (if (string< newgroup (car (car groups)))
2850           (setq before (car (car groups)))
2851         (setq groups (cdr groups))))
2852     (gnus-subscribe-newsgroup newgroup before)))
2853
2854 (defun gnus-subscribe-hierarchically (newgroup)
2855   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
2856   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2857   (save-excursion
2858     (set-buffer (find-file-noselect gnus-current-startup-file))
2859     (let ((groupkey newgroup)
2860           before)
2861       (while (and (not before) groupkey)
2862         (goto-char (point-min))
2863         (let ((groupkey-re
2864                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
2865           (while (and (re-search-forward groupkey-re nil t)
2866                       (progn
2867                         (setq before (match-string 1))
2868                         (string< before newgroup)))))
2869         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
2870         (setq groupkey
2871               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
2872                   (substring groupkey (match-beginning 1) (match-end 1)))))
2873       (gnus-subscribe-newsgroup newgroup before))))
2874
2875 (defun gnus-subscribe-interactively (group)
2876   "Subscribe the new GROUP interactively.
2877 It is inserted in hierarchical newsgroup order if subscribed.  If not,
2878 it is killed."
2879   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
2880       (gnus-subscribe-hierarchically group)
2881     (push group gnus-killed-list)))
2882
2883 (defun gnus-subscribe-zombies (group)
2884   "Make the new GROUP into a zombie group."
2885   (push group gnus-zombie-list))
2886
2887 (defun gnus-subscribe-killed (group)
2888   "Make the new GROUP a killed group."
2889   (push group gnus-killed-list))
2890
2891 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
2892   "Subscribe new NEWSGROUP.
2893 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
2894 the first newsgroup."
2895   ;; We subscribe the group by changing its level to `subscribed'.
2896   (gnus-group-change-level
2897    newsgroup gnus-level-default-subscribed
2898    gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
2899   (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
2900
2901 ;; For directories
2902
2903 (defun gnus-newsgroup-directory-form (newsgroup)
2904   "Make hierarchical directory name from NEWSGROUP name."
2905   (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
2906         (len (length newsgroup))
2907         idx)
2908     ;; If this is a foreign group, we don't want to translate the
2909     ;; entire name.
2910     (if (setq idx (string-match ":" newsgroup))
2911         (aset newsgroup idx ?/)
2912       (setq idx 0))
2913     ;; Replace all occurrences of `.' with `/'.
2914     (while (< idx len)
2915       (if (= (aref newsgroup idx) ?.)
2916           (aset newsgroup idx ?/))
2917       (setq idx (1+ idx)))
2918     newsgroup))
2919
2920 (defun gnus-newsgroup-savable-name (group)
2921   ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
2922   ;; with dots.
2923   (nnheader-replace-chars-in-string group ?/ ?.))
2924
2925 (defun gnus-make-directory (dir)
2926   "Make DIRECTORY recursively."
2927   ;; Why don't we use `(make-directory dir 'parents)'?  That's just one
2928   ;; of the many mysteries of the universe.
2929   (let* ((dir (expand-file-name dir default-directory))
2930          dirs err)
2931     (if (string-match "/$" dir)
2932         (setq dir (substring dir 0 (match-beginning 0))))
2933     ;; First go down the path until we find a directory that exists.
2934     (while (not (file-exists-p dir))
2935       (setq dirs (cons dir dirs))
2936       (string-match "/[^/]+$" dir)
2937       (setq dir (substring dir 0 (match-beginning 0))))
2938     ;; Then create all the subdirs.
2939     (while (and dirs (not err))
2940       (condition-case ()
2941           (make-directory (car dirs))
2942         (error (setq err t)))
2943       (setq dirs (cdr dirs)))
2944     ;; We return whether we were successful or not.
2945     (not dirs)))
2946
2947 (defun gnus-capitalize-newsgroup (newsgroup)
2948   "Capitalize NEWSGROUP name."
2949   (and (not (zerop (length newsgroup)))
2950        (concat (char-to-string (upcase (aref newsgroup 0)))
2951                (substring newsgroup 1))))
2952
2953 ;; Various... things.
2954
2955 (defun gnus-simplify-subject (subject &optional re-only)
2956   "Remove `Re:' and words in parentheses.
2957 If RE-ONLY is non-nil, strip leading `Re:'s only."
2958   (let ((case-fold-search t))           ;Ignore case.
2959     ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
2960     (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
2961       (setq subject (substring subject (match-end 0))))
2962     ;; Remove uninteresting prefixes.
2963     (if (and (not re-only)
2964              gnus-simplify-ignored-prefixes
2965              (string-match gnus-simplify-ignored-prefixes subject))
2966         (setq subject (substring subject (match-end 0))))
2967     ;; Remove words in parentheses from end.
2968     (unless re-only
2969       (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
2970         (setq subject (substring subject 0 (match-beginning 0)))))
2971     ;; Return subject string.
2972     subject))
2973
2974 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
2975 ;; all whitespace.
2976 ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
2977 (defun gnus-simplify-buffer-fuzzy ()
2978   (goto-char (point-min))
2979   (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*" nil t)
2980   (goto-char (match-beginning 0))
2981   (while (or
2982           (looking-at "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*")
2983           (looking-at "^[[].*:[ \t].*[]]$"))
2984     (goto-char (point-min))
2985     (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
2986                               nil t)
2987       (replace-match "" t t))
2988     (goto-char (point-min))
2989     (while (re-search-forward "^[[].*:[ \t].*[]]$" nil t)
2990       (goto-char (match-end 0))
2991       (delete-char -1)
2992       (delete-region
2993        (progn (goto-char (match-beginning 0)))
2994        (re-search-forward ":"))))
2995   (goto-char (point-min))
2996   (while (re-search-forward "[ \t\n]*[[{(][^()]*[]})][ \t]*$" nil t)
2997     (replace-match "" t t))
2998   (goto-char (point-min))
2999   (while (re-search-forward "[ \t]+" nil t)
3000     (replace-match " " t t))
3001   (goto-char (point-min))
3002   (while (re-search-forward "[ \t]+$" nil t)
3003     (replace-match "" t t))
3004   (goto-char (point-min))
3005   (while (re-search-forward "^[ \t]+" nil t)
3006     (replace-match "" t t))
3007   (goto-char (point-min))
3008   (if gnus-simplify-subject-fuzzy-regexp
3009       (if (listp gnus-simplify-subject-fuzzy-regexp)
3010           (let ((list gnus-simplify-subject-fuzzy-regexp))
3011             (while list
3012               (goto-char (point-min))
3013               (while (re-search-forward (car list) nil t)
3014                 (replace-match "" t t))
3015               (setq list (cdr list))))
3016         (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
3017           (replace-match "" t t)))))
3018
3019 (defun gnus-simplify-subject-fuzzy (subject)
3020   "Siplify a subject string fuzzily."
3021   (save-excursion
3022     (gnus-set-work-buffer)
3023     (let ((case-fold-search t))
3024       (insert subject)
3025       (inline (gnus-simplify-buffer-fuzzy))
3026       (buffer-string))))
3027
3028 ;; Add the current buffer to the list of buffers to be killed on exit.
3029 (defun gnus-add-current-to-buffer-list ()
3030   (or (memq (current-buffer) gnus-buffer-list)
3031       (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
3032
3033 (defun gnus-string> (s1 s2)
3034   (not (or (string< s1 s2)
3035            (string= s1 s2))))
3036
3037 ;;; General various misc type functions.
3038
3039 (defun gnus-clear-system ()
3040   "Clear all variables and buffers."
3041   ;; Clear Gnus variables.
3042   (let ((variables gnus-variable-list))
3043     (while variables
3044       (set (car variables) nil)
3045       (setq variables (cdr variables))))
3046   ;; Clear other internal variables.
3047   (setq gnus-list-of-killed-groups nil
3048         gnus-have-read-active-file nil
3049         gnus-newsrc-alist nil
3050         gnus-newsrc-hashtb nil
3051         gnus-killed-list nil
3052         gnus-zombie-list nil
3053         gnus-killed-hashtb nil
3054         gnus-active-hashtb nil
3055         gnus-moderated-list nil
3056         gnus-description-hashtb nil
3057         gnus-newsgroup-headers nil
3058         gnus-newsgroup-name nil
3059         gnus-server-alist nil
3060         gnus-opened-servers nil
3061         gnus-current-select-method nil)
3062   ;; Reset any score variables.
3063   (and gnus-use-scoring (gnus-score-close))
3064   ;; Kill the startup file.
3065   (and gnus-current-startup-file
3066        (get-file-buffer gnus-current-startup-file)
3067        (kill-buffer (get-file-buffer gnus-current-startup-file)))
3068   ;; Save any cache buffers.
3069   (and gnus-use-cache (gnus-cache-save-buffers))
3070   ;; Clear the dribble buffer.
3071   (gnus-dribble-clear)
3072   ;; Close down NoCeM.
3073   (and gnus-use-nocem (gnus-nocem-close))
3074   ;; Shut down the demons.
3075   (and gnus-use-demon (gnus-demon-cancel))
3076   ;; Kill global KILL file buffer.
3077   (if (get-file-buffer (gnus-newsgroup-kill-file nil))
3078       (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
3079   (gnus-kill-buffer nntp-server-buffer)
3080   ;; Backlog.
3081   (and gnus-keep-backlog (gnus-backlog-shutdown))
3082   ;; Kill Gnus buffers.
3083   (while gnus-buffer-list
3084     (gnus-kill-buffer (car gnus-buffer-list))
3085     (setq gnus-buffer-list (cdr gnus-buffer-list))))
3086
3087 (defun gnus-windows-old-to-new (setting)
3088   ;; First we take care of the really, really old Gnus 3 actions.
3089   (if (symbolp setting)
3090       (setq setting
3091             (cond ((memq setting '(SelectArticle))
3092                    'article)
3093                   ((memq setting '(SelectSubject ExpandSubject))
3094                    'summary)
3095                   ((memq setting '(SelectNewsgroup ExitNewsgroup))
3096                    'group)
3097                   (t setting))))
3098   (if (or (listp setting)
3099           (not (and gnus-window-configuration
3100                     (memq setting '(group summary article)))))
3101       setting
3102     (let* ((setting (if (eq setting 'group)
3103                         (if (assq 'newsgroup gnus-window-configuration)
3104                             'newsgroup
3105                           'newsgroups) setting))
3106            (elem (car (cdr (assq setting gnus-window-configuration))))
3107            (total (apply '+ elem))
3108            (types '(group summary article))
3109            (pbuf (if (eq setting 'newsgroups) 'group 'summary))
3110            (i 0)
3111            perc
3112            out)
3113       (while (< i 3)
3114         (or (not (numberp (nth i elem)))
3115             (zerop (nth i elem))
3116             (progn
3117               (setq perc  (/ (float (nth 0 elem)) total))
3118               (setq out (cons (if (eq pbuf (nth i types))
3119                                   (vector (nth i types) perc 'point)
3120                                 (vector (nth i types) perc))
3121                               out))))
3122         (setq i (1+ i)))
3123       (list (nreverse out)))))
3124
3125 (defun gnus-add-configuration (conf)
3126   "Add the window configuration CONF to `gnus-buffer-configuration'."
3127   (setq gnus-buffer-configuration
3128         (cons conf (delq (assq (car conf) gnus-buffer-configuration)
3129                          gnus-buffer-configuration))))
3130
3131 (defvar gnus-frame-list nil)
3132
3133 (defun gnus-configure-frame (split &optional window)
3134   "Split WINDOW according to SPLIT."
3135   (unless window
3136     (setq window (get-buffer-window (current-buffer))))
3137   (select-window window)
3138   ;; This might be an old-stylee buffer config.
3139   (when (vectorp split)
3140     (setq split (append split nil)))
3141   (when (or (consp (car split))
3142             (vectorp (car split)))
3143     (push 1.0 split)
3144     (push 'vertical split))
3145   ;; The SPLIT might be something that is to be evaled to
3146   ;; return a new SPLIT.
3147   (while (and (not (assq (car split) gnus-window-to-buffer))
3148               (gnus-functionp (car split)))
3149     (setq split (eval split)))
3150   (let* ((type (car split))
3151          (subs (cddr split))
3152          (len (if (eq type 'horizontal) (window-width) (window-height)))
3153          (total 0)
3154          (window-min-width (or gnus-window-min-width window-min-width))
3155          (window-min-height (or gnus-window-min-height window-min-height))
3156          s result new-win rest comp-subs size sub)
3157     (cond
3158      ;; Nothing to do here.
3159      ((null split))
3160      ;; Don't switch buffers.
3161      ((null type)
3162       (and (memq 'point split) window))
3163      ;; This is a buffer to be selected.
3164      ((not (memq type '(frame horizontal vertical)))
3165       (let ((buffer (cond ((stringp type) type)
3166                           (t (cdr (assq type gnus-window-to-buffer)))))
3167             buf)
3168         (unless buffer
3169           (error "Illegal buffer type: %s" type))
3170         (unless (setq buf (get-buffer (if (symbolp buffer)
3171                                           (symbol-value buffer) buffer)))
3172           (setq buf (get-buffer-create (if (symbolp buffer)
3173                                            (symbol-value buffer) buffer))))
3174         (switch-to-buffer buf)
3175         ;; We return the window if it has the `point' spec.
3176         (and (memq 'point split) window)))
3177      ;; This is a frame split.
3178      ((eq type 'frame)
3179       (unless gnus-frame-list
3180         (setq gnus-frame-list (list (window-frame
3181                                      (get-buffer-window (current-buffer))))))
3182       (let ((i 0)
3183             params frame fresult)
3184         (while (< i (length subs))
3185           ;; Frame parameter is gotten from the sub-split.
3186           (setq params (cadr (elt subs i)))
3187           ;; It should be a list.
3188           (unless (listp params)
3189             (setq params nil))
3190           ;; Create a new frame?
3191           (unless (setq frame (elt gnus-frame-list i))
3192             (nconc gnus-frame-list (list (setq frame (make-frame params)))))
3193           ;; Is the old frame still alive?
3194           (unless (frame-live-p frame)
3195             (setcar (nthcdr i gnus-frame-list)
3196                     (setq frame (make-frame params))))
3197           ;; Select the frame in question and do more splits there.
3198           (select-frame frame)
3199           (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
3200           (incf i))
3201         ;; Select the frame that has the selected buffer.
3202         (when fresult
3203           (select-frame (window-frame fresult)))))
3204      ;; This is a normal split.
3205      (t
3206       (when (> (length subs) 0)
3207         ;; First we have to compute the sizes of all new windows.
3208         (while subs
3209           (setq sub (append (pop subs) nil))
3210           (while (and (not (assq (car sub) gnus-window-to-buffer))
3211                       (gnus-functionp (car sub)))
3212             (setq sub (eval sub)))
3213           (when sub
3214             (push sub comp-subs)
3215             (setq size (cadar comp-subs))
3216             (cond ((equal size 1.0)
3217                    (setq rest (car comp-subs))
3218                    (setq s 0))
3219                   ((floatp size)
3220                    (setq s (floor (* size len))))
3221                   ((integerp size)
3222                    (setq s size))
3223                   (t
3224                    (error "Illegal size: %s" size)))
3225             ;; Try to make sure that we are inside the safe limits.
3226             (cond ((zerop s))
3227                   ((eq type 'horizontal)
3228                    (setq s (max s window-min-width)))
3229                   ((eq type 'vertical)
3230                    (setq s (max s window-min-height))))
3231             (setcar (cdar comp-subs) s)
3232             (incf total s)))
3233         ;; Take care of the "1.0" spec.
3234         (if rest
3235             (setcar (cdr rest) (- len total))
3236           (error "No 1.0 specs in %s" split))
3237         ;; The we do the actual splitting in a nice recursive
3238         ;; fashion.
3239         (setq comp-subs (nreverse comp-subs))
3240         (while comp-subs
3241           (if (null (cdr comp-subs))
3242               (setq new-win window)
3243             (setq new-win
3244                   (split-window window (cadar comp-subs)
3245                                 (eq type 'horizontal))))
3246           (setq result (or (gnus-configure-frame
3247                             (car comp-subs) window) result))
3248           (select-window new-win)
3249           (setq window new-win)
3250           (setq comp-subs (cdr comp-subs))))
3251       ;; Return the proper window, if any.
3252       (when result
3253         (select-window result))))))
3254
3255 (defun gnus-configure-windows (setting &optional force)
3256   (setq setting (gnus-windows-old-to-new setting))
3257   (let ((split (if (symbolp setting)
3258                    (car (cdr (assq setting gnus-buffer-configuration)))
3259                  setting))
3260         (in-buf (current-buffer))
3261         rule val w height hor ohor heights sub jump-buffer
3262         rel total to-buf all-visible)
3263
3264     (unless split
3265       (error "No such setting: %s" setting))
3266
3267     (if (and (not force) (setq all-visible (gnus-all-windows-visible-p split)))
3268         ;; All the windows mentioned are already visible, so we just
3269         ;; put point in the assigned buffer, and do not touch the
3270         ;; winconf.
3271         (select-window all-visible)
3272
3273       ;; Either remove all windows or just remove all Gnus windows.
3274       (let ((frame (selected-frame)))
3275         (unwind-protect
3276             (if gnus-use-full-window
3277                 (mapcar (lambda (frame)
3278                           (select-frame frame)
3279                           (delete-other-windows)) 
3280                         (frame-list))
3281               (gnus-remove-some-windows)
3282               (switch-to-buffer nntp-server-buffer))
3283           (select-frame frame)))
3284
3285       (switch-to-buffer nntp-server-buffer)
3286       (gnus-configure-frame split (get-buffer-window (current-buffer))))))
3287
3288 (defun gnus-all-windows-visible-p (split)
3289   (when (vectorp split)
3290     (setq split (append split nil)))
3291   (when (or (consp (car split))
3292             (vectorp (car split)))
3293     (push 1.0 split)
3294     (push 'vertical split))
3295   ;; The SPLIT might be something that is to be evaled to
3296   ;; return a new SPLIT.
3297   (while (and (not (assq (car split) gnus-window-to-buffer))
3298               (gnus-functionp (car split)))
3299     (setq split (eval split)))
3300   (let* ((type (elt split 0)))
3301     (cond
3302      ((null split)
3303       t)
3304      ((not (or (eq type 'horizontal) (eq type 'vertical) (eq type 'frame)))
3305       (let ((buffer (cond ((stringp type) type)
3306                           (t (cdr (assq type gnus-window-to-buffer)))))
3307             win buf)
3308         (unless buffer
3309           (error "Illegal buffer type: %s" type))
3310         (when (setq buf (get-buffer (if (symbolp buffer) (symbol-value buffer)
3311                                       buffer)))
3312           (setq win (get-buffer-window buf t)))
3313         (when win
3314           (if (memq 'point split)
3315               win
3316             t))))
3317      (t
3318       (let ((n (mapcar 'gnus-all-windows-visible-p
3319                        (cdr (cdr split))))
3320             (win t))
3321         (while n
3322           (cond ((windowp (car n))
3323                  (setq win (car n)))
3324                 ((null (car n))
3325                  (setq win nil)))
3326           (setq n (cdr n)))
3327         win)))))
3328
3329 (defun gnus-window-top-edge (&optional window)
3330   (nth 1 (window-edges window)))
3331
3332 (defun gnus-remove-some-windows ()
3333   (let ((buffers gnus-window-to-buffer)
3334         buf bufs lowest-buf lowest)
3335     (save-excursion
3336       ;; Remove windows on all known Gnus buffers.
3337       (while buffers
3338         (setq buf (cdr (car buffers)))
3339         (if (symbolp buf)
3340             (setq buf (and (boundp buf) (symbol-value buf))))
3341         (and buf
3342              (get-buffer-window buf)
3343              (progn
3344                (setq bufs (cons buf bufs))
3345                (pop-to-buffer buf)
3346                (if (or (not lowest)
3347                        (< (gnus-window-top-edge) lowest))
3348                    (progn
3349                      (setq lowest (gnus-window-top-edge))
3350                      (setq lowest-buf buf)))))
3351         (setq buffers (cdr buffers)))
3352       ;; Remove windows on *all* summary buffers.
3353       (let (wins)
3354         (walk-windows
3355          (lambda (win)
3356            (let ((buf (window-buffer win)))
3357              (if (string-match  "^\\*Summary" (buffer-name buf))
3358                  (progn
3359                    (setq bufs (cons buf bufs))
3360                    (pop-to-buffer buf)
3361                    (if (or (not lowest)
3362                            (< (gnus-window-top-edge) lowest))
3363                        (progn
3364                          (setq lowest-buf buf)
3365                          (setq lowest (gnus-window-top-edge))))))))))
3366       (and lowest-buf
3367            (progn
3368              (pop-to-buffer lowest-buf)
3369              (switch-to-buffer nntp-server-buffer)))
3370       (while bufs
3371         (and (not (eq (car bufs) lowest-buf))
3372              (delete-windows-on (car bufs)))
3373         (setq bufs (cdr bufs))))))
3374
3375 (defun gnus-version ()
3376   "Version numbers of this version of Gnus."
3377   (interactive)
3378   (let ((methods gnus-valid-select-methods)
3379         (mess gnus-version)
3380         meth)
3381     ;; Go through all the legal select methods and add their version
3382     ;; numbers to the total version string.  Only the backends that are
3383     ;; currently in use will have their message numbers taken into
3384     ;; consideration.
3385     (while methods
3386       (setq meth (intern (concat (car (car methods)) "-version")))
3387       (and (boundp meth)
3388            (stringp (symbol-value meth))
3389            (setq mess (concat mess "; " (symbol-value meth))))
3390       (setq methods (cdr methods)))
3391     (gnus-message 2 mess)))
3392
3393 (defun gnus-info-find-node ()
3394   "Find Info documentation of Gnus."
3395   (interactive)
3396   ;; Enlarge info window if needed.
3397   (let ((mode major-mode)
3398         gnus-info-buffer)
3399     (Info-goto-node (car (cdr (assq mode gnus-info-nodes))))
3400     (setq gnus-info-buffer (current-buffer))
3401     (gnus-configure-windows 'info)))
3402
3403 (defun gnus-days-between (date1 date2)
3404   ;; Return the number of days between date1 and date2.
3405   (- (gnus-day-number date1) (gnus-day-number date2)))
3406
3407 (defun gnus-day-number (date)
3408   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
3409                      (timezone-parse-date date))))
3410     (timezone-absolute-from-gregorian
3411      (nth 1 dat) (nth 2 dat) (car dat))))
3412
3413 (defun gnus-encode-date (date)
3414   "Convert DATE to internal time."
3415   (let* ((parse (timezone-parse-date date))
3416          (date (mapcar (lambda (d) (and d (string-to-int d))) parse))
3417          (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
3418     (encode-time (caddr time) (cadr time) (car time)
3419                  (caddr date) (cadr date) (car date) (nth 4 date))))
3420
3421 (defun gnus-time-minus (t1 t2)
3422   "Subtract two internal times."
3423   (let ((borrow (< (cadr t1) (cadr t2))))
3424     (list (- (car t1) (car t2) (if borrow 1 0))
3425           (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
3426
3427 (defun gnus-file-newer-than (file date)
3428   (let ((fdate (nth 5 (file-attributes file))))
3429     (or (> (car fdate) (car date))
3430         (and (= (car fdate) (car date))
3431              (> (nth 1 fdate) (nth 1 date))))))
3432
3433 (defmacro gnus-define-keys (keymap &rest plist)
3434   "Define all keys in PLIST in KEYMAP."
3435   `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
3436
3437 (defun gnus-define-keys-1 (keymap plist)
3438   (when (null keymap)
3439     (error "Can't set keys in a null keymap"))
3440   (cond ((symbolp keymap)
3441          (setq keymap (symbol-value keymap)))
3442         ((listp keymap)
3443          (set (car keymap) nil)
3444          (define-prefix-command (car keymap))
3445          (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
3446          (setq keymap (symbol-value (car keymap)))))
3447   (let (key)
3448     (while plist
3449       (when (symbolp (setq key (pop plist)))
3450         (setq key (symbol-value key)))
3451       (define-key keymap key (pop plist)))))
3452
3453 (defun gnus-group-read-only-p (&optional group)
3454   "Check whether GROUP supports editing or not.
3455 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
3456 that that variable is buffer-local to the summary buffers."
3457   (let ((group (or group gnus-newsgroup-name)))
3458     (not (gnus-check-backend-function 'request-replace-article group))))
3459
3460 (defun gnus-group-total-expirable-p (group)
3461   "Check whether GROUP is total-expirable or not."
3462   (let ((params (gnus-info-params (gnus-get-info group))))
3463     (or (memq 'total-expire params)
3464         (cdr (assq 'total-expire params)) ; (total-expire . t)
3465         (and gnus-total-expirable-newsgroups ; Check var.
3466              (string-match gnus-total-expirable-newsgroups group)))))
3467
3468 (defun gnus-group-auto-expirable-p (group)
3469   "Check whether GROUP is total-expirable or not."
3470   (let ((params (gnus-info-params (gnus-get-info group))))
3471     (or (memq 'auto-expire params)
3472         (cdr (assq 'auto-expire params)) ; (auto-expire . t)
3473         (and gnus-auto-expirable-newsgroups ; Check var.
3474              (string-match gnus-auto-expirable-newsgroups group)))))
3475
3476 (defun gnus-virtual-group-p (group)
3477   "Say whether GROUP is virtual or not."
3478   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
3479                         gnus-valid-select-methods)))
3480
3481 (defsubst gnus-simplify-subject-fully (subject)
3482   "Simplify a subject string according to the user's wishes."
3483   (cond
3484    ((null gnus-summary-gather-subject-limit)
3485     (gnus-simplify-subject-re subject))
3486    ((eq gnus-summary-gather-subject-limit 'fuzzy)
3487     (gnus-simplify-subject-fuzzy subject))
3488    ((numberp gnus-summary-gather-subject-limit)
3489     (gnus-limit-string (gnus-simplify-subject-re subject)
3490                        gnus-summary-gather-subject-limit))
3491    (t
3492     subject)))
3493
3494 (defsubst gnus-subject-equal (s1 s2 &optional simple-first)
3495   "Check whether two subjects are equal.  If optional argument
3496 simple-first is t, first argument is already simplified."
3497   (cond
3498    ((null simple-first)
3499     (equal (gnus-simplify-subject-fully s1)
3500            (gnus-simplify-subject-fully s2)))
3501    (t
3502     (equal s1
3503            (gnus-simplify-subject-fully s2)))))
3504
3505 ;; Returns a list of writable groups.
3506 (defun gnus-writable-groups ()
3507   (let ((alist gnus-newsrc-alist)
3508         groups)
3509     (while alist
3510       (or (gnus-group-read-only-p (car (car alist)))
3511           (setq groups (cons (car (car alist)) groups)))
3512       (setq alist (cdr alist)))
3513     (nreverse groups)))
3514
3515 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
3516 ;; the echo area.
3517 (defun gnus-y-or-n-p (prompt)
3518   (prog1
3519       (y-or-n-p prompt)
3520     (message "")))
3521
3522 (defun gnus-yes-or-no-p (prompt)
3523   (prog1
3524       (yes-or-no-p prompt)
3525     (message "")))
3526
3527 ;; Check whether to use long file names.
3528 (defun gnus-use-long-file-name (symbol)
3529   ;; The variable has to be set...
3530   (and gnus-use-long-file-name
3531        ;; If it isn't a list, then we return t.
3532        (or (not (listp gnus-use-long-file-name))
3533            ;; If it is a list, and the list contains `symbol', we
3534            ;; return nil.
3535            (not (memq symbol gnus-use-long-file-name)))))
3536
3537 ;; I suspect there's a better way, but I haven't taken the time to do
3538 ;; it yet. -erik selberg@cs.washington.edu
3539 (defun gnus-dd-mmm (messy-date)
3540   "Return a string like DD-MMM from a big messy string"
3541   (let ((datevec (timezone-parse-date messy-date)))
3542     (format "%2s-%s"
3543             (or (aref datevec 2) "??")
3544             (capitalize
3545              (or (car
3546                   (nth (1- (string-to-number (aref datevec 1)))
3547                        timezone-months-assoc))
3548                  "???")))))
3549
3550 ;; Make a hash table (default and minimum size is 255).
3551 ;; Optional argument HASHSIZE specifies the table size.
3552 (defun gnus-make-hashtable (&optional hashsize)
3553   (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
3554
3555 ;; Make a number that is suitable for hashing; bigger than MIN and one
3556 ;; less than 2^x.
3557 (defun gnus-create-hash-size (min)
3558   (let ((i 1))
3559     (while (< i min)
3560       (setq i (* 2 i)))
3561     (1- i)))
3562
3563 ;; Show message if message has a lower level than `gnus-verbose'.
3564 ;; Guideline for numbers:
3565 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
3566 ;; for things that take a long time, 7 - not very important messages
3567 ;; on stuff, 9 - messages inside loops.
3568 (defun gnus-message (level &rest args)
3569   (if (<= level gnus-verbose)
3570       (apply 'message args)
3571     ;; We have to do this format thingy here even if the result isn't
3572     ;; shown - the return value has to be the same as the return value
3573     ;; from `message'.
3574     (apply 'format args)))
3575
3576 (defun gnus-functionp (form)
3577   "Return non-nil if FORM is funcallable."
3578   (or (and (symbolp form) (fboundp form))
3579       (and (listp form) (eq (car form) 'lambda))))
3580
3581 ;; Generate a unique new group name.
3582 (defun gnus-generate-new-group-name (leaf)
3583   (let ((name leaf)
3584         (num 0))
3585     (while (gnus-gethash name gnus-newsrc-hashtb)
3586       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3587     name))
3588
3589 ;; Find out whether the gnus-visual TYPE is wanted.
3590 (defun gnus-visual-p (&optional type class)
3591   (and gnus-visual                      ; Has to be non-nil, at least.
3592        (if (not type)                   ; We don't care about type.
3593            gnus-visual
3594          (if (listp gnus-visual)        ; It's a list, so we check it.
3595              (or (memq type gnus-visual)
3596                  (memq class gnus-visual))
3597            t))))
3598
3599 (defun gnus-parent-id (references)
3600   "Return the last Message-ID in REFERENCES."
3601   (when (and references
3602              (string-match "\\(<[^<>]+>\\)[ \t\n]*\\'" references))
3603     (substring references (match-beginning 1) (match-end 1))))
3604
3605 (defun gnus-split-references (references)
3606   "Return a list of Message-IDs in REFERENCES."
3607   (let ((beg 0)
3608         ids)
3609     (while (string-match "<[^>]+>" references beg)
3610       (push (substring references (match-beginning 0) (setq beg (match-end 0)))
3611             ids))
3612     (nreverse ids)))
3613
3614 (defun gnus-ephemeral-group-p (group)
3615   "Say whether GROUP is ephemeral or not."
3616   (assoc 'quit-config (gnus-find-method-for-group group)))
3617
3618 (defun gnus-group-quit-config (group)
3619   "Return the quit-config of GROUP."
3620   (nth 1 (assoc 'quit-config (gnus-find-method-for-group group))))
3621
3622 (defun gnus-simplify-mode-line ()
3623   "Make mode lines a bit simpler."
3624   (setq mode-line-modified "-- ")
3625   (when (listp mode-line-format)
3626     (make-local-variable 'mode-line-format)
3627     (setq mode-line-format (copy-sequence mode-line-format))
3628     (when (equal (nth 3 mode-line-format) "   ")
3629       (setcar (nthcdr 3 mode-line-format) " "))))
3630
3631 ;;; List and range functions
3632
3633 (defun gnus-last-element (list)
3634   "Return last element of LIST."
3635   (while (cdr list)
3636     (setq list (cdr list)))
3637   (car list))
3638
3639 (defun gnus-copy-sequence (list)
3640   "Do a complete, total copy of a list."
3641   (if (and (consp list) (not (consp (cdr list))))
3642       (cons (car list) (cdr list))
3643     (mapcar (lambda (elem) (if (consp elem)
3644                                (if (consp (cdr elem))
3645                                    (gnus-copy-sequence elem)
3646                                  (cons (car elem) (cdr elem)))
3647                              elem))
3648             list)))
3649
3650 (defun gnus-set-difference (list1 list2)
3651   "Return a list of elements of LIST1 that do not appear in LIST2."
3652   (let ((list1 (copy-sequence list1)))
3653     (while list2
3654       (setq list1 (delq (car list2) list1))
3655       (setq list2 (cdr list2)))
3656     list1))
3657
3658 (defun gnus-sorted-complement (list1 list2)
3659   "Return a list of elements of LIST1 that do not appear in LIST2.
3660 Both lists have to be sorted over <."
3661   (let (out)
3662     (if (or (null list1) (null list2))
3663         (or list1 list2)
3664       (while (and list1 list2)
3665         (cond ((= (car list1) (car list2))
3666                (setq list1 (cdr list1)
3667                      list2 (cdr list2)))
3668               ((< (car list1) (car list2))
3669                (setq out (cons (car list1) out))
3670                (setq list1 (cdr list1)))
3671               (t
3672                (setq out (cons (car list2) out))
3673                (setq list2 (cdr list2)))))
3674       (nconc (nreverse out) (or list1 list2)))))
3675
3676 (defun gnus-intersection (list1 list2)
3677   (let ((result nil))
3678     (while list2
3679       (if (memq (car list2) list1)
3680           (setq result (cons (car list2) result)))
3681       (setq list2 (cdr list2)))
3682     result))
3683
3684 (defun gnus-sorted-intersection (list1 list2)
3685   ;; LIST1 and LIST2 have to be sorted over <.
3686   (let (out)
3687     (while (and list1 list2)
3688       (cond ((= (car list1) (car list2))
3689              (setq out (cons (car list1) out)
3690                    list1 (cdr list1)
3691                    list2 (cdr list2)))
3692             ((< (car list1) (car list2))
3693              (setq list1 (cdr list1)))
3694             (t
3695              (setq list2 (cdr list2)))))
3696     (nreverse out)))
3697
3698 (defun gnus-set-sorted-intersection (list1 list2)
3699   ;; LIST1 and LIST2 have to be sorted over <.
3700   ;; This function modifies LIST1.
3701   (let* ((top (cons nil list1))
3702          (prev top))
3703     (while (and list1 list2)
3704       (cond ((= (car list1) (car list2))
3705              (setq prev list1
3706                    list1 (cdr list1)
3707                    list2 (cdr list2)))
3708             ((< (car list1) (car list2))
3709              (setcdr prev (cdr list1))
3710              (setq list1 (cdr list1)))
3711             (t
3712              (setq list2 (cdr list2)))))
3713     (setcdr prev nil)
3714     (cdr top)))
3715
3716 (defun gnus-compress-sequence (numbers &optional always-list)
3717   "Convert list of numbers to a list of ranges or a single range.
3718 If ALWAYS-LIST is non-nil, this function will always release a list of
3719 ranges."
3720   (let* ((first (car numbers))
3721          (last (car numbers))
3722          result)
3723     (if (null numbers)
3724         nil
3725       (if (not (listp (cdr numbers)))
3726           numbers
3727         (while numbers
3728           (cond ((= last (car numbers)) nil) ;Omit duplicated number
3729                 ((= (1+ last) (car numbers)) ;Still in sequence
3730                  (setq last (car numbers)))
3731                 (t                      ;End of one sequence
3732                  (setq result
3733                        (cons (if (= first last) first
3734                                (cons first last)) result))
3735                  (setq first (car numbers))
3736                  (setq last  (car numbers))))
3737           (setq numbers (cdr numbers)))
3738         (if (and (not always-list) (null result))
3739             (if (= first last) (list first) (cons first last))
3740           (nreverse (cons (if (= first last) first (cons first last))
3741                           result)))))))
3742
3743 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
3744 (defun gnus-uncompress-range (ranges)
3745   "Expand a list of ranges into a list of numbers.
3746 RANGES is either a single range on the form `(num . num)' or a list of
3747 these ranges."
3748   (let (first last result)
3749     (cond
3750      ((null ranges)
3751       nil)
3752      ((not (listp (cdr ranges)))
3753       (setq first (car ranges))
3754       (setq last (cdr ranges))
3755       (while (<= first last)
3756         (setq result (cons first result))
3757         (setq first (1+ first)))
3758       (nreverse result))
3759      (t
3760       (while ranges
3761         (if (atom (car ranges))
3762             (if (numberp (car ranges))
3763                 (setq result (cons (car ranges) result)))
3764           (setq first (car (car ranges)))
3765           (setq last  (cdr (car ranges)))
3766           (while (<= first last)
3767             (setq result (cons first result))
3768             (setq first (1+ first))))
3769         (setq ranges (cdr ranges)))
3770       (nreverse result)))))
3771
3772 (defun gnus-add-to-range (ranges list)
3773   "Return a list of ranges that has all articles from both RANGES and LIST.
3774 Note: LIST has to be sorted over `<'."
3775   (if (not ranges)
3776       (gnus-compress-sequence list t)
3777     (setq list (copy-sequence list))
3778     (or (listp (cdr ranges))
3779         (setq ranges (list ranges)))
3780     (let ((out ranges)
3781           ilist lowest highest temp)
3782       (while (and ranges list)
3783         (setq ilist list)
3784         (setq lowest (or (and (atom (car ranges)) (car ranges))
3785                          (car (car ranges))))
3786         (while (and list (cdr list) (< (car (cdr list)) lowest))
3787           (setq list (cdr list)))
3788         (if (< (car ilist) lowest)
3789             (progn
3790               (setq temp list)
3791               (setq list (cdr list))
3792               (setcdr temp nil)
3793               (setq out (nconc (gnus-compress-sequence ilist t) out))))
3794         (setq highest (or (and (atom (car ranges)) (car ranges))
3795                           (cdr (car ranges))))
3796         (while (and list (<= (car list) highest))
3797           (setq list (cdr list)))
3798         (setq ranges (cdr ranges)))
3799       (if list
3800           (setq out (nconc (gnus-compress-sequence list t) out)))
3801       (setq out (sort out (lambda (r1 r2)
3802                             (< (or (and (atom r1) r1) (car r1))
3803                                (or (and (atom r2) r2) (car r2))))))
3804       (setq ranges out)
3805       (while ranges
3806         (if (atom (car ranges))
3807             (if (cdr ranges)
3808                 (if (atom (car (cdr ranges)))
3809                     (if (= (1+ (car ranges)) (car (cdr ranges)))
3810                         (progn
3811                           (setcar ranges (cons (car ranges)
3812                                                (car (cdr ranges))))
3813                           (setcdr ranges (cdr (cdr ranges)))))
3814                   (if (= (1+ (car ranges)) (car (car (cdr ranges))))
3815                       (progn
3816                         (setcar (car (cdr ranges)) (car ranges))
3817                         (setcar ranges (car (cdr ranges)))
3818                         (setcdr ranges (cdr (cdr ranges)))))))
3819           (if (cdr ranges)
3820               (if (atom (car (cdr ranges)))
3821                   (if (= (1+ (cdr (car ranges))) (car (cdr ranges)))
3822                       (progn
3823                         (setcdr (car ranges) (car (cdr ranges)))
3824                         (setcdr ranges (cdr (cdr ranges)))))
3825                 (if (= (1+ (cdr (car ranges))) (car (car (cdr ranges))))
3826                     (progn
3827                       (setcdr (car ranges) (cdr (car (cdr ranges))))
3828                       (setcdr ranges (cdr (cdr ranges))))))))
3829         (setq ranges (cdr ranges)))
3830       out)))
3831
3832 (defun gnus-remove-from-range (ranges list)
3833   "Return a list of ranges that has all articles from LIST removed from RANGES.
3834 Note: LIST has to be sorted over `<'."
3835   ;; !!! This function shouldn't look like this, but I've got a headache.
3836   (gnus-compress-sequence
3837    (gnus-sorted-complement
3838     (gnus-uncompress-range ranges) list)))
3839
3840 (defun gnus-member-of-range (number ranges)
3841   (if (not (listp (cdr ranges)))
3842       (and (>= number (car ranges))
3843            (<= number (cdr ranges)))
3844     (let ((not-stop t))
3845       (while (and ranges
3846                   (if (numberp (car ranges))
3847                       (>= number (car ranges))
3848                     (>= number (car (car ranges))))
3849                   not-stop)
3850         (if (if (numberp (car ranges))
3851                 (= number (car ranges))
3852               (and (>= number (car (car ranges)))
3853                    (<= number (cdr (car ranges)))))
3854             (setq not-stop nil))
3855         (setq ranges (cdr ranges)))
3856       (not not-stop))))
3857
3858 (defun gnus-range-length (range)
3859   "Return the length RANGE would have if uncompressed."
3860   (length (gnus-uncompress-range range)))
3861
3862 (defun gnus-sublist-p (list sublist)
3863   "Test whether all elements in SUBLIST are members of LIST."
3864   (let ((sublistp t))
3865     (while sublist
3866       (unless (memq (pop sublist) list)
3867         (setq sublistp nil
3868               sublist nil)))
3869     sublistp))
3870
3871 \f
3872 ;;;
3873 ;;; Gnus group mode
3874 ;;;
3875
3876 (defvar gnus-group-mode-map nil)
3877 (put 'gnus-group-mode 'mode-class 'special)
3878
3879 (unless gnus-group-mode-map
3880   (setq gnus-group-mode-map (make-keymap))
3881   (suppress-keymap gnus-group-mode-map)
3882
3883   (gnus-define-keys
3884    gnus-group-mode-map
3885    " " gnus-group-read-group
3886    "=" gnus-group-select-group
3887    "\M- " gnus-group-unhidden-select-group
3888    "\r" gnus-group-select-group
3889    "\M-\r" gnus-group-quick-select-group
3890    "j" gnus-group-jump-to-group
3891    "n" gnus-group-next-unread-group
3892    "p" gnus-group-prev-unread-group
3893    "\177" gnus-group-prev-unread-group
3894    "N" gnus-group-next-group
3895    "P" gnus-group-prev-group
3896    "\M-n" gnus-group-next-unread-group-same-level
3897    "\M-p" gnus-group-prev-unread-group-same-level
3898    "," gnus-group-best-unread-group
3899    "." gnus-group-first-unread-group
3900    "u" gnus-group-unsubscribe-current-group
3901    "U" gnus-group-unsubscribe-group
3902    "c" gnus-group-catchup-current
3903    "C" gnus-group-catchup-current-all
3904    "l" gnus-group-list-groups
3905    "L" gnus-group-list-all-groups
3906    "m" gnus-group-mail
3907    "g" gnus-group-get-new-news
3908    "\M-g" gnus-group-get-new-news-this-group
3909    "R" gnus-group-restart
3910    "r" gnus-group-read-init-file
3911    "B" gnus-group-browse-foreign-server
3912    "b" gnus-group-check-bogus-groups
3913    "F" gnus-find-new-newsgroups
3914    "\C-c\C-d" gnus-group-describe-group
3915    "\M-d" gnus-group-describe-all-groups
3916    "\C-c\C-a" gnus-group-apropos
3917    "\C-c\M-\C-a" gnus-group-description-apropos
3918    "a" gnus-group-post-news
3919    "\ek" gnus-group-edit-local-kill
3920    "\eK" gnus-group-edit-global-kill
3921    "\C-k" gnus-group-kill-group
3922    "\C-y" gnus-group-yank-group
3923    "\C-w" gnus-group-kill-region
3924    "\C-x\C-t" gnus-group-transpose-groups
3925    "\C-c\C-l" gnus-group-list-killed
3926    "\C-c\C-x" gnus-group-expire-articles
3927    "\C-c\M-\C-x" gnus-group-expire-all-groups
3928    "V" gnus-version
3929    "s" gnus-group-save-newsrc
3930    "z" gnus-group-suspend
3931    "Z" gnus-group-clear-dribble
3932    "q" gnus-group-exit
3933    "Q" gnus-group-quit
3934    "?" gnus-group-describe-briefly
3935    "\C-c\C-i" gnus-info-find-node
3936    "\M-e" gnus-group-edit-group-method
3937    "^" gnus-group-enter-server-mode
3938    gnus-mouse-2 gnus-mouse-pick-group
3939    "<" beginning-of-buffer
3940    ">" end-of-buffer
3941    "\C-c\C-b" gnus-bug
3942    "\C-c\C-s" gnus-group-sort-groups
3943    "t" gnus-topic-mode
3944    "\C-c\M-g" gnus-activate-all-groups
3945    "\M-&" gnus-group-universal-argument
3946    "#" gnus-group-mark-group
3947    "\M-#" gnus-group-unmark-group)
3948
3949   (gnus-define-keys
3950    (gnus-group-mark-map "M" gnus-group-mode-map)
3951    "m" gnus-group-mark-group
3952    "u" gnus-group-unmark-group
3953    "w" gnus-group-mark-region
3954    "m" gnus-group-mark-buffer
3955    "r" gnus-group-mark-regexp
3956    "U" gnus-group-unmark-all-groups)
3957
3958   (gnus-define-keys
3959    (gnus-group-group-map "G" gnus-group-mode-map)
3960    "d" gnus-group-make-directory-group
3961    "h" gnus-group-make-help-group
3962    "a" gnus-group-make-archive-group
3963    "k" gnus-group-make-kiboze-group
3964    "m" gnus-group-make-group
3965    "E" gnus-group-edit-group
3966    "e" gnus-group-edit-group-method
3967    "p" gnus-group-edit-group-parameters
3968    "v" gnus-group-add-to-virtual
3969    "V" gnus-group-make-empty-virtual
3970    "D" gnus-group-enter-directory
3971    "f" gnus-group-make-doc-group
3972    "r" gnus-group-rename-group
3973    "\177" gnus-group-delete-group)
3974
3975    (gnus-define-keys
3976     (gnus-group-soup-map "s" gnus-group-group-map)
3977     "b" gnus-group-brew-soup
3978     "w" gnus-soup-save-areas
3979     "s" gnus-soup-send-replies
3980     "p" gnus-soup-pack-packet
3981     "r" nnsoup-pack-replies)
3982
3983    (gnus-define-keys
3984     (gnus-group-sort-map "S" gnus-group-group-map)
3985     "s" gnus-group-sort-groups
3986     "a" gnus-group-sort-groups-by-alphabet
3987     "u" gnus-group-sort-groups-by-unread
3988     "l" gnus-group-sort-groups-by-level
3989     "v" gnus-group-sort-groups-by-score
3990     "r" gnus-group-sort-groups-by-rank
3991     "m" gnus-group-sort-groups-by-method)
3992
3993    (gnus-define-keys
3994     (gnus-group-list-map "A" gnus-group-mode-map)
3995     "k" gnus-group-list-killed
3996     "z" gnus-group-list-zombies
3997     "s" gnus-group-list-groups
3998     "u" gnus-group-list-all-groups
3999     "A" gnus-group-list-active
4000     "a" gnus-group-apropos
4001     "d" gnus-group-description-apropos
4002     "m" gnus-group-list-matching
4003     "M" gnus-group-list-all-matching
4004     "l" gnus-group-list-level)
4005
4006    (gnus-define-keys
4007     (gnus-group-score-map "W" gnus-group-mode-map)
4008     "f" gnus-score-flush-cache)
4009
4010    (gnus-define-keys
4011     (gnus-group-help-map "H" gnus-group-mode-map)
4012     "f" gnus-group-fetch-faq)
4013
4014    (gnus-define-keys
4015     (gnus-group-sub-map "S" gnus-group-mode-map)
4016     "l" gnus-group-set-current-level
4017     "t" gnus-group-unsubscribe-current-group
4018     "s" gnus-group-unsubscribe-group
4019     "k" gnus-group-kill-group
4020     "y" gnus-group-yank-group
4021     "w" gnus-group-kill-region
4022     "\C-k" gnus-group-kill-level
4023     "z" gnus-group-kill-all-zombies))
4024
4025 (defun gnus-group-mode ()
4026   "Major mode for reading news.
4027
4028 All normal editing commands are switched off.
4029 \\<gnus-group-mode-map>
4030 The group buffer lists (some of) the groups available.  For instance,
4031 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
4032 lists all zombie groups.
4033
4034 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
4035 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
4036
4037 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
4038
4039 The following commands are available:
4040
4041 \\{gnus-group-mode-map}"
4042   (interactive)
4043   (when (and menu-bar-mode
4044              (gnus-visual-p 'group-menu 'menu))
4045     (gnus-group-make-menu-bar))
4046   (kill-all-local-variables)
4047   (gnus-simplify-mode-line)
4048   (setq major-mode 'gnus-group-mode)
4049   (setq mode-name "Group")
4050   (gnus-group-set-mode-line)
4051   (setq mode-line-process nil)
4052   (use-local-map gnus-group-mode-map)
4053   (buffer-disable-undo (current-buffer))
4054   (setq truncate-lines t)
4055   (setq buffer-read-only t)
4056   (run-hooks 'gnus-group-mode-hook))
4057
4058 (defun gnus-mouse-pick-group (e)
4059   "Enter the group under the mouse pointer."
4060   (interactive "e")
4061   (mouse-set-point e)
4062   (gnus-group-read-group nil))
4063
4064 ;; Look at LEVEL and find out what the level is really supposed to be.
4065 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
4066 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
4067 (defun gnus-group-default-level (&optional level number-or-nil)
4068   (cond
4069    (gnus-group-use-permanent-levels
4070     (setq gnus-group-default-list-level
4071           (or level gnus-group-default-list-level))
4072     (or gnus-group-default-list-level gnus-level-subscribed))
4073    (number-or-nil
4074     level)
4075    (t
4076     (or level gnus-group-default-list-level gnus-level-subscribed))))
4077
4078 ;;;###autoload
4079 (defun gnus-slave-no-server (&optional arg)
4080   "Read network news as a slave, without connecting to local server"
4081   (interactive "P")
4082   (gnus-no-server arg t))
4083
4084 ;;;###autoload
4085 (defun gnus-no-server (&optional arg slave)
4086   "Read network news.
4087 If ARG is a positive number, Gnus will use that as the
4088 startup level.  If ARG is nil, Gnus will be started at level 2.
4089 If ARG is non-nil and not a positive number, Gnus will
4090 prompt the user for the name of an NNTP server to use.
4091 As opposed to `gnus', this command will not connect to the local server."
4092   (interactive "P")
4093   (make-local-variable 'gnus-group-use-permanent-levels)
4094   (setq gnus-group-use-permanent-levels t)
4095   (gnus (or arg (1- gnus-level-default-subscribed)) t slave))
4096
4097 ;;;###autoload
4098 (defun gnus-slave (&optional arg)
4099   "Read news as a slave."
4100   (interactive "P")
4101   (gnus arg nil 'slave))
4102
4103 ;;;###autoload
4104 (defun gnus-other-frame (&optional arg)
4105   "Pop up a frame to read news."
4106   (interactive "P")
4107   (if (get-buffer gnus-group-buffer)
4108       (let ((pop-up-frames t))
4109         (gnus arg))
4110     (select-frame (make-frame))
4111     (gnus arg)))
4112
4113 ;;;###autoload
4114 (defun gnus (&optional arg dont-connect slave)
4115   "Read network news.
4116 If ARG is non-nil and a positive number, Gnus will use that as the
4117 startup level.  If ARG is non-nil and not a positive number, Gnus will
4118 prompt the user for the name of an NNTP server to use."
4119   (interactive "P")
4120
4121   (if (get-buffer gnus-group-buffer)
4122       (progn
4123         (switch-to-buffer gnus-group-buffer)
4124         (gnus-group-get-new-news))
4125
4126     (gnus-clear-system)
4127     (nnheader-init-server-buffer)
4128     (gnus-read-init-file)
4129     (setq gnus-slave slave)
4130
4131     (gnus-group-setup-buffer)
4132     (let ((buffer-read-only nil))
4133       (erase-buffer)
4134       (if (not gnus-inhibit-startup-message)
4135           (progn
4136             (gnus-group-startup-message)
4137             (sit-for 0))))
4138
4139     (let ((level (and (numberp arg) (> arg 0) arg))
4140           did-connect)
4141       (unwind-protect
4142           (progn
4143             (or dont-connect
4144                 (setq did-connect
4145                       (gnus-start-news-server (and arg (not level))))))
4146         (if (and (not dont-connect)
4147                  (not did-connect))
4148             (gnus-group-quit)
4149           (run-hooks 'gnus-startup-hook)
4150           ;; NNTP server is successfully open.
4151
4152           ;; Find the current startup file name.
4153           (setq gnus-current-startup-file
4154                 (gnus-make-newsrc-file gnus-startup-file))
4155
4156           ;; Read the dribble file.
4157           (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
4158
4159           (gnus-summary-make-display-table)
4160           ;; Do the actual startup.
4161           (gnus-setup-news nil level)
4162           ;; Generate the group buffer.
4163           (gnus-group-list-groups level)
4164           (gnus-group-first-unread-group)
4165           (gnus-configure-windows 'group)
4166           (gnus-group-set-mode-line))))))
4167
4168 (defun gnus-unload ()
4169   "Unload all Gnus features."
4170   (interactive)
4171   (or (boundp 'load-history)
4172       (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
4173   (let ((history load-history)
4174         feature)
4175     (while history
4176       (and (string-match "^\\(gnus\\|nn\\)" (caar history))
4177            (setq feature (cdr (assq 'provide (car history))))
4178            (unload-feature feature 'force))
4179       (setq history (cdr history)))))
4180
4181 (defun gnus-compile ()
4182   "Byte-compile the user-defined format specs."
4183   (interactive)
4184   (let ((entries gnus-format-specs)
4185         entry gnus-tmp-func)
4186     (save-excursion
4187       (gnus-message 7 "Compiling format specs...")
4188
4189       (while entries
4190         (setq entry (pop entries))
4191         (if (eq (car entry) 'version)
4192             (setq gnus-format-specs (delq entry gnus-format-specs))
4193           (when (and (listp (caddr entry))
4194                      (not (eq 'byte-code (caaddr entry))))
4195             (fset 'gnus-tmp-func
4196                   `(lambda () ,(caddr entry)))
4197             (byte-compile 'gnus-tmp-func)
4198             (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
4199
4200       (push (cons 'version emacs-version) gnus-format-specs)
4201
4202       (gnus-message 7 "Compiling user specs...done"))))
4203
4204 (defun gnus-indent-rigidly (start end arg)
4205   "Indent rigidly using only spaces and no tabs."
4206   (save-excursion
4207     (save-restriction
4208       (narrow-to-region start end)
4209       (indent-rigidly start end arg)
4210       (goto-char (point-min))
4211       (while (search-forward "\t" nil t)
4212         (replace-match "        " t t)))))
4213
4214 (defun gnus-group-startup-message (&optional x y)
4215   "Insert startup message in current buffer."
4216   ;; Insert the message.
4217   (erase-buffer)
4218   (insert
4219    (format "              %s
4220           _    ___ _             _
4221           _ ___ __ ___  __    _ ___
4222           __   _     ___    __  ___
4223               _           ___     _
4224              _  _ __             _
4225              ___   __            _
4226                    __           _
4227                     _      _   _
4228                    _      _    _
4229                       _  _    _
4230                   __  ___
4231                  _   _ _     _
4232                 _   _
4233               _    _
4234              _    _
4235             _
4236           __
4237
4238 "
4239            ""))
4240   ;; And then hack it.
4241   (gnus-indent-rigidly (point-min) (point-max)
4242                        (/ (max (- (window-width) (or x 46)) 0) 2))
4243   (goto-char (point-min))
4244   (forward-line 1)
4245   (let* ((pheight (count-lines (point-min) (point-max)))
4246          (wheight (window-height))
4247          (rest (- wheight pheight)))
4248     (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
4249   ;; Fontify some.
4250   (goto-char (point-min))
4251   (and (search-forward "Praxis" nil t)
4252        (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
4253   (goto-char (point-min))
4254   (let* ((mode-string (gnus-group-set-mode-line)))
4255     (setq mode-line-buffer-identification
4256           (list (concat gnus-version (substring (car mode-string) 4))))
4257     (set-buffer-modified-p t)))
4258
4259 (defun gnus-group-setup-buffer ()
4260   (or (get-buffer gnus-group-buffer)
4261       (progn
4262         (switch-to-buffer gnus-group-buffer)
4263         (gnus-add-current-to-buffer-list)
4264         (gnus-group-mode)
4265         (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
4266
4267 (defun gnus-group-list-groups (&optional level unread lowest)
4268   "List newsgroups with level LEVEL or lower that have unread articles.
4269 Default is all subscribed groups.
4270 If argument UNREAD is non-nil, groups with no unread articles are also
4271 listed."
4272   (interactive (list (if current-prefix-arg
4273                          (prefix-numeric-value current-prefix-arg)
4274                        (or
4275                         (gnus-group-default-level nil t)
4276                         gnus-group-default-list-level
4277                         gnus-level-subscribed))))
4278   (or level
4279       (setq level (car gnus-group-list-mode)
4280             unread (cdr gnus-group-list-mode)))
4281   (setq level (gnus-group-default-level level))
4282   (gnus-group-setup-buffer)             ;May call from out of group buffer
4283   (gnus-update-format-specifications)
4284   (let ((case-fold-search nil)
4285         (props (text-properties-at (gnus-point-at-bol)))
4286         (group (gnus-group-group-name)))
4287     (funcall gnus-group-prepare-function level unread lowest)
4288     (if (zerop (buffer-size))
4289         (gnus-message 5 gnus-no-groups-message)
4290       (goto-char (point-max))
4291       (when (or (not gnus-group-goto-next-group-function)
4292                 (not (funcall gnus-group-goto-next-group-function 
4293                               group props)))
4294         (if (not group)
4295             ;; Go to the first group with unread articles.
4296             (gnus-group-search-forward t)
4297           ;; Find the right group to put point on.  If the current group
4298           ;; has disappeared in the new listing, try to find the next
4299           ;; one.        If no next one can be found, just leave point at the
4300           ;; first newsgroup in the buffer.
4301           (if (not (gnus-goto-char
4302                     (text-property-any
4303                      (point-min) (point-max)
4304                      'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
4305               (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
4306                 (while (and newsrc
4307                             (not (gnus-goto-char
4308                                   (text-property-any
4309                                    (point-min) (point-max) 'gnus-group
4310                                    (gnus-intern-safe
4311                                     (car (car newsrc)) gnus-active-hashtb)))))
4312                   (setq newsrc (cdr newsrc)))
4313                 (or newsrc (progn (goto-char (point-max))
4314                                   (forward-line -1)))))))
4315       ;; Adjust cursor point.
4316       (gnus-group-position-point))))
4317
4318 (defun gnus-group-list-level (level &optional all)
4319   "List groups on LEVEL.
4320 If ALL (the prefix), also list groups that have no unread articles."
4321   (interactive "nList groups on level: \nP")
4322   (gnus-group-list-groups level all level))
4323
4324 (defun gnus-group-prepare-flat (level &optional all lowest regexp)
4325   "List all newsgroups with unread articles of level LEVEL or lower.
4326 If ALL is non-nil, list groups that have no unread articles.
4327 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
4328 If REGEXP, only list groups matching REGEXP."
4329   (set-buffer gnus-group-buffer)
4330   (let ((buffer-read-only nil)
4331         (newsrc (cdr gnus-newsrc-alist))
4332         (lowest (or lowest 1))
4333         info clevel unread group params)
4334     (erase-buffer)
4335     (if (< lowest gnus-level-zombie)
4336         ;; List living groups.
4337         (while newsrc
4338           (setq info (car newsrc)
4339                 group (gnus-info-group info)
4340                 params (gnus-info-params info)
4341                 newsrc (cdr newsrc)
4342                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
4343           (and unread                   ; This group might be bogus
4344                (or (not regexp)
4345                    (string-match regexp group))
4346                (<= (setq clevel (gnus-info-level info)) level)
4347                (>= clevel lowest)
4348                (or all                  ; We list all groups?
4349                    (and gnus-group-list-inactive-groups
4350                         (eq unread t))  ; We list unactivated groups
4351                    (> unread 0)         ; We list groups with unread articles
4352                    (and gnus-list-groups-with-ticked-articles
4353                         (cdr (assq 'tick (gnus-info-marks info))))
4354                                         ; And groups with tickeds
4355                    ;; Check for permanent visibility.
4356                    (and gnus-permanently-visible-groups
4357                         (string-match gnus-permanently-visible-groups
4358                                       group))
4359                    (memq 'visible params)
4360                    (cdr (assq 'visible params)))
4361                (gnus-group-insert-group-line
4362                 group (gnus-info-level info)
4363                 (gnus-info-marks info) unread (gnus-info-method info)))))
4364
4365     ;; List dead groups.
4366     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
4367          (gnus-group-prepare-flat-list-dead
4368           (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
4369           gnus-level-zombie ?Z
4370           regexp))
4371     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
4372          (gnus-group-prepare-flat-list-dead
4373           (setq gnus-killed-list (sort gnus-killed-list 'string<))
4374           gnus-level-killed ?K regexp))
4375
4376     (gnus-group-set-mode-line)
4377     (setq gnus-group-list-mode (cons level all))
4378     (run-hooks 'gnus-group-prepare-hook)))
4379
4380 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
4381   ;; List zombies and killed lists somewhat faster, which was
4382   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
4383   ;; this by ignoring the group format specification altogether.
4384   (let (group beg)
4385     (if regexp
4386         ;; This loop is used when listing groups that match some
4387         ;; regexp.
4388         (while groups
4389           (setq group (pop groups))
4390           (when (string-match regexp group)
4391             (add-text-properties
4392              (point) (prog1 (1+ (point))
4393                        (insert " " mark "     *: " group "\n"))
4394              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4395                    'gnus-unread t
4396                    'gnus-level level))))
4397       ;; This loop is used when listing all groups.
4398       (while groups
4399         (add-text-properties
4400          (point) (prog1 (1+ (point))
4401                    (insert " " mark "     *: "
4402                            (setq group (pop groups)) "\n"))
4403          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4404                'gnus-unread t
4405                'gnus-level level))))))
4406
4407 (defmacro gnus-group-real-name (group)
4408   "Find the real name of a foreign newsgroup."
4409   `(let ((gname ,group))
4410      (if (string-match ":[^:]+$" gname)
4411          (substring gname (1+ (match-beginning 0)))
4412        gname)))
4413
4414 (defsubst gnus-server-add-address (method)
4415   (let ((method-name (symbol-name (car method))))
4416     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
4417              (not (assq (intern (concat method-name "-address")) method)))
4418         (append method (list (list (intern (concat method-name "-address"))
4419                                    (nth 1 method))))
4420       method)))
4421
4422 (defsubst gnus-server-get-method (group method)
4423   ;; Input either a server name, and extended server name, or a
4424   ;; select method, and return a select method.
4425   (cond ((stringp method)
4426          (gnus-server-to-method method))
4427         ((and (stringp (car method)) group)
4428          (gnus-server-extend-method group method))
4429         (t
4430          (gnus-server-add-address method))))
4431
4432 (defun gnus-server-to-method (server)
4433   "Map virtual server names to select methods."
4434   (or (and (equal server "native") gnus-select-method)
4435       (cdr (assoc server gnus-server-alist))))
4436
4437 (defmacro gnus-server-equal (ss1 ss2)
4438   "Say whether two servers are equal."
4439   `(let ((s1 ,ss1)
4440          (s2 ,ss2))
4441      (or (equal s1 s2)
4442          (and (= (length s1) (length s2))
4443               (progn
4444                 (while (and s1 (member (car s1) s2))
4445                   (setq s1 (cdr s1)))
4446                 (null s1))))))
4447
4448 (defun gnus-group-prefixed-name (group method)
4449   "Return the whole name from GROUP and METHOD."
4450   (and (stringp method) (setq method (gnus-server-to-method method)))
4451   (concat (format "%s" (car method))
4452           (if (and
4453                (assoc (format "%s" (car method)) (gnus-methods-using 'address))
4454                (not (string= (nth 1 method) "")))
4455               (concat "+" (nth 1 method)))
4456           ":" group))
4457
4458 (defun gnus-group-real-prefix (group)
4459   "Return the prefix of the current group name."
4460   (if (string-match "^[^:]+:" group)
4461       (substring group 0 (match-end 0))
4462     ""))
4463
4464 (defun gnus-group-method-name (group)
4465   "Return the method used for selecting GROUP."
4466   (let ((prefix (gnus-group-real-prefix group)))
4467     (if (equal prefix "")
4468         gnus-select-method
4469       (if (string-match "^[^\\+]+\\+" prefix)
4470           (list (intern (substring prefix 0 (1- (match-end 0))))
4471                 (substring prefix (match-end 0) (1- (length prefix))))
4472         (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
4473
4474 (defsubst gnus-secondary-method-p (method)
4475   "Return whether METHOD is a secondary select method."
4476   (let ((methods gnus-secondary-select-methods)
4477         (gmethod (gnus-server-get-method nil method)))
4478     (while (and methods
4479                 (not (equal (gnus-server-get-method nil (car methods))
4480                             gmethod)))
4481       (setq methods (cdr methods)))
4482     methods))
4483
4484 (defun gnus-group-foreign-p (group)
4485   "Say whether a group is foreign or not."
4486   (and (not (gnus-group-native-p group))
4487        (not (gnus-group-secondary-p group))))
4488
4489 (defun gnus-group-native-p (group)
4490   "Say whether the group is native or not."
4491   (not (string-match ":" group)))
4492
4493 (defun gnus-group-secondary-p (group)
4494   "Say whether the group is secondary or not."
4495   (gnus-secondary-method-p (gnus-find-method-for-group group)))
4496
4497 (defun gnus-group-get-parameter (group &optional symbol)
4498   "Returns the group parameters for GROUP.
4499 If SYMBOL, return the value of that symbol in the group parameters."
4500   (let ((params (gnus-info-params (gnus-get-info group))))
4501     (if symbol
4502         (gnus-group-parameter-value params symbol)
4503       params)))
4504
4505 (defun gnus-group-parameter-value (params symbol)
4506   "Return the value of SYMBOL in group PARAMS."
4507   (or (car (memq symbol params))        ; It's either a simple symbol
4508       (cdr (assq symbol params))))      ; or a cons.
4509
4510 (defun gnus-group-add-parameter (group param)
4511   "Add parameter PARAM to GROUP."
4512   (let ((info (gnus-get-info group)))
4513     (if (not info)
4514         () ; This is a dead group.  We just ignore it.
4515       ;; Cons the new param to the old one and update.
4516       (gnus-group-set-info (cons param (gnus-info-params info))
4517                            group 'params))))
4518
4519 (defun gnus-group-add-score (group &optional score)
4520   "Add SCORE to the GROUP score.
4521 If SCORE is nil, add 1 to the score of GROUP."
4522   (let ((info (gnus-get-info group)))
4523     (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))
4524
4525 (defun gnus-summary-bubble-group ()
4526   "Increase the score of the current group.
4527 This is a handy function to add to `gnus-summary-exit-hook' to
4528 increase the score of each group you read."
4529   (gnus-group-add-score gnus-newsgroup-name))
4530
4531 (defun gnus-group-set-info (info &optional method-only-group part)
4532   (let* ((entry (gnus-gethash
4533                  (or method-only-group (gnus-info-group info))
4534                  gnus-newsrc-hashtb))
4535          (part-info info)
4536          (info (if method-only-group (nth 2 entry) info)))
4537     (when method-only-group
4538       (unless entry
4539         (error "Trying to change non-existent group %s" method-only-group))
4540       ;; We have received parts of the actual group info - either the
4541       ;; select method or the group parameters.  We first check
4542       ;; whether we have to extend the info, and if so, do that.
4543       (let ((len (length info))
4544             (total (if (eq part 'method) 5 6)))
4545         (when (< len total)
4546           (setcdr (nthcdr (1- len) info)
4547                   (make-list (- total len) nil)))
4548         ;; Then we enter the new info.
4549         (setcar (nthcdr (1- total) info) part-info)))
4550     (unless entry
4551       ;; This is a new group, so we just create it.
4552       (save-excursion
4553         (set-buffer gnus-group-buffer)
4554         (if (gnus-info-method info)
4555             ;; It's a foreign group...
4556             (gnus-group-make-group
4557              (gnus-group-real-name (gnus-info-group info))
4558              (prin1-to-string (car (gnus-info-method info)))
4559              (nth 1 (gnus-info-method info)))
4560           ;; It's a native group.
4561           (gnus-group-make-group (gnus-info-group info)))
4562         (gnus-message 6 "Note: New group created")
4563         (setq entry
4564               (gnus-gethash (gnus-group-prefixed-name
4565                              (gnus-group-real-name (gnus-info-group info))
4566                              (or (gnus-info-method info) gnus-select-method))
4567                             gnus-newsrc-hashtb))))
4568     ;; Whether it was a new group or not, we now have the entry, so we
4569     ;; can do the update.
4570     (if entry
4571         (progn
4572           (setcar (nthcdr 2 entry) info)
4573           (when (and (not (eq (car entry) t))
4574                      (gnus-active (gnus-info-group info)))
4575             (let ((marked (gnus-info-marks info)))
4576               (setcar entry (length (gnus-list-of-unread-articles
4577                                      (car info)))))))
4578       (error "No such group: %s" (gnus-info-group info)))))
4579
4580 (defun gnus-group-set-method-info (group select-method)
4581   (gnus-group-set-info select-method group 'method))
4582
4583 (defun gnus-group-set-params-info (group params)
4584   (gnus-group-set-info params group 'params))
4585
4586 (defun gnus-group-update-group-line ()
4587   "Update the current line in the group buffer."
4588   (let* ((buffer-read-only nil)
4589          (group (gnus-group-group-name))
4590          (gnus-group-indentation (gnus-group-group-indentation))
4591          (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
4592     (and entry
4593          (not (gnus-ephemeral-group-p group))
4594          (gnus-dribble-enter
4595           (concat "(gnus-group-set-info '"
4596                   (prin1-to-string (nth 2 entry)) ")")))
4597     (gnus-delete-line)
4598     (gnus-group-insert-group-line-info group)
4599     (forward-line -1)
4600     (gnus-group-position-point)))
4601
4602 (defun gnus-group-insert-group-line-info (group)
4603   "Insert GROUP on the current line."
4604   (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
4605         active info)
4606     (if entry
4607         (progn
4608           ;; (Un)subscribed group.
4609           (setq info (nth 2 entry))
4610           (gnus-group-insert-group-line
4611            group (gnus-info-level info) (gnus-info-marks info)
4612            (or (car entry) t) (gnus-info-method info)))
4613       ;; This group is dead.
4614       (gnus-group-insert-group-line
4615        group
4616        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
4617        nil
4618        (if (setq active (gnus-active group))
4619            (- (1+ (cdr active)) (car active)) 0)
4620        nil))))
4621
4622 (defun gnus-group-insert-group-line
4623   (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number
4624                   gnus-tmp-method)
4625   "Insert a group line in the group buffer."
4626   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
4627          (gnus-tmp-number-total
4628           (if gnus-tmp-active
4629               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
4630             0))
4631          (gnus-tmp-number-of-unread
4632           (if (numberp number) (int-to-string (max 0 number))
4633             "*"))
4634          (gnus-tmp-number-of-read
4635           (if (numberp number)
4636               (int-to-string (max 0 (- gnus-tmp-number-total number)))
4637             "*"))
4638          (gnus-tmp-subscribed
4639           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
4640                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
4641                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
4642                 (t ?K)))
4643          (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
4644          (gnus-tmp-newsgroup-description
4645           (if gnus-description-hashtb
4646               (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
4647             ""))
4648          (gnus-tmp-moderated
4649           (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
4650          (gnus-tmp-moderated-string
4651           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
4652          (gnus-tmp-method
4653           (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
4654          (gnus-tmp-news-server (or (car (cdr gnus-tmp-method)) ""))
4655          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
4656          (gnus-tmp-news-method-string
4657           (if gnus-tmp-method
4658               (format "(%s:%s)" (car gnus-tmp-method)
4659                       (car (cdr gnus-tmp-method))) ""))
4660          (gnus-tmp-marked-mark
4661           (if (and (numberp number)
4662                    (zerop number)
4663                    (cdr (assq 'tick gnus-tmp-marked)))
4664               ?* ? ))
4665          (gnus-tmp-process-marked
4666           (if (member gnus-tmp-group gnus-group-marked)
4667               gnus-process-mark ? ))
4668          (buffer-read-only nil)
4669          header gnus-tmp-header)                        ; passed as parameter to user-funcs.
4670     (beginning-of-line)
4671     (add-text-properties
4672      (point)
4673      (prog1 (1+ (point))
4674        ;; Insert the text.
4675        (eval gnus-group-line-format-spec))
4676      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
4677        gnus-unread ,(if (numberp number)
4678                         (string-to-int gnus-tmp-number-of-unread)
4679                       t)
4680        gnus-marked ,gnus-tmp-marked-mark
4681        gnus-indentation ,gnus-group-indentation
4682        gnus-level ,gnus-tmp-level))
4683     (when (gnus-visual-p 'group-highlight 'highlight)
4684       (forward-line -1)
4685       (run-hooks 'gnus-group-update-hook)
4686       (forward-line))
4687     ;; Allow XEmacs to remove front-sticky text properties.
4688     (gnus-group-remove-excess-properties)))
4689
4690 (defun gnus-group-update-group (group &optional visible-only)
4691   "Update all lines where GROUP appear.
4692 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
4693 already."
4694   (save-excursion
4695     (set-buffer gnus-group-buffer)
4696     ;; The buffer may be narrowed.
4697     (save-restriction
4698       (widen)
4699       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
4700             (loc (point-min))
4701             found buffer-read-only visible)
4702         ;; Enter the current status into the dribble buffer.
4703         (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
4704           (if (and entry (not (gnus-ephemeral-group-p group)))
4705               (gnus-dribble-enter
4706                (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
4707                        ")"))))
4708         ;; Find all group instances.  If topics are in use, each group
4709         ;; may be listed in more than once.
4710         (while (setq loc (text-property-any
4711                           loc (point-max) 'gnus-group ident))
4712           (setq found t)
4713           (goto-char loc)
4714           (let ((gnus-group-indentation (gnus-group-group-indentation)))
4715             (gnus-delete-line)
4716             (gnus-group-insert-group-line-info group))
4717           (setq loc (1+ loc)))
4718         (if (or found visible-only)
4719             ()
4720           ;; No such line in the buffer, find out where it's supposed to
4721           ;; go, and insert it there (or at the end of the buffer).
4722           ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
4723           (let ((entry (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb)))))
4724             (while (and entry (car entry)
4725                         (not
4726                          (gnus-goto-char
4727                           (text-property-any
4728                            (point-min) (point-max)
4729                            'gnus-group (gnus-intern-safe
4730                                         (car (car entry))
4731                                         gnus-active-hashtb)))))
4732               (setq entry (cdr entry)))
4733             (or entry (goto-char (point-max))))
4734           ;; Finally insert the line.
4735           (let ((gnus-group-indentation (gnus-group-group-indentation)))
4736             (gnus-group-insert-group-line-info group)))
4737         (gnus-group-set-mode-line)))))
4738
4739 (defun gnus-group-set-mode-line ()
4740   (when (memq 'group gnus-updated-mode-lines)
4741     (let* ((gformat (or gnus-group-mode-line-format-spec
4742                         (setq gnus-group-mode-line-format-spec
4743                               (gnus-parse-format
4744                                gnus-group-mode-line-format
4745                                gnus-group-mode-line-format-alist))))
4746            (gnus-tmp-news-server (car (cdr gnus-select-method)))
4747            (gnus-tmp-news-method (car gnus-select-method))
4748            (max-len 60)
4749            gnus-tmp-header                      ;Dummy binding for user-defined formats
4750            ;; Get the resulting string.
4751            (mode-string (eval gformat)))
4752       ;; If the line is too long, we chop it off.
4753       (when (> (length mode-string) max-len)
4754         (setq mode-string (substring mode-string 0 (- max-len 4))))
4755       (prog1
4756           (setq mode-line-buffer-identification (list mode-string))
4757         (set-buffer-modified-p t)))))
4758
4759 (defun gnus-group-group-name ()
4760   "Get the name of the newsgroup on the current line."
4761   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
4762     (and group (symbol-name group))))
4763
4764 (defun gnus-group-group-level ()
4765   "Get the level of the newsgroup on the current line."
4766   (get-text-property (gnus-point-at-bol) 'gnus-level))
4767
4768 (defun gnus-group-group-indentation ()
4769   "Get the indentation of the newsgroup on the current line."
4770   (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) ""))
4771
4772 (defun gnus-group-group-unread ()
4773   "Get the number of unread articles of the newsgroup on the current line."
4774   (get-text-property (gnus-point-at-bol) 'gnus-unread))
4775
4776 (defun gnus-group-search-forward (&optional backward all level first-too)
4777   "Find the next newsgroup with unread articles.
4778 If BACKWARD is non-nil, find the previous newsgroup instead.
4779 If ALL is non-nil, just find any newsgroup.
4780 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
4781 group exists.
4782 If FIRST-TOO, the current line is also eligible as a target."
4783   (let ((way (if backward -1 1))
4784         (low gnus-level-killed)
4785         (beg (point))
4786         pos found lev)
4787     (if (and backward (progn (beginning-of-line)) (bobp))
4788         nil
4789       (or first-too (forward-line way))
4790       (while (and
4791               (not (eobp))
4792               (not (setq
4793                     found
4794                     (and (or all
4795                              (and
4796                               (let ((unread
4797                                      (get-text-property (point) 'gnus-unread)))
4798                                 (and (numberp unread) (> unread 0)))
4799                               (setq lev (get-text-property (point)
4800                                                            'gnus-level))
4801                               (<= lev gnus-level-subscribed)))
4802                          (or (not level)
4803                              (and (setq lev (get-text-property (point)
4804                                                                'gnus-level))
4805                                   (or (= lev level)
4806                                       (and (< lev low)
4807                                            (< level lev)
4808                                            (progn
4809                                              (setq low lev)
4810                                              (setq pos (point))
4811                                              nil))))))))
4812               (zerop (forward-line way)))))
4813     (if found
4814         (progn (gnus-group-position-point) t)
4815       (goto-char (or pos beg))
4816       (and pos t))))
4817
4818 ;;; Gnus group mode commands
4819
4820 ;; Group marking.
4821
4822 (defun gnus-group-mark-group (n &optional unmark no-advance)
4823   "Mark the current group."
4824   (interactive "p")
4825   (let ((buffer-read-only nil)
4826         group)
4827     (while
4828         (and (> n 0)
4829              (setq group (gnus-group-group-name))
4830              (progn
4831                (beginning-of-line)
4832                (forward-char
4833                 (or (cdr (assq 'process gnus-group-mark-positions)) 2))
4834                (delete-char 1)
4835                (if unmark
4836                    (progn
4837                      (insert " ")
4838                      (setq gnus-group-marked (delete group gnus-group-marked)))
4839                  (insert "#")
4840                  (setq gnus-group-marked
4841                        (cons group (delete group gnus-group-marked))))
4842                t)
4843              (or no-advance (zerop (gnus-group-next-group 1))))
4844       (setq n (1- n)))
4845     (gnus-summary-position-point)
4846     n))
4847
4848 (defun gnus-group-unmark-group (n)
4849   "Remove the mark from the current group."
4850   (interactive "p")
4851   (gnus-group-mark-group n 'unmark)
4852   (gnus-group-position-point))
4853
4854 (defun gnus-group-unmark-all-groups ()
4855   "Unmark all groups."
4856   (let ((groups gnus-group-marked))
4857     (save-excursion
4858       (while groups
4859         (gnus-group-remove-mark (pop groups)))))
4860   (gnus-group-position-point))
4861
4862 (defun gnus-group-mark-region (unmark beg end)
4863   "Mark all groups between point and mark.
4864 If UNMARK, remove the mark instead."
4865   (interactive "P\nr")
4866   (let ((num (count-lines beg end)))
4867     (save-excursion
4868       (goto-char beg)
4869       (- num (gnus-group-mark-group num unmark)))))
4870
4871 (defun gnus-group-mark-buffer (&optional unmark)
4872   "Mark all groups in the buffer.
4873 If UNMARK, remove the mark instead."
4874   (interactive "P")
4875   (gnus-group-mark-region unmark (point-min) (point-max)))
4876
4877 (defun gnus-group-mark-regexp (regexp)
4878   "Mark all groups that match some regexp."
4879   (interactive "sMark (regexp): ")
4880   (let ((alist (cdr gnus-newsrc-alist))
4881         group)
4882     (while alist
4883       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
4884         (gnus-group-set-mark group))))
4885   (gnus-group-position-point))
4886
4887 (defun gnus-group-remove-mark (group)
4888   "Remove the process mark from GROUP and move point there.
4889 Return nil if the group isn't displayed."
4890   (if (gnus-group-goto-group group)
4891       (save-excursion
4892         (gnus-group-mark-group 1 'unmark t)
4893         t)
4894     (setq gnus-group-marked
4895           (delete group gnus-group-marked))
4896     nil))
4897
4898 (defun gnus-group-set-mark (group)
4899   "Set the process mark on GROUP."
4900   (if (gnus-group-goto-group group)
4901       (save-excursion
4902         (gnus-group-mark-group 1 nil t))
4903     (setq gnus-group-marked
4904           (cons group (delete group gnus-group-marked)))))
4905
4906 (defun gnus-group-universal-argument (arg &optional groups func)
4907   "Perform any command on all groups accoring to the process/prefix convention."
4908   (interactive "P")
4909   (let ((groups (or groups (gnus-group-process-prefix arg)))
4910         group func)
4911     (if (eq (setq func (or func
4912                            (key-binding
4913                             (read-key-sequence
4914                              (substitute-command-keys
4915                               "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
4916             'undefined)
4917         (progn
4918           (message "Undefined key")
4919           (ding))
4920       (while groups
4921         (gnus-group-remove-mark (setq group (pop groups)))
4922         (command-execute func))))
4923   (gnus-group-position-point))
4924
4925 (defun gnus-group-process-prefix (n)
4926   "Return a list of groups to work on.
4927 Take into consideration N (the prefix) and the list of marked groups."
4928   (cond
4929    (n
4930     (setq n (prefix-numeric-value n))
4931     ;; There is a prefix, so we return a list of the N next
4932     ;; groups.
4933     (let ((way (if (< n 0) -1 1))
4934           (n (abs n))
4935           group groups)
4936       (save-excursion
4937         (while (and (> n 0)
4938                     (setq group (gnus-group-group-name)))
4939           (setq groups (cons group groups))
4940           (setq n (1- n))
4941           (gnus-group-next-group way)))
4942       (nreverse groups)))
4943    ((and (boundp 'transient-mark-mode)
4944          transient-mark-mode
4945          mark-active)
4946     ;; Work on the region between point and mark.
4947     (let ((max (max (point) (mark)))
4948           groups)
4949       (save-excursion
4950         (goto-char (min (point) (mark)))
4951         (while
4952             (and
4953              (push (gnus-group-group-name) groups)
4954              (zerop (gnus-group-next-group 1))
4955              (< (point) max)))
4956         (nreverse groups))))
4957    (gnus-group-marked
4958     ;; No prefix, but a list of marked articles.
4959     (reverse gnus-group-marked))
4960    (t
4961     ;; Neither marked articles or a prefix, so we return the
4962     ;; current group.
4963     (let ((group (gnus-group-group-name)))
4964       (and group (list group))))))
4965
4966 ;; Selecting groups.
4967
4968 (defun gnus-group-read-group (&optional all no-article group)
4969   "Read news in this newsgroup.
4970 If the prefix argument ALL is non-nil, already read articles become
4971 readable.  IF ALL is a number, fetch this number of articles.  If the
4972 optional argument NO-ARTICLE is non-nil, no article will be
4973 auto-selected upon group entry.  If GROUP is non-nil, fetch that
4974 group."
4975   (interactive "P")
4976   (let ((group (or group (gnus-group-group-name)))
4977         number active marked entry)
4978     (or group (error "No group on current line"))
4979     (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
4980                                             group gnus-newsrc-hashtb)))))
4981     ;; This group might be a dead group.  In that case we have to get
4982     ;; the number of unread articles from `gnus-active-hashtb'.
4983     (setq number
4984           (cond ((numberp all) all)
4985                 (entry (car entry))
4986                 ((setq active (gnus-active group))
4987                  (- (1+ (cdr active)) (car active)))))
4988     (gnus-summary-read-group
4989      group (or all (and (numberp number)
4990                         (zerop (+ number (length (cdr (assq 'tick marked)))
4991                                   (length (cdr (assq 'dormant marked)))))))
4992      no-article)))
4993
4994 (defun gnus-group-select-group (&optional all)
4995   "Select this newsgroup.
4996 No article is selected automatically.
4997 If ALL is non-nil, already read articles become readable.
4998 If ALL is a number, fetch this number of articles."
4999   (interactive "P")
5000   (gnus-group-read-group all t))
5001
5002 (defun gnus-group-quick-select-group (&optional all)
5003   "Select the current group \"quickly\".
5004 This means that no highlighting or scoring will be performed."
5005   (interactive "P")
5006   (let (gnus-visual
5007         gnus-score-find-score-files-function
5008         gnus-apply-kill-hook
5009         gnus-summary-expunge-below)
5010     (gnus-group-read-group all t)))
5011
5012 (defun gnus-group-visible-select-group (&optional all)
5013   "Select the current group without hiding any articles."
5014   (interactive "P")
5015   (let ((gnus-inhibit-limiting t))
5016     (gnus-group-read-group all t)))
5017
5018 ;;;###autoload
5019 (defun gnus-fetch-group (group)
5020   "Start Gnus if necessary and enter GROUP.
5021 Returns whether the fetching was successful or not."
5022   (interactive "sGroup name: ")
5023   (or (get-buffer gnus-group-buffer)
5024       (gnus))
5025   (gnus-group-select-group))
5026
5027 ;; Enter a group that is not in the group buffer.  Non-nil is returned
5028 ;; if selection was successful.
5029 (defun gnus-group-read-ephemeral-group
5030   (group method &optional activate quit-config)
5031   (let ((group (if (gnus-group-foreign-p group) group
5032                  (gnus-group-prefixed-name group method))))
5033     (gnus-sethash
5034      group
5035      (list t nil (list group gnus-level-default-subscribed nil nil
5036                        (append method
5037                                (list
5038                                 (list 'quit-config
5039                                       (if quit-config quit-config
5040                                         (cons (current-buffer) 'summary)))))))
5041      gnus-newsrc-hashtb)
5042     (set-buffer gnus-group-buffer)
5043     (or (gnus-check-server method)
5044         (error "Unable to contact server: %s" (gnus-status-message method)))
5045     (if activate (or (gnus-request-group group)
5046                      (error "Couldn't request group")))
5047     (condition-case ()
5048         (gnus-group-read-group t t group)
5049       (error nil)
5050       (quit nil))))
5051
5052 (defun gnus-group-jump-to-group (group)
5053   "Jump to newsgroup GROUP."
5054   (interactive
5055    (list (completing-read
5056           "Group: " gnus-active-hashtb nil
5057           (memq gnus-select-method gnus-have-read-active-file))))
5058
5059   (if (equal group "")
5060       (error "Empty group name"))
5061
5062   (let ((b (text-property-any
5063             (point-min) (point-max)
5064             'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
5065     (if b
5066         ;; Either go to the line in the group buffer...
5067         (goto-char b)
5068       ;; ... or insert the line.
5069       (or
5070        (gnus-active group)
5071        (gnus-activate-group group)
5072        (error "%s error: %s" group (gnus-status-message group)))
5073
5074       (gnus-group-update-group group)
5075       (goto-char (text-property-any
5076                   (point-min) (point-max)
5077                   'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
5078   ;; Adjust cursor point.
5079   (gnus-group-position-point))
5080
5081 (defun gnus-group-goto-group (group)
5082   "Goto to newsgroup GROUP."
5083   (when group
5084     (let ((b (text-property-any (point-min) (point-max)
5085                                 'gnus-group (gnus-intern-safe
5086                                              group gnus-active-hashtb))))
5087       (and b (goto-char b)))))
5088
5089 (defun gnus-group-next-group (n)
5090   "Go to next N'th newsgroup.
5091 If N is negative, search backward instead.
5092 Returns the difference between N and the number of skips actually
5093 done."
5094   (interactive "p")
5095   (gnus-group-next-unread-group n t))
5096
5097 (defun gnus-group-next-unread-group (n &optional all level)
5098   "Go to next N'th unread newsgroup.
5099 If N is negative, search backward instead.
5100 If ALL is non-nil, choose any newsgroup, unread or not.
5101 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
5102 such group can be found, the next group with a level higher than
5103 LEVEL.
5104 Returns the difference between N and the number of skips actually
5105 made."
5106   (interactive "p")
5107   (let ((backward (< n 0))
5108         (n (abs n)))
5109     (while (and (> n 0)
5110                 (gnus-group-search-forward
5111                  backward (or (not gnus-group-goto-unread) all) level))
5112       (setq n (1- n)))
5113     (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
5114                                (if level " on this level or higher" "")))
5115     n))
5116
5117 (defun gnus-group-prev-group (n)
5118   "Go to previous N'th newsgroup.
5119 Returns the difference between N and the number of skips actually
5120 done."
5121   (interactive "p")
5122   (gnus-group-next-unread-group (- n) t))
5123
5124 (defun gnus-group-prev-unread-group (n)
5125   "Go to previous N'th unread newsgroup.
5126 Returns the difference between N and the number of skips actually
5127 done."
5128   (interactive "p")
5129   (gnus-group-next-unread-group (- n)))
5130
5131 (defun gnus-group-next-unread-group-same-level (n)
5132   "Go to next N'th unread newsgroup on the same level.
5133 If N is negative, search backward instead.
5134 Returns the difference between N and the number of skips actually
5135 done."
5136   (interactive "p")
5137   (gnus-group-next-unread-group n t (gnus-group-group-level))
5138   (gnus-group-position-point))
5139
5140 (defun gnus-group-prev-unread-group-same-level (n)
5141   "Go to next N'th unread newsgroup on the same level.
5142 Returns the difference between N and the number of skips actually
5143 done."
5144   (interactive "p")
5145   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
5146   (gnus-group-position-point))
5147
5148 (defun gnus-group-best-unread-group (&optional exclude-group)
5149   "Go to the group with the highest level.
5150 If EXCLUDE-GROUP, do not go to that group."
5151   (interactive)
5152   (goto-char (point-min))
5153   (let ((best 100000)
5154         unread best-point)
5155     (while (setq unread (get-text-property (point) 'gnus-unread))
5156       (if (and (numberp unread) (> unread 0))
5157           (progn
5158             (if (and (< (get-text-property (point) 'gnus-level) best)
5159                      (or (not exclude-group)
5160                          (not (equal exclude-group (gnus-group-group-name)))))
5161                 (progn
5162                   (setq best (get-text-property (point) 'gnus-level))
5163                   (setq best-point (point))))))
5164       (forward-line 1))
5165     (if best-point (goto-char best-point))
5166     (gnus-summary-position-point)
5167     (and best-point (gnus-group-group-name))))
5168
5169 (defun gnus-group-first-unread-group ()
5170   "Go to the first group with unread articles."
5171   (interactive)
5172   (prog1
5173       (let ((opoint (point))
5174             unread)
5175         (goto-char (point-min))
5176         (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
5177                 (and (numberp unread)   ; Not a topic.
5178                      (not (zerop unread))) ; Has unread articles.
5179                 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
5180             (point)                     ; Success.
5181           (goto-char opoint)
5182           nil))                         ; Not success.
5183     (gnus-group-position-point)))
5184
5185 (defun gnus-group-enter-server-mode ()
5186   "Jump to the server buffer."
5187   (interactive)
5188   (gnus-enter-server-buffer))
5189
5190 (defun gnus-group-make-group (name &optional method address)
5191   "Add a new newsgroup.
5192 The user will be prompted for a NAME, for a select METHOD, and an
5193 ADDRESS."
5194   (interactive
5195    (cons
5196     (read-string "Group name: ")
5197     (let ((method
5198            (completing-read
5199             "Method: " (append gnus-valid-select-methods gnus-server-alist)
5200             nil t)))
5201       (if (assoc method gnus-valid-select-methods)
5202           (list method
5203                 (if (memq 'prompt-address
5204                           (assoc method gnus-valid-select-methods))
5205                     (read-string "Address: ")
5206                   ""))
5207         (list method nil)))))
5208
5209   (save-excursion
5210     (set-buffer gnus-group-buffer)
5211     (let* ((meth (and method (if address (list (intern method) address)
5212                                method)))
5213            (nname (if method (gnus-group-prefixed-name name meth) name))
5214            info)
5215       (and (gnus-gethash nname gnus-newsrc-hashtb)
5216            (error "Group %s already exists" nname))
5217       (gnus-group-change-level
5218        (setq info (list t nname gnus-level-default-subscribed nil nil meth))
5219        gnus-level-default-subscribed gnus-level-killed
5220        (and (gnus-group-group-name)
5221             (gnus-gethash (gnus-group-group-name)
5222                           gnus-newsrc-hashtb))
5223        t)
5224       (gnus-set-active nname (cons 1 0))
5225       (or (gnus-ephemeral-group-p name)
5226           (gnus-dribble-enter
5227            (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
5228       (gnus-group-insert-group-line-info nname)
5229
5230       (if (assoc method gnus-valid-select-methods)
5231           (require (intern method)))
5232       (and (gnus-check-backend-function 'request-create-group nname)
5233            (gnus-request-create-group nname))
5234       t)))
5235
5236 (defun gnus-group-delete-group (group &optional force)
5237   "Delete the current group.
5238 If FORCE (the prefix) is non-nil, all the articles in the group will
5239 be deleted.  This is \"deleted\" as in \"removed forever from the face
5240 of the Earth\".  There is no undo."
5241   (interactive
5242    (list (gnus-group-group-name)
5243          current-prefix-arg))
5244   (or group (error "No group to rename"))
5245   (or (gnus-check-backend-function 'request-delete-group group)
5246       (error "This backend does not support group deletion"))
5247   (prog1
5248       (if (not (gnus-yes-or-no-p
5249                 (format
5250                  "Do you really want to delete %s%s? "
5251                  group (if force " and all its contents" ""))))
5252           () ; Whew!
5253         (gnus-message 6 "Deleting group %s..." group)
5254         (if (not (gnus-request-delete-group group force))
5255             (progn
5256               (gnus-message 3 "Couldn't delete group %s" group)
5257               (ding))
5258           (gnus-message 6 "Deleting group %s...done" group)
5259           (gnus-group-goto-group group)
5260           (gnus-group-kill-group 1 t)
5261           t))
5262     (gnus-group-position-point)))
5263
5264 (defun gnus-group-rename-group (group new-name)
5265   (interactive
5266    (list
5267     (gnus-group-group-name)
5268     (progn
5269       (or (gnus-check-backend-function
5270            'request-rename-group (gnus-group-group-name))
5271           (error "This backend does not support renaming groups"))
5272       (read-string "New group name: "))))
5273
5274   (or (gnus-check-backend-function 'request-rename-group group)
5275       (error "This backend does not support renaming groups"))
5276
5277   (or group (error "No group to rename"))
5278   (and (string-match "^[ \t]*$" new-name)
5279        (error "Not a valid group name"))
5280
5281   ;; We find the proper prefixed name.
5282   (setq new-name
5283         (gnus-group-prefixed-name
5284          (gnus-group-real-name new-name)
5285          (gnus-info-method (gnus-get-info group))))
5286
5287   (gnus-message 6 "Renaming group %s to %s..." group new-name)
5288   (prog1
5289       (if (not (gnus-request-rename-group group new-name))
5290           (progn
5291             (gnus-message 3 "Couldn't rename group %s to %s" group new-name)
5292             (ding))
5293         ;; We rename the group internally by killing it...
5294         (gnus-group-goto-group group)
5295         (gnus-group-kill-group)
5296         ;; ... changing its name ...
5297         (setcar (cdr (car gnus-list-of-killed-groups))
5298                 new-name)
5299         ;; ... and then yanking it.  Magic!
5300         (gnus-group-yank-group)
5301         (gnus-set-active new-name (gnus-active group))
5302         (gnus-message 6 "Renaming group %s to %s...done" group new-name)
5303         new-name)
5304     (gnus-group-position-point)))
5305
5306
5307 (defun gnus-group-edit-group (group &optional part)
5308   "Edit the group on the current line."
5309   (interactive (list (gnus-group-group-name)))
5310   (let ((done-func '(lambda ()
5311                       "Exit editing mode and update the information."
5312                       (interactive)
5313                       (gnus-group-edit-group-done 'part 'group)))
5314         (part (or part 'info))
5315         (winconf (current-window-configuration))
5316         info)
5317     (or group (error "No group on current line"))
5318     (or (setq info (gnus-get-info group))
5319         (error "Killed group; can't be edited"))
5320     (set-buffer (get-buffer-create gnus-group-edit-buffer))
5321     (gnus-configure-windows 'edit-group)
5322     (gnus-add-current-to-buffer-list)
5323     (emacs-lisp-mode)
5324     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
5325     (use-local-map (copy-keymap emacs-lisp-mode-map))
5326     (local-set-key "\C-c\C-c" done-func)
5327     (make-local-variable 'gnus-prev-winconf)
5328     (setq gnus-prev-winconf winconf)
5329     ;; We modify the func to let it know what part it is editing.
5330     (setcar (cdr (nth 4 done-func)) (list 'quote part))
5331     (setcar (cdr (cdr (nth 4 done-func))) group)
5332     (erase-buffer)
5333     (insert
5334      (cond
5335       ((eq part 'method)
5336        ";; Type `C-c C-c' after editing the select method.\n\n")
5337       ((eq part 'params)
5338        ";; Type `C-c C-c' after editing the group parameters.\n\n")
5339       ((eq part 'info)
5340        ";; Type `C-c C-c' after editing the group info.\n\n")))
5341     (insert
5342      (pp-to-string
5343       (cond ((eq part 'method)
5344              (or (gnus-info-method info) "native"))
5345             ((eq part 'params)
5346              (gnus-info-params info))
5347             (t info)))
5348      "\n")))
5349
5350 (defun gnus-group-edit-group-method (group)
5351   "Edit the select method of GROUP."
5352   (interactive (list (gnus-group-group-name)))
5353   (gnus-group-edit-group group 'method))
5354
5355 (defun gnus-group-edit-group-parameters (group)
5356   "Edit the group parameters of GROUP."
5357   (interactive (list (gnus-group-group-name)))
5358   (gnus-group-edit-group group 'params))
5359
5360 (defun gnus-group-edit-group-done (part group)
5361   "Get info from buffer, update variables and jump to the group buffer."
5362   (set-buffer (get-buffer-create gnus-group-edit-buffer))
5363   (goto-char (point-min))
5364   (let* ((form (read (current-buffer)))
5365          (winconf gnus-prev-winconf)
5366          (new-group (when (eq part 'info)
5367                       (if (or (not (nth 4 form))
5368                               (gnus-server-equal
5369                                gnus-select-method (nth 4 form)))
5370                           (gnus-group-real-name (car form))
5371                         (gnus-group-prefixed-name
5372                          (gnus-group-real-name (car form)) (nth 4 form))))))
5373     ;; Set the info.
5374     (if (eq part 'info)
5375         (progn
5376           (when new-group (setcar form new-group))
5377           (gnus-group-set-info form))
5378       (gnus-group-set-info form group part))
5379     (kill-buffer (current-buffer))
5380     (and winconf (set-window-configuration winconf))
5381     (set-buffer gnus-group-buffer)
5382     (when (and new-group
5383              (not (equal new-group group)))
5384       (when (gnus-group-goto-group group)
5385         (gnus-group-kill-group 1))
5386       (gnus-activate-group new-group))
5387     (gnus-group-update-group (or new-group group))
5388     (gnus-group-position-point)))
5389
5390 (defun gnus-group-make-help-group ()
5391   "Create the Gnus documentation group."
5392   (interactive)
5393   (let ((path load-path)
5394         (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
5395         file dir)
5396     (and (gnus-gethash name gnus-newsrc-hashtb)
5397          (error "Documentation group already exists"))
5398     (while path
5399       (setq dir (file-name-as-directory (expand-file-name (pop path)))
5400             file nil)
5401       (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt")))
5402                 (file-exists-p
5403                  (setq file (concat (file-name-directory
5404                                      (directory-file-name dir))
5405                                     "etc/gnus-tut.txt"))))
5406         (setq path nil)))
5407     (if (not file)
5408         (message "Couldn't find doc group")
5409       (gnus-group-make-group
5410        (gnus-group-real-name name)
5411        (list 'nndoc name
5412              (list 'nndoc-address file)
5413              (list 'nndoc-article-type 'mbox)))))
5414   (gnus-group-position-point))
5415
5416 (defun gnus-group-make-doc-group (file type)
5417   "Create a group that uses a single file as the source."
5418   (interactive
5419    (list (read-file-name "File name: ")
5420          (and current-prefix-arg 'ask)))
5421   (when (eq type 'ask)
5422     (let ((err "")
5423           char found)
5424       (while (not found)
5425         (message
5426          "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
5427          err)
5428         (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
5429                           ((= char ?b) 'babyl)
5430                           ((= char ?d) 'digest)
5431                           ((= char ?f) 'forward)
5432                           ((= char ?a) 'mmfd)
5433                           (t (setq err (format "%c unknown. " char))
5434                              nil))))
5435       (setq type found)))
5436   (let* ((file (expand-file-name file))
5437          (name (gnus-generate-new-group-name
5438                 (gnus-group-prefixed-name
5439                  (file-name-nondirectory file) '(nndoc "")))))
5440     (gnus-group-make-group
5441      (gnus-group-real-name name)
5442      (list 'nndoc name
5443            (list 'nndoc-address file)
5444            (list 'nndoc-article-type (or type 'guess))))
5445     (forward-line -1)
5446     (gnus-group-position-point)))
5447
5448 (defun gnus-group-make-archive-group (&optional all)
5449   "Create the (ding) Gnus archive group of the most recent articles.
5450 Given a prefix, create a full group."
5451   (interactive "P")
5452   (let ((group (gnus-group-prefixed-name
5453                 (if all "ding.archives" "ding.recent") '(nndir ""))))
5454     (and (gnus-gethash group gnus-newsrc-hashtb)
5455          (error "Archive group already exists"))
5456     (gnus-group-make-group
5457      (gnus-group-real-name group)
5458      (list 'nndir (if all "hpc" "edu")
5459            (list 'nndir-directory
5460                  (if all gnus-group-archive-directory
5461                    gnus-group-recent-archive-directory)))))
5462   (forward-line -1)
5463   (gnus-group-position-point))
5464
5465 (defun gnus-group-make-directory-group (dir)
5466   "Create an nndir group.
5467 The user will be prompted for a directory.  The contents of this
5468 directory will be used as a newsgroup.  The directory should contain
5469 mail messages or news articles in files that have numeric names."
5470   (interactive
5471    (list (read-file-name "Create group from directory: ")))
5472   (or (file-exists-p dir) (error "No such directory"))
5473   (or (file-directory-p dir) (error "Not a directory"))
5474   (let ((ext "")
5475         (i 0)
5476         group)
5477     (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
5478       (setq group
5479             (gnus-group-prefixed-name
5480              (concat (file-name-as-directory (directory-file-name dir))
5481                      ext)
5482              '(nndir "")))
5483       (setq ext (format "<%d>" (setq i (1+ i)))))
5484     (gnus-group-make-group
5485      (gnus-group-real-name group)
5486      (list 'nndir group (list 'nndir-directory dir))))
5487   (forward-line -1)
5488   (gnus-group-position-point))
5489
5490 (defun gnus-group-make-kiboze-group (group address scores)
5491   "Create an nnkiboze group.
5492 The user will be prompted for a name, a regexp to match groups, and
5493 score file entries for articles to include in the group."
5494   (interactive
5495    (list
5496     (read-string "nnkiboze group name: ")
5497     (read-string "Source groups (regexp): ")
5498     (let ((headers (mapcar (lambda (group) (list group))
5499                            '("subject" "from" "number" "date" "message-id"
5500                              "references" "chars" "lines" "xref"
5501                              "followup" "all" "body" "head")))
5502           scores header regexp regexps)
5503       (while (not (equal "" (setq header (completing-read
5504                                           "Match on header: " headers nil t))))
5505         (setq regexps nil)
5506         (while (not (equal "" (setq regexp (read-string
5507                                             (format "Match on %s (string): "
5508                                                     header)))))
5509           (setq regexps (cons (list regexp nil nil 'r) regexps)))
5510         (setq scores (cons (cons header regexps) scores)))
5511       scores)))
5512   (gnus-group-make-group group "nnkiboze" address)
5513   (save-excursion
5514     (gnus-set-work-buffer)
5515     (let (emacs-lisp-mode-hook)
5516       (pp scores (current-buffer)))
5517     (write-region (point-min) (point-max)
5518                   (gnus-score-file-name (concat "nnkiboze:" group))))
5519   (forward-line -1)
5520   (gnus-group-position-point))
5521
5522 (defun gnus-group-add-to-virtual (n vgroup)
5523   "Add the current group to a virtual group."
5524   (interactive
5525    (list current-prefix-arg
5526          (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
5527                           "nnvirtual:")))
5528   (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
5529       (error "%s is not an nnvirtual group" vgroup))
5530   (let* ((groups (gnus-group-process-prefix n))
5531          (method (gnus-info-method (gnus-get-info vgroup))))
5532     (setcar (cdr method)
5533             (concat
5534              (nth 1 method) "\\|"
5535              (mapconcat
5536               (lambda (s)
5537                 (gnus-group-remove-mark s)
5538                 (concat "\\(^" (regexp-quote s) "$\\)"))
5539               groups "\\|"))))
5540   (gnus-group-position-point))
5541
5542 (defun gnus-group-make-empty-virtual (group)
5543   "Create a new, fresh, empty virtual group."
5544   (interactive "sCreate new, empty virtual group: ")
5545   (let* ((method (list 'nnvirtual "^$"))
5546          (pgroup (gnus-group-prefixed-name group method)))
5547     ;; Check whether it exists already.
5548     (and (gnus-gethash pgroup gnus-newsrc-hashtb)
5549          (error "Group %s already exists." pgroup))
5550     ;; Subscribe the new group after the group on the current line.
5551     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
5552     (gnus-group-update-group pgroup)
5553     (forward-line -1)
5554     (gnus-group-position-point)))
5555
5556 (defun gnus-group-enter-directory (dir)
5557   "Enter an ephemeral nneething group."
5558   (interactive "DDirectory to read: ")
5559   (let* ((method (list 'nneething dir))
5560          (leaf (gnus-group-prefixed-name
5561                 (file-name-nondirectory (directory-file-name dir))
5562                 method))
5563          (name (gnus-generate-new-group-name leaf)))
5564     (let ((nneething-read-only t))
5565       (or (gnus-group-read-ephemeral-group
5566            name method t
5567            (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
5568                                       'summary 'group)))
5569           (error "Couldn't enter %s" dir)))))
5570
5571 ;; Group sorting commands
5572 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
5573
5574 (defun gnus-group-sort-groups (func &optional reverse)
5575   "Sort the group buffer according to FUNC.
5576 If REVERSE, reverse the sorting order."
5577   (interactive (list gnus-group-sort-function
5578                      current-prefix-arg))
5579   (let ((func (cond 
5580                ((not (listp func)) func)
5581                ((null func) func)
5582                ((= 1 (length func)) (car func))
5583                (t `(lambda (t1 t2)
5584                      ,(gnus-make-sort-function 
5585                        (reverse func)))))))
5586     ;; We peel off the dummy group from the alist.
5587     (when func
5588       (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
5589         (pop gnus-newsrc-alist))
5590       ;; Do the sorting.
5591       (setq gnus-newsrc-alist
5592             (sort gnus-newsrc-alist func))
5593       (when reverse
5594         (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
5595       ;; Regenerate the hash table.
5596       (gnus-make-hashtable-from-newsrc-alist)
5597       (gnus-group-list-groups))))
5598
5599 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
5600   "Sort the group buffer alphabetically by group name.
5601 If REVERSE, sort in reverse order."
5602   (interactive "P")
5603   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
5604
5605 (defun gnus-group-sort-groups-by-unread (&optional reverse)
5606   "Sort the group buffer by number of unread articles.
5607 If REVERSE, sort in reverse order."
5608   (interactive "P")
5609   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
5610
5611 (defun gnus-group-sort-groups-by-level (&optional reverse)
5612   "Sort the group buffer by group level.
5613 If REVERSE, sort in reverse order."
5614   (interactive "P")
5615   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
5616
5617 (defun gnus-group-sort-groups-by-score (&optional reverse)
5618   "Sort the group buffer by group score.
5619 If REVERSE, sort in reverse order."
5620   (interactive "P")
5621   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
5622
5623 (defun gnus-group-sort-groups-by-rank (&optional reverse)
5624   "Sort the group buffer by group rank.
5625 If REVERSE, sort in reverse order."
5626   (interactive "P")
5627   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
5628
5629 (defun gnus-group-sort-groups-by-method (&optional reverse)
5630   "Sort the group buffer alphabetically by backend name.
5631 If REVERSE, sort in reverse order."
5632   (interactive "P")
5633   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
5634
5635 (defun gnus-group-sort-by-alphabet (info1 info2)
5636   "Sort alphabetically."
5637   (string< (gnus-info-group info1) (gnus-info-group info2)))
5638
5639 (defun gnus-group-sort-by-unread (info1 info2)
5640   "Sort by number of unread articles."
5641   (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
5642         (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
5643     (< (or (and (numberp n1) n1) 0)
5644        (or (and (numberp n2) n2) 0))))
5645
5646 (defun gnus-group-sort-by-level (info1 info2)
5647   "Sort by level."
5648   (< (gnus-info-level info1) (gnus-info-level info2)))
5649
5650 (defun gnus-group-sort-by-method (info1 info2)
5651   "Sort alphabetically by backend name."
5652   (string< (symbol-name (car (gnus-find-method-for-group
5653                               (gnus-info-group info1) info1)))
5654            (symbol-name (car (gnus-find-method-for-group
5655                               (gnus-info-group info2) info2)))))
5656
5657 (defun gnus-group-sort-by-score (info1 info2)
5658   "Sort by group score."
5659   (< (gnus-info-score info1) (gnus-info-score info2)))
5660
5661 (defun gnus-group-sort-by-rank (info1 info2)
5662   "Sort by level and score."
5663   (let ((level1 (gnus-info-level info1))
5664         (level2 (gnus-info-level info2)))
5665     (or (< level1 level2)
5666         (and (= level1 level2)
5667              (< (gnus-info-score info1) (gnus-info-score info2))))))
5668
5669 ;; Group catching up.
5670
5671 (defun gnus-group-catchup-current (&optional n all)
5672   "Mark all articles not marked as unread in current newsgroup as read.
5673 If prefix argument N is numeric, the ARG next newsgroups will be
5674 caught up.  If ALL is non-nil, marked articles will also be marked as
5675 read.  Cross references (Xref: header) of articles are ignored.
5676 The difference between N and actual number of newsgroups that were
5677 caught up is returned."
5678   (interactive "P")
5679   (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
5680                gnus-expert-user
5681                (gnus-y-or-n-p
5682                 (if all
5683                     "Do you really want to mark all articles as read? "
5684                   "Mark all unread articles as read? "))))
5685       n
5686     (let ((groups (gnus-group-process-prefix n))
5687           (ret 0))
5688       (while groups
5689         ;; Virtual groups have to be given special treatment.
5690         (let ((method (gnus-find-method-for-group (car groups))))
5691           (if (eq 'nnvirtual (car method))
5692               (nnvirtual-catchup-group
5693                (gnus-group-real-name (car groups)) (nth 1 method) all)))
5694         (gnus-group-remove-mark (car groups))
5695         (if (prog1
5696                 (gnus-group-goto-group (car groups))
5697               (gnus-group-catchup (car groups) all))
5698             (gnus-group-update-group-line)
5699           (setq ret (1+ ret)))
5700         (setq groups (cdr groups)))
5701       (gnus-group-next-unread-group 1)
5702       ret)))
5703
5704 (defun gnus-group-catchup-current-all (&optional n)
5705   "Mark all articles in current newsgroup as read.
5706 Cross references (Xref: header) of articles are ignored."
5707   (interactive "P")
5708   (gnus-group-catchup-current n 'all))
5709
5710 (defun gnus-group-catchup (group &optional all)
5711   "Mark all articles in GROUP as read.
5712 If ALL is non-nil, all articles are marked as read.
5713 The return value is the number of articles that were marked as read,
5714 or nil if no action could be taken."
5715   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
5716          (num (car entry)))
5717     ;; Do the updating only if the newsgroup isn't killed.
5718     (if (not (numberp (car entry)))
5719         (gnus-message 1 "Can't catch up; non-active group")
5720       ;; Do auto-expirable marks if that's required.
5721       (when (gnus-group-auto-expirable-p group)
5722         (gnus-add-marked-articles
5723          group 'expire (gnus-list-of-unread-articles group))
5724         (when all
5725           (let ((marks (nth 3 (nth 2 entry))))
5726             (gnus-add-marked-articles
5727              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
5728             (gnus-add-marked-articles
5729              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
5730       (when entry
5731         (gnus-update-read-articles group nil)
5732         ;; Also nix out the lists of marks and dormants.
5733         (when all
5734           (gnus-add-marked-articles group 'tick nil nil 'force)
5735           (gnus-add-marked-articles group 'dormant nil nil 'force))
5736         (run-hooks 'gnus-group-catchup-group-hook)
5737         num))))
5738
5739 (defun gnus-group-expire-articles (&optional n)
5740   "Expire all expirable articles in the current newsgroup."
5741   (interactive "P")
5742   (let ((groups (gnus-group-process-prefix n))
5743         group)
5744     (unless groups
5745       (error "No groups to expire"))
5746     (while (setq group (pop groups))
5747       (gnus-group-remove-mark group)
5748       (when (gnus-check-backend-function 'request-expire-articles group)
5749         (gnus-message 6 "Expiring articles in %s..." group)
5750         (let* ((info (gnus-get-info group))
5751                (expirable (if (gnus-group-total-expirable-p group)
5752                               (cons nil (gnus-list-of-read-articles group))
5753                             (assq 'expire (gnus-info-marks info))))
5754                (expiry-wait (gnus-group-get-parameter group 'expiry-wait)))
5755           (when expirable
5756             (setcdr expirable
5757                     (gnus-compress-sequence
5758                      (if expiry-wait
5759                          (let ((nnmail-expiry-wait-function nil)
5760                                (nnmail-expiry-wait expiry-wait))
5761                            (gnus-request-expire-articles
5762                             (gnus-uncompress-sequence (cdr expirable)) group))
5763                        (gnus-request-expire-articles
5764                         (gnus-uncompress-sequence (cdr expirable))
5765                         group)))))
5766           (gnus-message 6 "Expiring articles in %s...done" group)))
5767       (gnus-group-position-point))))
5768
5769
5770 (defun gnus-group-expire-all-groups ()
5771   "Expire all expirable articles in all newsgroups."
5772   (interactive)
5773   (save-excursion
5774     (gnus-message 5 "Expiring...")
5775     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
5776                                      (cdr gnus-newsrc-alist))))
5777       (gnus-group-expire-articles nil)))
5778   (gnus-group-position-point)
5779   (gnus-message 5 "Expiring...done"))
5780
5781 (defun gnus-group-set-current-level (n level)
5782   "Set the level of the next N groups to LEVEL."
5783   (interactive
5784    (list
5785     current-prefix-arg
5786     (string-to-int
5787      (let ((s (read-string
5788                (format "Level (default %s): " (gnus-group-group-level)))))
5789        (if (string-match "^\\s-*$" s)
5790            (int-to-string (gnus-group-group-level))
5791          s)))))
5792   (or (and (>= level 1) (<= level gnus-level-killed))
5793       (error "Illegal level: %d" level))
5794   (let ((groups (gnus-group-process-prefix n))
5795         group)
5796     (while groups
5797       (setq group (car groups)
5798             groups (cdr groups))
5799       (gnus-group-remove-mark group)
5800       (gnus-message 6 "Changed level of %s from %d to %d"
5801                     group (or (gnus-group-group-level) gnus-level-killed)
5802                     level)
5803       (gnus-group-change-level
5804        group level (or (gnus-group-group-level) gnus-level-killed))
5805       (gnus-group-update-group-line)))
5806   (gnus-group-position-point))
5807
5808 (defun gnus-group-unsubscribe-current-group (&optional n)
5809   "Toggle subscription of the current group.
5810 If given numerical prefix, toggle the N next groups."
5811   (interactive "P")
5812   (let ((groups (gnus-group-process-prefix n))
5813         group)
5814     (while groups
5815       (setq group (car groups)
5816             groups (cdr groups))
5817       (gnus-group-remove-mark group)
5818       (gnus-group-unsubscribe-group
5819        group (if (<= (gnus-group-group-level) gnus-level-subscribed)
5820                  gnus-level-default-unsubscribed
5821                gnus-level-default-subscribed) t)
5822       (gnus-group-update-group-line))
5823     (gnus-group-next-group 1)))
5824
5825 (defun gnus-group-unsubscribe-group (group &optional level silent)
5826   "Toggle subscription to GROUP.
5827 Killed newsgroups are subscribed.  If SILENT, don't try to update the
5828 group line."
5829   (interactive
5830    (list (completing-read
5831           "Group: " gnus-active-hashtb nil
5832           (memq gnus-select-method gnus-have-read-active-file))))
5833   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
5834     (cond
5835      ((string-match "^[ \t]$" group)
5836       (error "Empty group name"))
5837      (newsrc
5838       ;; Toggle subscription flag.
5839       (gnus-group-change-level
5840        newsrc (if level level (if (<= (nth 1 (nth 2 newsrc))
5841                                       gnus-level-subscribed)
5842                                   (1+ gnus-level-subscribed)
5843                                 gnus-level-default-subscribed)))
5844       (unless silent
5845         (gnus-group-update-group group)))
5846      ((and (stringp group)
5847            (or (not (memq gnus-select-method gnus-have-read-active-file))
5848                (gnus-active group)))
5849       ;; Add new newsgroup.
5850       (gnus-group-change-level
5851        group
5852        (if level level gnus-level-default-subscribed)
5853        (or (and (member group gnus-zombie-list)
5854                 gnus-level-zombie)
5855            gnus-level-killed)
5856        (and (gnus-group-group-name)
5857             (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
5858       (unless silent
5859         (gnus-group-update-group group)))
5860      (t (error "No such newsgroup: %s" group)))
5861     (gnus-group-position-point)))
5862
5863 (defun gnus-group-transpose-groups (n)
5864   "Move the current newsgroup up N places.
5865 If given a negative prefix, move down instead.  The difference between
5866 N and the number of steps taken is returned."
5867   (interactive "p")
5868   (or (gnus-group-group-name)
5869       (error "No group on current line"))
5870   (gnus-group-kill-group 1)
5871   (prog1
5872       (forward-line (- n))
5873     (gnus-group-yank-group)
5874     (gnus-group-position-point)))
5875
5876 (defun gnus-group-kill-all-zombies ()
5877   "Kill all zombie newsgroups."
5878   (interactive)
5879   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
5880   (setq gnus-zombie-list nil)
5881   (gnus-group-list-groups))
5882
5883 (defun gnus-group-kill-region (begin end)
5884   "Kill newsgroups in current region (excluding current point).
5885 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
5886   (interactive "r")
5887   (let ((lines
5888          ;; Count lines.
5889          (save-excursion
5890            (count-lines
5891             (progn
5892               (goto-char begin)
5893               (beginning-of-line)
5894               (point))
5895             (progn
5896               (goto-char end)
5897               (beginning-of-line)
5898               (point))))))
5899     (goto-char begin)
5900     (beginning-of-line)                 ;Important when LINES < 1
5901     (gnus-group-kill-group lines)))
5902
5903 (defun gnus-group-kill-group (&optional n discard)
5904   "Kill the next N groups.
5905 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
5906 However, only groups that were alive can be yanked; already killed
5907 groups or zombie groups can't be yanked.
5908 The return value is the name of the group that was killed, or a list
5909 of groups killed."
5910   (interactive "P")
5911   (let ((buffer-read-only nil)
5912         (groups (gnus-group-process-prefix n))
5913         group entry level out)
5914     (if (< (length groups) 10)
5915         ;; This is faster when there are few groups.
5916         (while groups
5917           (push (setq group (pop groups)) out)
5918           (gnus-group-remove-mark group)
5919           (setq level (gnus-group-group-level))
5920           (gnus-delete-line)
5921           (if (and (not discard)
5922                    (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
5923               (setq gnus-list-of-killed-groups
5924                     (cons (cons (car entry) (nth 2 entry))
5925                           gnus-list-of-killed-groups)))
5926           (gnus-group-change-level
5927            (if entry entry group) gnus-level-killed (if entry nil level)))
5928       ;; If there are lots and lots of groups to be killed, we use
5929       ;; this thing instead.
5930       (let (entry)
5931         (setq groups (nreverse groups))
5932         (while groups
5933           (gnus-group-remove-mark (car groups))
5934           (gnus-delete-line)
5935           (when (setq entry (gnus-gethash (pop groups) gnus-newsrc-hashtb))
5936             (push (cons (car entry) (nth 2 entry))
5937                   gnus-list-of-killed-groups)
5938             (setcdr (cdr entry) (cdr (cdr (cdr entry))))))
5939         (gnus-make-hashtable-from-newsrc-alist)))
5940
5941     (gnus-group-position-point)
5942     (if (< (length out) 2) (car out) (nreverse out))))
5943
5944 (defun gnus-group-yank-group (&optional arg)
5945   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
5946 inserting it before the current newsgroup.  The numeric ARG specifies
5947 how many newsgroups are to be yanked.  The name of the newsgroup yanked
5948 is returned, or (if several groups are yanked) a list of yanked groups
5949 is returned."
5950   (interactive "p")
5951   (setq arg (or arg 1))
5952   (let (info group prev out)
5953     (while (>= (decf arg) 0)
5954       (if (not (setq info (pop gnus-list-of-killed-groups)))
5955           (error "No more newsgroups to yank"))
5956       (push (setq group (nth 1 info)) out)
5957       ;; Find which newsgroup to insert this one before - search
5958       ;; backward until something suitable is found.  If there are no
5959       ;; other newsgroups in this buffer, just make this newsgroup the
5960       ;; first newsgroup.
5961       (setq prev (gnus-group-group-name))
5962       (gnus-group-change-level
5963        info (nth 2 info) gnus-level-killed
5964        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
5965        t)
5966       (gnus-group-insert-group-line-info group))
5967     (forward-line -1)
5968     (gnus-group-position-point)
5969     (if (< (length out) 2) (car out) (nreverse out))))
5970
5971 (defun gnus-group-kill-level (level)
5972   "Kill all groups that is on a certain LEVEL."
5973   (interactive "nKill all groups on level: ")
5974   (cond
5975    ((= level gnus-level-zombie)
5976     (setq gnus-killed-list
5977           (nconc gnus-zombie-list gnus-killed-list))
5978     (setq gnus-zombie-list nil))
5979    ((and (< level gnus-level-zombie)
5980          (> level 0)
5981          (or gnus-expert-user
5982              (gnus-yes-or-no-p
5983               (format
5984                "Do you really want to kill all groups on level %d? "
5985                level))))
5986     (let* ((prev gnus-newsrc-alist)
5987            (alist (cdr prev)))
5988       (while alist
5989         (if (= (gnus-info-level level) level)
5990             (setcdr prev (cdr alist))
5991           (setq prev alist))
5992         (setq alist (cdr alist)))
5993       (gnus-make-hashtable-from-newsrc-alist)
5994       (gnus-group-list-groups)))
5995    (t
5996     (error "Can't kill; illegal level: %d" level))))
5997
5998 (defun gnus-group-list-all-groups (&optional arg)
5999   "List all newsgroups with level ARG or lower.
6000 Default is gnus-level-unsubscribed, which lists all subscribed and most
6001 unsubscribed groups."
6002   (interactive "P")
6003   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
6004
6005 ;; Redefine this to list ALL killed groups if prefix arg used.
6006 ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
6007 (defun gnus-group-list-killed (&optional arg)
6008   "List all killed newsgroups in the group buffer.
6009 If ARG is non-nil, list ALL killed groups known to Gnus.  This may
6010 entail asking the server for the groups."
6011   (interactive "P")
6012   ;; Find all possible killed newsgroups if arg.
6013   (when arg
6014     ;; First make sure active file has been read.
6015     (unless gnus-have-read-active-file
6016       (let ((gnus-read-active-file t))
6017         (gnus-read-active-file)))
6018     (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
6019     ;; Go through all newsgroups that are known to Gnus - enlarge kill list
6020     (mapatoms
6021      (lambda (sym)
6022        (let ((groups 0)
6023              (group (symbol-name sym)))
6024          (if (or (null group)
6025                  (gnus-gethash group gnus-killed-hashtb)
6026                  (gnus-gethash group gnus-newsrc-hashtb))
6027              ()
6028            (let ((do-sub (gnus-matches-options-n group)))
6029              (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
6030                  ()
6031                (setq groups (1+ groups))
6032                (setq gnus-killed-list
6033                      (cons group gnus-killed-list))
6034                (gnus-sethash group group gnus-killed-hashtb))))))
6035      gnus-active-hashtb))
6036   (if (not gnus-killed-list)
6037       (gnus-message 6 "No killed groups")
6038     (let (gnus-group-list-mode)
6039       (funcall gnus-group-prepare-function
6040                gnus-level-killed t gnus-level-killed))
6041     (goto-char (point-min)))
6042   (gnus-group-position-point))
6043
6044 (defun gnus-group-list-zombies ()
6045   "List all zombie newsgroups in the group buffer."
6046   (interactive)
6047   (if (not gnus-zombie-list)
6048       (gnus-message 6 "No zombie groups")
6049     (let (gnus-group-list-mode)
6050       (funcall gnus-group-prepare-function
6051                gnus-level-zombie t gnus-level-zombie))
6052     (goto-char (point-min)))
6053   (gnus-group-position-point))
6054
6055 (defun gnus-group-list-active ()
6056   "List all groups that are available from the server(s)."
6057   (interactive)
6058   ;; First we make sure that we have really read the active file.
6059   (unless gnus-have-read-active-file
6060     (let ((gnus-read-active-file t))
6061       (gnus-read-active-file)))
6062   ;; Find all groups and sort them.
6063   (let ((groups
6064          (sort
6065           (let (list)
6066             (mapatoms
6067              (lambda (sym)
6068                (and (symbol-value sym)
6069                     (setq list (cons (symbol-name sym) list))))
6070              gnus-active-hashtb)
6071             list)
6072           'string<))
6073         (buffer-read-only nil))
6074     (erase-buffer)
6075     (while groups
6076       (gnus-group-insert-group-line-info (car groups))
6077       (setq groups (cdr groups)))
6078     (goto-char (point-min))))
6079
6080 (defun gnus-activate-all-groups (level)
6081   "Activate absolutely all groups."
6082   (interactive (list 7))
6083   (let ((gnus-activate-level level)
6084         (gnus-activate-foreign-newsgroups level))
6085     (gnus-group-get-new-news)))
6086
6087 (defun gnus-group-get-new-news (&optional arg)
6088   "Get newly arrived articles.
6089 If ARG is a number, it specifies which levels you are interested in
6090 re-scanning.  If ARG is non-nil and not a number, this will force
6091 \"hard\" re-reading of the active files from all servers."
6092   (interactive "P")
6093   (run-hooks 'gnus-get-new-news-hook)
6094   ;; We might read in new NoCeM messages here.
6095   (and gnus-use-nocem (gnus-nocem-scan-groups))
6096   ;; If ARG is not a number, then we read the active file.
6097   (and arg
6098        (not (numberp arg))
6099        (progn
6100          (let ((gnus-read-active-file t))
6101            (gnus-read-active-file))
6102          (setq arg nil)))
6103
6104   (setq arg (gnus-group-default-level arg t))
6105   (if (and gnus-read-active-file (not arg))
6106       (progn
6107         (gnus-read-active-file)
6108         (gnus-get-unread-articles arg))
6109     (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
6110       (gnus-get-unread-articles arg)))
6111   (gnus-group-list-groups))
6112
6113 (defun gnus-group-get-new-news-this-group (&optional n)
6114   "Check for newly arrived news in the current group (and the N-1 next groups).
6115 The difference between N and the number of newsgroup checked is returned.
6116 If N is negative, this group and the N-1 previous groups will be checked."
6117   (interactive "P")
6118   (let* ((groups (gnus-group-process-prefix n))
6119          (ret (if (numberp n) (- n (length groups)) 0))
6120          group)
6121     (while groups
6122       (setq group (car groups)
6123             groups (cdr groups))
6124       (gnus-group-remove-mark group)
6125       (unless (gnus-get-new-news-in-group group)
6126         (ding)
6127         (gnus-message 3 "%s error: %s" group (gnus-status-message group))))
6128     (when gnus-goto-next-group-when-activating
6129       (gnus-group-next-unread-group 1 t))
6130     (gnus-summary-position-point)
6131     ret))
6132
6133 (defun gnus-get-new-news-in-group (group)
6134   (when (and group (gnus-activate-group group 'scan))
6135     (gnus-get-unread-articles-in-group
6136      (gnus-get-info group) (gnus-active group) t)
6137     (when (gnus-group-goto-group group)
6138       (gnus-group-update-group-line))
6139     t))
6140
6141 (defun gnus-group-fetch-faq (group &optional faq-dir)
6142   "Fetch the FAQ for the current group."
6143   (interactive
6144    (list
6145     (gnus-group-real-name (gnus-group-group-name))
6146     (cond (current-prefix-arg
6147            (completing-read
6148             "Faq dir: " (and (listp gnus-group-faq-directory)
6149                              gnus-group-faq-directory))))))
6150   (or faq-dir
6151       (setq faq-dir (if (listp gnus-group-faq-directory)
6152                         (car gnus-group-faq-directory)
6153                       gnus-group-faq-directory)))
6154   (or group (error "No group name given"))
6155   (let ((file (concat (file-name-as-directory faq-dir)
6156                       (gnus-group-real-name group))))
6157     (if (not (file-exists-p file))
6158         (error "No such file: %s" file)
6159       (find-file file))))
6160
6161 (defun gnus-group-describe-group (force &optional group)
6162   "Display a description of the current newsgroup."
6163   (interactive (list current-prefix-arg (gnus-group-group-name)))
6164   (and force (setq gnus-description-hashtb nil))
6165   (let ((method (gnus-find-method-for-group group))
6166         desc)
6167     (or group (error "No group name given"))
6168     (and (or (and gnus-description-hashtb
6169                   ;; We check whether this group's method has been
6170                   ;; queried for a description file.
6171                   (gnus-gethash
6172                    (gnus-group-prefixed-name "" method)
6173                    gnus-description-hashtb))
6174              (setq desc (gnus-group-get-description group))
6175              (gnus-read-descriptions-file method))
6176          (message
6177           (or desc (gnus-gethash group gnus-description-hashtb)
6178               "No description available")))))
6179
6180 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6181 (defun gnus-group-describe-all-groups (&optional force)
6182   "Pop up a buffer with descriptions of all newsgroups."
6183   (interactive "P")
6184   (and force (setq gnus-description-hashtb nil))
6185   (if (not (or gnus-description-hashtb
6186                (gnus-read-all-descriptions-files)))
6187       (error "Couldn't request descriptions file"))
6188   (let ((buffer-read-only nil)
6189         b)
6190     (erase-buffer)
6191     (mapatoms
6192      (lambda (group)
6193        (setq b (point))
6194        (insert (format "      *: %-20s %s\n" (symbol-name group)
6195                        (symbol-value group)))
6196        (add-text-properties
6197         b (1+ b) (list 'gnus-group group
6198                        'gnus-unread t 'gnus-marked nil
6199                        'gnus-level (1+ gnus-level-subscribed))))
6200      gnus-description-hashtb)
6201     (goto-char (point-min))
6202     (gnus-group-position-point)))
6203
6204 ;; Suggested by by Daniel Quinlan <quinlan@best.com>.
6205 (defun gnus-group-apropos (regexp &optional search-description)
6206   "List all newsgroups that have names that match a regexp."
6207   (interactive "sGnus apropos (regexp): ")
6208   (let ((prev "")
6209         (obuf (current-buffer))
6210         groups des)
6211     ;; Go through all newsgroups that are known to Gnus.
6212     (mapatoms
6213      (lambda (group)
6214        (and (symbol-name group)
6215             (string-match regexp (symbol-name group))
6216             (setq groups (cons (symbol-name group) groups))))
6217      gnus-active-hashtb)
6218     ;; Go through all descriptions that are known to Gnus.
6219     (if search-description
6220         (mapatoms
6221          (lambda (group)
6222            (and (string-match regexp (symbol-value group))
6223                 (gnus-active (symbol-name group))
6224                 (setq groups (cons (symbol-name group) groups))))
6225          gnus-description-hashtb))
6226     (if (not groups)
6227         (gnus-message 3 "No groups matched \"%s\"." regexp)
6228       ;; Print out all the groups.
6229       (save-excursion
6230         (pop-to-buffer "*Gnus Help*")
6231         (buffer-disable-undo (current-buffer))
6232         (erase-buffer)
6233         (setq groups (sort groups 'string<))
6234         (while groups
6235           ;; Groups may be entered twice into the list of groups.
6236           (if (not (string= (car groups) prev))
6237               (progn
6238                 (insert (setq prev (car groups)) "\n")
6239                 (if (and gnus-description-hashtb
6240                          (setq des (gnus-gethash (car groups)
6241                                                  gnus-description-hashtb)))
6242                     (insert "  " des "\n"))))
6243           (setq groups (cdr groups)))
6244         (goto-char (point-min))))
6245     (pop-to-buffer obuf)))
6246
6247 (defun gnus-group-description-apropos (regexp)
6248   "List all newsgroups that have names or descriptions that match a regexp."
6249   (interactive "sGnus description apropos (regexp): ")
6250   (if (not (or gnus-description-hashtb
6251                (gnus-read-all-descriptions-files)))
6252       (error "Couldn't request descriptions file"))
6253   (gnus-group-apropos regexp t))
6254
6255 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6256 (defun gnus-group-list-matching (level regexp &optional all lowest)
6257   "List all groups with unread articles that match REGEXP.
6258 If the prefix LEVEL is non-nil, it should be a number that says which
6259 level to cut off listing groups.
6260 If ALL, also list groups with no unread articles.
6261 If LOWEST, don't list groups with level lower than LOWEST."
6262   (interactive "P\nsList newsgroups matching: ")
6263   (gnus-group-prepare-flat (or level gnus-level-subscribed)
6264                            all (or lowest 1) regexp)
6265   (goto-char (point-min))
6266   (gnus-group-position-point))
6267
6268 (defun gnus-group-list-all-matching (level regexp &optional lowest)
6269   "List all groups that match REGEXP.
6270 If the prefix LEVEL is non-nil, it should be a number that says which
6271 level to cut off listing groups.
6272 If LOWEST, don't list groups with level lower than LOWEST."
6273   (interactive "P\nsList newsgroups matching: ")
6274   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
6275
6276 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
6277 (defun gnus-group-save-newsrc (&optional force)
6278   "Save the Gnus startup files.
6279 If FORCE, force saving whether it is necessary or not."
6280   (interactive "P")
6281   (gnus-save-newsrc-file force))
6282
6283 (defun gnus-group-restart (&optional arg)
6284   "Force Gnus to read the .newsrc file."
6285   (interactive "P")
6286   (gnus-save-newsrc-file)
6287   (gnus-setup-news 'force)
6288   (gnus-group-list-groups arg))
6289
6290 (defun gnus-group-read-init-file ()
6291   "Read the Gnus elisp init file."
6292   (interactive)
6293   (gnus-read-init-file))
6294
6295 (defun gnus-group-check-bogus-groups (&optional silent)
6296   "Check bogus newsgroups.
6297 If given a prefix, don't ask for confirmation before removing a bogus
6298 group."
6299   (interactive "P")
6300   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
6301   (gnus-group-list-groups))
6302
6303 (defun gnus-group-edit-global-kill (&optional article group)
6304   "Edit the global kill file.
6305 If GROUP, edit that local kill file instead."
6306   (interactive "P")
6307   (setq gnus-current-kill-article article)
6308   (gnus-kill-file-edit-file group)
6309   (gnus-message
6310    6
6311    (substitute-command-keys
6312     (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
6313             (if group "local" "global")))))
6314
6315 (defun gnus-group-edit-local-kill (article group)
6316   "Edit a local kill file."
6317   (interactive (list nil (gnus-group-group-name)))
6318   (gnus-group-edit-global-kill article group))
6319
6320 (defun gnus-group-force-update ()
6321   "Update `.newsrc' file."
6322   (interactive)
6323   (gnus-save-newsrc-file))
6324
6325 (defun gnus-group-suspend ()
6326   "Suspend the current Gnus session.
6327 In fact, cleanup buffers except for group mode buffer.
6328 The hook gnus-suspend-gnus-hook is called before actually suspending."
6329   (interactive)
6330   (run-hooks 'gnus-suspend-gnus-hook)
6331   ;; Kill Gnus buffers except for group mode buffer.
6332   (let ((group-buf (get-buffer gnus-group-buffer)))
6333     ;; Do this on a separate list in case the user does a ^G before we finish
6334     (let ((gnus-buffer-list
6335            (delq group-buf (delq gnus-dribble-buffer
6336                                  (append gnus-buffer-list nil)))))
6337       (while gnus-buffer-list
6338         (gnus-kill-buffer (car gnus-buffer-list))
6339         (setq gnus-buffer-list (cdr gnus-buffer-list))))
6340     (if group-buf
6341         (progn
6342           (setq gnus-buffer-list (list group-buf))
6343           (bury-buffer group-buf)
6344           (delete-windows-on group-buf t)))))
6345
6346 (defun gnus-group-clear-dribble ()
6347   "Clear all information from the dribble buffer."
6348   (interactive)
6349   (gnus-dribble-clear)
6350   (gnus-message 7 "Cleared dribble buffer"))
6351
6352 (defun gnus-group-exit ()
6353   "Quit reading news after updating .newsrc.eld and .newsrc.
6354 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6355   (interactive)
6356   (if (or noninteractive                ;For gnus-batch-kill
6357           (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
6358           (not gnus-interactive-exit)   ;Without confirmation
6359           gnus-expert-user
6360           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
6361       (progn
6362         (run-hooks 'gnus-exit-gnus-hook)
6363         ;; Offer to save data from non-quitted summary buffers.
6364         (gnus-offer-save-summaries)
6365         ;; Save the newsrc file(s).
6366         (gnus-save-newsrc-file)
6367         ;; Kill-em-all.
6368         (gnus-close-backends)
6369         ;; Shut down the cache.
6370         (when gnus-use-cache
6371           (gnus-cache-close))
6372         ;; Reset everything.
6373         (gnus-clear-system))))
6374
6375 (defun gnus-close-backends ()
6376   ;; Send a close request to all backends that support such a request.
6377   (let ((methods gnus-valid-select-methods)
6378         func)
6379     (while methods
6380       (if (fboundp (setq func (intern (concat (car (car methods))
6381                                               "-request-close"))))
6382           (funcall func))
6383       (setq methods (cdr methods)))))
6384
6385 (defun gnus-group-quit ()
6386   "Quit reading news without updating .newsrc.eld or .newsrc.
6387 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6388   (interactive)
6389   (when (or noninteractive              ;For gnus-batch-kill
6390             (zerop (buffer-size))
6391             (not (gnus-server-opened gnus-select-method))
6392             gnus-expert-user
6393             (not gnus-current-startup-file)
6394             (gnus-yes-or-no-p
6395              (format "Quit reading news without saving %s? "
6396                      (file-name-nondirectory gnus-current-startup-file))))
6397     (run-hooks 'gnus-exit-gnus-hook)
6398     (if gnus-use-full-window
6399         (delete-other-windows)
6400       (gnus-remove-some-windows))
6401     (gnus-dribble-save)
6402     (gnus-close-backends)
6403     ;; Shut down the cache.
6404     (when gnus-use-cache
6405       (gnus-cache-close))
6406     (gnus-clear-system)))
6407
6408 (defun gnus-offer-save-summaries ()
6409   "Offer to save all active summary buffers."
6410   (save-excursion
6411     (let ((buflist (buffer-list))
6412           buffers bufname)
6413       ;; Go through all buffers and find all summaries.
6414       (while buflist
6415         (and (setq bufname (buffer-name (car buflist)))
6416              (string-match "Summary" bufname)
6417              (save-excursion
6418                (set-buffer bufname)
6419                ;; We check that this is, indeed, a summary buffer.
6420                (and (eq major-mode 'gnus-summary-mode)
6421                     ;; Also make sure this isn't bogus.
6422                     gnus-newsgroup-prepared))
6423              (push bufname buffers))
6424         (setq buflist (cdr buflist)))
6425       ;; Go through all these summary buffers and offer to save them.
6426       (when buffers
6427         (map-y-or-n-p
6428          "Update summary buffer %s? "
6429          (lambda (buf) (set-buffer buf) (gnus-summary-exit))
6430          buffers)))))
6431
6432 (defun gnus-group-describe-briefly ()
6433   "Give a one line description of the group mode commands."
6434   (interactive)
6435   (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")))
6436
6437 (defun gnus-group-browse-foreign-server (method)
6438   "Browse a foreign news server.
6439 If called interactively, this function will ask for a select method
6440  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
6441 If not, METHOD should be a list where the first element is the method
6442 and the second element is the address."
6443   (interactive
6444    (list (let ((how (completing-read
6445                      "Which backend: "
6446                      (append gnus-valid-select-methods gnus-server-alist)
6447                      nil t (cons "nntp" 0))))
6448            ;; We either got a backend name or a virtual server name.
6449            ;; If the first, we also need an address.
6450            (if (assoc how gnus-valid-select-methods)
6451                (list (intern how)
6452                      ;; Suggested by mapjph@bath.ac.uk.
6453                      (completing-read
6454                       "Address: "
6455                       (mapcar (lambda (server) (list server))
6456                               gnus-secondary-servers)))
6457              ;; We got a server name, so we find the method.
6458              (gnus-server-to-method how)))))
6459   (gnus-browse-foreign-server method))
6460
6461 \f
6462 ;;;
6463 ;;; Gnus summary mode
6464 ;;;
6465
6466 (defvar gnus-summary-mode-map nil)
6467
6468 (put 'gnus-summary-mode 'mode-class 'special)
6469
6470 (unless gnus-summary-mode-map
6471   (setq gnus-summary-mode-map (make-keymap))
6472   (suppress-keymap gnus-summary-mode-map)
6473
6474   ;; Non-orthogonal keys
6475
6476   (gnus-define-keys
6477    gnus-summary-mode-map
6478    " " gnus-summary-next-page
6479    "\177" gnus-summary-prev-page
6480    "\r" gnus-summary-scroll-up
6481    "n" gnus-summary-next-unread-article
6482    "p" gnus-summary-prev-unread-article
6483    "N" gnus-summary-next-article
6484    "P" gnus-summary-prev-article
6485    "\M-\C-n" gnus-summary-next-same-subject
6486    "\M-\C-p" gnus-summary-prev-same-subject
6487    "\M-n" gnus-summary-next-unread-subject
6488    "\M-p" gnus-summary-prev-unread-subject
6489    "." gnus-summary-first-unread-article
6490    "," gnus-summary-best-unread-article
6491    "\M-s" gnus-summary-search-article-forward
6492    "\M-r" gnus-summary-search-article-backward
6493    "<" gnus-summary-beginning-of-article
6494    ">" gnus-summary-end-of-article
6495    "j" gnus-summary-goto-article
6496    "^" gnus-summary-refer-parent-article
6497    "\M-^" gnus-summary-refer-article
6498    "u" gnus-summary-tick-article-forward
6499    "!" gnus-summary-tick-article-forward
6500    "U" gnus-summary-tick-article-backward
6501    "d" gnus-summary-mark-as-read-forward
6502    "D" gnus-summary-mark-as-read-backward
6503    "E" gnus-summary-mark-as-expirable
6504    "\M-u" gnus-summary-clear-mark-forward
6505    "\M-U" gnus-summary-clear-mark-backward
6506    "k" gnus-summary-kill-same-subject-and-select
6507    "\C-k" gnus-summary-kill-same-subject
6508    "\M-\C-k" gnus-summary-kill-thread
6509    "\M-\C-l" gnus-summary-lower-thread
6510    "e" gnus-summary-edit-article
6511    "#" gnus-summary-mark-as-processable
6512    "\M-#" gnus-summary-unmark-as-processable
6513    "\M-\C-t" gnus-summary-toggle-threads
6514    "\M-\C-s" gnus-summary-show-thread
6515    "\M-\C-h" gnus-summary-hide-thread
6516    "\M-\C-f" gnus-summary-next-thread
6517    "\M-\C-b" gnus-summary-prev-thread
6518    "\M-\C-u" gnus-summary-up-thread
6519    "\M-\C-d" gnus-summary-down-thread
6520    "&" gnus-summary-execute-command
6521    "c" gnus-summary-catchup-and-exit
6522    "\C-w" gnus-summary-mark-region-as-read
6523    "\C-t" gnus-summary-toggle-truncation
6524    "?" gnus-summary-mark-as-dormant
6525    "\C-c\M-\C-s" gnus-summary-limit-include-expunged
6526    "\C-c\C-s\C-n" gnus-summary-sort-by-number
6527    "\C-c\C-s\C-a" gnus-summary-sort-by-author
6528    "\C-c\C-s\C-s" gnus-summary-sort-by-subject
6529    "\C-c\C-s\C-d" gnus-summary-sort-by-date
6530    "\C-c\C-s\C-i" gnus-summary-sort-by-score
6531    "=" gnus-summary-expand-window
6532    "\C-x\C-s" gnus-summary-reselect-current-group
6533    "\M-g" gnus-summary-rescan-group
6534    "w" gnus-summary-stop-page-breaking
6535    "\C-c\C-r" gnus-summary-caesar-message
6536    "\M-t" gnus-summary-toggle-mime
6537    "f" gnus-summary-followup
6538    "F" gnus-summary-followup-with-original
6539    "C" gnus-summary-cancel-article
6540    "r" gnus-summary-reply
6541    "R" gnus-summary-reply-with-original
6542    "\C-c\C-f" gnus-summary-mail-forward
6543    "o" gnus-summary-save-article
6544    "\C-o" gnus-summary-save-article-mail
6545    "|" gnus-summary-pipe-output
6546    "\M-k" gnus-summary-edit-local-kill
6547    "\M-K" gnus-summary-edit-global-kill
6548    "V" gnus-version
6549    "\C-c\C-d" gnus-summary-describe-group
6550    "q" gnus-summary-exit
6551    "Q" gnus-summary-exit-no-update
6552    "\C-c\C-i" gnus-info-find-node
6553    gnus-mouse-2 gnus-mouse-pick-article
6554    "m" gnus-summary-mail-other-window
6555    "a" gnus-summary-post-news
6556    "x" gnus-summary-limit-to-unread
6557    "s" gnus-summary-isearch-article
6558    "t" gnus-article-hide-headers
6559    "g" gnus-summary-show-article
6560    "l" gnus-summary-goto-last-article
6561    "\C-c\C-v\C-v" gnus-uu-decode-uu-view
6562    "\C-d" gnus-summary-enter-digest-group
6563    "\C-c\C-b" gnus-bug
6564    "*" gnus-cache-enter-article
6565    "\M-*" gnus-cache-remove-article
6566    "\M-&" gnus-summary-universal-argument
6567    "\C-l" gnus-recenter
6568    "I" gnus-summary-increase-score
6569    "L" gnus-summary-lower-score
6570
6571    "V" gnus-summary-score-map
6572    "X" gnus-uu-extract-map
6573    "S" gnus-summary-send-map)
6574
6575   ;; Sort of orthogonal keymap
6576   (gnus-define-keys
6577    (gnus-summary-mark-map "M" gnus-summary-mode-map)
6578    "t" gnus-summary-tick-article-forward
6579    "!" gnus-summary-tick-article-forward
6580    "d" gnus-summary-mark-as-read-forward
6581    "r" gnus-summary-mark-as-read-forward
6582    "c" gnus-summary-clear-mark-forward
6583    " " gnus-summary-clear-mark-forward
6584    "e" gnus-summary-mark-as-expirable
6585    "x" gnus-summary-mark-as-expirable
6586    "?" gnus-summary-mark-as-dormant
6587    "b" gnus-summary-set-bookmark
6588    "B" gnus-summary-remove-bookmark
6589    "#" gnus-summary-mark-as-processable
6590    "\M-#" gnus-summary-unmark-as-processable
6591    "S" gnus-summary-limit-include-expunged
6592    "C" gnus-summary-catchup
6593    "H" gnus-summary-catchup-to-here
6594    "\C-c" gnus-summary-catchup-all
6595    "k" gnus-summary-kill-same-subject-and-select
6596    "K" gnus-summary-kill-same-subject
6597    "P" gnus-uu-mark-map)
6598
6599   (gnus-define-keys
6600    (gnus-summary-mscore-map "V" gnus-summary-mode-map)
6601    "c" gnus-summary-clear-above
6602    "u" gnus-summary-tick-above
6603    "m" gnus-summary-mark-above
6604    "k" gnus-summary-kill-below)
6605
6606   (gnus-define-keys
6607    (gnus-summary-limit-map "/" gnus-summary-mode-map)
6608    "/" gnus-summary-limit-to-subject
6609    "n" gnus-summary-limit-to-articles
6610    "w" gnus-summary-pop-limit
6611    "s" gnus-summary-limit-to-subject
6612    "a" gnus-summary-limit-to-author
6613    "u" gnus-summary-limit-to-unread
6614    "m" gnus-summary-limit-to-marks
6615    "v" gnus-summary-limit-to-score
6616    "D" gnus-summary-limit-include-dormant
6617    "d" gnus-summary-limit-exclude-dormant
6618 ;;  "t" gnus-summary-limit-exclude-thread
6619    "E" gnus-summary-limit-include-expunged
6620    "c" gnus-summary-limit-exclude-childless-dormant
6621    "C" gnus-summary-limit-mark-excluded-as-read)
6622
6623   (gnus-define-keys
6624    (gnus-summary-goto-map "G" gnus-summary-mode-map)
6625    "n" gnus-summary-next-unread-article
6626    "p" gnus-summary-prev-unread-article
6627    "N" gnus-summary-next-article
6628    "P" gnus-summary-prev-article
6629    "\C-n" gnus-summary-next-same-subject
6630    "\C-p" gnus-summary-prev-same-subject
6631    "\M-n" gnus-summary-next-unread-subject
6632    "\M-p" gnus-summary-prev-unread-subject
6633    "f" gnus-summary-first-unread-article
6634    "b" gnus-summary-best-unread-article
6635    "g" gnus-summary-goto-subject
6636    "l" gnus-summary-goto-last-article
6637    "p" gnus-summary-pop-article)
6638
6639   (gnus-define-keys
6640    (gnus-summary-thread-map "T" gnus-summary-mode-map)
6641    "k" gnus-summary-kill-thread
6642    "l" gnus-summary-lower-thread
6643    "i" gnus-summary-raise-thread
6644    "T" gnus-summary-toggle-threads
6645    "t" gnus-summary-rethread-current
6646    "^" gnus-summary-reparent-thread
6647    "s" gnus-summary-show-thread
6648    "S" gnus-summary-show-all-threads
6649    "h" gnus-summary-hide-thread
6650    "H" gnus-summary-hide-all-threads
6651    "n" gnus-summary-next-thread
6652    "p" gnus-summary-prev-thread
6653    "u" gnus-summary-up-thread
6654    "o" gnus-summary-top-thread
6655    "d" gnus-summary-down-thread
6656    "#" gnus-uu-mark-thread
6657    "\M-#" gnus-uu-unmark-thread)
6658
6659   (gnus-define-keys
6660    (gnus-summary-exit-map "Z" gnus-summary-mode-map)
6661    "c" gnus-summary-catchup-and-exit
6662    "C" gnus-summary-catchup-all-and-exit
6663    "E" gnus-summary-exit-no-update
6664    "Q" gnus-summary-exit
6665    "Z" gnus-summary-exit
6666    "n" gnus-summary-catchup-and-goto-next-group
6667    "R" gnus-summary-reselect-current-group
6668    "G" gnus-summary-rescan-group
6669    "N" gnus-summary-next-group
6670    "P" gnus-summary-prev-group)
6671
6672   (gnus-define-keys
6673    (gnus-summary-article-map "A" gnus-summary-mode-map)
6674    " " gnus-summary-next-page
6675    "n" gnus-summary-next-page
6676    "\177" gnus-summary-prev-page
6677    "p" gnus-summary-prev-page
6678    "\r" gnus-summary-scroll-up
6679    "<" gnus-summary-beginning-of-article
6680    ">" gnus-summary-end-of-article
6681    "b" gnus-summary-beginning-of-article
6682    "e" gnus-summary-end-of-article
6683    "^" gnus-summary-refer-parent-article
6684    "r" gnus-summary-refer-parent-article
6685    "R" gnus-summary-refer-references
6686    "g" gnus-summary-show-article
6687    "s" gnus-summary-isearch-article)
6688
6689   (gnus-define-keys
6690    (gnus-summary-wash-map "W" gnus-summary-mode-map)
6691    "b" gnus-article-add-buttons
6692    "B" gnus-article-add-buttons-to-head
6693    "o" gnus-article-treat-overstrike
6694 ;;  "w" gnus-article-word-wrap
6695    "w" gnus-article-fill-cited-article
6696    "c" gnus-article-remove-cr
6697    "L" gnus-article-remove-trailing-blank-lines
6698    "q" gnus-article-de-quoted-unreadable
6699    "f" gnus-article-display-x-face
6700    "l" gnus-summary-stop-page-breaking
6701    "r" gnus-summary-caesar-message
6702    "t" gnus-summary-toggle-header
6703    "v" gnus-summary-verbose-headers
6704    "m" gnus-summary-toggle-mime)
6705
6706   (gnus-define-keys
6707    (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
6708    "a" gnus-article-hide
6709    "h" gnus-article-hide-headers
6710    "b" gnus-article-hide-boring-headers
6711    "s" gnus-article-hide-signature
6712    "c" gnus-article-hide-citation
6713    "p" gnus-article-hide-pgp
6714    "\C-c" gnus-article-hide-citation-maybe)
6715
6716   (gnus-define-keys
6717    (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
6718    "a" gnus-article-highlight
6719    "h" gnus-article-highlight-headers
6720    "c" gnus-article-highlight-citation
6721    "s" gnus-article-highlight-signature)
6722
6723   (gnus-define-keys
6724    (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
6725    "z" gnus-article-date-ut
6726    "u" gnus-article-date-ut
6727    "l" gnus-article-date-local
6728    "e" gnus-article-date-lapsed
6729    "o" gnus-article-date-original)
6730
6731   (gnus-define-keys
6732    (gnus-summary-help-map "H" gnus-summary-mode-map)
6733    "v" gnus-version
6734    "f" gnus-summary-fetch-faq
6735    "d" gnus-summary-describe-group
6736    "h" gnus-summary-describe-briefly
6737    "i" gnus-info-find-node)
6738
6739   (gnus-define-keys
6740    (gnus-summary-backend-map "B" gnus-summary-mode-map)
6741    "e" gnus-summary-expire-articles
6742    "\M-\C-e" gnus-summary-expire-articles-now
6743    "\177" gnus-summary-delete-article
6744    "m" gnus-summary-move-article
6745    "r" gnus-summary-respool-article
6746    "w" gnus-summary-edit-article
6747    "c" gnus-summary-copy-article
6748    "B" gnus-summary-crosspost-article
6749    "q" gnus-summary-respool-query
6750    "i" gnus-summary-import-article)
6751
6752   (gnus-define-keys
6753    (gnus-summary-save-map "O" gnus-summary-mode-map)
6754    "o" gnus-summary-save-article
6755    "m" gnus-summary-save-article-mail
6756    "r" gnus-summary-save-article-rmail
6757    "f" gnus-summary-save-article-file
6758    "b" gnus-summary-save-article-body-file
6759    "h" gnus-summary-save-article-folder
6760    "v" gnus-summary-save-article-vm
6761    "p" gnus-summary-pipe-output
6762    "s" gnus-soup-add-article)
6763   )
6764
6765
6766 \f
6767
6768 (defun gnus-summary-mode (&optional group)
6769   "Major mode for reading articles.
6770
6771 All normal editing commands are switched off.
6772 \\<gnus-summary-mode-map>
6773 Each line in this buffer represents one article.  To read an
6774 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
6775 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
6776 respectively.
6777
6778 You can also post articles and send mail from this buffer.  To
6779 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author
6780 of an article, type `\\[gnus-summary-reply]'.
6781
6782 There are approx. one gazillion commands you can execute in this
6783 buffer; read the info pages for more information (`\\[gnus-info-find-node]').
6784
6785 The following commands are available:
6786
6787 \\{gnus-summary-mode-map}"
6788   (interactive)
6789   (when (and menu-bar-mode
6790              (gnus-visual-p 'summary-menu 'menu))
6791     (gnus-summary-make-menu-bar))
6792   (kill-all-local-variables)
6793   (let ((locals gnus-summary-local-variables))
6794     (while locals
6795       (if (consp (car locals))
6796           (progn
6797             (make-local-variable (car (car locals)))
6798             (set (car (car locals)) (eval (cdr (car locals)))))
6799         (make-local-variable (car locals))
6800         (set (car locals) nil))
6801       (setq locals (cdr locals))))
6802   (gnus-make-thread-indent-array)
6803   (gnus-simplify-mode-line)
6804   (setq major-mode 'gnus-summary-mode)
6805   (setq mode-name "Summary")
6806   (make-local-variable 'minor-mode-alist)
6807   (use-local-map gnus-summary-mode-map)
6808   (buffer-disable-undo (current-buffer))
6809   (setq buffer-read-only t)             ;Disable modification
6810   (setq truncate-lines t)
6811   (setq selective-display t)
6812   (setq selective-display-ellipses t)   ;Display `...'
6813   (setq buffer-display-table gnus-summary-display-table)
6814   (setq gnus-newsgroup-name group)
6815   (run-hooks 'gnus-summary-mode-hook))
6816
6817 (defun gnus-summary-make-display-table ()
6818   ;; Change the display table.  Odd characters have a tendency to mess
6819   ;; up nicely formatted displays - we make all possible glyphs
6820   ;; display only a single character.
6821
6822   ;; We start from the standard display table, if any.
6823   (setq gnus-summary-display-table
6824         (or (copy-sequence standard-display-table)
6825             (make-display-table)))
6826   ;; Nix out all the control chars...
6827   (let ((i 32))
6828     (while (>= (setq i (1- i)) 0)
6829       (aset gnus-summary-display-table i [??])))
6830   ;; ... but not newline and cr, of course. (cr is necessary for the
6831   ;; selective display).
6832   (aset gnus-summary-display-table ?\n nil)
6833   (aset gnus-summary-display-table ?\r nil)
6834   ;; We nix out any glyphs over 126 that are not set already.
6835   (let ((i 256))
6836     (while (>= (setq i (1- i)) 127)
6837       ;; Only modify if the entry is nil.
6838       (or (aref gnus-summary-display-table i)
6839           (aset gnus-summary-display-table i [??])))))
6840
6841 (defun gnus-summary-clear-local-variables ()
6842   (let ((locals gnus-summary-local-variables))
6843     (while locals
6844       (if (consp (car locals))
6845           (and (vectorp (car (car locals)))
6846                (set (car (car locals)) nil))
6847         (and (vectorp (car locals))
6848              (set (car locals) nil)))
6849       (setq locals (cdr locals)))))
6850
6851 ;; Summary data functions.
6852
6853 (defmacro gnus-data-number (data)
6854   `(car ,data))
6855
6856 (defmacro gnus-data-set-number (data number)
6857   `(setcar ,data ,number))
6858
6859 (defmacro gnus-data-mark (data)
6860   `(nth 1 ,data))
6861
6862 (defmacro gnus-data-set-mark (data mark)
6863   `(setcar (nthcdr 1 ,data) ,mark))
6864
6865 (defmacro gnus-data-pos (data)
6866   `(nth 2 ,data))
6867
6868 (defmacro gnus-data-set-pos (data pos)
6869   `(setcar (nthcdr 2 ,data) ,pos))
6870
6871 (defmacro gnus-data-header (data)
6872   `(nth 3 ,data))
6873
6874 (defmacro gnus-data-level (data)
6875   `(nth 4 ,data))
6876
6877 (defmacro gnus-data-unread-p (data)
6878   `(= (nth 1 ,data) gnus-unread-mark))
6879
6880 (defmacro gnus-data-pseudo-p (data)
6881   `(consp (nth 3 ,data)))
6882
6883 (defmacro gnus-data-find (number)
6884   `(assq ,number gnus-newsgroup-data))
6885
6886 (defmacro gnus-data-find-list (number &optional data)
6887   `(let ((bdata ,(or data 'gnus-newsgroup-data)))
6888      (memq (assq ,number bdata)
6889            bdata)))
6890
6891 (defmacro gnus-data-make (number mark pos header level)
6892   `(list ,number ,mark ,pos ,header ,level))
6893
6894 (defun gnus-data-enter (after-article number mark pos header level offset)
6895   (let ((data (gnus-data-find-list after-article)))
6896     (or data (error "No such article: %d" after-article))
6897     (setcdr data (cons (gnus-data-make number mark pos header level)
6898                        (cdr data)))
6899     (setq gnus-newsgroup-data-reverse nil)
6900     (gnus-data-update-list (cdr (cdr data)) offset)))
6901
6902 (defun gnus-data-enter-list (after-article list &optional offset)
6903   (when list
6904     (let ((data (and after-article (gnus-data-find-list after-article)))
6905           (ilist list))
6906       (or data (not after-article) (error "No such article: %d" after-article))
6907       ;; Find the last element in the list to be spliced into the main
6908       ;; list.
6909       (while (cdr list)
6910         (setq list (cdr list)))
6911       (if (not data)
6912           (progn
6913             (setcdr list gnus-newsgroup-data)
6914             (setq gnus-newsgroup-data ilist)
6915             (and offset (gnus-data-update-list (cdr list) offset)))
6916         (setcdr list (cdr data))
6917         (setcdr data ilist)
6918         (and offset (gnus-data-update-list (cdr data) offset)))
6919       (setq gnus-newsgroup-data-reverse nil))))
6920
6921 (defun gnus-data-remove (article &optional offset)
6922   (let ((data gnus-newsgroup-data))
6923     (if (= (gnus-data-number (car data)) article)
6924         (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
6925               gnus-newsgroup-data-reverse nil)
6926       (while (cdr data)
6927         (and (= (gnus-data-number (car (cdr data))) article)
6928              (progn
6929                (setcdr data (cdr (cdr data)))
6930                (and offset (gnus-data-update-list (cdr data) offset))
6931                (setq data nil
6932                      gnus-newsgroup-data-reverse nil)))
6933         (setq data (cdr data))))))
6934
6935 (defmacro gnus-data-list (backward)
6936   `(if ,backward
6937        (or gnus-newsgroup-data-reverse
6938            (setq gnus-newsgroup-data-reverse
6939                  (reverse gnus-newsgroup-data)))
6940      gnus-newsgroup-data))
6941
6942 (defun gnus-data-update-list (data offset)
6943   "Add OFFSET to the POS of all data entries in DATA."
6944   (while data
6945     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
6946     (setq data (cdr data))))
6947
6948 (defun gnus-data-compute-positions ()
6949   "Compute the positions of all articles."
6950   (let ((data gnus-newsgroup-data)
6951         pos)
6952     (while data
6953       (when (setq pos (text-property-any
6954                        (point-min) (point-max)
6955                        'gnus-number (gnus-data-number (car data))))
6956         (gnus-data-set-pos (car data) (+ pos 3)))
6957       (setq data (cdr data)))))
6958
6959 (defun gnus-summary-article-pseudo-p (article)
6960   "Say whether this article is a pseudo article or not."
6961   (not (vectorp (gnus-data-header (gnus-data-find article)))))
6962
6963 (defun gnus-article-parent-p (number)
6964   "Say whether this article is a parent or not."
6965   (let* ((data (gnus-data-find-list number)))
6966     (and (cdr data)                     ; There has to be an article after...
6967          (< (gnus-data-level (car data)) ; And it has to have a higher level.
6968             (gnus-data-level (nth 1 data))))))
6969
6970 (defmacro gnus-summary-skip-intangible ()
6971   "If the current article is intangible, then jump to a different article."
6972   '(let ((to (get-text-property (point) 'gnus-intangible)))
6973     (when to
6974       (gnus-summary-goto-subject to))))
6975
6976 (defmacro gnus-summary-article-intangible-p ()
6977   "Say whether this article is intangible or not."
6978   '(get-text-property (point) 'gnus-intangible))
6979
6980 ;; Some summary mode macros.
6981
6982 (defmacro gnus-summary-article-number ()
6983   "The article number of the article on the current line.
6984 If there isn's an article number here, then we return the current
6985 article number."
6986   '(progn
6987      (gnus-summary-skip-intangible)
6988      (or (get-text-property (point) 'gnus-number)
6989          (gnus-summary-last-subject))))
6990
6991 (defmacro gnus-summary-article-header (&optional number)
6992   `(gnus-data-header (gnus-data-find
6993                       ,(or number '(gnus-summary-article-number)))))
6994
6995 (defmacro gnus-summary-thread-level (&optional number)
6996   `(if (and (eq gnus-summary-make-false-root 'dummy)
6997             (get-text-property (point) 'gnus-intangible))
6998        0
6999      (gnus-data-level (gnus-data-find
7000                        ,(or number '(gnus-summary-article-number))))))
7001
7002 (defmacro gnus-summary-article-mark (&optional number)
7003   `(gnus-data-mark (gnus-data-find
7004                     ,(or number '(gnus-summary-article-number)))))
7005
7006 (defmacro gnus-summary-article-pos (&optional number)
7007   `(gnus-data-pos (gnus-data-find
7008                    ,(or number '(gnus-summary-article-number)))))
7009
7010 (defmacro gnus-summary-article-subject (&optional number)
7011   "Return current subject string or nil if nothing."
7012   `(let ((headers
7013           ,(if number
7014                `(gnus-data-header (assq ,number gnus-newsgroup-data))
7015              '(gnus-data-header (assq (gnus-summary-article-number)
7016                                       gnus-newsgroup-data)))))
7017      (and headers
7018           (vectorp headers)
7019           (mail-header-subject headers))))
7020
7021 (defmacro gnus-summary-article-score (&optional number)
7022   "Return current article score."
7023   `(or (cdr (assq ,(or number '(gnus-summary-article-number))
7024                   gnus-newsgroup-scored))
7025        gnus-summary-default-score 0))
7026
7027 (defun gnus-summary-article-children (&optional number)
7028   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
7029          (level (gnus-data-level (car data)))
7030          l children)
7031     (while (and (setq data (cdr data))
7032                 (> (setq l (gnus-data-level (car data))) level))
7033       (and (= (1+ level) l)
7034            (setq children (cons (gnus-data-number (car data))
7035                                 children))))
7036     (nreverse children)))
7037
7038 (defun gnus-summary-article-parent (&optional number)
7039   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
7040                                     (gnus-data-list t)))
7041          (level (gnus-data-level (car data)))
7042          l)
7043     (if (zerop level)
7044         () ; This is a root.
7045       ;; We search until we find an article with a level less than
7046       ;; this one.  That function has to be the parent.
7047       (while (and (setq data (cdr data))
7048                   (not (< (gnus-data-level (car data)) level))))
7049       (and data (gnus-data-number (car data))))))
7050
7051
7052 ;; Various summary mode internalish functions.
7053
7054 (defun gnus-mouse-pick-article (e)
7055   (interactive "e")
7056   (mouse-set-point e)
7057   (gnus-summary-next-page nil t))
7058
7059 (defun gnus-summary-setup-buffer (group)
7060   "Initialize summary buffer."
7061   (let ((buffer (concat "*Summary " group "*")))
7062     (if (get-buffer buffer)
7063         (progn
7064           (set-buffer buffer)
7065           (setq gnus-summary-buffer (current-buffer))
7066           (not gnus-newsgroup-prepared))
7067       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
7068       (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
7069       (gnus-add-current-to-buffer-list)
7070       (gnus-summary-mode group)
7071       (when gnus-carpal
7072         (gnus-carpal-setup-buffer 'summary))
7073       (unless gnus-single-article-buffer
7074         (make-local-variable 'gnus-article-buffer)
7075         (make-local-variable 'gnus-original-article-buffer))
7076       (setq gnus-newsgroup-name group)
7077       t)))
7078
7079 (defun gnus-set-global-variables ()
7080   ;; Set the global equivalents of the summary buffer-local variables
7081   ;; to the latest values they had.  These reflect the summary buffer
7082   ;; that was in action when the last article was fetched.
7083   (when (eq major-mode 'gnus-summary-mode)
7084     (setq gnus-summary-buffer (current-buffer))
7085     (let ((name gnus-newsgroup-name)
7086           (marked gnus-newsgroup-marked)
7087           (unread gnus-newsgroup-unreads)
7088           (headers gnus-current-headers)
7089           (data gnus-newsgroup-data)
7090           (article-buffer gnus-article-buffer)
7091           (score-file gnus-current-score-file))
7092       (save-excursion
7093         (set-buffer gnus-group-buffer)
7094         (setq gnus-newsgroup-name name)
7095         (setq gnus-newsgroup-marked marked)
7096         (setq gnus-newsgroup-unreads unread)
7097         (setq gnus-current-headers headers)
7098         (setq gnus-newsgroup-data data)
7099         (setq gnus-article-buffer article-buffer)
7100         (setq gnus-current-score-file score-file)))))
7101
7102 (defun gnus-summary-last-article-p (&optional article)
7103   "Return whether ARTICLE is the last article in the buffer."
7104   (if (not (setq article (or article (gnus-summary-article-number))))
7105       t ; All non-existant numbers are the last article. :-)
7106     (cdr (gnus-data-find-list article))))
7107
7108 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
7109   "Insert a dummy root in the summary buffer."
7110   (beginning-of-line)
7111   (add-text-properties
7112    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
7113    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
7114
7115 (defvar gnus-thread-indent-array nil)
7116 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
7117 (defun gnus-make-thread-indent-array ()
7118   (let ((n 200))
7119     (if (and gnus-thread-indent-array
7120              (= gnus-thread-indent-level gnus-thread-indent-array-level))
7121         nil
7122       (setq gnus-thread-indent-array (make-vector 201 "")
7123             gnus-thread-indent-array-level gnus-thread-indent-level)
7124       (while (>= n 0)
7125         (aset gnus-thread-indent-array n
7126               (make-string (* n gnus-thread-indent-level) ? ))
7127         (setq n (1- n))))))
7128
7129 (defun gnus-summary-insert-line
7130   (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread
7131                    gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
7132                    &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
7133   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
7134          (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
7135          (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
7136          (gnus-tmp-score-char
7137           (if (or (null gnus-summary-default-score)
7138                   (<= (abs (- gnus-tmp-score gnus-summary-default-score))
7139                       gnus-summary-zcore-fuzz)) ? 
7140             (if (< gnus-tmp-score gnus-summary-default-score)
7141                 gnus-score-below-mark gnus-score-over-mark)))
7142          (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark)
7143                                  ((memq gnus-tmp-current gnus-newsgroup-cached)
7144                                   gnus-cached-mark)
7145                                  (gnus-tmp-replied gnus-replied-mark)
7146                                  ((memq gnus-tmp-current gnus-newsgroup-saved)
7147                                   gnus-saved-mark)
7148                                  (t gnus-unread-mark)))
7149          (gnus-tmp-from (mail-header-from gnus-tmp-header))
7150          (gnus-tmp-name
7151           (cond
7152            ((string-match "(.+)" gnus-tmp-from)
7153             (substring gnus-tmp-from
7154                        (1+ (match-beginning 0)) (1- (match-end 0))))
7155            ((string-match "<[^>]+> *$" gnus-tmp-from)
7156             (let ((beg (match-beginning 0)))
7157               (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
7158                        (substring gnus-tmp-from (1+ (match-beginning 0))
7159                                   (1- (match-end 0))))
7160                   (substring gnus-tmp-from 0 beg))))
7161            (t gnus-tmp-from)))
7162          (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
7163          (gnus-tmp-number (mail-header-number gnus-tmp-header))
7164          (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
7165          (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
7166          (buffer-read-only nil))
7167     (when (string= gnus-tmp-name "")
7168       (setq gnus-tmp-name gnus-tmp-from))
7169     (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
7170     (put-text-property
7171      (point)
7172      (progn (eval gnus-summary-line-format-spec) (point))
7173      'gnus-number gnus-tmp-number)
7174     (when (gnus-visual-p 'summary-highlight 'highlight)
7175       (forward-line -1)
7176       (run-hooks 'gnus-summary-update-hook)
7177       (forward-line 1))))
7178
7179 (defun gnus-summary-update-line (&optional dont-update)
7180   ;; Update summary line after change.
7181   (when (and gnus-summary-default-score
7182              (not gnus-summary-inhibit-highlight))
7183     (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
7184            (article (gnus-summary-article-number))
7185            (score (gnus-summary-article-score article)))
7186       (unless dont-update
7187         (if (and gnus-summary-mark-below
7188                  (< (gnus-summary-article-score)
7189                     gnus-summary-mark-below))
7190             ;; This article has a low score, so we mark it as read.
7191             (when (memq article gnus-newsgroup-unreads)
7192               (gnus-summary-mark-article-as-read gnus-low-score-mark))
7193           (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
7194             ;; This article was previously marked as read on account
7195             ;; of a low score, but now it has risen, so we mark it as
7196             ;; unread.
7197             (gnus-summary-mark-article-as-unread gnus-unread-mark)))
7198         (gnus-summary-update-mark
7199          (if (or (null gnus-summary-default-score)
7200                  (<= (abs (- score gnus-summary-default-score))
7201                      gnus-summary-zcore-fuzz)) ? 
7202            (if (< score gnus-summary-default-score)
7203                gnus-score-below-mark gnus-score-over-mark)) 'score))
7204       ;; Do visual highlighting.
7205       (when (gnus-visual-p 'summary-highlight 'highlight)
7206         (run-hooks 'gnus-summary-update-hook)))))
7207
7208 (defvar gnus-tmp-new-adopts nil)
7209
7210 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
7211   ;; Sum up all elements (and sub-elements) in a list.
7212   (let* ((number
7213           ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
7214           (cond
7215            ((and (consp thread) (cdr thread))
7216             (apply
7217              '+ 1 (mapcar
7218                    'gnus-summary-number-of-articles-in-thread (cdr thread))))
7219            ((null thread)
7220             1)
7221            ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
7222             1)
7223            (t 1))))
7224     (when (and level (zerop level) gnus-tmp-new-adopts)
7225       (incf number
7226             (apply '+ (mapcar
7227                        'gnus-summary-number-of-articles-in-thread
7228                        gnus-tmp-new-adopts))))
7229     (if char
7230         (if (> number 1) gnus-not-empty-thread-mark
7231           gnus-empty-thread-mark)
7232       number)))
7233
7234 (defun gnus-summary-set-local-parameters (group)
7235  "Go through the local params of GROUP and set all variable specs in that list."
7236   (let ((params (gnus-info-params (gnus-get-info group)))
7237         elem)
7238     (while params
7239       (setq elem (car params)
7240             params (cdr params))
7241       (and (consp elem)                 ; Has to be a cons.
7242            (consp (cdr elem))           ; The cdr has to be a list.
7243            (symbolp (car elem))         ; Has to be a symbol in there.
7244            (progn                       ; So we set it.
7245              (make-local-variable (car elem))
7246              (set (car elem) (eval (nth 1 elem))))))))
7247
7248 (defun gnus-summary-read-group
7249   (group &optional show-all no-article kill-buffer no-display)
7250   "Start reading news in newsgroup GROUP.
7251 If SHOW-ALL is non-nil, already read articles are also listed.
7252 If NO-ARTICLE is non-nil, no article is selected initially.
7253 If NO-DISPLAY, don't generate a summary buffer."
7254   (gnus-message 5 "Retrieving newsgroup: %s..." group)
7255   (let* ((new-group (gnus-summary-setup-buffer group))
7256          (quit-config (gnus-group-quit-config group))
7257          (did-select (and new-group (gnus-select-newsgroup group show-all))))
7258     (cond
7259      ;; This summary buffer exists already, so we just select it.
7260      ((not new-group)
7261       (gnus-set-global-variables)
7262       (when kill-buffer
7263         (gnus-kill-or-deaden-summary kill-buffer))
7264       (gnus-configure-windows 'summary 'force)
7265       (gnus-set-mode-line 'summary)
7266       (gnus-summary-position-point)
7267       (message "")
7268       t)
7269      ;; We couldn't select this group.
7270      ((null did-select)
7271       (when (and (eq major-mode 'gnus-summary-mode)
7272                  (not (equal (current-buffer) kill-buffer)))
7273         (kill-buffer (current-buffer))
7274         (if (not quit-config)
7275             (progn
7276               (set-buffer gnus-group-buffer)
7277               (gnus-group-jump-to-group group)
7278               (gnus-group-next-unread-group 1))
7279           (if (not (buffer-name (car quit-config)))
7280               (gnus-configure-windows 'group 'force)
7281             (set-buffer (car quit-config))
7282             (and (eq major-mode 'gnus-summary-mode)
7283                  (gnus-set-global-variables))
7284             (gnus-configure-windows (cdr quit-config)))))
7285       (gnus-message 3 "Can't select group")
7286       nil)
7287      ;; The user did a `C-g' while prompting for number of articles,
7288      ;; so we exit this group.
7289      ((eq did-select 'quit)
7290       (and (eq major-mode 'gnus-summary-mode)
7291            (not (equal (current-buffer) kill-buffer))
7292            (kill-buffer (current-buffer)))
7293       (when kill-buffer
7294         (gnus-kill-or-deaden-summary kill-buffer))
7295       (if (not quit-config)
7296           (progn
7297             (set-buffer gnus-group-buffer)
7298             (gnus-group-jump-to-group group)
7299             (gnus-group-next-unread-group 1)
7300             (gnus-configure-windows 'group 'force))
7301         (if (not (buffer-name (car quit-config)))
7302             (gnus-configure-windows 'group 'force)
7303           (set-buffer (car quit-config))
7304           (and (eq major-mode 'gnus-summary-mode)
7305                (gnus-set-global-variables))
7306           (gnus-configure-windows (cdr quit-config))))
7307       ;; Finally signal the quit.
7308       (signal 'quit nil))
7309      ;; The group was successfully selected.
7310      (t
7311       (gnus-set-global-variables)
7312       ;; Save the active value in effect when the group was entered.
7313       (setq gnus-newsgroup-active
7314             (gnus-copy-sequence
7315              (gnus-active gnus-newsgroup-name)))
7316       ;; You can change the summary buffer in some way with this hook.
7317       (run-hooks 'gnus-select-group-hook)
7318       ;; Set any local variables in the group parameters.
7319       (gnus-summary-set-local-parameters gnus-newsgroup-name)
7320       (gnus-update-format-specifications)
7321       ;; Do score processing.
7322       (when gnus-use-scoring
7323         (gnus-possibly-score-headers))
7324       ;; Check whether to fill in the gaps in the threads.
7325       (when gnus-build-sparse-threads
7326         (gnus-build-sparse-threads))
7327       ;; Find the initial limit.
7328       (gnus-summary-initial-limit show-all)
7329       ;; Generate the summary buffer.
7330       (unless no-display
7331         (gnus-summary-prepare))
7332       (when gnus-use-trees
7333         (gnus-tree-open group)
7334         (setq gnus-summary-highlight-line-function
7335               'gnus-tree-highlight-article))
7336       ;; If the summary buffer is empty, but there are some low-scored
7337       ;; articles or some excluded dormants, we include these in the
7338       ;; buffer.
7339       (when (and (zerop (buffer-size))
7340                  (not no-display))
7341         (cond (gnus-newsgroup-dormant
7342                (gnus-summary-limit-include-dormant))
7343               ((and gnus-newsgroup-scored show-all)
7344                (gnus-summary-limit-include-expunged))))
7345       ;; Function `gnus-apply-kill-file' must be called in this hook.
7346       (run-hooks 'gnus-apply-kill-hook)
7347       (if (and (zerop (buffer-size))
7348                (not no-display))
7349           (progn
7350             ;; This newsgroup is empty.
7351             (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
7352             (gnus-message 6 "No unread news")
7353             (when kill-buffer
7354               (gnus-kill-or-deaden-summary kill-buffer))
7355             ;; Return nil from this function.
7356             nil)
7357         ;; Hide conversation thread subtrees.  We cannot do this in
7358         ;; gnus-summary-prepare-hook since kill processing may not
7359         ;; work with hidden articles.
7360         (and gnus-show-threads
7361              gnus-thread-hide-subtree
7362              (gnus-summary-hide-all-threads))
7363         ;; Show first unread article if requested.
7364         (if (and (not no-article)
7365                  (not no-display)
7366                  gnus-newsgroup-unreads
7367                  gnus-auto-select-first)
7368             (if (eq gnus-auto-select-first 'best)
7369                 (gnus-summary-best-unread-article)
7370               (gnus-summary-first-unread-article))
7371           ;; Don't select any articles, just move point to the first
7372           ;; article in the group.
7373           (goto-char (point-min))
7374           (gnus-summary-position-point)
7375           (gnus-set-mode-line 'summary)
7376           (gnus-configure-windows 'summary 'force))
7377         ;; If we are in async mode, we send some info to the backend.
7378         (when gnus-newsgroup-async
7379           (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data))
7380         (when kill-buffer
7381           (gnus-kill-or-deaden-summary kill-buffer))
7382         (when (get-buffer-window gnus-group-buffer)
7383           ;; Gotta use windows, because recenter does wierd stuff if
7384           ;; the current buffer ain't the displayed window.
7385           (let ((owin (selected-window)))
7386             (select-window (get-buffer-window gnus-group-buffer))
7387             (when (gnus-group-goto-group group)
7388               (recenter))
7389             (select-window owin))))
7390       ;; Mark this buffer as "prepared".
7391       (setq gnus-newsgroup-prepared t)
7392       t))))
7393
7394 (defun gnus-summary-prepare ()
7395   "Generate the summary buffer."
7396   (let ((buffer-read-only nil))
7397     (erase-buffer)
7398     (setq gnus-newsgroup-data nil
7399           gnus-newsgroup-data-reverse nil)
7400     (run-hooks 'gnus-summary-generate-hook)
7401     ;; Generate the buffer, either with threads or without.
7402     (when gnus-newsgroup-headers
7403       (gnus-summary-prepare-threads
7404        (if gnus-show-threads
7405            (gnus-sort-gathered-threads
7406             (funcall gnus-summary-thread-gathering-function
7407                      (gnus-sort-threads
7408                       (gnus-cut-threads (gnus-make-threads)))))
7409          ;; Unthreaded display.
7410          (gnus-sort-articles gnus-newsgroup-headers))))
7411     (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
7412     ;; Call hooks for modifying summary buffer.
7413     (goto-char (point-min))
7414     (run-hooks 'gnus-summary-prepare-hook)))
7415
7416 (defun gnus-gather-threads-by-subject (threads)
7417   "Gather threads by looking at Subject headers."
7418   (if (not gnus-summary-make-false-root)
7419       threads
7420     (let ((hashtb (gnus-make-hashtable 1023))
7421           (prev threads)
7422           (result threads)
7423           subject hthread whole-subject)
7424       (while threads
7425         (setq whole-subject (mail-header-subject (car (car threads))))
7426         (if (and gnus-summary-gather-exclude-subject
7427                  (string-match gnus-summary-gather-exclude-subject
7428                                whole-subject))
7429             () ; We don't want to do anything with this article.
7430           ;; We simplify the subject before looking it up in the
7431           ;; hash table.
7432           (setq subject
7433                 (cond
7434                  ;; Truncate the subject.
7435                  ((numberp gnus-summary-gather-subject-limit)
7436                   (setq subject (gnus-simplify-subject-re whole-subject))
7437                   (if (> (length subject) gnus-summary-gather-subject-limit)
7438                       (substring subject 0 gnus-summary-gather-subject-limit)
7439                     subject))
7440                  ;; Fuzzily simplify it.
7441                  ((eq 'fuzzy gnus-summary-gather-subject-limit)
7442                   (gnus-simplify-subject-fuzzy whole-subject))
7443                  ;; Just remove the leading "Re:".
7444                  (t
7445                   (gnus-simplify-subject-re whole-subject))))
7446
7447           (if (setq hthread (gnus-gethash subject hashtb))
7448               (progn
7449                 ;; We enter a dummy root into the thread, if we
7450                 ;; haven't done that already.
7451                 (unless (stringp (car (car hthread)))
7452                   (setcar hthread (list whole-subject (car hthread))))
7453                 ;; We add this new gathered thread to this gathered
7454                 ;; thread.
7455                 (setcdr (car hthread)
7456                         (nconc (cdr (car hthread)) (list (car threads))))
7457                 ;; Remove it from the list of threads.
7458                 (setcdr prev (cdr threads))
7459                 (setq threads prev))
7460             ;; Enter this thread into the hash table.
7461             (gnus-sethash subject threads hashtb)))
7462         (setq prev threads)
7463         (setq threads (cdr threads)))
7464       result)))
7465
7466 (defun gnus-summary-gather-threads-by-references (threads)
7467   "Gather threads by looking at References headers."
7468   (let ((idhashtb (gnus-make-hashtable 1023))
7469         (thhashtb (gnus-make-hashtable 1023))
7470         (prev threads)
7471         (result threads)
7472         ids references id gthread gid entered)
7473     (while threads
7474       (when (setq references (mail-header-references (caar threads)))
7475         (setq id (mail-header-id (caar threads)))
7476         (setq ids (gnus-split-references references))
7477         (setq entered nil)
7478         (while ids
7479           (if (not (setq gid (gnus-gethash (car ids) idhashtb)))
7480               (progn
7481                 (gnus-sethash (car ids) id idhashtb)
7482                 (gnus-sethash id threads thhashtb))
7483             (setq gthread (gnus-gethash gid thhashtb))
7484             (unless entered
7485               ;; We enter a dummy root into the thread, if we
7486               ;; haven't done that already.
7487               (unless (stringp (caar gthread))
7488                 (setcar gthread (list (mail-header-subject (caar gthread))
7489                                       (car gthread))))
7490               ;; We add this new gathered thread to this gathered
7491               ;; thread.
7492               (setcdr (car gthread)
7493                       (nconc (cdar gthread) (list (car threads)))))
7494             ;; Add it into the thread hash table.
7495             (gnus-sethash id gthread thhashtb)
7496             (setq entered t)
7497             ;; Remove it from the list of threads.
7498             (setcdr prev (cdr threads))
7499             (setq threads prev))
7500           (setq ids (cdr ids))))
7501       (setq prev threads)
7502       (setq threads (cdr threads)))
7503     result))
7504
7505 (defun gnus-sort-gathered-threads (threads)
7506   "Sort subtreads inside each gathered thread by article number."
7507   (let ((result threads))
7508     (while threads
7509       (when (stringp (car (car threads)))
7510         (setcdr (car threads)
7511                 (sort (cdr (car threads)) 'gnus-thread-sort-by-number)))
7512       (setq threads (cdr threads)))
7513     result))
7514
7515 (defun gnus-make-threads ()
7516   "Go through the dependency hashtb and find the roots.  Return all threads."
7517   (let (threads)
7518     (mapatoms
7519      (lambda (refs)
7520        (unless (car (symbol-value refs))
7521          ;; These threads do not refer back to any other articles,
7522          ;; so they're roots.
7523          (setq threads (append (cdr (symbol-value refs)) threads))))
7524      gnus-newsgroup-dependencies)
7525     threads))
7526
7527 (defun gnus-build-sparse-threads ()
7528   (let ((headers gnus-newsgroup-headers)
7529         (deps gnus-newsgroup-dependencies)
7530         header references generation relations 
7531         cthread subject child end pthread relation)
7532     ;; First we create an alist of generations/relations, where 
7533     ;; generations is how much we trust the ralation, and the relation
7534     ;; is parent/child.
7535     (gnus-message 7 "Making sparse threads...")
7536     (save-excursion
7537       (nnheader-set-temp-buffer " *gnus sparse threads*")
7538       (while (setq header (pop headers))
7539         (when (and (setq references (mail-header-references header))
7540                    (not (string= references "")))
7541           (insert references)
7542           (setq child (downcase (mail-header-id header))
7543                 subject (mail-header-subject header))
7544           (setq generation 0)
7545           (while (search-backward ">" nil t)
7546             (setq end (1+ (point)))
7547             (when (search-backward "<" nil t)
7548               (push (list (incf generation) 
7549                           child (setq child (downcase
7550                                              (buffer-substring (point) end)))
7551                           subject)
7552                     relations)))
7553           (push (list (1+ generation) child nil subject) relations)
7554           (erase-buffer)))
7555       (kill-buffer (current-buffer)))
7556     ;; Sort over trustworthiness.
7557     (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2)))))
7558     (while (setq relation (pop relations))
7559       (when (if (boundp (setq cthread (intern (cadr relation) deps)))
7560                 (unless (car (symbol-value cthread))
7561                   ;; Make this article the parent of these threads.
7562                   (setcar (symbol-value cthread)
7563                           (vector gnus-reffed-article-number 
7564                                   (cadddr relation) 
7565                                   "" ""
7566                                   (cadr relation) 
7567                                   (or (caddr relation) "") 0 0 "")))
7568               (set cthread (list (vector gnus-reffed-article-number
7569                                          (cadddr relation) 
7570                                          "" "" (cadr relation) 
7571                                          (or (caddr relation) "") 0 0 ""))))
7572         (push gnus-reffed-article-number gnus-newsgroup-limit)
7573         (push gnus-reffed-article-number gnus-newsgroup-sparse)
7574         (push (cons gnus-reffed-article-number gnus-sparse-mark)
7575               gnus-newsgroup-reads)
7576         (decf gnus-reffed-article-number)
7577         ;; Make this new thread the child of its parent.
7578         (if (boundp (setq pthread (intern (or (caddr relation) "none") deps)))
7579             (setcdr (symbol-value pthread)
7580                     (nconc (cdr (symbol-value pthread))
7581                            (list (symbol-value cthread))))
7582           (set pthread (list nil (symbol-value cthread))))))
7583     (gnus-message 7 "Making sparse threads...done")))
7584
7585 (defun gnus-build-old-threads ()
7586   ;; Look at all the articles that refer back to old articles, and
7587   ;; fetch the headers for the articles that aren't there.  This will
7588   ;; build complete threads - if the roots haven't been expired by the
7589   ;; server, that is.
7590   (let (id heads)
7591     (mapatoms
7592      (lambda (refs)
7593        (when (not (car (symbol-value refs)))
7594          (setq heads (cdr (symbol-value refs)))
7595          (while heads
7596            (if (memq (mail-header-number (car (car heads)))
7597                      gnus-newsgroup-dormant)
7598                (setq heads (cdr heads))
7599              (setq id (symbol-name refs))
7600              (while (and (setq id (gnus-build-get-header id))
7601                          (not (car (gnus-gethash
7602                                     id gnus-newsgroup-dependencies)))))
7603              (setq heads nil)))))
7604      gnus-newsgroup-dependencies)))
7605
7606 (defun gnus-build-get-header (id)
7607   ;; Look through the buffer of NOV lines and find the header to
7608   ;; ID.  Enter this line into the dependencies hash table, and return
7609   ;; the id of the parent article (if any).
7610   (let ((deps gnus-newsgroup-dependencies)
7611         found header)
7612     (prog1
7613         (save-excursion
7614           (set-buffer nntp-server-buffer)
7615           (goto-char (point-min))
7616           (while (and (not found) (search-forward id nil t))
7617             (beginning-of-line)
7618             (setq found (looking-at
7619                          (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
7620                                  (regexp-quote id))))
7621             (or found (beginning-of-line 2)))
7622           (when found
7623             (let (ref)
7624               (beginning-of-line)
7625               (and
7626                (setq header (gnus-nov-parse-line
7627                              (read (current-buffer)) deps))
7628                (gnus-parent-id (mail-header-references header))))))
7629       (when header
7630         (let ((number (mail-header-number header)))
7631           (push number gnus-newsgroup-limit)
7632           (push header gnus-newsgroup-headers)
7633           (if (memq number gnus-newsgroup-unselected)
7634               (progn
7635                 (push number gnus-newsgroup-unreads)
7636                 (setq gnus-newsgroup-unselected
7637                       (delq number gnus-newsgroup-unselected)))
7638             (push number gnus-newsgroup-ancient)))))))
7639
7640 (defun gnus-summary-update-article (article &optional header)
7641   "Update ARTICLE in the summary buffer."
7642   (let ((id (mail-header-id (gnus-summary-article-header article)))
7643         (data (gnus-data-find article)))
7644     (setcar (gnus-id-to-thread id) nil)
7645     (gnus-summary-insert-subject id)
7646     ;; Set the (possibly) new article number in the data structure.
7647     (gnus-data-set-number data (gnus-id-to-article id))))
7648
7649 (defun gnus-rebuild-thread (id)
7650   "Rebuild the thread containing ID."
7651   (let ((dep gnus-newsgroup-dependencies)
7652         (buffer-read-only nil)
7653         current headers refs thread art data)
7654     (if (not gnus-show-threads)
7655         (setq thread (list (car (gnus-id-to-thread id))))
7656       ;; Get the thread this article is part of.
7657       (setq thread (gnus-remove-thread id)))
7658     (setq current (save-excursion
7659                     (and (zerop (forward-line -1))
7660                          (gnus-summary-article-number))))
7661     ;; If this is a gathered thread, we have to go some re-gathering.
7662     (when (stringp (car thread))
7663       (let ((subject (car thread))
7664             roots thr)
7665         (setq thread (cdr thread))
7666         (while thread
7667           (unless (memq (setq thr (gnus-id-to-thread
7668                                       (gnus-root-id
7669                                        (mail-header-id (car (car thread))))))
7670                         roots)
7671             (push thr roots))
7672           (setq thread (cdr thread)))
7673         ;; We now have all (unique) roots.
7674         (if (= (length roots) 1)
7675             ;; All the loose roots are now one solid root.
7676             (setq thread (car roots))
7677           (setq thread (cons subject (gnus-sort-threads roots))))))
7678     (let ((beg (point))
7679           threads)
7680       ;; We then insert this thread into the summary buffer.
7681       (let (gnus-newsgroup-data gnus-newsgroup-threads)
7682         (gnus-summary-prepare-threads (list thread))
7683         (setq data (nreverse gnus-newsgroup-data))
7684         (setq threads gnus-newsgroup-threads))
7685       ;; We splice the new data into the data structure.
7686       (gnus-data-enter-list current data)
7687       (gnus-data-compute-positions)
7688       (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
7689
7690 (defun gnus-id-to-thread (id)
7691   "Return the (sub-)thread where ID appears."
7692   (gnus-gethash (downcase id) gnus-newsgroup-dependencies))
7693
7694 (defun gnus-id-to-article (id)
7695   "Return the article number of ID."
7696   (let ((thread (gnus-id-to-thread id)))
7697     (when thread
7698       (mail-header-number (car thread)))))
7699
7700 (defun gnus-id-to-header (id)
7701   "Return the article headers of ID."
7702   (car (gnus-id-to-thread id)))
7703
7704 (defun gnus-article-displayed-root-p (article)
7705   "Say whether ARTICLE is a root(ish) article."
7706   (let ((level (gnus-summary-thread-level article))
7707         particle)
7708     (cond 
7709      ((null level) nil)
7710      ((zerop level) t)
7711      ((and (= 1 level)
7712            (null (setq particle (gnus-id-to-article
7713                                  (gnus-parent-id 
7714                                   (mail-header-references 
7715                                    (gnus-summary-article-header article))))))
7716            (null (gnus-summary-thread-level particle)))))))
7717
7718 (defun gnus-root-id (id)
7719   "Return the id of the root of the thread where ID appears."
7720   (let (last-id prev)
7721     (while (and id (setq prev (car (gnus-gethash
7722                                     (downcase id)
7723                                     gnus-newsgroup-dependencies))))
7724       (setq last-id id
7725             id (gnus-parent-id (mail-header-references prev))))
7726     last-id))
7727
7728 (defun gnus-remove-thread (id &optional dont-remove)
7729   "Remove the thread that has ID in it."
7730   (let ((dep gnus-newsgroup-dependencies)
7731         headers thread prev last-id)
7732     ;; First go up in this thread until we find the root.
7733     (setq last-id (gnus-root-id id))
7734     (setq headers (list (car (gnus-id-to-thread last-id))
7735                         (car (car (cdr (gnus-id-to-thread last-id))))))
7736     ;; We have now found the real root of this thread.  It might have
7737     ;; been gathered into some loose thread, so we have to search
7738     ;; through the threads to find the thread we wanted.
7739     (let ((threads gnus-newsgroup-threads)
7740           sub)
7741       (while threads
7742         (setq sub (car threads))
7743         (if (stringp (car sub))
7744             ;; This is a gathered threads, so we look at the roots
7745             ;; below it to find whether this article in in this
7746             ;; gathered root.
7747             (progn
7748               (setq sub (cdr sub))
7749               (while sub
7750                 (when (member (car (car sub)) headers)
7751                   (setq thread (car threads)
7752                         threads nil
7753                         sub nil))
7754                 (setq sub (cdr sub))))
7755           ;; It's an ordinary thread, so we check it.
7756           (when (eq (car sub) (car headers))
7757             (setq thread sub
7758                   threads nil)))
7759         (setq threads (cdr threads)))
7760       ;; If this article is in no thread, then it's a root.
7761       (if thread
7762           (unless dont-remove
7763             (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
7764         (setq thread (gnus-gethash (downcase last-id) dep)))
7765       (when thread
7766         (prog1
7767             thread ; We return this thread.
7768           (unless dont-remove
7769             (if (stringp (car thread))
7770                 (progn
7771                   ;; If we use dummy roots, then we have to remove the
7772                   ;; dummy root as well.
7773                   (when (eq gnus-summary-make-false-root 'dummy)
7774                     ;; Uhm.
7775                     )
7776                   (setq thread (cdr thread))
7777                   (while thread
7778                     (gnus-remove-thread-1 (car thread))
7779                     (setq thread (cdr thread))))
7780               (gnus-remove-thread-1 thread))))))))
7781
7782 (defun gnus-remove-thread-1 (thread)
7783   "Remove the thread THREAD recursively."
7784   (let ((number (mail-header-number (car thread)))
7785         pos)
7786     (when (setq pos (text-property-any
7787                      (point-min) (point-max) 'gnus-number number))
7788       (goto-char pos)
7789       (gnus-delete-line)
7790       (gnus-data-remove number))
7791     (setq thread (cdr thread))
7792     (while thread
7793       (gnus-remove-thread-1 (car thread))
7794       (setq thread (cdr thread)))))
7795
7796 (defun gnus-sort-threads (threads)
7797   "Sort THREADS."
7798   (if (not gnus-thread-sort-functions)
7799       threads
7800     (let ((func (if (= 1 (length gnus-thread-sort-functions))
7801                     (car gnus-thread-sort-functions)
7802                   `(lambda (t1 t2)
7803                      ,(gnus-make-sort-function 
7804                        (reverse gnus-thread-sort-functions))))))
7805       (gnus-message 7 "Sorting threads...")
7806       (prog1
7807           (sort threads func)
7808         (gnus-message 7 "Sorting threads...done")))))
7809
7810 (defun gnus-sort-articles (articles)
7811   "Sort ARTICLES."
7812   (when gnus-article-sort-functions
7813     (let ((func (if (= 1 (length gnus-article-sort-functions))
7814                     (car gnus-article-sort-functions)
7815                   `(lambda (t1 t2)
7816                      ,(gnus-make-sort-function 
7817                        (reverse gnus-article-sort-functions))))))
7818       (gnus-message 7 "Sorting articles...")
7819       (prog1
7820           (setq gnus-newsgroup-headers (sort articles func))
7821         (gnus-message 7 "Sorting articles...done")))))
7822
7823 (defun gnus-make-sort-function (funs)
7824   "Return a composite sort condition based on the functions in FUNC."
7825   (if (cdr funs)
7826       `(or (,(car funs) t1 t2)
7827            (and (not (,(car funs) t2 t1))
7828                 ,(gnus-make-sort-function (cdr funs))))
7829     `(,(car funs) t1 t2)))
7830                  
7831 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
7832 (defmacro gnus-thread-header (thread)
7833   ;; Return header of first article in THREAD.
7834   ;; Note that THREAD must never, ever be anything else than a variable -
7835   ;; using some other form will lead to serious barfage.
7836   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
7837   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
7838   (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
7839         (vector thread) 2))
7840
7841 (defsubst gnus-article-sort-by-number (h1 h2)
7842   "Sort articles by article number."
7843   (< (mail-header-number h1)
7844      (mail-header-number h2)))
7845
7846 (defun gnus-thread-sort-by-number (h1 h2)
7847   "Sort threads by root article number."
7848   (gnus-article-sort-by-number
7849    (gnus-thread-header h1) (gnus-thread-header h2)))
7850
7851 (defsubst gnus-article-sort-by-author (h1 h2)
7852   "Sort articles by root author."
7853   (string-lessp
7854    (let ((extract (funcall
7855                    gnus-extract-address-components
7856                    (mail-header-from h1))))
7857      (or (car extract) (cdr extract)))
7858    (let ((extract (funcall
7859                    gnus-extract-address-components
7860                    (mail-header-from h2))))
7861      (or (car extract) (cdr extract)))))
7862
7863 (defun gnus-thread-sort-by-author (h1 h2)
7864   "Sort threads by root author."
7865   (gnus-article-sort-by-author
7866    (gnus-thread-header h1)  (gnus-thread-header h2)))
7867
7868 (defsubst gnus-article-sort-by-subject (h1 h2)
7869   "Sort articles by root subject."
7870   (string-lessp
7871    (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
7872    (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
7873
7874 (defun gnus-thread-sort-by-subject (h1 h2)
7875   "Sort threads by root subject."
7876   (gnus-article-sort-by-subject
7877    (gnus-thread-header h1) (gnus-thread-header h2)))
7878
7879 (defsubst gnus-article-sort-by-date (h1 h2)
7880   "Sort articles by root article date."
7881   (string-lessp
7882    (gnus-sortable-date (mail-header-date h1))
7883    (gnus-sortable-date (mail-header-date h2))))
7884
7885 (defun gnus-thread-sort-by-date (h1 h2)
7886   "Sort threads by root article date."
7887   (gnus-article-sort-by-date
7888    (gnus-thread-header h1) (gnus-thread-header h2)))
7889
7890 (defsubst gnus-article-sort-by-score (h1 h2)
7891   "Sort articles by root article score.
7892 Unscored articles will be counted as having a score of zero."
7893   (> (or (cdr (assq (mail-header-number h1)
7894                     gnus-newsgroup-scored))
7895          gnus-summary-default-score 0)
7896      (or (cdr (assq (mail-header-number h2)
7897                     gnus-newsgroup-scored))
7898          gnus-summary-default-score 0)))
7899
7900 (defun gnus-thread-sort-by-score (h1 h2)
7901   "Sort threads by root article score."
7902   (gnus-article-sort-by-score
7903    (gnus-thread-header h1) (gnus-thread-header h2)))
7904
7905 (defun gnus-thread-sort-by-total-score (h1 h2)
7906   "Sort threads by the sum of all scores in the thread.
7907 Unscored articles will be counted as having a score of zero."
7908   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
7909
7910 (defun gnus-thread-total-score (thread)
7911   ;;  This function find the total score of THREAD.
7912   (if (consp thread)
7913       (if (stringp (car thread))
7914           (apply gnus-thread-score-function 0
7915                  (mapcar 'gnus-thread-total-score-1 (cdr thread)))
7916         (gnus-thread-total-score-1 thread))
7917     (gnus-thread-total-score-1 (list thread))))
7918
7919 (defun gnus-thread-total-score-1 (root)
7920   ;; This function find the total score of the thread below ROOT.
7921   (setq root (car root))
7922   (apply gnus-thread-score-function
7923          (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
7924              gnus-summary-default-score 0)
7925          (mapcar 'gnus-thread-total-score
7926                  (cdr (gnus-gethash (downcase (mail-header-id root))
7927                                     gnus-newsgroup-dependencies)))))
7928
7929 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
7930 (defvar gnus-tmp-prev-subject nil)
7931 (defvar gnus-tmp-false-parent nil)
7932 (defvar gnus-tmp-root-expunged nil)
7933 (defvar gnus-tmp-dummy-line nil)
7934
7935 (defun gnus-summary-prepare-threads (threads)
7936   "Prepare summary buffer from THREADS and indentation LEVEL.
7937 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
7938 or a straight list of headers."
7939   (gnus-message 7 "Generating summary...")
7940
7941   (setq gnus-newsgroup-threads threads)
7942   (beginning-of-line)
7943
7944   (let ((gnus-tmp-level 0)
7945         (default-score (or gnus-summary-default-score 0))
7946         (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
7947         thread number subject stack state gnus-tmp-gathered beg-match
7948         new-roots gnus-tmp-new-adopts thread-end
7949         gnus-tmp-header gnus-tmp-unread
7950         gnus-tmp-replied gnus-tmp-subject-or-nil
7951         gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
7952         gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
7953         gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
7954
7955     (setq gnus-tmp-prev-subject nil)
7956
7957     (if (vectorp (car threads))
7958         ;; If this is a straight (sic) list of headers, then a
7959         ;; threaded summary display isn't required, so we just create
7960         ;; an unthreaded one.
7961         (gnus-summary-prepare-unthreaded threads)
7962
7963       ;; Do the threaded display.
7964
7965       (while (or threads stack gnus-tmp-new-adopts new-roots)
7966
7967         (if (and (= gnus-tmp-level 0)
7968                  (not (setq gnus-tmp-dummy-line nil))
7969                  (or (not stack)
7970                      (= (car (car stack)) 0))
7971                  (not gnus-tmp-false-parent)
7972                  (or gnus-tmp-new-adopts new-roots))
7973             (if gnus-tmp-new-adopts
7974                 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
7975                       thread (list (car gnus-tmp-new-adopts))
7976                       gnus-tmp-header (car (car thread))
7977                       gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
7978               (if new-roots
7979                   (setq thread (list (car new-roots))
7980                         gnus-tmp-header (car (car thread))
7981                         new-roots (cdr new-roots))))
7982
7983           (if threads
7984               ;; If there are some threads, we do them before the
7985               ;; threads on the stack.
7986               (setq thread threads
7987                     gnus-tmp-header (car (car thread)))
7988             ;; There were no current threads, so we pop something off
7989             ;; the stack.
7990             (setq state (car stack)
7991                   gnus-tmp-level (car state)
7992                   thread (cdr state)
7993                   stack (cdr stack)
7994                   gnus-tmp-header (car (car thread)))))
7995
7996         (setq gnus-tmp-false-parent nil)
7997         (setq gnus-tmp-root-expunged nil)
7998         (setq thread-end nil)
7999
8000         (if (stringp gnus-tmp-header)
8001             ;; The header is a dummy root.
8002             (cond
8003              ((eq gnus-summary-make-false-root 'adopt)
8004               ;; We let the first article adopt the rest.
8005               (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
8006                                                (cdr (cdr (car thread)))))
8007               (setq gnus-tmp-gathered
8008                     (nconc (mapcar
8009                             (lambda (h) (mail-header-number (car h)))
8010                             (cdr (cdr (car thread))))
8011                            gnus-tmp-gathered))
8012               (setq thread (cons (list (car (car thread))
8013                                        (car (cdr (car thread))))
8014                                  (cdr thread)))
8015               (setq gnus-tmp-level -1
8016                     gnus-tmp-false-parent t))
8017              ((eq gnus-summary-make-false-root 'empty)
8018               ;; We print adopted articles with empty subject fields.
8019               (setq gnus-tmp-gathered
8020                     (nconc (mapcar
8021                             (lambda (h) (mail-header-number (car h)))
8022                             (cdr (cdr (car thread))))
8023                            gnus-tmp-gathered))
8024               (setq gnus-tmp-level -1))
8025              ((eq gnus-summary-make-false-root 'dummy)
8026               ;; We remember that we probably want to output a dummy
8027               ;; root.
8028               (setq gnus-tmp-dummy-line gnus-tmp-header)
8029               (setq gnus-tmp-prev-subject gnus-tmp-header))
8030              (t
8031               ;; We do not make a root for the gathered
8032               ;; sub-threads at all.
8033               (setq gnus-tmp-level -1)))
8034
8035           (setq number (mail-header-number gnus-tmp-header)
8036                 subject (mail-header-subject gnus-tmp-header))
8037
8038           (cond
8039            ;; If the thread has changed subject, we might want to make
8040            ;; this subthread into a root.
8041            ((and (null gnus-thread-ignore-subject)
8042                  (not (zerop gnus-tmp-level))
8043                  gnus-tmp-prev-subject
8044                  (not (inline
8045                         (gnus-subject-equal gnus-tmp-prev-subject subject))))
8046             (setq new-roots (nconc new-roots (list (car thread)))
8047                   thread-end t
8048                   gnus-tmp-header nil))
8049            ;; If the article lies outside the current limit,
8050            ;; then we do not display it.
8051            ((and (not (memq number gnus-newsgroup-limit))
8052                  (not gnus-tmp-dummy-line))
8053             (setq gnus-tmp-gathered
8054                   (nconc (mapcar
8055                           (lambda (h) (mail-header-number (car h)))
8056                           (cdr (car thread)))
8057                          gnus-tmp-gathered))
8058             (setq gnus-tmp-new-adopts (if (cdr (car thread))
8059                                           (append gnus-tmp-new-adopts
8060                                                   (cdr (car thread)))
8061                                         gnus-tmp-new-adopts)
8062                   thread-end t
8063                   gnus-tmp-header nil)
8064             (when (zerop gnus-tmp-level)
8065               (setq gnus-tmp-root-expunged t)))
8066            ;; Perhaps this article is to be marked as read?
8067            ((and gnus-summary-mark-below
8068                  (< (or (cdr (assq number gnus-newsgroup-scored))
8069                         default-score)
8070                     gnus-summary-mark-below))
8071             (setq gnus-newsgroup-unreads
8072                   (delq number gnus-newsgroup-unreads))
8073             (if gnus-newsgroup-auto-expire
8074                 (push number gnus-newsgroup-expirable)
8075               (push (cons number gnus-low-score-mark)
8076                     gnus-newsgroup-reads))))
8077
8078           (when gnus-tmp-header
8079             ;; We may have an old dummy line to output before this
8080             ;; article.
8081             (if gnus-tmp-dummy-line
8082                 (progn
8083                   (gnus-summary-insert-dummy-line
8084                    gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
8085                   (setq gnus-tmp-dummy-line nil))
8086
8087               ;; Compute the mark.
8088               (setq
8089                gnus-tmp-unread
8090                (cond
8091                 ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8092                 ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8093                 ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8094                 ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8095                 (t (or (cdr (assq number gnus-newsgroup-reads))
8096                        gnus-ancient-mark))))
8097
8098               (push (gnus-data-make number gnus-tmp-unread (1+ (point))
8099                                     gnus-tmp-header gnus-tmp-level)
8100                     gnus-newsgroup-data)
8101
8102               ;; Actually insert the line.
8103               (setq
8104                gnus-tmp-subject-or-nil
8105                (cond
8106                 ((and gnus-thread-ignore-subject
8107                       gnus-tmp-prev-subject
8108                       (not (inline (gnus-subject-equal
8109                                     gnus-tmp-prev-subject subject))))
8110                  subject)
8111                 ((zerop gnus-tmp-level)
8112                  (if (and (eq gnus-summary-make-false-root 'empty)
8113                           (memq number gnus-tmp-gathered)
8114                           gnus-tmp-prev-subject
8115                           (inline (gnus-subject-equal
8116                                    gnus-tmp-prev-subject subject)))
8117                      gnus-summary-same-subject
8118                    subject))
8119                 (t gnus-summary-same-subject)))
8120               (if (and (eq gnus-summary-make-false-root 'adopt)
8121                        (= gnus-tmp-level 1)
8122                        (memq number gnus-tmp-gathered))
8123                   (setq gnus-tmp-opening-bracket ?\<
8124                         gnus-tmp-closing-bracket ?\>)
8125                 (setq gnus-tmp-opening-bracket ?\[
8126                       gnus-tmp-closing-bracket ?\]))
8127               (setq
8128                gnus-tmp-indentation
8129                (aref gnus-thread-indent-array gnus-tmp-level)
8130                gnus-tmp-lines (mail-header-lines gnus-tmp-header)
8131                gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
8132                                   gnus-summary-default-score 0)
8133                gnus-tmp-score-char
8134                (if (or (null gnus-summary-default-score)
8135                        (<= (abs (- gnus-tmp-score gnus-summary-default-score))
8136                            gnus-summary-zcore-fuzz)) ? 
8137                  (if (< gnus-tmp-score gnus-summary-default-score)
8138                      gnus-score-below-mark gnus-score-over-mark))
8139                gnus-tmp-replied
8140                (cond ((memq number gnus-newsgroup-processable)
8141                       gnus-process-mark)
8142                      ((memq number gnus-newsgroup-cached)
8143                       gnus-cached-mark)
8144                      ((memq number gnus-newsgroup-replied)
8145                       gnus-replied-mark)
8146                      (t gnus-unread-mark))
8147                gnus-tmp-from (mail-header-from gnus-tmp-header)
8148                gnus-tmp-name
8149                (cond
8150                 ((string-match "(.+)" gnus-tmp-from)
8151                  (substring gnus-tmp-from
8152                             (1+ (match-beginning 0)) (1- (match-end 0))))
8153                 ((string-match "<[^>]+> *$" gnus-tmp-from)
8154                  (setq beg-match (match-beginning 0))
8155                  (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
8156                           (substring gnus-tmp-from (1+ (match-beginning 0))
8157                                      (1- (match-end 0))))
8158                      (substring gnus-tmp-from 0 beg-match)))
8159                 (t gnus-tmp-from)))
8160               (when (string= gnus-tmp-name "")
8161                 (setq gnus-tmp-name gnus-tmp-from))
8162               (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
8163               (put-text-property
8164                (point)
8165                (progn (eval gnus-summary-line-format-spec) (point))
8166                'gnus-number number)
8167               (when gnus-visual-p
8168                 (forward-line -1)
8169                 (run-hooks 'gnus-summary-update-hook)
8170                 (forward-line 1))
8171
8172               )
8173
8174             (setq gnus-tmp-prev-subject subject)))
8175
8176         (when (nth 1 thread)
8177           (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
8178         (incf gnus-tmp-level)
8179         (setq threads (if thread-end nil (cdr (car thread))))
8180         (unless threads
8181           (setq gnus-tmp-level 0)))))
8182   (gnus-message 7 "Generating summary...done"))
8183
8184 (defun gnus-summary-prepare-unthreaded (headers)
8185   "Generate an unthreaded summary buffer based on HEADERS."
8186   (let (header number mark)
8187
8188     (while headers
8189       (setq header (car headers)
8190             headers (cdr headers)
8191             number (mail-header-number header))
8192
8193       ;; We may have to root out some bad articles...
8194       (when (memq number gnus-newsgroup-limit)
8195         (when (and gnus-summary-mark-below
8196                    (< (or (cdr (assq number gnus-newsgroup-scored))
8197                           gnus-summary-default-score 0)
8198                       gnus-summary-mark-below))
8199           (setq gnus-newsgroup-unreads
8200                 (delq number gnus-newsgroup-unreads))
8201           (if gnus-newsgroup-auto-expire
8202               (push number gnus-newsgroup-expirable)
8203             (push (cons number gnus-low-score-mark)
8204                   gnus-newsgroup-reads)))
8205
8206         (setq mark
8207               (cond
8208                ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8209                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8210                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8211                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8212                (t (or (cdr (assq number gnus-newsgroup-reads))
8213                       gnus-ancient-mark))))
8214         (setq gnus-newsgroup-data
8215               (cons (gnus-data-make number mark (1+ (point)) header 0)
8216                     gnus-newsgroup-data))
8217         (gnus-summary-insert-line
8218          header 0 nil mark (memq number gnus-newsgroup-replied)
8219          (memq number gnus-newsgroup-expirable)
8220          (mail-header-subject header) nil
8221          (cdr (assq number gnus-newsgroup-scored))
8222          (memq number gnus-newsgroup-processable))))))
8223
8224 (defun gnus-select-newsgroup (group &optional read-all)
8225   "Select newsgroup GROUP.
8226 If READ-ALL is non-nil, all articles in the group are selected."
8227   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
8228          (info (nth 2 entry))
8229          articles fetched-articles cached)
8230
8231     (or (gnus-check-server
8232          (setq gnus-current-select-method (gnus-find-method-for-group group)))
8233         (error "Couldn't open server"))
8234
8235     (or (and entry (not (eq (car entry) t))) ; Either it's active...
8236         (gnus-activate-group group) ; Or we can activate it...
8237         (progn ; Or we bug out.
8238           (kill-buffer (current-buffer))
8239           (error "Couldn't request group %s: %s"
8240                  group (gnus-status-message group))))
8241
8242     (setq gnus-newsgroup-name group)
8243     (setq gnus-newsgroup-unselected nil)
8244     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
8245
8246     (and gnus-asynchronous
8247          (gnus-check-backend-function
8248           'request-asynchronous gnus-newsgroup-name)
8249          (setq gnus-newsgroup-async
8250                (gnus-request-asynchronous gnus-newsgroup-name)))
8251
8252     ;; Adjust and set lists of article marks.
8253     (when info
8254       (gnus-adjust-marked-articles info))
8255
8256     ;; Kludge to avoid having cached articles nixed out in virtual groups.
8257     (when (gnus-virtual-group-p group)
8258       (setq cached gnus-newsgroup-cached))
8259
8260     (setq gnus-newsgroup-unreads
8261           (gnus-set-difference
8262            (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
8263            gnus-newsgroup-dormant))
8264
8265     (setq gnus-newsgroup-processable nil)
8266
8267     (setq articles (gnus-articles-to-read group read-all))
8268
8269     (cond
8270      ((null articles)
8271       (gnus-message 3 "Couldn't select newsgroup -- no articles to display")
8272       'quit)
8273      ((eq articles 0) nil)
8274      (t
8275       ;; Init the dependencies hash table.
8276       (setq gnus-newsgroup-dependencies
8277             (gnus-make-hashtable (length articles)))
8278       ;; Retrieve the headers and read them in.
8279       (gnus-message 5 "Fetching headers...")
8280       (setq gnus-newsgroup-headers
8281             (if (eq 'nov
8282                     (setq gnus-headers-retrieved-by
8283                           (gnus-retrieve-headers
8284                            articles gnus-newsgroup-name
8285                            ;; We might want to fetch old headers, but
8286                            ;; not if there is only 1 article.
8287                            (and gnus-fetch-old-headers
8288                                 (or (and
8289                                      (not (eq gnus-fetch-old-headers 'some))
8290                                      (not (numberp gnus-fetch-old-headers)))
8291                                     (> (length articles) 1))))))
8292                 (gnus-get-newsgroup-headers-xover articles)
8293               (gnus-get-newsgroup-headers)))
8294       (gnus-message 5 "Fetching headers...done")
8295
8296       ;; Kludge to avoid having cached articles nixed out in virtual groups.
8297       (when cached
8298         (setq gnus-newsgroup-cached cached))
8299
8300       ;; Set the initial limit.
8301       (setq gnus-newsgroup-limit (copy-sequence articles))
8302       ;; Remove canceled articles from the list of unread articles.
8303       (setq gnus-newsgroup-unreads
8304             (gnus-set-sorted-intersection
8305              gnus-newsgroup-unreads
8306              (setq fetched-articles
8307                    (mapcar (lambda (headers) (mail-header-number headers))
8308                            gnus-newsgroup-headers))))
8309       ;; Removed marked articles that do not exist.
8310       (gnus-update-missing-marks
8311        (gnus-sorted-complement fetched-articles articles))
8312       ;; We might want to build some more threads first.
8313       (and gnus-fetch-old-headers
8314            (eq gnus-headers-retrieved-by 'nov)
8315            (gnus-build-old-threads))
8316       ;; Check whether auto-expire is to be done in this group.
8317       (setq gnus-newsgroup-auto-expire
8318             (gnus-group-auto-expirable-p group))
8319       ;; First and last article in this newsgroup.
8320       (and gnus-newsgroup-headers
8321            (setq gnus-newsgroup-begin
8322                  (mail-header-number (car gnus-newsgroup-headers)))
8323            (setq gnus-newsgroup-end
8324                  (mail-header-number
8325                   (gnus-last-element gnus-newsgroup-headers))))
8326       (setq gnus-reffed-article-number -1)
8327       ;; GROUP is successfully selected.
8328       (or gnus-newsgroup-headers t)))))
8329
8330 (defun gnus-articles-to-read (group read-all)
8331   ;; Find out what articles the user wants to read.
8332   (let* ((articles
8333           ;; Select all articles if `read-all' is non-nil, or if there
8334           ;; are no unread articles.
8335           (if (or read-all
8336                   (and (zerop (length gnus-newsgroup-marked))
8337                        (zerop (length gnus-newsgroup-unreads))))
8338               (gnus-uncompress-range (gnus-active group))
8339             (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
8340                           (copy-sequence gnus-newsgroup-unreads))
8341                   '<)))
8342          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
8343          (scored (length scored-list))
8344          (number (length articles))
8345          (marked (+ (length gnus-newsgroup-marked)
8346                     (length gnus-newsgroup-dormant)))
8347          (select
8348           (cond
8349            ((numberp read-all)
8350             read-all)
8351            (t
8352             (condition-case ()
8353                 (cond
8354                  ((and (or (<= scored marked) (= scored number))
8355                        (numberp gnus-large-newsgroup)
8356                        (> number gnus-large-newsgroup))
8357                   (let ((input
8358                          (read-string
8359                           (format
8360                            "How many articles from %s (default %d): "
8361                            gnus-newsgroup-name number))))
8362                     (if (string-match "^[ \t]*$" input) number input)))
8363                  ((and (> scored marked) (< scored number))
8364                   (let ((input
8365                          (read-string
8366                           (format "%s %s (%d scored, %d total): "
8367                                   "How many articles from"
8368                                   group scored number))))
8369                     (if (string-match "^[ \t]*$" input)
8370                         number input)))
8371                  (t number))
8372               (quit nil))))))
8373     (setq select (if (stringp select) (string-to-number select) select))
8374     (if (or (null select) (zerop select))
8375         select
8376       (if (and (not (zerop scored)) (<= (abs select) scored))
8377           (progn
8378             (setq articles (sort scored-list '<))
8379             (setq number (length articles)))
8380         (setq articles (copy-sequence articles)))
8381
8382       (if (< (abs select) number)
8383           (if (< select 0)
8384               ;; Select the N oldest articles.
8385               (setcdr (nthcdr (1- (abs select)) articles) nil)
8386             ;; Select the N most recent articles.
8387             (setq articles (nthcdr (- number select) articles))))
8388       (setq gnus-newsgroup-unselected
8389             (gnus-sorted-intersection
8390              gnus-newsgroup-unreads
8391              (gnus-sorted-complement gnus-newsgroup-unreads articles)))
8392       articles)))
8393
8394 (defun gnus-killed-articles (killed articles)
8395   (let (out)
8396     (while articles
8397       (if (inline (gnus-member-of-range (car articles) killed))
8398           (setq out (cons (car articles) out)))
8399       (setq articles (cdr articles)))
8400     out))
8401
8402 (defun gnus-uncompress-marks (marks)
8403   "Uncompress the mark ranges in MARKS."
8404   (let ((uncompressed '(score bookmark))
8405         out)
8406     (while marks
8407       (if (memq (caar marks) uncompressed)
8408           (push (car marks) out)
8409         (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
8410       (setq marks (cdr marks)))
8411     out))
8412
8413 (defun gnus-adjust-marked-articles (info)
8414   "Set all article lists and remove all marks that are no longer legal."
8415   (let* ((marked-lists (gnus-info-marks info))
8416          (active (gnus-active (gnus-info-group info)))
8417          (min (car active))
8418          (max (cdr active))
8419          (types gnus-article-mark-lists)
8420          (uncompressed '(score bookmark))
8421          marks var articles article mark)
8422
8423     (while marked-lists
8424       (setq marks (pop marked-lists))
8425       (set (setq var (intern (format "gnus-newsgroup-%s"
8426                                      (car (rassq (setq mark (car marks))
8427                                                  types)))))
8428            (if (memq (car marks) uncompressed) (cdr marks)
8429              (gnus-uncompress-range (cdr marks))))
8430
8431       (setq articles (symbol-value var))
8432
8433       ;; All articles have to be subsets of the active articles.
8434       (cond
8435        ;; Adjust "simple" lists.
8436        ((memq mark '(tick dormant expirable reply killed save))
8437         (while articles
8438           (when (or (< (setq article (pop articles)) min) (> article max))
8439             (set var (delq article (symbol-value var))))))
8440        ;; Adjust assocs.
8441        ((memq mark '(score bookmark))
8442         (while articles
8443           (when (or (< (car (setq article (pop articles))) min)
8444                     (> (car article) max))
8445             (set var (delq article (symbol-value var))))))))))
8446
8447 (defun gnus-update-missing-marks (missing)
8448   "Go through the list of MISSING articles and remove them mark lists."
8449   (when missing
8450     (let ((types gnus-article-mark-lists)
8451           var m)
8452       ;; Go through all types.
8453       (while types
8454         (setq var (intern (format "gnus-newsgroup-%s" (car (pop types)))))
8455         (when (symbol-value var)
8456           ;; This list has articles.  So we delete all missing articles
8457           ;; from it.
8458           (setq m missing)
8459           (while m
8460             (set var (delq (pop m) (symbol-value var)))))))))
8461
8462 (defun gnus-update-marks ()
8463   "Enter the various lists of marked articles into the newsgroup info list."
8464   (let ((types gnus-article-mark-lists)
8465         (info (gnus-get-info gnus-newsgroup-name))
8466         (uncompressed '(score bookmark killed))
8467         var type list newmarked symbol)
8468     (when info
8469       ;; Add all marks lists that are non-nil to the list of marks lists.
8470       (while types
8471         (setq type (pop types))
8472         (when (setq list (symbol-value
8473                           (setq symbol
8474                                 (intern (format "gnus-newsgroup-%s"
8475                                                 (car type))))))
8476           (push (cons (cdr type)
8477                       (if (memq (cdr type) uncompressed) list
8478                         (gnus-compress-sequence (set symbol (sort list '<)) t)))
8479                 newmarked)))
8480
8481       ;; Enter these new marks into the info of the group.
8482       (if (nthcdr 3 info)
8483           (setcar (nthcdr 3 info) newmarked)
8484         ;; Add the marks lists to the end of the info.
8485         (when newmarked
8486           (setcdr (nthcdr 2 info) (list newmarked))))
8487
8488       ;; Cut off the end of the info if there's nothing else there.
8489       (let ((i 5))
8490         (while (and (> i 2)
8491                     (not (nth i info)))
8492           (when (nthcdr (decf i) info)
8493             (setcdr (nthcdr i info) nil)))))))
8494
8495 (defun gnus-add-marked-articles (group type articles &optional info force)
8496   ;; Add ARTICLES of TYPE to the info of GROUP.
8497   ;; If INFO is non-nil, use that info.  If FORCE is non-nil, don't
8498   ;; add, but replace marked articles of TYPE with ARTICLES.
8499   (let ((info (or info (gnus-get-info group)))
8500         (uncompressed '(score bookmark killed))
8501         marked m)
8502     (or (not info)
8503         (and (not (setq marked (nthcdr 3 info)))
8504              (setcdr (nthcdr 2 info)
8505                      (list (list (cons type (gnus-compress-sequence
8506                                              articles t))))))
8507         (and (not (setq m (assq type (car marked))))
8508              (setcar marked
8509                      (cons (cons type (gnus-compress-sequence articles t) )
8510                            (car marked))))
8511         (if force
8512             (setcdr m (gnus-compress-sequence articles t))
8513           (setcdr m (gnus-compress-sequence
8514                      (sort (nconc (gnus-uncompress-range m)
8515                                   (copy-sequence articles)) '<) t))))))
8516
8517 (defun gnus-set-mode-line (where)
8518   "This function sets the mode line of the article or summary buffers.
8519 If WHERE is `summary', the summary mode line format will be used."
8520   ;; Is this mode line one we keep updated?
8521   (when (memq where gnus-updated-mode-lines)
8522     (let (mode-string)
8523       (save-excursion
8524         ;; We evaluate this in the summary buffer since these
8525         ;; variables are buffer-local to that buffer.
8526         (set-buffer gnus-summary-buffer)
8527         ;; We bind all these variables that are used in the `eval' form
8528         ;; below.
8529         (let* ((mformat (symbol-value
8530                          (intern
8531                           (format "gnus-%s-mode-line-format-spec" where))))
8532                (gnus-tmp-group-name gnus-newsgroup-name)
8533                (gnus-tmp-article-number (or gnus-current-article 0))
8534                (gnus-tmp-unread gnus-newsgroup-unreads)
8535                (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
8536                (gnus-tmp-unselected (length gnus-newsgroup-unselected))
8537                (gnus-tmp-unread-and-unselected
8538                 (cond ((and (zerop gnus-tmp-unread-and-unticked)
8539                             (zerop gnus-tmp-unselected)) "")
8540                       ((zerop gnus-tmp-unselected)
8541                        (format "{%d more}" gnus-tmp-unread-and-unticked))
8542                       (t (format "{%d(+%d) more}"
8543                                  gnus-tmp-unread-and-unticked
8544                                  gnus-tmp-unselected))))
8545                (gnus-tmp-subject
8546                 (if (and gnus-current-headers
8547                          (vectorp gnus-current-headers))
8548                     (mail-header-subject gnus-current-headers) ""))
8549                max-len
8550                gnus-tmp-header);; passed as argument to any user-format-funcs
8551           (setq mode-string (eval mformat))
8552           (setq max-len (max 4 (if gnus-mode-non-string-length
8553                                    (- (frame-width)
8554                                       gnus-mode-non-string-length)
8555                                  (length mode-string))))
8556           ;; We might have to chop a bit of the string off...
8557           (when (> (length mode-string) max-len)
8558             (setq mode-string
8559                   (concat (gnus-truncate-string mode-string (- max-len 3))
8560                           "...")))
8561           ;; Pad the mode string a bit.
8562           (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
8563       ;; Update the mode line.
8564       (setq mode-line-buffer-identification (list mode-string))
8565       (set-buffer-modified-p t))))
8566
8567 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
8568   "Go through the HEADERS list and add all Xrefs to a hash table.
8569 The resulting hash table is returned, or nil if no Xrefs were found."
8570   (let* ((from-method (gnus-find-method-for-group from-newsgroup))
8571          (virtual (gnus-virtual-group-p from-newsgroup))
8572          (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
8573          (xref-hashtb (make-vector 63 0))
8574          start group entry number xrefs header)
8575     (while headers
8576       (setq header (pop headers))
8577       (when (and (setq xrefs (mail-header-xref header))
8578                  (not (memq (setq number (mail-header-number header))
8579                             unreads)))
8580         (setq start 0)
8581         (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
8582           (setq start (match-end 0))
8583           (setq group (concat prefix (substring xrefs (match-beginning 1)
8584                                                 (match-end 1))))
8585           (setq number
8586                 (string-to-int (substring xrefs (match-beginning 2)
8587                                           (match-end 2))))
8588           (if (setq entry (gnus-gethash group xref-hashtb))
8589               (setcdr entry (cons number (cdr entry)))
8590             (gnus-sethash group (cons number nil) xref-hashtb)))))
8591     (and start xref-hashtb)))
8592
8593 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
8594   "Look through all the headers and mark the Xrefs as read."
8595   (let ((virtual (gnus-virtual-group-p from-newsgroup))
8596         name entry info xref-hashtb idlist method nth4)
8597     (save-excursion
8598       (set-buffer gnus-group-buffer)
8599       (when (setq xref-hashtb
8600                   (gnus-create-xref-hashtb from-newsgroup headers unreads))
8601         (mapatoms
8602          (lambda (group)
8603            (unless (string= from-newsgroup (setq name (symbol-name group)))
8604              (setq idlist (symbol-value group))
8605              ;; Dead groups are not updated.
8606              (and (prog1
8607                       (setq entry (gnus-gethash name gnus-newsrc-hashtb)
8608                             info (nth 2 entry))
8609                     (if (stringp (setq nth4 (gnus-info-method info)))
8610                         (setq nth4 (gnus-server-to-method nth4))))
8611                   ;; Only do the xrefs if the group has the same
8612                   ;; select method as the group we have just read.
8613                   (or (gnus-methods-equal-p
8614                        nth4 (gnus-find-method-for-group from-newsgroup))
8615                       virtual
8616                       (equal nth4 (setq method (gnus-find-method-for-group
8617                                                 from-newsgroup)))
8618                       (and (equal (car nth4) (car method))
8619                            (equal (nth 1 nth4) (nth 1 method))))
8620                   gnus-use-cross-reference
8621                   (or (not (eq gnus-use-cross-reference t))
8622                       virtual
8623                       ;; Only do cross-references on subscribed
8624                       ;; groups, if that is what is wanted.
8625                       (<= (gnus-info-level info) gnus-level-subscribed))
8626                   (gnus-group-make-articles-read name idlist))))
8627          xref-hashtb)))))
8628
8629 (defun gnus-group-make-articles-read (group articles)
8630   (let* ((num 0)
8631          (entry (gnus-gethash group gnus-newsrc-hashtb))
8632          (info (nth 2 entry))
8633          (active (gnus-active group))
8634          range)
8635     ;; First peel off all illegal article numbers.
8636     (if active
8637         (let ((ids articles)
8638               id first)
8639           (while ids
8640             (setq id (car ids))
8641             (if (and first (> id (cdr active)))
8642                 (progn
8643                   ;; We'll end up in this situation in one particular
8644                   ;; obscure situation.  If you re-scan a group and get
8645                   ;; a new article that is cross-posted to a different
8646                   ;; group that has not been re-scanned, you might get
8647                   ;; crossposted article that has a higher number than
8648                   ;; Gnus believes possible.  So we re-activate this
8649                   ;; group as well.  This might mean doing the
8650                   ;; crossposting thingy will *increase* the number
8651                   ;; of articles in some groups.  Tsk, tsk.
8652                   (setq active (or (gnus-activate-group group) active))))
8653             (if (or (> id (cdr active))
8654                     (< id (car active)))
8655                 (setq articles (delq id articles)))
8656             (setq ids (cdr ids)))))
8657     ;; If the read list is nil, we init it.
8658     (and active
8659          (null (gnus-info-read info))
8660          (> (car active) 1)
8661          (gnus-info-set-read info (cons 1 (1- (car active)))))
8662     ;; Then we add the read articles to the range.
8663     (gnus-info-set-read
8664      info
8665      (setq range
8666            (gnus-add-to-range
8667             (gnus-info-read info) (setq articles (sort articles '<)))))
8668     ;; Then we have to re-compute how many unread
8669     ;; articles there are in this group.
8670     (if active
8671         (progn
8672           (cond
8673            ((not range)
8674             (setq num (- (1+ (cdr active)) (car active))))
8675            ((not (listp (cdr range)))
8676             (setq num (- (cdr active) (- (1+ (cdr range))
8677                                          (car range)))))
8678            (t
8679             (while range
8680               (if (numberp (car range))
8681                   (setq num (1+ num))
8682                 (setq num (+ num (- (1+ (cdr (car range)))
8683                                     (car (car range))))))
8684               (setq range (cdr range)))
8685             (setq num (- (cdr active) num))))
8686           ;; Update the number of unread articles.
8687           (setcar entry num)
8688           ;; Update the group buffer.
8689           (gnus-group-update-group group t)))))
8690
8691 (defun gnus-methods-equal-p (m1 m2)
8692   (let ((m1 (or m1 gnus-select-method))
8693         (m2 (or m2 gnus-select-method)))
8694     (or (equal m1 m2)
8695         (and (eq (car m1) (car m2))
8696              (or (not (memq 'address (assoc (symbol-name (car m1))
8697                                             gnus-valid-select-methods)))
8698                  (equal (nth 1 m1) (nth 1 m2)))))))
8699
8700 (defsubst gnus-header-value ()
8701   (buffer-substring (match-end 0) (gnus-point-at-eol)))
8702
8703 (defvar gnus-newsgroup-none-id 0)
8704
8705 (defun gnus-get-newsgroup-headers (&optional dependencies force-new)
8706   (let ((cur nntp-server-buffer)
8707         (dependencies
8708          (or dependencies
8709              (save-excursion (set-buffer gnus-summary-buffer)
8710                              gnus-newsgroup-dependencies)))
8711         headers id id-dep ref-dep end ref)
8712     (save-excursion
8713       (set-buffer nntp-server-buffer)
8714       (let ((case-fold-search t)
8715             in-reply-to header number p lines)
8716         (goto-char (point-min))
8717         ;; Search to the beginning of the next header.  Error messages
8718         ;; do not begin with 2 or 3.
8719         (while (re-search-forward "^[23][0-9]+ " nil t)
8720           (setq id nil
8721                 ref nil)
8722           ;; This implementation of this function, with nine
8723           ;; search-forwards instead of the one re-search-forward and
8724           ;; a case (which basically was the old function) is actually
8725           ;; about twice as fast, even though it looks messier.  You
8726           ;; can't have everything, I guess.  Speed and elegance
8727           ;; doesn't always go hand in hand.
8728           (setq
8729            header
8730            (vector
8731             ;; Number.
8732             (prog1
8733                 (read cur)
8734               (end-of-line)
8735               (setq p (point))
8736               (narrow-to-region (point)
8737                                 (or (and (search-forward "\n.\n" nil t)
8738                                          (- (point) 2))
8739                                     (point))))
8740             ;; Subject.
8741             (progn
8742               (goto-char p)
8743               (if (search-forward "\nsubject: " nil t)
8744                   (gnus-header-value) "(none)"))
8745             ;; From.
8746             (progn
8747               (goto-char p)
8748               (if (search-forward "\nfrom: " nil t)
8749                   (gnus-header-value) "(nobody)"))
8750             ;; Date.
8751             (progn
8752               (goto-char p)
8753               (if (search-forward "\ndate: " nil t)
8754                   (gnus-header-value) ""))
8755             ;; Message-ID.
8756             (progn
8757               (goto-char p)
8758               (if (search-forward "\nmessage-id: " nil t)
8759                   (setq id (gnus-header-value))
8760                 ;; If there was no message-id, we just fake one to make
8761                 ;; subsequent routines simpler.
8762                 (setq id (concat "none+"
8763                                  (int-to-string
8764                                   (setq gnus-newsgroup-none-id
8765                                         (1+ gnus-newsgroup-none-id)))))))
8766             ;; References.
8767             (progn
8768               (goto-char p)
8769               (if (search-forward "\nreferences: " nil t)
8770                   (prog1
8771                       (gnus-header-value)
8772                     (setq end (match-end 0))
8773                     (save-excursion
8774                       (setq ref
8775                             (downcase
8776                              (buffer-substring
8777                               (progn
8778                                 (end-of-line)
8779                                 (search-backward ">" end t)
8780                                 (1+ (point)))
8781                               (progn
8782                                 (search-backward "<" end t)
8783                                 (point)))))))
8784                 ;; Get the references from the in-reply-to header if there
8785                 ;; were no references and the in-reply-to header looks
8786                 ;; promising.
8787                 (if (and (search-forward "\nin-reply-to: " nil t)
8788                          (setq in-reply-to (gnus-header-value))
8789                          (string-match "<[^>]+>" in-reply-to))
8790                     (prog1
8791                         (setq ref (substring in-reply-to (match-beginning 0)
8792                                              (match-end 0)))
8793                       (setq ref (downcase ref))))
8794                 (setq ref "")))
8795             ;; Chars.
8796             0
8797             ;; Lines.
8798             (progn
8799               (goto-char p)
8800               (if (search-forward "\nlines: " nil t)
8801                   (if (numberp (setq lines (read cur)))
8802                       lines 0)
8803                 0))
8804             ;; Xref.
8805             (progn
8806               (goto-char p)
8807               (and (search-forward "\nxref: " nil t)
8808                    (gnus-header-value)))))
8809           (if (and gnus-nocem-hashtb
8810                    (gnus-gethash id gnus-nocem-hashtb))
8811               ;; Banned article.
8812               (setq header nil)
8813             ;; We do the threading while we read the headers.  The
8814             ;; message-id and the last reference are both entered into
8815             ;; the same hash table.  Some tippy-toeing around has to be
8816             ;; done in case an article has arrived before the article
8817             ;; which it refers to.
8818             (if (boundp (setq id-dep (intern (downcase id) dependencies)))
8819                 (if (and (car (symbol-value id-dep))
8820                          (not force-new))
8821                     ;; An article with this Message-ID has already
8822                     ;; been seen, so we ignore this one, except we add
8823                     ;; any additional Xrefs (in case the two articles
8824                     ;; came from different servers).
8825                     (progn
8826                       (mail-header-set-xref
8827                        (car (symbol-value id-dep))
8828                        (concat (or (mail-header-xref
8829                                     (car (symbol-value id-dep))) "")
8830                                (or (mail-header-xref header) "")))
8831                       (setq header nil))
8832                   (setcar (symbol-value id-dep) header))
8833               (set id-dep (list header))))
8834           (when header
8835             (if (boundp (setq ref-dep (intern ref dependencies)))
8836                 (setcdr (symbol-value ref-dep)
8837                         (nconc (cdr (symbol-value ref-dep))
8838                                (list (symbol-value id-dep))))
8839               (set ref-dep (list nil (symbol-value id-dep))))
8840             (setq headers (cons header headers)))
8841           (goto-char (point-max))
8842           (widen))
8843         (nreverse headers)))))
8844
8845 ;; The following macros and functions were written by Felix Lee
8846 ;; <flee@cse.psu.edu>.
8847
8848 (defmacro gnus-nov-read-integer ()
8849   '(prog1
8850        (if (= (following-char) ?\t)
8851            0
8852          (let ((num (condition-case nil (read buffer) (error nil))))
8853            (if (numberp num) num 0)))
8854      (or (eobp) (forward-char 1))))
8855
8856 (defmacro gnus-nov-skip-field ()
8857   '(search-forward "\t" eol 'move))
8858
8859 (defmacro gnus-nov-field ()
8860   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
8861
8862 ;; Goes through the xover lines and returns a list of vectors
8863 (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new)
8864   "Parse the news overview data in the server buffer, and return a
8865 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
8866   ;; Get the Xref when the users reads the articles since most/some
8867   ;; NNTP servers do not include Xrefs when using XOVER.
8868   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
8869   (let ((cur nntp-server-buffer)
8870         (dependencies gnus-newsgroup-dependencies)
8871         number headers header)
8872     (save-excursion
8873       (set-buffer nntp-server-buffer)
8874       ;; Allow the user to mangle the headers before parsing them.
8875       (run-hooks 'gnus-parse-headers-hook)
8876       ;; Allow the user to mangle the headers before parsing them.
8877       (run-hooks 'gnus-parse-headers-hook)
8878       (goto-char (point-min))
8879       (while (and sequence (not (eobp)))
8880         (setq number (read cur))
8881         (while (and sequence (< (car sequence) number))
8882           (setq sequence (cdr sequence)))
8883         (and sequence
8884              (eq number (car sequence))
8885              (progn
8886                (setq sequence (cdr sequence))
8887                (if (setq header
8888                          (inline (gnus-nov-parse-line
8889                                   number dependencies force-new)))
8890                    (setq headers (cons header headers)))))
8891         (forward-line 1))
8892       (setq headers (nreverse headers)))
8893     headers))
8894
8895 ;; This function has to be called with point after the article number
8896 ;; on the beginning of the line.
8897 (defun gnus-nov-parse-line (number dependencies &optional force-new)
8898   (let ((none 0)
8899         (eol (gnus-point-at-eol))
8900         (buffer (current-buffer))
8901         header ref id id-dep ref-dep)
8902
8903     ;; overview: [num subject from date id refs chars lines misc]
8904     (narrow-to-region (point) eol)
8905     (or (eobp) (forward-char))
8906
8907     (condition-case nil
8908         (setq header
8909               (vector
8910                number                   ; number
8911                (gnus-nov-field)         ; subject
8912                (gnus-nov-field)         ; from
8913                (gnus-nov-field)         ; date
8914                (setq id (or (gnus-nov-field)
8915                             (concat "none+"
8916                                     (int-to-string
8917                                      (setq none (1+ none)))))) ; id
8918                (progn
8919                  (save-excursion
8920                    (let ((beg (point)))
8921                      (search-forward "\t" eol)
8922                      (if (search-backward ">" beg t)
8923                          (setq ref
8924                                (downcase
8925                                 (buffer-substring
8926                                  (1+ (point))
8927                                  (progn
8928                                    (search-backward "<" beg t)
8929                                    (point)))))
8930                        (setq ref nil))))
8931                  (gnus-nov-field))      ; refs
8932                (gnus-nov-read-integer)  ; chars
8933                (gnus-nov-read-integer)  ; lines
8934                (if (= (following-char) ?\n)
8935                    nil
8936                  (gnus-nov-field))      ; misc
8937                ))
8938       (error (progn
8939                (ding)
8940                (gnus-message 4 "Strange nov line")
8941                (setq header nil)
8942                (goto-char eol))))
8943
8944     (widen)
8945
8946     ;; We build the thread tree.
8947     (and header
8948          (if (and gnus-nocem-hashtb
8949                   (gnus-gethash id gnus-nocem-hashtb))
8950              ;; Banned article.
8951              (setq header nil)
8952            (if (boundp (setq id-dep (intern (downcase id) dependencies)))
8953                (if (and (car (symbol-value id-dep))
8954                         (not force-new))
8955                    ;; An article with this Message-ID has already been seen,
8956                    ;; so we ignore this one, except we add any additional
8957                    ;; Xrefs (in case the two articles came from different
8958                    ;; servers.
8959                    (progn
8960                      (mail-header-set-xref
8961                       (car (symbol-value id-dep))
8962                       (concat (or (mail-header-xref
8963                                    (car (symbol-value id-dep))) "")
8964                               (or (mail-header-xref header) "")))
8965                      (setq header nil))
8966                  (setcar (symbol-value id-dep) header))
8967              (set id-dep (list header)))))
8968     (if header
8969         (progn
8970           (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
8971               (setcdr (symbol-value ref-dep)
8972                       (nconc (cdr (symbol-value ref-dep))
8973                              (list (symbol-value id-dep))))
8974             (set ref-dep (list nil (symbol-value id-dep))))))
8975     header))
8976
8977 (defun gnus-article-get-xrefs ()
8978   "Fill in the Xref value in `gnus-current-headers', if necessary.
8979 This is meant to be called in `gnus-article-internal-prepare-hook'."
8980   (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
8981                                  gnus-current-headers)))
8982     (or (not gnus-use-cross-reference)
8983         (not headers)
8984         (and (mail-header-xref headers)
8985              (not (string= (mail-header-xref headers) "")))
8986         (let ((case-fold-search t)
8987               xref)
8988           (save-restriction
8989             (nnheader-narrow-to-headers)
8990             (goto-char (point-min))
8991             (if (or (and (eq (downcase (following-char)) ?x)
8992                          (looking-at "Xref:"))
8993                     (search-forward "\nXref:" nil t))
8994                 (progn
8995                   (goto-char (1+ (match-end 0)))
8996                   (setq xref (buffer-substring (point)
8997                                                (progn (end-of-line) (point))))
8998                   (mail-header-set-xref headers xref))))))))
8999
9000 (defun gnus-summary-insert-subject (id)
9001   "Find article ID and insert the summary line for that article."
9002   (let ((header (gnus-read-header id))
9003         (number (and (numberp id) id)))
9004     (when header
9005       ;; Rebuild the thread that this article is part of and go to the
9006       ;; article we have fetched.
9007       (gnus-rebuild-thread (mail-header-id header))
9008       (gnus-summary-goto-subject (setq number (mail-header-number header))))
9009     (when (and (numberp number)
9010                (> number 0))
9011       ;; We have to update the boundaries even if we can't fetch the
9012       ;; article if ID is a number -- so that the next `P' or `N'
9013       ;; command will fetch the previous (or next) article even
9014       ;; if the one we tried to fetch this time has been canceled.
9015       (and (> number gnus-newsgroup-end)
9016            (setq gnus-newsgroup-end number))
9017       (and (< number gnus-newsgroup-begin)
9018            (setq gnus-newsgroup-begin number))
9019       (setq gnus-newsgroup-unselected
9020             (delq number gnus-newsgroup-unselected)))
9021     ;; Report back a success?
9022     (and header number)))
9023
9024 (defun gnus-summary-work-articles (n)
9025   "Return a list of articles to be worked upon.  The prefix argument,
9026 the list of process marked articles, and the current article will be
9027 taken into consideration."
9028   (cond
9029    ((and n (numberp n))
9030     ;; A numerical prefix has been given.
9031     (let ((backward (< n 0))
9032           (n (abs n))
9033           articles article)
9034       (save-excursion
9035         (while
9036             (and (> n 0)
9037                  (push (setq article (gnus-summary-article-number))
9038                        articles)
9039                  (if backward
9040                      (gnus-summary-find-prev nil article)
9041                    (gnus-summary-find-next nil article)))
9042           (decf n)))
9043       (nreverse articles)))
9044    ((and (boundp 'transient-mark-mode)
9045          transient-mark-mode
9046          mark-active)
9047     ;; Work on the region between point and mark.
9048     (let ((max (max (point) (mark)))
9049           articles article)
9050       (save-excursion
9051         (goto-char (min (point) (mark)))
9052         (while
9053             (and
9054              (push (setq article (gnus-summary-article-number)) articles)
9055              (gnus-summary-find-next nil article)
9056              (< (point) max)))
9057         (nreverse articles))))
9058    (gnus-newsgroup-processable
9059     ;; There are process-marked articles present.
9060     (reverse gnus-newsgroup-processable))
9061    (t
9062     ;; Just return the current article.
9063     (list (gnus-summary-article-number)))))
9064
9065 (defun gnus-summary-search-group (&optional backward use-level)
9066   "Search for next unread newsgroup.
9067 If optional argument BACKWARD is non-nil, search backward instead."
9068   (save-excursion
9069     (set-buffer gnus-group-buffer)
9070     (if (gnus-group-search-forward
9071          backward nil (if use-level (gnus-group-group-level) nil))
9072         (gnus-group-group-name))))
9073
9074 (defun gnus-summary-best-group (&optional exclude-group)
9075   "Find the name of the best unread group.
9076 If EXCLUDE-GROUP, do not go to this group."
9077   (save-excursion
9078     (set-buffer gnus-group-buffer)
9079     (save-excursion
9080       (gnus-group-best-unread-group exclude-group))))
9081
9082 (defun gnus-summary-find-next (&optional unread article backward)
9083   (if backward (gnus-summary-find-prev)
9084     (let* ((article (or article (gnus-summary-article-number)))
9085            (arts (gnus-data-find-list article))
9086            result)
9087       (when (or (not gnus-summary-check-current)
9088                 (not unread)
9089                 (not (gnus-data-unread-p (car arts))))
9090         (setq arts (cdr arts)))
9091       (when (setq result
9092                   (if unread
9093                       (progn
9094                         (while arts
9095                           (when (gnus-data-unread-p (car arts))
9096                             (setq result (car arts)
9097                                   arts nil))
9098                           (setq arts (cdr arts)))
9099                         result)
9100                     (car arts)))
9101         (goto-char (gnus-data-pos result))
9102         (gnus-data-number result)))))
9103
9104 (defun gnus-summary-find-prev (&optional unread article)
9105   (let* ((article (or article (gnus-summary-article-number)))
9106          (arts (gnus-data-find-list article (gnus-data-list 'rev)))
9107          result)
9108     (when (or (not gnus-summary-check-current)
9109               (not unread)
9110               (not (gnus-data-unread-p (car arts))))
9111       (setq arts (cdr arts)))
9112     (if (setq result
9113               (if unread
9114                   (progn
9115                     (while arts
9116                       (and (gnus-data-unread-p (car arts))
9117                            (setq result (car arts)
9118                                  arts nil))
9119                       (setq arts (cdr arts)))
9120                     result)
9121                 (car arts)))
9122         (progn
9123           (goto-char (gnus-data-pos result))
9124           (gnus-data-number result)))))
9125
9126 (defun gnus-summary-find-subject (subject &optional unread backward article)
9127   (let* ((simp-subject (gnus-simplify-subject-fully subject))
9128          (article (or article (gnus-summary-article-number)))
9129          (articles (gnus-data-list backward))
9130          (arts (gnus-data-find-list article articles))
9131          result)
9132     (when (or (not gnus-summary-check-current)
9133               (not unread)
9134               (not (gnus-data-unread-p (car arts))))
9135       (setq arts (cdr arts)))
9136     (while arts
9137       (and (or (not unread)
9138                (gnus-data-unread-p (car arts)))
9139            (vectorp (gnus-data-header (car arts)))
9140            (gnus-subject-equal
9141             simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
9142            (setq result (car arts)
9143                  arts nil))
9144       (setq arts (cdr arts)))
9145     (and result
9146          (goto-char (gnus-data-pos result))
9147          (gnus-data-number result))))
9148
9149 (defun gnus-summary-search-forward (&optional unread subject backward)
9150   (cond (subject
9151          (gnus-summary-find-subject subject unread backward))
9152         (backward
9153          (gnus-summary-find-prev unread))
9154         (t
9155          (gnus-summary-find-next unread))))
9156
9157 (defun gnus-recenter (&optional n)
9158   "Center point in window and redisplay frame.
9159 Also do horizontal recentering."
9160   (interactive)
9161   (gnus-horizontal-recenter)
9162   (recenter n))
9163
9164 (defun gnus-summary-recenter ()
9165   "Center point in the summary window.
9166 If `gnus-auto-center-summary' is nil, or the article buffer isn't
9167 displayed, no centering will be performed."
9168   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
9169   ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
9170   (let* ((top (cond ((< (window-height) 4) 0)
9171                     ((< (window-height) 7) 1)
9172                     (t 2)))
9173          (height (1- (window-height)))
9174          (bottom (save-excursion (goto-char (point-max))
9175                                  (forward-line (- height))
9176                                  (point)))
9177          (window (get-buffer-window (current-buffer))))
9178     ;; The user has to want it.
9179     (when gnus-auto-center-summary
9180       (when (get-buffer-window gnus-article-buffer)
9181        ;; Only do recentering when the article buffer is displayed,
9182        ;; Set the window start to either `bottom', which is the biggest
9183        ;; possible valid number, or the second line from the top,
9184        ;; whichever is the least.
9185        (set-window-start
9186         window (min bottom (save-excursion 
9187                              (forward-line (- top)) (point)))))
9188       ;; Do horizontal recentering while we're at it.
9189       (when (get-buffer-window (current-buffer) t)
9190         (let ((selected (selected-window)))
9191           (select-window (get-buffer-window (current-buffer) t))
9192           (gnus-summary-position-point)
9193           (gnus-horizontal-recenter)
9194           (select-window selected))))))
9195
9196 (defun gnus-horizontal-recenter ()
9197   "Recenter the current buffer horizontally."
9198   (if (< (current-column) (/ (window-width) 2))
9199       (set-window-hscroll (get-buffer-window (current-buffer) t) 0)
9200     (let* ((orig (point))
9201            (end (window-end (get-buffer-window (current-buffer) t)))
9202            (max 0))
9203       ;; Find the longest line currently displayed in the window.
9204       (goto-char (window-start))
9205       (while (and (not (eobp)) 
9206                   (< (point) end))
9207         (end-of-line)
9208         (setq max (max max (current-column)))
9209         (forward-line 1))
9210       (goto-char orig)
9211       ;; Scroll horizontally to center (sort of) the point.
9212       (if (> max (window-width))
9213           (set-window-hscroll 
9214            (get-buffer-window (current-buffer) t)
9215            (min (- (current-column) (/ (window-width) 3))
9216                 (+ 2 (- max (window-width)))))
9217         (set-window-hscroll (get-buffer-window (current-buffer) t) 0))
9218       max)))
9219
9220 ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
9221 (defun gnus-short-group-name (group &optional levels)
9222   "Collapse GROUP name LEVELS."
9223   (let* ((name "") 
9224          (foreign "")
9225          (depth 0) 
9226          (skip 1)
9227          (levels (or levels
9228                      (progn
9229                        (while (string-match "\\." group skip)
9230                          (setq skip (match-end 0)
9231                                depth (+ depth 1)))
9232                        depth))))
9233     (if (string-match ":" group)
9234         (setq foreign (substring group 0 (match-end 0))
9235               group (substring group (match-end 0))))
9236     (while group
9237       (if (and (string-match "\\." group)
9238                (> levels (- gnus-group-uncollapsed-levels 1)))
9239           (setq name (concat name (substring group 0 1))
9240                 group (substring group (match-end 0))
9241                 levels (- levels 1)
9242                 name (concat name "."))
9243         (setq name (concat foreign name group)
9244               group nil)))
9245     name))
9246
9247 (defun gnus-summary-jump-to-group (newsgroup)
9248   "Move point to NEWSGROUP in group mode buffer."
9249   ;; Keep update point of group mode buffer if visible.
9250   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
9251       (save-window-excursion
9252         ;; Take care of tree window mode.
9253         (if (get-buffer-window gnus-group-buffer)
9254             (pop-to-buffer gnus-group-buffer))
9255         (gnus-group-jump-to-group newsgroup))
9256     (save-excursion
9257       ;; Take care of tree window mode.
9258       (if (get-buffer-window gnus-group-buffer)
9259           (pop-to-buffer gnus-group-buffer)
9260         (set-buffer gnus-group-buffer))
9261       (gnus-group-jump-to-group newsgroup))))
9262
9263 ;; This function returns a list of article numbers based on the
9264 ;; difference between the ranges of read articles in this group and
9265 ;; the range of active articles.
9266 (defun gnus-list-of-unread-articles (group)
9267   (let* ((read (gnus-info-read (gnus-get-info group)))
9268          (active (gnus-active group))
9269          (last (cdr active))
9270          first nlast unread)
9271     ;; If none are read, then all are unread.
9272     (if (not read)
9273         (setq first (car active))
9274       ;; If the range of read articles is a single range, then the
9275       ;; first unread article is the article after the last read
9276       ;; article.  Sounds logical, doesn't it?
9277       (if (not (listp (cdr read)))
9278           (setq first (1+ (cdr read)))
9279         ;; `read' is a list of ranges.
9280         (if (/= (setq nlast (or (and (numberp (car read)) (car read))
9281                                 (car (car read)))) 1)
9282             (setq first 1))
9283         (while read
9284           (if first
9285               (while (< first nlast)
9286                 (setq unread (cons first unread))
9287                 (setq first (1+ first))))
9288           (setq first (1+ (if (atom (car read)) (car read) (cdr (car read)))))
9289           (setq nlast (if (atom (car (cdr read)))
9290                           (car (cdr read))
9291                         (car (car (cdr read)))))
9292           (setq read (cdr read)))))
9293     ;; And add the last unread articles.
9294     (while (<= first last)
9295       (setq unread (cons first unread))
9296       (setq first (1+ first)))
9297     ;; Return the list of unread articles.
9298     (nreverse unread)))
9299
9300 (defun gnus-list-of-read-articles (group)
9301   "Return a list of unread, unticked and non-dormant articles."
9302   (let* ((info (gnus-get-info group))
9303          (marked (gnus-info-marks info))
9304          (active (gnus-active group)))
9305     (and info active
9306          (gnus-set-difference
9307           (gnus-sorted-complement
9308            (gnus-uncompress-range active)
9309            (gnus-list-of-unread-articles group))
9310           (append
9311            (gnus-uncompress-range (cdr (assq 'dormant marked)))
9312            (gnus-uncompress-range (cdr (assq 'tick marked))))))))
9313
9314 ;; Various summary commands
9315
9316 (defun gnus-summary-universal-argument (arg)
9317   "Perform any operation on all articles that are process/prefixed."
9318   (interactive "P")
9319   (gnus-set-global-variables)
9320   (let ((articles (gnus-summary-work-articles arg))
9321         func article)
9322     (if (eq
9323          (setq
9324           func
9325           (key-binding
9326            (read-key-sequence
9327             (substitute-command-keys
9328              "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
9329              ))))
9330          'undefined)
9331         (progn
9332           (message "Undefined key")
9333           (ding))
9334       (save-excursion
9335         (while articles
9336           (gnus-summary-goto-subject (setq article (pop articles)))
9337           (command-execute func)
9338           (gnus-summary-remove-process-mark article)))))
9339   (gnus-summary-position-point))
9340
9341 (defun gnus-summary-toggle-truncation (&optional arg)
9342   "Toggle truncation of summary lines.
9343 With arg, turn line truncation on iff arg is positive."
9344   (interactive "P")
9345   (setq truncate-lines
9346         (if (null arg) (not truncate-lines)
9347           (> (prefix-numeric-value arg) 0)))
9348   (redraw-display))
9349
9350 (defun gnus-summary-reselect-current-group (&optional all rescan)
9351   "Exit and then reselect the current newsgroup.
9352 The prefix argument ALL means to select all articles."
9353   (interactive "P")
9354   (gnus-set-global-variables)
9355   (let ((current-subject (gnus-summary-article-number))
9356         (group gnus-newsgroup-name))
9357     (setq gnus-newsgroup-begin nil)
9358     (gnus-summary-exit)
9359     ;; We have to adjust the point of group mode buffer because the
9360     ;; current point was moved to the next unread newsgroup by
9361     ;; exiting.
9362     (gnus-summary-jump-to-group group)
9363     (when rescan
9364       (save-excursion
9365         (gnus-group-get-new-news-this-group 1)))
9366     (gnus-group-read-group all t)
9367     (gnus-summary-goto-subject current-subject)))
9368
9369 (defun gnus-summary-rescan-group (&optional all)
9370   "Exit the newsgroup, ask for new articles, and select the newsgroup."
9371   (interactive "P")
9372   (gnus-summary-reselect-current-group all t))
9373
9374 (defun gnus-summary-update-info ()
9375   (let* ((group gnus-newsgroup-name))
9376     (when gnus-newsgroup-kill-headers
9377       (setq gnus-newsgroup-killed
9378             (gnus-compress-sequence
9379              (nconc
9380               (gnus-set-sorted-intersection
9381                (gnus-uncompress-range gnus-newsgroup-killed)
9382                (setq gnus-newsgroup-unselected
9383                      (sort gnus-newsgroup-unselected '<)))
9384               (setq gnus-newsgroup-unreads
9385                     (sort gnus-newsgroup-unreads '<))) t)))
9386     (unless (listp (cdr gnus-newsgroup-killed))
9387       (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
9388     (let ((headers gnus-newsgroup-headers))
9389       (gnus-close-group group)
9390       (run-hooks 'gnus-exit-group-hook)
9391       (unless gnus-save-score
9392         (setq gnus-newsgroup-scored nil))
9393       ;; Set the new ranges of read articles.
9394       (gnus-update-read-articles
9395        group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
9396       ;; Set the current article marks.
9397       (gnus-update-marks)
9398       ;; Do the cross-ref thing.
9399       (when gnus-use-cross-reference
9400         (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
9401       ;; Do adaptive scoring, and possibly save score files.
9402       (when gnus-newsgroup-adaptive
9403         (gnus-score-adaptive))
9404       (when gnus-use-scoring
9405         (gnus-score-save))
9406       ;; Do not switch windows but change the buffer to work.
9407       (set-buffer gnus-group-buffer)
9408       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
9409           (gnus-group-update-group group)))))
9410
9411 (defun gnus-summary-exit (&optional temporary)
9412   "Exit reading current newsgroup, and then return to group selection mode.
9413 gnus-exit-group-hook is called with no arguments if that value is non-nil."
9414   (interactive)
9415   (gnus-set-global-variables)
9416   (gnus-kill-save-kill-buffer)
9417   (let* ((group gnus-newsgroup-name)
9418          (quit-config (gnus-group-quit-config gnus-newsgroup-name))
9419          (mode major-mode)
9420          (buf (current-buffer)))
9421     (run-hooks 'gnus-summary-prepare-exit-hook)
9422     (when gnus-use-cache
9423       (gnus-cache-possibly-remove-articles)
9424       (gnus-cache-save-buffers))
9425     (when gnus-use-trees
9426       (gnus-tree-close group))
9427     ;; Make all changes in this group permanent.
9428     (gnus-summary-update-info)
9429     ;; Make sure where I was, and go to next newsgroup.
9430     (set-buffer gnus-group-buffer)
9431     (or quit-config
9432         (progn
9433           (gnus-group-jump-to-group group)
9434           (gnus-group-next-unread-group 1)))
9435     (run-hooks 'gnus-summary-exit-hook)
9436     (if temporary
9437         nil                             ;Nothing to do.
9438       ;; If we have several article buffers, we kill them at exit.
9439       (unless gnus-single-article-buffer
9440         (gnus-kill-buffer gnus-article-buffer)
9441         (gnus-kill-buffer gnus-original-article-buffer))
9442       (set-buffer buf)
9443       (if (not gnus-kill-summary-on-exit)
9444           (gnus-deaden-summary)
9445         ;; We set all buffer-local variables to nil.  It is unclear why
9446         ;; this is needed, but if we don't, buffer-local variables are
9447         ;; not garbage-collected, it seems.  This would the lead to en
9448         ;; ever-growing Emacs.
9449         (gnus-summary-clear-local-variables)
9450         (when (get-buffer gnus-article-buffer)
9451           (bury-buffer gnus-article-buffer))
9452         ;; We clear the global counterparts of the buffer-local
9453         ;; variables as well, just to be on the safe side.
9454         (gnus-configure-windows 'group 'force)
9455         (gnus-summary-clear-local-variables)
9456         ;; Return to group mode buffer.
9457         (if (eq mode 'gnus-summary-mode)
9458             (gnus-kill-buffer buf)))
9459       (setq gnus-current-select-method gnus-select-method)
9460       (pop-to-buffer gnus-group-buffer)
9461       ;; Clear the current group name.
9462       (if (not quit-config)
9463           (progn
9464             (gnus-group-jump-to-group group)
9465             (gnus-group-next-unread-group 1)
9466             (gnus-configure-windows 'group 'force))
9467         (if (not (buffer-name (car quit-config)))
9468             (gnus-configure-windows 'group 'force)
9469           (set-buffer (car quit-config))
9470           (and (eq major-mode 'gnus-summary-mode)
9471                (gnus-set-global-variables))
9472           (gnus-configure-windows (cdr quit-config))))
9473       (unless quit-config
9474         (setq gnus-newsgroup-name nil)))))
9475
9476 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
9477 (defun gnus-summary-exit-no-update (&optional no-questions)
9478   "Quit reading current newsgroup without updating read article info."
9479   (interactive)
9480   (gnus-set-global-variables)
9481   (let* ((group gnus-newsgroup-name)
9482          (quit-config (gnus-group-quit-config group)))
9483     (when (or no-questions
9484               gnus-expert-user
9485               (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
9486       ;; If we have several article buffers, we kill them at exit.
9487       (unless gnus-single-article-buffer
9488         (gnus-kill-buffer gnus-article-buffer)
9489         (gnus-kill-buffer gnus-original-article-buffer))
9490       (if (not gnus-kill-summary-on-exit)
9491           (gnus-deaden-summary)
9492         (gnus-close-group group)
9493         (gnus-summary-clear-local-variables)
9494         (set-buffer gnus-group-buffer)
9495         (gnus-summary-clear-local-variables)
9496         (when (get-buffer gnus-summary-buffer)
9497           (kill-buffer gnus-summary-buffer)))
9498       (when gnus-use-trees
9499         (gnus-tree-close group))
9500       (when (get-buffer gnus-article-buffer)
9501         (bury-buffer gnus-article-buffer))
9502       ;; Return to the group buffer.
9503       (gnus-configure-windows 'group 'force)
9504       ;; Clear the current group name.
9505       (setq gnus-newsgroup-name nil)
9506       (when (equal (gnus-group-group-name) group)
9507         (gnus-group-next-unread-group 1))
9508       (when quit-config
9509         (if (not (buffer-name (car quit-config)))
9510             (gnus-configure-windows 'group 'force)
9511           (set-buffer (car quit-config))
9512           (when (eq major-mode 'gnus-summary-mode)
9513             (gnus-set-global-variables))
9514           (gnus-configure-windows (cdr quit-config)))))))
9515
9516 ;;; Dead summaries.
9517
9518 (defvar gnus-dead-summary-mode-map nil)
9519
9520 (if gnus-dead-summary-mode-map
9521     nil
9522   (setq gnus-dead-summary-mode-map (make-keymap))
9523   (suppress-keymap gnus-dead-summary-mode-map)
9524   (substitute-key-definition
9525    'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
9526   (let ((keys '("\C-d" "\r" "\177")))
9527     (while keys
9528       (define-key gnus-dead-summary-mode-map
9529         (pop keys) 'gnus-summary-wake-up-the-dead))))
9530
9531 (defvar gnus-dead-summary-mode nil
9532   "Minor mode for Gnus summary buffers.")
9533
9534 (defun gnus-dead-summary-mode (&optional arg)
9535   "Minor mode for Gnus summary buffers."
9536   (interactive "P")
9537   (when (eq major-mode 'gnus-summary-mode)
9538     (make-local-variable 'gnus-dead-summary-mode)
9539     (setq gnus-dead-summary-mode
9540           (if (null arg) (not gnus-dead-summary-mode)
9541             (> (prefix-numeric-value arg) 0)))
9542     (when gnus-dead-summary-mode
9543       (unless (assq 'gnus-dead-summary-mode minor-mode-alist)
9544         (push '(gnus-dead-summary-mode " Dead") minor-mode-alist))
9545       (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist)
9546         (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map)
9547               minor-mode-map-alist)))))
9548
9549 (defun gnus-deaden-summary ()
9550   "Make the current summary buffer into a dead summary buffer."
9551   ;; Kill any previous dead summary buffer.
9552   (when (and gnus-dead-summary
9553              (buffer-name gnus-dead-summary))
9554     (save-excursion
9555       (set-buffer gnus-dead-summary)
9556       (when gnus-dead-summary-mode
9557         (kill-buffer (current-buffer)))))
9558   ;; Make this the current dead summary.
9559   (setq gnus-dead-summary (current-buffer))
9560   (gnus-dead-summary-mode 1)
9561   (let ((name (buffer-name)))
9562     (when (string-match "Summary" name)
9563       (rename-buffer
9564        (concat (substring name 0 (match-beginning 0)) "Dead "
9565                (substring name (match-beginning 0))) t))))
9566
9567 (defun gnus-kill-or-deaden-summary (buffer)
9568   "Kill or deaden the summary BUFFER."
9569   (cond (gnus-kill-summary-on-exit
9570          (when (and gnus-use-trees
9571                     (and (get-buffer buffer)
9572                          (buffer-name (get-buffer buffer))))
9573            (save-excursion
9574              (set-buffer (get-buffer buffer))
9575              (gnus-tree-close gnus-newsgroup-name)))
9576          (gnus-kill-buffer buffer))
9577         ((and (get-buffer buffer)
9578               (buffer-name (get-buffer buffer)))
9579          (save-excursion
9580            (set-buffer buffer)
9581            (gnus-deaden-summary)))))
9582
9583 (defun gnus-summary-wake-up-the-dead (&rest args)
9584   "Wake up the dead summary buffer."
9585   (interactive)
9586   (gnus-dead-summary-mode -1)
9587   (let ((name (buffer-name)))
9588     (when (string-match "Dead " name)
9589       (rename-buffer
9590        (concat (substring name 0 (match-beginning 0))
9591                (substring name (match-end 0))) t)))
9592   (gnus-message 3 "This dead summary is now alive again"))
9593
9594 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
9595 (defun gnus-summary-fetch-faq (&optional faq-dir)
9596   "Fetch the FAQ for the current group.
9597 If FAQ-DIR (the prefix), prompt for a directory to search for the faq
9598 in."
9599   (interactive
9600    (list
9601     (if current-prefix-arg
9602         (completing-read
9603          "Faq dir: " (and (listp gnus-group-faq-directory)
9604                           gnus-group-faq-directory)))))
9605   (let (gnus-faq-buffer)
9606     (and (setq gnus-faq-buffer
9607                (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
9608          (gnus-configure-windows 'summary-faq))))
9609
9610 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
9611 (defun gnus-summary-describe-group (&optional force)
9612   "Describe the current newsgroup."
9613   (interactive "P")
9614   (gnus-group-describe-group force gnus-newsgroup-name))
9615
9616 (defun gnus-summary-describe-briefly ()
9617   "Describe summary mode commands briefly."
9618   (interactive)
9619   (gnus-message 6
9620                 (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")))
9621
9622 ;; Walking around group mode buffer from summary mode.
9623
9624 (defun gnus-summary-next-group (&optional no-article target-group backward)
9625   "Exit current newsgroup and then select next unread newsgroup.
9626 If prefix argument NO-ARTICLE is non-nil, no article is selected
9627 initially.  If NEXT-GROUP, go to this group.  If BACKWARD, go to
9628 previous group instead."
9629   (interactive "P")
9630   (gnus-set-global-variables)
9631   (let ((current-group gnus-newsgroup-name)
9632         (current-buffer (current-buffer))
9633         entered)
9634     ;; First we semi-exit this group to update Xrefs and all variables.
9635     ;; We can't do a real exit, because the window conf must remain
9636     ;; the same in case the user is prompted for info, and we don't
9637     ;; want the window conf to change before that...
9638     (gnus-summary-exit t)
9639     (while (not entered)
9640       ;; Then we find what group we are supposed to enter.
9641       (set-buffer gnus-group-buffer)
9642       (gnus-group-jump-to-group current-group)
9643       (setq target-group
9644             (or target-group
9645                 (if (eq gnus-keep-same-level 'best)
9646                     (gnus-summary-best-group gnus-newsgroup-name)
9647                   (gnus-summary-search-group backward gnus-keep-same-level))))
9648       (if (not target-group)
9649           ;; There are no further groups, so we return to the group
9650           ;; buffer.
9651           (progn
9652             (gnus-message 5 "Returning to the group buffer")
9653             (setq entered t)
9654             (set-buffer current-buffer)
9655             (gnus-summary-exit))
9656         ;; We try to enter the target group.
9657         (gnus-group-jump-to-group target-group)
9658         (let ((unreads (gnus-group-group-unread)))
9659           (if (and (or (eq t unreads)
9660                        (and unreads (not (zerop unreads))))
9661                    (gnus-summary-read-group
9662                     target-group nil no-article current-buffer))
9663               (setq entered t)
9664             (setq current-group target-group
9665                   target-group nil)))))))
9666
9667 (defun gnus-summary-prev-group (&optional no-article)
9668   "Exit current newsgroup and then select previous unread newsgroup.
9669 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
9670   (interactive "P")
9671   (gnus-summary-next-group no-article nil t))
9672
9673 ;; Walking around summary lines.
9674
9675 (defun gnus-summary-first-subject (&optional unread)
9676   "Go to the first unread subject.
9677 If UNREAD is non-nil, go to the first unread article.
9678 Returns the article selected or nil if there are no unread articles."
9679   (interactive "P")
9680   (prog1
9681       (cond
9682        ;; Empty summary.
9683        ((null gnus-newsgroup-data)
9684         (gnus-message 3 "No articles in the group")
9685         nil)
9686        ;; Pick the first article.
9687        ((not unread)
9688         (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
9689         (gnus-data-number (car gnus-newsgroup-data)))
9690        ;; No unread articles.
9691        ((null gnus-newsgroup-unreads)
9692         (gnus-message 3 "No more unread articles")
9693         nil)
9694        ;; Find the first unread article.
9695        (t
9696         (let ((data gnus-newsgroup-data))
9697           (while (and data
9698                       (not (gnus-data-unread-p (car data))))
9699             (setq data (cdr data)))
9700           (if data
9701               (progn
9702                 (goto-char (gnus-data-pos (car data)))
9703                 (gnus-data-number (car data)))))))
9704     (gnus-summary-position-point)))
9705
9706 (defun gnus-summary-next-subject (n &optional unread dont-display)
9707   "Go to next N'th summary line.
9708 If N is negative, go to the previous N'th subject line.
9709 If UNREAD is non-nil, only unread articles are selected.
9710 The difference between N and the actual number of steps taken is
9711 returned."
9712   (interactive "p")
9713   (let ((backward (< n 0))
9714         (n (abs n)))
9715     (while (and (> n 0)
9716                 (if backward
9717                     (gnus-summary-find-prev unread)
9718                   (gnus-summary-find-next unread)))
9719       (setq n (1- n)))
9720     (if (/= 0 n) (gnus-message 7 "No more%s articles"
9721                                (if unread " unread" "")))
9722     (or dont-display
9723         (progn
9724           (gnus-summary-recenter)
9725           (gnus-summary-position-point)))
9726     n))
9727
9728 (defun gnus-summary-next-unread-subject (n)
9729   "Go to next N'th unread summary line."
9730   (interactive "p")
9731   (gnus-summary-next-subject n t))
9732
9733 (defun gnus-summary-prev-subject (n &optional unread)
9734   "Go to previous N'th summary line.
9735 If optional argument UNREAD is non-nil, only unread article is selected."
9736   (interactive "p")
9737   (gnus-summary-next-subject (- n) unread))
9738
9739 (defun gnus-summary-prev-unread-subject (n)
9740   "Go to previous N'th unread summary line."
9741   (interactive "p")
9742   (gnus-summary-next-subject (- n) t))
9743
9744 (defun gnus-summary-goto-subject (article &optional force silent)
9745   "Go the subject line of ARTICLE.
9746 If FORCE, also allow jumping to articles not currently shown."
9747   (let ((b (point))
9748         (data (gnus-data-find article)))
9749     ;; We read in the article if we have to.
9750     (and (not data)
9751          force
9752          (gnus-summary-insert-subject article)
9753          (setq data (gnus-data-find article)))
9754     (goto-char b)
9755     (if (not data)
9756         (progn
9757           (unless silent
9758             (gnus-message 3 "Can't find article %d" article))
9759           nil)
9760       (goto-char (gnus-data-pos data))
9761       article)))
9762
9763 ;; Walking around summary lines with displaying articles.
9764
9765 (defun gnus-summary-expand-window (&optional arg)
9766   "Make the summary buffer take up the entire Emacs frame.
9767 Given a prefix, will force an `article' buffer configuration."
9768   (interactive "P")
9769   (gnus-set-global-variables)
9770   (if arg
9771       (gnus-configure-windows 'article 'force)
9772     (gnus-configure-windows 'summary 'force)))
9773
9774 (defun gnus-summary-display-article (article &optional all-header)
9775   "Display ARTICLE in article buffer."
9776   (gnus-set-global-variables)
9777   (if (null article)
9778       nil
9779     (prog1
9780         (if gnus-summary-display-article-function
9781             (funcall gnus-summary-display-article-function article all-header)
9782           (gnus-article-prepare article all-header))
9783       (run-hooks 'gnus-select-article-hook)
9784       (gnus-summary-recenter)
9785       (gnus-summary-goto-subject article)
9786       (when gnus-use-trees
9787         (gnus-possibly-generate-tree article)
9788         (gnus-highlight-selected-tree article))
9789       ;; Successfully display article.
9790       (gnus-article-set-window-start
9791        (cdr (assq article gnus-newsgroup-bookmarks)))
9792       t)))
9793
9794 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
9795   "Select the current article.
9796 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
9797 non-nil, the article will be re-fetched even if it already present in
9798 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
9799 be displayed."
9800   (let ((article (or article (gnus-summary-article-number)))
9801         (all-headers (not (not all-headers))) ;Must be T or NIL.
9802         gnus-summary-display-article-function
9803         did)
9804     (and (not pseudo)
9805          (gnus-summary-article-pseudo-p article)
9806          (error "This is a pseudo-article."))
9807     (prog1
9808         (save-excursion
9809           (set-buffer gnus-summary-buffer)
9810           (if (or (and gnus-single-article-buffer
9811                        (or (null gnus-current-article)
9812                            (null gnus-article-current)
9813                            (null (get-buffer gnus-article-buffer))
9814                            (not (eq article (cdr gnus-article-current)))
9815                            (not (equal (car gnus-article-current)
9816                                        gnus-newsgroup-name))))
9817                   (and (not gnus-single-article-buffer)
9818                        (null gnus-current-article))
9819                   force)
9820               ;; The requested article is different from the current article.
9821               (prog1
9822                   (gnus-summary-display-article article all-headers)
9823                 (setq did article))
9824             (if (or all-headers gnus-show-all-headers)
9825                 (gnus-article-show-all-headers))
9826             'old))
9827       (if did
9828           (gnus-article-set-window-start
9829            (cdr (assq article gnus-newsgroup-bookmarks)))))))
9830
9831 (defun gnus-summary-set-current-mark (&optional current-mark)
9832   "Obsolete function."
9833   nil)
9834
9835 (defun gnus-summary-next-article (&optional unread subject backward push)
9836   "Select the next article.
9837 If UNREAD, only unread articles are selected.
9838 If SUBJECT, only articles with SUBJECT are selected.
9839 If BACKWARD, the previous article is selected instead of the next."
9840   (interactive "P")
9841   (gnus-set-global-variables)
9842   (let (header)
9843     (cond
9844      ;; Is there such an article?
9845      ((and (gnus-summary-search-forward unread subject backward)
9846            (or (gnus-summary-display-article (gnus-summary-article-number))
9847                (eq (gnus-summary-article-mark) gnus-canceled-mark)))
9848       (gnus-summary-position-point))
9849      ;; If not, we try the first unread, if that is wanted.
9850      ((and subject
9851            gnus-auto-select-same
9852            (or (gnus-summary-first-unread-article)
9853                (eq (gnus-summary-article-mark) gnus-canceled-mark)))
9854       (gnus-summary-position-point)
9855       (gnus-message 6 "Wrapped"))
9856      ;; Try to get next/previous article not displayed in this group.
9857      ((and gnus-auto-extend-newsgroup
9858            (not unread) (not subject))
9859       (gnus-summary-goto-article
9860        (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
9861        nil t))
9862      ;; Go to next/previous group.
9863      (t
9864       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
9865           (gnus-summary-jump-to-group gnus-newsgroup-name))
9866       (let ((cmd last-command-char)
9867             (group
9868              (if (eq gnus-keep-same-level 'best)
9869                  (gnus-summary-best-group gnus-newsgroup-name)
9870                (gnus-summary-search-group backward gnus-keep-same-level))))
9871         ;; For some reason, the group window gets selected.  We change
9872         ;; it back.
9873         (select-window (get-buffer-window (current-buffer)))
9874         ;; Select next unread newsgroup automagically.
9875         (cond
9876          ((not gnus-auto-select-next)
9877           (gnus-message 7 "No more%s articles" (if unread " unread" "")))
9878          ((or (eq gnus-auto-select-next 'quietly)
9879               (and (eq gnus-auto-select-next 'slightly-quietly)
9880                    push)
9881               (and (eq gnus-auto-select-next 'almost-quietly)
9882                    (gnus-summary-last-article-p)))
9883           ;; Select quietly.
9884           (if (gnus-ephemeral-group-p gnus-newsgroup-name)
9885               (gnus-summary-exit)
9886             (gnus-message 7 "No more%s articles (%s)..."
9887                           (if unread " unread" "")
9888                           (if group (concat "selecting " group)
9889                             "exiting"))
9890             (gnus-summary-next-group nil group backward)))
9891          (t
9892           (gnus-summary-walk-group-buffer
9893            gnus-newsgroup-name cmd unread backward))))))))
9894
9895 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
9896   (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
9897                       (?\C-p (gnus-group-prev-unread-group 1))))
9898         keve key group ended)
9899     (save-excursion
9900       (set-buffer gnus-group-buffer)
9901       (gnus-summary-jump-to-group from-group)
9902       (setq group
9903             (if (eq gnus-keep-same-level 'best)
9904                 (gnus-summary-best-group gnus-newsgroup-name)
9905               (gnus-summary-search-group backward gnus-keep-same-level))))
9906     (while (not ended)
9907       (gnus-message
9908        5 "No more%s articles%s" (if unread " unread" "")
9909        (if (and group
9910                 (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
9911            (format " (Type %s for %s [%s])"
9912                    (single-key-description cmd) group
9913                    (car (gnus-gethash group gnus-newsrc-hashtb)))
9914          (format " (Type %s to exit %s)"
9915                  (single-key-description cmd)
9916                  gnus-newsgroup-name)))
9917       ;; Confirm auto selection.
9918       (setq key (car (setq keve (gnus-read-event-char))))
9919       (setq ended t)
9920       (cond
9921        ((assq key keystrokes)
9922         (let ((obuf (current-buffer)))
9923           (switch-to-buffer gnus-group-buffer)
9924           (and group
9925                (gnus-group-jump-to-group group))
9926           (eval (car (cdr (assq key keystrokes))))
9927           (setq group (gnus-group-group-name))
9928           (switch-to-buffer obuf))
9929         (setq ended nil))
9930        ((equal key cmd)
9931         (if (or (not group)
9932                 (gnus-ephemeral-group-p gnus-newsgroup-name))
9933             (gnus-summary-exit)
9934           (gnus-summary-next-group nil group backward)))
9935        (t
9936         (push (cdr keve) unread-command-events))))))
9937
9938 (defun gnus-read-event-char ()
9939   "Get the next event."
9940   (let ((event (read-event)))
9941     (cons (and (numberp event) event) event)))
9942
9943 (defun gnus-summary-next-unread-article ()
9944   "Select unread article after current one."
9945   (interactive)
9946   (gnus-summary-next-article t (and gnus-auto-select-same
9947                                     (gnus-summary-article-subject))))
9948
9949 (defun gnus-summary-prev-article (&optional unread subject)
9950   "Select the article after the current one.
9951 If UNREAD is non-nil, only unread articles are selected."
9952   (interactive "P")
9953   (gnus-summary-next-article unread subject t))
9954
9955 (defun gnus-summary-prev-unread-article ()
9956   "Select unred article before current one."
9957   (interactive)
9958   (gnus-summary-prev-article t (and gnus-auto-select-same
9959                                     (gnus-summary-article-subject))))
9960
9961 (defun gnus-summary-next-page (&optional lines circular)
9962   "Show next page of the selected article.
9963 If at the end of the current article, select the next article.
9964 LINES says how many lines should be scrolled up.
9965
9966 If CIRCULAR is non-nil, go to the start of the article instead of
9967 selecting the next article when reaching the end of the current
9968 article."
9969   (interactive "P")
9970   (setq gnus-summary-buffer (current-buffer))
9971   (gnus-set-global-variables)
9972   (let ((article (gnus-summary-article-number))
9973         (endp nil))
9974     (gnus-configure-windows 'article)
9975     (if (or (null gnus-current-article)
9976             (null gnus-article-current)
9977             (/= article (cdr gnus-article-current))
9978             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
9979         ;; Selected subject is different from current article's.
9980         (gnus-summary-display-article article)
9981       (gnus-eval-in-buffer-window
9982        gnus-article-buffer
9983        (setq endp (gnus-article-next-page lines)))
9984       (if endp
9985           (cond (circular
9986                  (gnus-summary-beginning-of-article))
9987                 (lines
9988                  (gnus-message 3 "End of message"))
9989                 ((null lines)
9990                  (if (eq gnus-summary-goto-unread 'always)
9991                      (gnus-summary-next-article)
9992                    (gnus-summary-next-unread-article))))))
9993     (gnus-summary-recenter)
9994     (gnus-summary-position-point)))
9995
9996 (defun gnus-summary-prev-page (&optional lines)
9997   "Show previous page of selected article.
9998 Argument LINES specifies lines to be scrolled down."
9999   (interactive "P")
10000   (gnus-set-global-variables)
10001   (let ((article (gnus-summary-article-number)))
10002     (gnus-configure-windows 'article)
10003     (if (or (null gnus-current-article)
10004             (null gnus-article-current)
10005             (/= article (cdr gnus-article-current))
10006             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
10007         ;; Selected subject is different from current article's.
10008         (gnus-summary-display-article article)
10009       (gnus-summary-recenter)
10010       (gnus-eval-in-buffer-window gnus-article-buffer
10011                                   (gnus-article-prev-page lines))))
10012   (gnus-summary-position-point))
10013
10014 (defun gnus-summary-scroll-up (lines)
10015   "Scroll up (or down) one line current article.
10016 Argument LINES specifies lines to be scrolled up (or down if negative)."
10017   (interactive "p")
10018   (gnus-set-global-variables)
10019   (gnus-configure-windows 'article)
10020   (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
10021     (gnus-eval-in-buffer-window
10022      gnus-article-buffer
10023      (cond ((> lines 0)
10024             (if (gnus-article-next-page lines)
10025                 (gnus-message 3 "End of message")))
10026            ((< lines 0)
10027             (gnus-article-prev-page (- lines))))))
10028   (gnus-summary-recenter)
10029   (gnus-summary-position-point))
10030
10031 (defun gnus-summary-next-same-subject ()
10032   "Select next article which has the same subject as current one."
10033   (interactive)
10034   (gnus-set-global-variables)
10035   (gnus-summary-next-article nil (gnus-summary-article-subject)))
10036
10037 (defun gnus-summary-prev-same-subject ()
10038   "Select previous article which has the same subject as current one."
10039   (interactive)
10040   (gnus-set-global-variables)
10041   (gnus-summary-prev-article nil (gnus-summary-article-subject)))
10042
10043 (defun gnus-summary-next-unread-same-subject ()
10044   "Select next unread article which has the same subject as current one."
10045   (interactive)
10046   (gnus-set-global-variables)
10047   (gnus-summary-next-article t (gnus-summary-article-subject)))
10048
10049 (defun gnus-summary-prev-unread-same-subject ()
10050   "Select previous unread article which has the same subject as current one."
10051   (interactive)
10052   (gnus-set-global-variables)
10053   (gnus-summary-prev-article t (gnus-summary-article-subject)))
10054
10055 (defun gnus-summary-first-unread-article ()
10056   "Select the first unread article.
10057 Return nil if there are no unread articles."
10058   (interactive)
10059   (gnus-set-global-variables)
10060   (prog1
10061       (if (gnus-summary-first-subject t)
10062           (progn
10063             (gnus-summary-show-thread)
10064             (gnus-summary-first-subject t)
10065             (gnus-summary-display-article (gnus-summary-article-number))))
10066     (gnus-summary-position-point)))
10067
10068 (defun gnus-summary-best-unread-article ()
10069   "Select the unread article with the highest score."
10070   (interactive)
10071   (gnus-set-global-variables)
10072   (let ((best -1000000)
10073         (data gnus-newsgroup-data)
10074         article score)
10075     (while data
10076       (and (gnus-data-unread-p (car data))
10077            (> (setq score
10078                     (gnus-summary-article-score (gnus-data-number (car data))))
10079               best)
10080            (setq best score
10081                  article (gnus-data-number (car data))))
10082       (setq data (cdr data)))
10083     (if article
10084         (gnus-summary-goto-article article)
10085       (error "No unread articles"))
10086     (gnus-summary-position-point)))
10087
10088 (defun gnus-summary-last-subject ()
10089   "Go to the last displayed subject line in the group."
10090   (let ((article (gnus-data-number (car (gnus-data-list t)))))
10091     (when article
10092       (gnus-summary-goto-subject article))))
10093
10094 (defun gnus-summary-goto-article (article &optional all-headers force)
10095   "Fetch ARTICLE and display it if it exists.
10096 If ALL-HEADERS is non-nil, no header lines are hidden."
10097   (interactive
10098    (list
10099     (string-to-int
10100      (completing-read
10101       "Article number: "
10102       (mapcar (lambda (number) (list (int-to-string number)))
10103               gnus-newsgroup-limit)))
10104     current-prefix-arg
10105     t))
10106   (prog1
10107       (if (gnus-summary-goto-subject article force)
10108           (gnus-summary-display-article article all-headers)
10109         (gnus-message 4 "Couldn't go to article %s" article) nil)
10110     (gnus-summary-position-point)))
10111
10112 (defun gnus-summary-goto-last-article ()
10113   "Go to the previously read article."
10114   (interactive)
10115   (prog1
10116       (and gnus-last-article
10117            (gnus-summary-goto-article gnus-last-article))
10118     (gnus-summary-position-point)))
10119
10120 (defun gnus-summary-pop-article (number)
10121   "Pop one article off the history and go to the previous.
10122 NUMBER articles will be popped off."
10123   (interactive "p")
10124   (let (to)
10125     (setq gnus-newsgroup-history
10126           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
10127     (if to
10128         (gnus-summary-goto-article (car to))
10129       (error "Article history empty")))
10130   (gnus-summary-position-point))
10131
10132 ;; Summary commands and functions for limiting the summary buffer.
10133
10134 (defun gnus-summary-limit-to-articles (n)
10135   "Limit the summary buffer to the next N articles.
10136 If not given a prefix, use the process marked articles instead."
10137   (interactive "P")
10138   (gnus-set-global-variables)
10139   (prog1
10140       (let ((articles (gnus-summary-work-articles n)))
10141         (setq gnus-newsgroup-processable nil)
10142         (gnus-summary-limit articles))
10143     (gnus-summary-position-point)))
10144
10145 (defun gnus-summary-pop-limit (&optional total)
10146   "Restore the previous limit.
10147 If given a prefix, remove all limits."
10148   (interactive "P")
10149   (gnus-set-global-variables)
10150   (when total 
10151     (setq gnus-newsgroup-limits
10152           (list (mapcar (lambda (h) (mail-header-number h))
10153                         gnus-newsgroup-headers))))
10154   (unless gnus-newsgroup-limits
10155     (error "No limit to pop"))
10156   (prog1
10157       (gnus-summary-limit nil 'pop)
10158     (gnus-summary-position-point)))
10159
10160 (defun gnus-summary-limit-to-subject (subject &optional header)
10161   "Limit the summary buffer to articles that have subjects that match a regexp."
10162   (interactive "sRegexp: ")
10163   (unless header
10164     (setq header "subject"))
10165   (when (not (equal "" subject))
10166     (prog1
10167         (let ((articles (gnus-summary-find-matching "subject" subject 'all)))
10168           (or articles (error "Found no matches for \"%s\"" subject))
10169           (gnus-summary-limit articles))
10170       (gnus-summary-position-point))))
10171
10172 (defun gnus-summary-limit-to-author (from)
10173   "Limit the summary buffer to articles that have authors that match a regexp."
10174   (interactive "sRegexp: ")
10175   (gnus-summary-limit-to-subject from "from"))
10176
10177 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10178 (make-obsolete
10179  'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10180
10181 (defun gnus-summary-limit-to-unread (&optional all)
10182   "Limit the summary buffer to articles that are not marked as read.
10183 If ALL is non-nil, limit strictly to unread articles."
10184   (interactive "P")
10185   (if all
10186       (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
10187     (gnus-summary-limit-to-marks
10188      ;; Concat all the marks that say that an article is read and have
10189      ;; those removed.
10190      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
10191            gnus-killed-mark gnus-kill-file-mark
10192            gnus-low-score-mark gnus-expirable-mark
10193            gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark)
10194      'reverse)))
10195
10196 (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10197 (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10198
10199 (defun gnus-summary-limit-to-marks (marks &optional reverse)
10200   "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
10201 If REVERSE, limit the summary buffer to articles that are not marked
10202 with MARKS.  MARKS can either be a string of marks or a list of marks.
10203 Returns how many articles were removed."
10204   (interactive "sMarks: ")
10205   (gnus-set-global-variables)
10206   (prog1
10207       (let ((data gnus-newsgroup-data)
10208             (marks (if (listp marks) marks
10209                      (append marks nil))) ; Transform to list.
10210             articles)
10211         (while data
10212           (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
10213                  (memq (gnus-data-mark (car data)) marks))
10214                (setq articles (cons (gnus-data-number (car data)) articles)))
10215           (setq data (cdr data)))
10216         (gnus-summary-limit articles))
10217     (gnus-summary-position-point)))
10218
10219 (defun gnus-summary-limit-to-score (&optional score)
10220   "Limit to articles with score at or above SCORE."
10221   (interactive "P")
10222   (gnus-set-global-variables)
10223   (setq score (if score
10224                   (prefix-numeric-value score)
10225                 (or gnus-summary-default-score 0)))
10226   (let ((data gnus-newsgroup-data)
10227         articles)
10228     (while data
10229       (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
10230                 score)
10231         (push (gnus-data-number (car data)) articles))
10232       (setq data (cdr data)))
10233     (prog1
10234         (gnus-summary-limit articles)
10235       (gnus-summary-position-point))))
10236
10237 (defun gnus-summary-limit-include-dormant ()
10238   "Display all the hidden articles that are marked as dormant."
10239   (interactive)
10240   (gnus-set-global-variables)
10241   (or gnus-newsgroup-dormant
10242       (error "There are no dormant articles in this group"))
10243   (prog1
10244       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
10245     (gnus-summary-position-point)))
10246
10247 (defun gnus-summary-limit-exclude-dormant ()
10248   "Hide all dormant articles."
10249   (interactive)
10250   (gnus-set-global-variables)
10251   (prog1
10252       (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
10253     (gnus-summary-position-point)))
10254
10255 (defun gnus-summary-limit-exclude-childless-dormant ()
10256   "Hide all dormant articles that have no children."
10257   (interactive)
10258   (gnus-set-global-variables)
10259   (let ((data gnus-newsgroup-data)
10260         articles)
10261     ;; Find all articles that are either not dormant or have
10262     ;; children.
10263     (while data
10264       (and (or (not (= (gnus-data-mark (car data)) gnus-dormant-mark))
10265                (gnus-article-parent-p (gnus-data-number (car data))))
10266            (setq articles (cons (gnus-data-number (car data))
10267                                 articles)))
10268       (setq data (cdr data)))
10269     ;; Do the limiting.
10270     (prog1
10271         (gnus-summary-limit articles)
10272       (gnus-summary-position-point))))
10273
10274 (defun gnus-summary-limit-mark-excluded-as-read (&optional all)
10275   "Mark all unread excluded articles as read.
10276 If ALL, mark even excluded ticked and dormants as read."
10277   (interactive "P")
10278   (let ((articles (gnus-sorted-complement
10279                    (sort
10280                     (mapcar (lambda (h) (mail-header-number h))
10281                             gnus-newsgroup-headers)
10282                     '<)
10283                    (sort gnus-newsgroup-limit '<)))
10284         article)
10285     (setq gnus-newsgroup-unreads nil)
10286     (if all
10287         (setq gnus-newsgroup-dormant nil
10288               gnus-newsgroup-marked nil
10289               gnus-newsgroup-reads
10290               (nconc
10291                (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
10292                gnus-newsgroup-reads))
10293       (while (setq article (pop articles))
10294         (unless (or (memq article gnus-newsgroup-dormant)
10295                     (memq article gnus-newsgroup-marked))
10296           (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
10297
10298
10299 (defun gnus-summary-limit (articles &optional pop)
10300   (if pop
10301       ;; We pop the previous limit off the stack and use that.
10302       (setq articles (car gnus-newsgroup-limits)
10303             gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
10304     ;; We use the new limit, so we push the old limit on the stack.
10305     (setq gnus-newsgroup-limits
10306           (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
10307   ;; Set the limit.
10308   (setq gnus-newsgroup-limit articles)
10309   (let ((total (length gnus-newsgroup-data))
10310         (data (gnus-data-find-list (gnus-summary-article-number)))
10311         found)
10312     ;; This will do all the work of generating the new summary buffer
10313     ;; according to the new limit.
10314     (gnus-summary-prepare)
10315     ;; Hide any threads, possibly.
10316     (and gnus-show-threads
10317          gnus-thread-hide-subtree
10318          (gnus-summary-hide-all-threads))
10319     ;; Try to return to the article you were at, or one in the
10320     ;; neighborhood.
10321     (if data
10322         ;; We try to find some article after the current one.
10323         (while data
10324           (and (gnus-summary-goto-subject
10325                 (gnus-data-number (car data)) nil t)
10326                (setq data nil
10327                      found t))
10328           (setq data (cdr data))))
10329     (or found
10330         ;; If there is no data, that means that we were after the last
10331         ;; article.  The same goes when we can't find any articles
10332         ;; after the current one.
10333         (progn
10334           (goto-char (point-max))
10335           (gnus-summary-find-prev)))
10336     ;; We return how many articles were removed from the summary
10337     ;; buffer as a result of the new limit.
10338     (- total (length gnus-newsgroup-data))))
10339
10340 (defsubst gnus-cut-thread (thread)
10341   "Go forwards in the thread until we find an article that we want to display."
10342   (if (eq gnus-fetch-old-headers 'some)
10343       (while (and thread
10344                   (memq (mail-header-number (car thread)) 
10345                         gnus-newsgroup-ancient)
10346                   (<= (length (cdr thread)) 1))
10347         (setq thread (cadr thread)))
10348     (while (and thread
10349                 (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
10350                 (= (length (cdr thread)) 1))
10351       (setq thread (cadr thread))))
10352   thread)
10353
10354 (defun gnus-cut-threads (threads)
10355   "Cut off all uninteresting articles from the beginning of threads."
10356   (when (or (eq gnus-fetch-old-headers 'some)
10357             (eq gnus-build-sparse-threads 'some)
10358             (eq gnus-build-sparse-threads 'more))
10359     (let ((th threads))
10360       (while th
10361         (setcar th (gnus-cut-thread (car th)))
10362         (setq th (cdr th)))))
10363   threads)
10364
10365 (defun gnus-summary-initial-limit (&optional show-if-empty)
10366   "Figure out what the initial limit is supposed to be on group entry.
10367 This entails weeding out unwanted dormants, low-scored articles,
10368 fetch-old-headers verbiage, and so on."
10369   ;; Most groups have nothing to remove.
10370   (if (or gnus-inhibit-limiting
10371           (and (null gnus-newsgroup-dormant)
10372                (not (eq gnus-fetch-old-headers 'some))
10373                (null gnus-summary-expunge-below)
10374                (not (eq gnus-build-sparse-threads 'some))
10375                (not (eq gnus-build-sparse-threads 'more))
10376                (null gnus-thread-expunge-below)))
10377       () ; Do nothing.
10378     (push gnus-newsgroup-limit gnus-newsgroup-limits)
10379     (setq gnus-newsgroup-limit nil)
10380     (mapatoms
10381      (lambda (node)
10382        (unless (car (symbol-value node))
10383          ;; These threads have no parents -- they are roots.
10384          (let ((nodes (cdr (symbol-value node)))
10385                thread)
10386            (while nodes
10387              (if (and gnus-thread-expunge-below
10388                       (< (gnus-thread-total-score (car nodes))
10389                          gnus-thread-expunge-below))
10390                  (gnus-expunge-thread (pop nodes))
10391                (setq thread (pop nodes))
10392                (gnus-summary-limit-children thread))))))
10393      gnus-newsgroup-dependencies)
10394     ;; If this limitation resulted in an empty group, we might
10395     ;; pop the previous limit and use it instead.
10396     (when (and (not gnus-newsgroup-limit)
10397                show-if-empty)
10398       (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
10399     gnus-newsgroup-limit))
10400
10401 (defun gnus-summary-limit-children (thread)
10402   "Return 1 if this subthread is visible and 0 if it is not."
10403   ;; First we get the number of visible children to this thread.  This
10404   ;; is done by recursing down the thread using this function, so this
10405   ;; will really go down to a leaf article first, before slowly
10406   ;; working its way up towards the root.
10407   (when thread
10408     (let ((children
10409            (if (cdr thread)
10410                (apply '+ (mapcar 'gnus-summary-limit-children
10411                                  (cdr thread)))
10412              0))
10413           (number (mail-header-number (car thread)))
10414           score)
10415       (if (or
10416            ;; If this article is dormant and has absolutely no visible
10417            ;; children, then this article isn't visible.
10418            (and (memq number gnus-newsgroup-dormant)
10419                 (= children 0))
10420            ;; If this is a "fetch-old-headered" and there is only one
10421            ;; visible child (or less), then we don't want this article.
10422            (and (eq gnus-fetch-old-headers 'some)
10423                 (memq number gnus-newsgroup-ancient)
10424                 (zerop children))
10425            ;; If this is a sparsely inserted article with no children,
10426            ;; we don't want it.
10427            (and (eq gnus-build-sparse-threads 'some)
10428                 (memq number gnus-newsgroup-sparse)
10429                 (zerop children))
10430            ;; If we use expunging, and this article is really
10431            ;; low-scored, then we don't want this article.
10432            (when (and gnus-summary-expunge-below
10433                       (< (setq score
10434                                (or (cdr (assq number gnus-newsgroup-scored))
10435                                    gnus-summary-default-score))
10436                          gnus-summary-expunge-below))
10437              ;; We increase the expunge-tally here, but that has
10438              ;; nothing to do with the limits, really.
10439              (incf gnus-newsgroup-expunged-tally)
10440              ;; We also mark as read here, if that's wanted.
10441              (when (and gnus-summary-mark-below
10442                         (< score gnus-summary-mark-below))
10443                (setq gnus-newsgroup-unreads
10444                      (delq number gnus-newsgroup-unreads))
10445                (if gnus-newsgroup-auto-expire
10446                    (push number gnus-newsgroup-expirable)
10447                  (push (cons number gnus-low-score-mark)
10448                        gnus-newsgroup-reads)))
10449              t))
10450           ;; Nope, invisible article.
10451           0
10452         ;; Ok, this article is to be visible, so we add it to the limit
10453         ;; and return 1.
10454         (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
10455         1))))
10456
10457 (defun gnus-expunge-thread (thread)
10458   "Mark all articles in THREAD as read."
10459   (let* ((number (mail-header-number (car thread))))
10460     (incf gnus-newsgroup-expunged-tally)
10461     ;; We also mark as read here, if that's wanted.
10462     (setq gnus-newsgroup-unreads
10463           (delq number gnus-newsgroup-unreads))
10464     (if gnus-newsgroup-auto-expire
10465         (push number gnus-newsgroup-expirable)
10466       (push (cons number gnus-low-score-mark)
10467             gnus-newsgroup-reads)))
10468   ;; Go recursively through all subthreads.
10469   (mapcar 'gnus-expunge-thread (cdr thread)))
10470
10471 ;; Summary article oriented commands
10472
10473 (defun gnus-summary-refer-parent-article (n)
10474   "Refer parent article N times.
10475 The difference between N and the number of articles fetched is returned."
10476   (interactive "p")
10477   (gnus-set-global-variables)
10478   (while
10479       (and
10480        (> n 0)
10481        (let* ((header (gnus-summary-article-header))
10482               (ref
10483                ;; If we try to find the parent of the currently
10484                ;; displayed article, then we take a look at the actual
10485                ;; References header, since this is slightly more
10486                ;; reliable than the References field we got from the
10487                ;; server.
10488                (if (and (eq (mail-header-number header)
10489                             (cdr gnus-article-current))
10490                         (equal gnus-newsgroup-name
10491                                (car gnus-article-current)))
10492                    (save-excursion
10493                      (set-buffer gnus-original-article-buffer)
10494                      (nnheader-narrow-to-headers)
10495                      (prog1
10496                          (mail-fetch-field "references")
10497                        (widen)))
10498                  ;; It's not the current article, so we take a bet on
10499                  ;; the value we got from the server.
10500                  (mail-header-references header))))
10501          (if ref
10502              (or (gnus-summary-refer-article (gnus-parent-id ref))
10503                  (gnus-message 1 "Couldn't find parent"))
10504            (gnus-message 1 "No references in article %d"
10505                          (gnus-summary-article-number))
10506            nil)))
10507     (setq n (1- n)))
10508   (gnus-summary-position-point)
10509   n)
10510
10511 (defun gnus-summary-refer-references ()
10512   "Fetch all articles mentioned in the References header.
10513 Return how many articles were fetched."
10514   (interactive)
10515   (gnus-set-global-variables)
10516   (let ((ref (mail-header-references (gnus-summary-article-header)))
10517         (current (gnus-summary-article-number))
10518         (n 0))
10519     ;; For each Message-ID in the References header...
10520     (while (string-match "<[^>]*>" ref)
10521       (incf n)
10522       ;; ... fetch that article.
10523       (gnus-summary-refer-article
10524        (prog1 (match-string 0 ref)
10525          (setq ref (substring ref (match-end 0))))))
10526     (gnus-summary-goto-subject current)
10527     (gnus-summary-position-point)
10528     n))
10529
10530 (defun gnus-summary-refer-article (message-id)
10531   "Fetch an article specified by MESSAGE-ID."
10532   (interactive "sMessage-ID: ")
10533   (when (and (stringp message-id)
10534              (not (zerop (length message-id))))
10535     ;; Construct the correct Message-ID if necessary.
10536     ;; Suggested by tale@pawl.rpi.edu.
10537     (unless (string-match "^<" message-id)
10538       (setq message-id (concat "<" message-id)))
10539     (unless (string-match ">$" message-id)
10540       (setq message-id (concat message-id ">")))
10541     (let ((header (car (gnus-gethash (downcase message-id)
10542                                      gnus-newsgroup-dependencies))))
10543       (if header
10544           ;; The article is present in the buffer, to we just go to it.
10545           (gnus-summary-goto-article (mail-header-number header) nil t)
10546         ;; We fetch the article
10547         (let ((gnus-override-method gnus-refer-article-method)
10548               number)
10549           ;; Start the special refer-article method, if necessary.
10550           (when gnus-refer-article-method
10551             (gnus-check-server gnus-refer-article-method))
10552           ;; Fetch the header, and display the article.
10553           (if (setq number (gnus-summary-insert-subject message-id))
10554               (gnus-summary-select-article nil nil nil number)
10555             (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
10556
10557 (defun gnus-summary-enter-digest-group (&optional force)
10558   "Enter a digest group based on the current article."
10559   (interactive "P")
10560   (gnus-set-global-variables)
10561   (gnus-summary-select-article)
10562   (let ((name (format "%s-%d"
10563                       (gnus-group-prefixed-name
10564                        gnus-newsgroup-name (list 'nndoc ""))
10565                       gnus-current-article))
10566         (ogroup gnus-newsgroup-name)
10567         (case-fold-search t)
10568         (buf (current-buffer))
10569         dig)
10570     (save-excursion
10571       (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
10572       (insert-buffer-substring gnus-original-article-buffer)
10573       (narrow-to-region
10574        (goto-char (point-min))
10575        (or (search-forward "\n\n" nil t) (point)))
10576       (goto-char (point-min))
10577       (delete-matching-lines "^\\(Path\\):")
10578       (widen))
10579     (unwind-protect
10580         (if (gnus-group-read-ephemeral-group
10581              name `(nndoc ,name (nndoc-address
10582                                  ,(get-buffer dig))
10583                           (nndoc-article-type ,(if force 'digest 'guess))) t)
10584             ;; Make all postings to this group go to the parent group.
10585             (setcdr (nthcdr 4 (gnus-get-info name))
10586                     (list (list (cons 'to-group ogroup))))
10587           ;; Couldn't select this doc group.
10588           (switch-to-buffer buf)
10589           (gnus-set-global-variables)
10590           (gnus-configure-windows 'summary)
10591           (gnus-message 3 "Article couldn't be entered?"))
10592       (kill-buffer dig))))
10593
10594 (defun gnus-summary-isearch-article (&optional regexp-p)
10595   "Do incremental search forward on the current article.
10596 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
10597   (interactive "P")
10598   (gnus-set-global-variables)
10599   (gnus-summary-select-article)
10600   (gnus-configure-windows 'article)
10601   (gnus-eval-in-buffer-window
10602    gnus-article-buffer
10603    (goto-char (point-min))
10604    (isearch-forward regexp-p)))
10605
10606 (defun gnus-summary-search-article-forward (regexp &optional backward)
10607   "Search for an article containing REGEXP forward.
10608 If BACKWARD, search backward instead."
10609   (interactive
10610    (list (read-string
10611           (format "Search article %s (regexp%s): "
10612                   (if current-prefix-arg "backward" "forward")
10613                   (if gnus-last-search-regexp
10614                       (concat ", default " gnus-last-search-regexp)
10615                     "")))
10616          current-prefix-arg))
10617   (gnus-set-global-variables)
10618   (if (string-equal regexp "")
10619       (setq regexp (or gnus-last-search-regexp ""))
10620     (setq gnus-last-search-regexp regexp))
10621   (if (gnus-summary-search-article regexp backward)
10622       (gnus-article-set-window-start
10623        (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks)))
10624     (error "Search failed: \"%s\"" regexp)))
10625
10626 (defun gnus-summary-search-article-backward (regexp)
10627   "Search for an article containing REGEXP backward."
10628   (interactive
10629    (list (read-string
10630           (format "Search article backward (regexp%s): "
10631                   (if gnus-last-search-regexp
10632                       (concat ", default " gnus-last-search-regexp)
10633                     "")))))
10634   (gnus-summary-search-article-forward regexp 'backward))
10635
10636 (defun gnus-summary-search-article (regexp &optional backward)
10637   "Search for an article containing REGEXP.
10638 Optional argument BACKWARD means do search for backward.
10639 gnus-select-article-hook is not called during the search."
10640   (let ((gnus-select-article-hook nil)  ;Disable hook.
10641         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
10642         (re-search
10643          (if backward
10644              (function re-search-backward) (function re-search-forward)))
10645         (found nil)
10646         (last nil))
10647     ;; Hidden thread subtrees must be searched for ,too.
10648     (gnus-summary-show-all-threads)
10649     ;; First of all, search current article.
10650     ;; We don't want to read article again from NNTP server nor reset
10651     ;; current point.
10652     (gnus-summary-select-article)
10653     (gnus-message 9 "Searching article: %d..." gnus-current-article)
10654     (setq last gnus-current-article)
10655     (gnus-eval-in-buffer-window
10656      gnus-article-buffer
10657      (save-restriction
10658        (widen)
10659        ;; Begin search from current point.
10660        (setq found (funcall re-search regexp nil t))))
10661     ;; Then search next articles.
10662     (while (and (not found)
10663                 (gnus-summary-display-article
10664                  (if backward (gnus-summary-find-prev)
10665                    (gnus-summary-find-next))))
10666       (gnus-message 9 "Searching article: %d..." gnus-current-article)
10667       (gnus-eval-in-buffer-window
10668        gnus-article-buffer
10669        (save-restriction
10670          (widen)
10671          (goto-char (if backward (point-max) (point-min)))
10672          (setq found (funcall re-search regexp nil t)))))
10673     (message "")
10674     ;; Adjust article pointer.
10675     (or (eq last gnus-current-article)
10676         (setq gnus-last-article last))
10677     ;; Return T if found such article.
10678     found))
10679
10680 (defun gnus-summary-find-matching (header regexp &optional backward unread
10681                                           not-case-fold)
10682   "Return a list of all articles that match REGEXP on HEADER.
10683 The search stars on the current article and goes forwards unless
10684 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
10685 If UNREAD is non-nil, only unread articles will
10686 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
10687 in the comparisons."
10688   (let ((data (if (eq backward 'all) gnus-newsgroup-data
10689                 (gnus-data-find-list
10690                  (gnus-summary-article-number) (gnus-data-list backward))))
10691         (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
10692         (case-fold-search (not not-case-fold))
10693         articles d)
10694     (or (fboundp (intern (concat "mail-header-" header)))
10695         (error "%s is not a valid header" header))
10696     (while data
10697       (setq d (car data))
10698       (and (or (not unread)             ; We want all articles...
10699                (gnus-data-unread-p d))  ; Or just unreads.
10700            (vectorp (gnus-data-header d)) ; It's not a pseudo.
10701            (string-match regexp (funcall func (gnus-data-header d))) ; Match.
10702            (setq articles (cons (gnus-data-number d) articles))) ; Success!
10703       (setq data (cdr data)))
10704     (nreverse articles)))
10705
10706 (defun gnus-summary-execute-command (header regexp command &optional backward)
10707   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
10708 If HEADER is an empty string (or nil), the match is done on the entire
10709 article.  If BACKWARD (the prefix) is non-nil, search backward instead."
10710   (interactive
10711    (list (let ((completion-ignore-case t))
10712            (completing-read
10713             "Header name: "
10714             (mapcar (lambda (string) (list string))
10715                     '("Number" "Subject" "From" "Lines" "Date"
10716                       "Message-ID" "Xref" "References"))
10717             nil 'require-match))
10718          (read-string "Regexp: ")
10719          (read-key-sequence "Command: ")
10720          current-prefix-arg))
10721   (gnus-set-global-variables)
10722   ;; Hidden thread subtrees must be searched as well.
10723   (gnus-summary-show-all-threads)
10724   ;; We don't want to change current point nor window configuration.
10725   (save-excursion
10726     (save-window-excursion
10727       (gnus-message 6 "Executing %s..." (key-description command))
10728       ;; We'd like to execute COMMAND interactively so as to give arguments.
10729       (gnus-execute header regexp
10730                     `(lambda () (call-interactively ',(key-binding command)))
10731                     backward)
10732       (gnus-message 6 "Executing %s...done" (key-description command)))))
10733
10734 (defun gnus-summary-beginning-of-article ()
10735   "Scroll the article back to the beginning."
10736   (interactive)
10737   (gnus-set-global-variables)
10738   (gnus-summary-select-article)
10739   (gnus-configure-windows 'article)
10740   (gnus-eval-in-buffer-window
10741    gnus-article-buffer
10742    (widen)
10743    (goto-char (point-min))
10744    (and gnus-break-pages (gnus-narrow-to-page))))
10745
10746 (defun gnus-summary-end-of-article ()
10747   "Scroll to the end of the article."
10748   (interactive)
10749   (gnus-set-global-variables)
10750   (gnus-summary-select-article)
10751   (gnus-configure-windows 'article)
10752   (gnus-eval-in-buffer-window
10753    gnus-article-buffer
10754    (widen)
10755    (goto-char (point-max))
10756    (recenter -3)
10757    (and gnus-break-pages (gnus-narrow-to-page))))
10758
10759 (defun gnus-summary-show-article (&optional arg)
10760   "Force re-fetching of the current article.
10761 If ARG (the prefix) is non-nil, show the raw article without any
10762 article massaging functions being run."
10763   (interactive "P")
10764   (gnus-set-global-variables)
10765   (if (not arg)
10766       ;; Select the article the normal way.
10767       (gnus-summary-select-article nil 'force)
10768     ;; Bind the article treatment functions to nil.
10769     (let ((gnus-have-all-headers t)
10770           gnus-article-display-hook
10771           gnus-article-prepare-hook
10772           gnus-visual)
10773       (gnus-summary-select-article nil 'force)))
10774 ;  (gnus-configure-windows 'article)
10775   (gnus-summary-position-point))
10776
10777 (defun gnus-summary-verbose-headers (&optional arg)
10778   "Toggle permanent full header display.
10779 If ARG is a positive number, turn header display on.
10780 If ARG is a negative number, turn header display off."
10781   (interactive "P")
10782   (gnus-set-global-variables)
10783   (gnus-summary-toggle-header arg)
10784   (setq gnus-show-all-headers
10785         (cond ((or (not (numberp arg))
10786                    (zerop arg))
10787                (not gnus-show-all-headers))
10788               ((natnump arg)
10789                t))))
10790
10791 (defun gnus-summary-toggle-header (&optional arg)
10792   "Show the headers if they are hidden, or hide them if they are shown.
10793 If ARG is a positive number, show the entire header.
10794 If ARG is a negative number, hide the unwanted header lines."
10795   (interactive "P")
10796   (gnus-set-global-variables)
10797   (save-excursion
10798     (set-buffer gnus-article-buffer)
10799     (let* ((buffer-read-only nil)
10800            (inhibit-point-motion-hooks t)
10801            (hidden (text-property-any
10802                     (goto-char (point-min)) (search-forward "\n\n")
10803                     'invisible t))
10804            e)
10805       (goto-char (point-min))
10806       (when (search-forward "\n\n" nil t)
10807         (delete-region (point-min) (1- (point))))
10808       (goto-char (point-min))
10809       (save-excursion
10810         (set-buffer gnus-original-article-buffer)
10811         (goto-char (point-min))
10812         (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
10813       (insert-buffer-substring gnus-original-article-buffer 1 e)
10814       (let ((gnus-inhibit-hiding t))
10815         (run-hooks 'gnus-article-display-hook))
10816       (if (or (not hidden) (and (numberp arg) (< arg 0)))
10817           (gnus-article-hide-headers)))))
10818
10819 (defun gnus-summary-show-all-headers ()
10820   "Make all header lines visible."
10821   (interactive)
10822   (gnus-set-global-variables)
10823   (gnus-article-show-all-headers))
10824
10825 (defun gnus-summary-toggle-mime (&optional arg)
10826   "Toggle MIME processing.
10827 If ARG is a positive number, turn MIME processing on."
10828   (interactive "P")
10829   (gnus-set-global-variables)
10830   (setq gnus-show-mime
10831         (if (null arg) (not gnus-show-mime)
10832           (> (prefix-numeric-value arg) 0)))
10833   (gnus-summary-select-article t 'force))
10834
10835 (defun gnus-summary-caesar-message (&optional arg)
10836   "Caesar rotate the current article by 13.
10837 The numerical prefix specifies how manu places to rotate each letter
10838 forward."
10839   (interactive "P")
10840   (gnus-set-global-variables)
10841   (gnus-summary-select-article)
10842   (let ((mail-header-separator ""))
10843     (gnus-eval-in-buffer-window
10844      gnus-article-buffer
10845      (save-restriction
10846        (widen)
10847        (let ((start (window-start)))
10848          (news-caesar-buffer-body arg)
10849          (set-window-start (get-buffer-window (current-buffer)) start))))))
10850
10851 (defun gnus-summary-stop-page-breaking ()
10852   "Stop page breaking in the current article."
10853   (interactive)
10854   (gnus-set-global-variables)
10855   (gnus-summary-select-article)
10856   (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
10857
10858 (defun gnus-summary-move-article (&optional n to-newsgroup select-method action)
10859   "Move the current article to a different newsgroup.
10860 If N is a positive number, move the N next articles.
10861 If N is a negative number, move the N previous articles.
10862 If N is nil and any articles have been marked with the process mark,
10863 move those articles instead.
10864 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
10865 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
10866 re-spool using this method.
10867
10868 For this function to work, both the current newsgroup and the
10869 newsgroup that you want to move to have to support the `request-move'
10870 and `request-accept' functions."
10871   (interactive "P")
10872   (unless action (setq action 'move))
10873   (gnus-set-global-variables)
10874   ;; Check whether the source group supports the required functions.
10875   (cond ((and (eq action 'move)
10876               (not (gnus-check-backend-function
10877                     'request-move-article gnus-newsgroup-name)))
10878          (error "The current group does not support article moving"))
10879         ((and (eq action 'crosspost)
10880               (not (gnus-check-backend-function
10881                     'request-replace-article gnus-newsgroup-name)))
10882          (error "The current group does not support article editing")))
10883   (let ((articles (gnus-summary-work-articles n))
10884         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
10885         (names '((move "move" "Moving")
10886                  (copy "copy" "Copying")
10887                  (crosspost "crosspost" "Crossposting")))
10888         (copy-buf (save-excursion
10889                     (nnheader-set-temp-buffer " *copy article*")))
10890         art-group to-method new-xref article)
10891     (unless (assq action names)
10892       (error "Unknown action %s" action))
10893     ;; Read the newsgroup name.
10894     (when (and (not to-newsgroup)
10895                (not select-method))
10896       (setq to-newsgroup
10897             (gnus-read-move-group-name
10898              (cadr (assq action names))
10899              gnus-current-move-group articles prefix))
10900       (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
10901     (setq to-method (if select-method (list select-method "")
10902                       (gnus-find-method-for-group to-newsgroup)))
10903     ;;(when (equal to-newsgroup gnus-newsgroup-name)
10904     ;;(error "Can't %s to the same group you're already in" action))
10905     ;; Check the method we are to move this article to...
10906     (or (gnus-check-backend-function 'request-accept-article (car to-method))
10907         (error "%s does not support article copying" (car to-method)))
10908     (or (gnus-check-server to-method)
10909         (error "Can't open server %s" (car to-method)))
10910     (gnus-message 6 "%s to %s: %s..."
10911                   (caddr (assq action names))
10912                   (or select-method to-newsgroup) articles)
10913     (while articles
10914       (setq article (pop articles))
10915       (setq
10916        art-group
10917        (cond
10918         ;; Move the article.
10919         ((eq action 'move)
10920          (gnus-request-move-article
10921           article                       ; Article to move
10922           gnus-newsgroup-name           ; From newsgrouo
10923           (nth 1 (gnus-find-method-for-group
10924                   gnus-newsgroup-name)) ; Server
10925           (list 'gnus-request-accept-article
10926                 (if select-method
10927                     (list 'quote select-method)
10928                   to-newsgroup)
10929                 (not articles))         ; Accept form
10930           (not articles)))              ; Only save nov last time
10931         ;; Copy the article.
10932         ((eq action 'copy)
10933          (save-excursion
10934            (set-buffer copy-buf)
10935            (gnus-request-article-this-buffer article gnus-newsgroup-name)
10936            (gnus-request-accept-article
10937             (if select-method select-method to-newsgroup)
10938             (not articles))))
10939         ;; Crosspost the article.
10940         ((eq action 'crosspost)
10941          (let ((xref (mail-header-xref (gnus-summary-article-header article))))
10942            (setq new-xref (concat gnus-newsgroup-name ":" article))
10943            (if (and xref (not (string= xref "")))
10944                (progn
10945                  (when (string-match "^Xref: " xref)
10946                    (setq xref (substring xref (match-end 0))))
10947                  (setq new-xref (concat xref " " new-xref)))
10948              (setq new-xref (concat (system-name) " " new-xref)))
10949            (save-excursion
10950              (set-buffer copy-buf)
10951              (gnus-request-article-this-buffer article gnus-newsgroup-name)
10952              (nnheader-replace-header "xref" new-xref)
10953              (gnus-request-accept-article
10954               (if select-method select-method to-newsgroup)
10955               (not articles)))))))
10956       (if (not art-group)
10957           (gnus-message 1 "Couldn't %s article %s"
10958                         (cadr (assq action names)) article)
10959         (let* ((entry
10960                 (or
10961                  (gnus-gethash (car art-group) gnus-newsrc-hashtb)
10962                  (gnus-gethash
10963                   (gnus-group-prefixed-name
10964                    (car art-group)
10965                    (if select-method (list select-method "")
10966                      (gnus-find-method-for-group to-newsgroup)))
10967                   gnus-newsrc-hashtb)))
10968                (info (nth 2 entry)))
10969           ;; Update the group that has been moved to.
10970           (when (and info
10971                      (memq action '(move copy)))
10972             (unless (memq article gnus-newsgroup-unreads)
10973               (gnus-info-set-read
10974                info (gnus-add-to-range (gnus-info-read info)
10975                                        (list (cdr art-group)))))
10976
10977             ;; Copy any marks over to the new group.
10978             (let ((marks gnus-article-mark-lists)
10979                   (to-article (cdr art-group)))
10980
10981               ;; See whether the article is to be put in the cache.
10982               (when gnus-use-cache
10983                 (gnus-cache-possibly-enter-article
10984                  (gnus-info-group info) to-article
10985                  (let ((header (copy-sequence
10986                                 (gnus-summary-article-header article))))
10987                    (mail-header-set-number header to-article)
10988                    header)
10989                  (memq article gnus-newsgroup-marked)
10990                  (memq article gnus-newsgroup-dormant)
10991                  (memq article gnus-newsgroup-unreads)))
10992
10993               (while marks
10994                 (when (memq article (symbol-value
10995                                      (intern (format "gnus-newsgroup-%s"
10996                                                      (caar marks)))))
10997                   (gnus-add-marked-articles
10998                    (gnus-info-group info) (cdar marks)
10999                    (list to-article) info))
11000                 (setq marks (cdr marks)))))
11001
11002           ;; Update the Xref header in this article to point to
11003           ;; the new crossposted article we have just created.
11004           (when (eq action 'crosspost)
11005             (save-excursion
11006               (set-buffer copy-buf)
11007               (gnus-request-article-this-buffer article gnus-newsgroup-name)
11008               (nnheader-replace-header
11009                "xref" (concat new-xref " " (gnus-group-prefixed-name
11010                                             (car art-group) to-method)
11011                               ":" (cdr art-group)))
11012               (gnus-request-replace-article
11013                article gnus-newsgroup-name (current-buffer)))))
11014
11015         (gnus-summary-goto-subject article)
11016         (gnus-summary-mark-article article gnus-canceled-mark))
11017       (gnus-summary-remove-process-mark article))
11018     (gnus-kill-buffer copy-buf)
11019     (gnus-summary-position-point)
11020     (gnus-set-mode-line 'summary)))
11021
11022 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
11023   "Move the current article to a different newsgroup.
11024 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
11025 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
11026 re-spool using this method."
11027   (interactive "P")
11028   (gnus-summary-move-article n nil nil 'copy))
11029
11030 (defun gnus-summary-crosspost-article (&optional n)
11031   "Crosspost the current article to some other group."
11032   (interactive "P")
11033   (gnus-summary-move-article n nil nil 'crosspost))
11034
11035 (defun gnus-summary-respool-article (&optional n respool-method)
11036   "Respool the current article.
11037 The article will be squeezed through the mail spooling process again,
11038 which means that it will be put in some mail newsgroup or other
11039 depending on `nnmail-split-methods'.
11040 If N is a positive number, respool the N next articles.
11041 If N is a negative number, respool the N previous articles.
11042 If N is nil and any articles have been marked with the process mark,
11043 respool those articles instead.
11044
11045 Respooling can be done both from mail groups and \"real\" newsgroups.
11046 In the former case, the articles in question will be moved from the
11047 current group into whatever groups they are destined to.  In the
11048 latter case, they will be copied into the relevant groups."
11049   (interactive "P")
11050   (gnus-set-global-variables)
11051   (let ((respool-methods (gnus-methods-using 'respool))
11052         (methname
11053          (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name)))))
11054     (or respool-method
11055         (setq respool-method
11056               (completing-read
11057                "What method do you want to use when respooling? "
11058                respool-methods nil t methname)))
11059     (or (string= respool-method "")
11060         (if (assoc (symbol-name
11061                     (car (gnus-find-method-for-group gnus-newsgroup-name)))
11062                    respool-methods)
11063             (gnus-summary-move-article n nil (intern respool-method))
11064           (gnus-summary-copy-article n nil (intern respool-method))))))
11065
11066 (defun gnus-summary-import-article (file)
11067   "Import a random file into a mail newsgroup."
11068   (interactive "fImport file: ")
11069   (gnus-set-global-variables)
11070   (let ((group gnus-newsgroup-name)
11071         (now (current-time))
11072         atts lines)
11073     (or (gnus-check-backend-function 'request-accept-article group)
11074         (error "%s does not support article importing" group))
11075     (or (file-readable-p file)
11076         (not (file-regular-p file))
11077         (error "Can't read %s" file))
11078     (save-excursion
11079       (set-buffer (get-buffer-create " *import file*"))
11080       (buffer-disable-undo (current-buffer))
11081       (erase-buffer)
11082       (insert-file-contents file)
11083       (goto-char (point-min))
11084       (unless (nnheader-article-p)
11085         ;; This doesn't look like an article, so we fudge some headers.
11086         (setq atts (file-attributes file)
11087               lines (count-lines (point-min) (point-max)))
11088         (insert "From: " (read-string "From: ") "\n"
11089                 "Subject: " (read-string "Subject: ") "\n"
11090                 "Date: " (timezone-make-date-arpa-standard
11091                           (current-time-string (nth 5 atts))
11092                           (current-time-zone now)
11093                           (current-time-zone now)) "\n"
11094                 "Message-ID: " (gnus-inews-message-id) "\n"
11095                 "Lines: " (int-to-string lines) "\n"
11096                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
11097       (gnus-request-accept-article group t)
11098       (kill-buffer (current-buffer)))))
11099
11100 (defun gnus-summary-expire-articles ()
11101   "Expire all articles that are marked as expirable in the current group."
11102   (interactive)
11103   (gnus-set-global-variables)
11104   (when (gnus-check-backend-function
11105          'request-expire-articles gnus-newsgroup-name)
11106     ;; This backend supports expiry.
11107     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
11108            (expirable (if total
11109                           (gnus-list-of-read-articles gnus-newsgroup-name)
11110                         (setq gnus-newsgroup-expirable
11111                               (sort gnus-newsgroup-expirable '<))))
11112            (expiry-wait (gnus-group-get-parameter
11113                          gnus-newsgroup-name 'expiry-wait))
11114            es)
11115       (when expirable
11116         ;; There are expirable articles in this group, so we run them
11117         ;; through the expiry process.
11118         (gnus-message 6 "Expiring articles...")
11119         ;; The list of articles that weren't expired is returned.
11120         (if expiry-wait
11121             (let ((nnmail-expiry-wait-function nil)
11122                   (nnmail-expiry-wait expiry-wait))
11123               (setq es (gnus-request-expire-articles
11124                         expirable gnus-newsgroup-name)))
11125           (setq es (gnus-request-expire-articles
11126                     expirable gnus-newsgroup-name)))
11127         (or total (setq gnus-newsgroup-expirable es))
11128         ;; We go through the old list of expirable, and mark all
11129         ;; really expired articles as nonexistent.
11130         (unless (eq es expirable)       ;If nothing was expired, we don't mark.
11131           (let ((gnus-use-cache nil))
11132             (while expirable
11133               (unless (memq (car expirable) es)
11134                 (when (gnus-data-find (car expirable))
11135                   (gnus-summary-mark-article
11136                    (car expirable) gnus-canceled-mark)))
11137               (setq expirable (cdr expirable)))))
11138         (gnus-message 6 "Expiring articles...done")))))
11139
11140 (defun gnus-summary-expire-articles-now ()
11141   "Expunge all expirable articles in the current group.
11142 This means that *all* articles that are marked as expirable will be
11143 deleted forever, right now."
11144   (interactive)
11145   (gnus-set-global-variables)
11146   (or gnus-expert-user
11147       (gnus-y-or-n-p
11148        "Are you really, really, really sure you want to expunge? ")
11149       (error "Phew!"))
11150   (let ((nnmail-expiry-wait 'immediate)
11151         (nnmail-expiry-wait-function nil))
11152     (gnus-summary-expire-articles)))
11153
11154 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
11155 (defun gnus-summary-delete-article (&optional n)
11156   "Delete the N next (mail) articles.
11157 This command actually deletes articles.  This is not a marking
11158 command.  The article will disappear forever from your life, never to
11159 return.
11160 If N is negative, delete backwards.
11161 If N is nil and articles have been marked with the process mark,
11162 delete these instead."
11163   (interactive "P")
11164   (gnus-set-global-variables)
11165   (or (gnus-check-backend-function 'request-expire-articles
11166                                    gnus-newsgroup-name)
11167       (error "The current newsgroup does not support article deletion."))
11168   ;; Compute the list of articles to delete.
11169   (let ((articles (gnus-summary-work-articles n))
11170         not-deleted)
11171     (if (and gnus-novice-user
11172              (not (gnus-y-or-n-p
11173                    (format "Do you really want to delete %s forever? "
11174                            (if (> (length articles) 1) "these articles"
11175                              "this article")))))
11176         ()
11177       ;; Delete the articles.
11178       (setq not-deleted (gnus-request-expire-articles
11179                          articles gnus-newsgroup-name 'force))
11180       (while articles
11181         (gnus-summary-remove-process-mark (car articles))
11182         ;; The backend might not have been able to delete the article
11183         ;; after all.
11184         (or (memq (car articles) not-deleted)
11185             (gnus-summary-mark-article (car articles) gnus-canceled-mark))
11186         (setq articles (cdr articles))))
11187     (gnus-summary-position-point)
11188     (gnus-set-mode-line 'summary)
11189     not-deleted))
11190
11191 (defun gnus-summary-edit-article (&optional force)
11192   "Enter into a buffer and edit the current article.
11193 This will have permanent effect only in mail groups.
11194 If FORCE is non-nil, allow editing of articles even in read-only
11195 groups."
11196   (interactive "P")
11197   (save-excursion
11198     (set-buffer gnus-summary-buffer)
11199     (gnus-set-global-variables)
11200     (when (and (not force)
11201                (gnus-group-read-only-p))
11202       (error "The current newsgroup does not support article editing."))
11203     (gnus-summary-select-article t nil t)
11204     (gnus-configure-windows 'article)
11205     (select-window (get-buffer-window gnus-article-buffer))
11206     (gnus-message 6 "C-c C-c to end edits")
11207     (setq buffer-read-only nil)
11208     (text-mode)
11209     (use-local-map (copy-keymap (current-local-map)))
11210     (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
11211     (buffer-enable-undo)
11212     (widen)
11213     (goto-char (point-min))
11214     (search-forward "\n\n" nil t)))
11215
11216 (defun gnus-summary-edit-article-done ()
11217   "Make edits to the current article permanent."
11218   (interactive)
11219   (if (gnus-group-read-only-p)
11220       (progn
11221         (gnus-summary-edit-article-postpone)
11222         (gnus-message
11223          1 "The current newsgroup does not support article editing.")
11224         (ding))
11225     (let ((buf (buffer-substring-no-properties (point-min) (point-max))))
11226       (erase-buffer)
11227       (insert buf)
11228       (if (not (gnus-request-replace-article
11229                 (cdr gnus-article-current) (car gnus-article-current)
11230                 (current-buffer)))
11231           (error "Couldn't replace article.")
11232         (gnus-article-mode)
11233         (use-local-map gnus-article-mode-map)
11234         (setq buffer-read-only t)
11235         (buffer-disable-undo (current-buffer))
11236         (gnus-configure-windows 'summary)
11237         (gnus-summary-update-article (cdr gnus-article-current)))
11238       (run-hooks 'gnus-article-display-hook)
11239       (and (gnus-visual-p 'summary-highlight 'highlight)
11240            (run-hooks 'gnus-visual-mark-article-hook)))))
11241
11242 (defun gnus-summary-edit-article-postpone ()
11243   "Postpone changes to the current article."
11244   (interactive)
11245   (gnus-article-mode)
11246   (use-local-map gnus-article-mode-map)
11247   (setq buffer-read-only t)
11248   (buffer-disable-undo (current-buffer))
11249   (gnus-configure-windows 'summary)
11250   (and (gnus-visual-p 'summary-highlight 'highlight)
11251        (run-hooks 'gnus-visual-mark-article-hook)))
11252
11253 (defun gnus-summary-respool-query ()
11254   "Query where the respool algorithm would put this article."
11255   (interactive)
11256   (gnus-set-global-variables)
11257   (gnus-summary-select-article)
11258   (save-excursion
11259     (set-buffer gnus-article-buffer)
11260     (save-restriction
11261       (goto-char (point-min))
11262       (search-forward "\n\n")
11263       (narrow-to-region (point-min) (point))
11264       (pp-eval-expression
11265        (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
11266
11267 ;; Summary score commands.
11268
11269 ;; Suggested by boubaker@cenatls.cena.dgac.fr.
11270
11271 (defun gnus-summary-raise-score (n)
11272   "Raise the score of the current article by N."
11273   (interactive "p")
11274   (gnus-set-global-variables)
11275   (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
11276
11277 (defun gnus-summary-set-score (n)
11278   "Set the score of the current article to N."
11279   (interactive "p")
11280   (gnus-set-global-variables)
11281   (save-excursion
11282     (gnus-summary-show-thread)
11283     (let ((buffer-read-only nil))
11284       ;; Set score.
11285       (gnus-summary-update-mark
11286        (if (= n (or gnus-summary-default-score 0)) ? 
11287          (if (< n (or gnus-summary-default-score 0))
11288              gnus-score-below-mark gnus-score-over-mark)) 'score))
11289     (let* ((article (gnus-summary-article-number))
11290            (score (assq article gnus-newsgroup-scored)))
11291       (if score (setcdr score n)
11292         (setq gnus-newsgroup-scored
11293               (cons (cons article n) gnus-newsgroup-scored))))
11294     (gnus-summary-update-line)))
11295
11296 (defun gnus-summary-current-score ()
11297   "Return the score of the current article."
11298   (interactive)
11299   (gnus-set-global-variables)
11300   (message "%s" (gnus-summary-article-score)))
11301
11302 ;; Summary marking commands.
11303
11304 (defun gnus-summary-kill-same-subject-and-select (&optional unmark)
11305   "Mark articles which has the same subject as read, and then select the next.
11306 If UNMARK is positive, remove any kind of mark.
11307 If UNMARK is negative, tick articles."
11308   (interactive "P")
11309   (gnus-set-global-variables)
11310   (if unmark
11311       (setq unmark (prefix-numeric-value unmark)))
11312   (let ((count
11313          (gnus-summary-mark-same-subject
11314           (gnus-summary-article-subject) unmark)))
11315     ;; Select next unread article.  If auto-select-same mode, should
11316     ;; select the first unread article.
11317     (gnus-summary-next-article t (and gnus-auto-select-same
11318                                       (gnus-summary-article-subject)))
11319     (gnus-message 7 "%d article%s marked as %s"
11320                   count (if (= count 1) " is" "s are")
11321                   (if unmark "unread" "read"))))
11322
11323 (defun gnus-summary-kill-same-subject (&optional unmark)
11324   "Mark articles which has the same subject as read.
11325 If UNMARK is positive, remove any kind of mark.
11326 If UNMARK is negative, tick articles."
11327   (interactive "P")
11328   (gnus-set-global-variables)
11329   (if unmark
11330       (setq unmark (prefix-numeric-value unmark)))
11331   (let ((count
11332          (gnus-summary-mark-same-subject
11333           (gnus-summary-article-subject) unmark)))
11334     ;; If marked as read, go to next unread subject.
11335     (if (null unmark)
11336         ;; Go to next unread subject.
11337         (gnus-summary-next-subject 1 t))
11338     (gnus-message 7 "%d articles are marked as %s"
11339                   count (if unmark "unread" "read"))))
11340
11341 (defun gnus-summary-mark-same-subject (subject &optional unmark)
11342   "Mark articles with same SUBJECT as read, and return marked number.
11343 If optional argument UNMARK is positive, remove any kinds of marks.
11344 If optional argument UNMARK is negative, mark articles as unread instead."
11345   (let ((count 1))
11346     (save-excursion
11347       (cond
11348        ((null unmark)                   ; Mark as read.
11349         (while (and
11350                 (progn
11351                   (gnus-summary-mark-article-as-read gnus-killed-mark)
11352                   (gnus-summary-show-thread) t)
11353                 (gnus-summary-find-subject subject))
11354           (setq count (1+ count))))
11355        ((> unmark 0)                    ; Tick.
11356         (while (and
11357                 (progn
11358                   (gnus-summary-mark-article-as-unread gnus-ticked-mark)
11359                   (gnus-summary-show-thread) t)
11360                 (gnus-summary-find-subject subject))
11361           (setq count (1+ count))))
11362        (t                               ; Mark as unread.
11363         (while (and
11364                 (progn
11365                   (gnus-summary-mark-article-as-unread gnus-unread-mark)
11366                   (gnus-summary-show-thread) t)
11367                 (gnus-summary-find-subject subject))
11368           (setq count (1+ count)))))
11369       (gnus-set-mode-line 'summary)
11370       ;; Return the number of marked articles.
11371       count)))
11372
11373 (defun gnus-summary-mark-as-processable (n &optional unmark)
11374   "Set the process mark on the next N articles.
11375 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
11376 the process mark instead.  The difference between N and the actual
11377 number of articles marked is returned."
11378   (interactive "p")
11379   (gnus-set-global-variables)
11380   (let ((backward (< n 0))
11381         (n (abs n)))
11382     (while (and
11383             (> n 0)
11384             (if unmark
11385                 (gnus-summary-remove-process-mark
11386                  (gnus-summary-article-number))
11387               (gnus-summary-set-process-mark (gnus-summary-article-number)))
11388             (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
11389       (setq n (1- n)))
11390     (if (/= 0 n) (gnus-message 7 "No more articles"))
11391     (gnus-summary-recenter)
11392     (gnus-summary-position-point)
11393     n))
11394
11395 (defun gnus-summary-unmark-as-processable (n)
11396   "Remove the process mark from the next N articles.
11397 If N is negative, mark backward instead.  The difference between N and
11398 the actual number of articles marked is returned."
11399   (interactive "p")
11400   (gnus-set-global-variables)
11401   (gnus-summary-mark-as-processable n t))
11402
11403 (defun gnus-summary-unmark-all-processable ()
11404   "Remove the process mark from all articles."
11405   (interactive)
11406   (gnus-set-global-variables)
11407   (save-excursion
11408     (while gnus-newsgroup-processable
11409       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
11410   (gnus-summary-position-point))
11411
11412 (defun gnus-summary-mark-as-expirable (n)
11413   "Mark N articles forward as expirable.
11414 If N is negative, mark backward instead.  The difference between N and
11415 the actual number of articles marked is returned."
11416   (interactive "p")
11417   (gnus-set-global-variables)
11418   (gnus-summary-mark-forward n gnus-expirable-mark))
11419
11420 (defun gnus-summary-mark-article-as-replied (article)
11421   "Mark ARTICLE replied and update the summary line."
11422   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
11423   (let ((buffer-read-only nil))
11424     (when (gnus-summary-goto-subject article)
11425       (gnus-summary-update-secondary-mark article))))
11426
11427 (defun gnus-summary-set-bookmark (article)
11428   "Set a bookmark in current article."
11429   (interactive (list (gnus-summary-article-number)))
11430   (gnus-set-global-variables)
11431   (if (or (not (get-buffer gnus-article-buffer))
11432           (not gnus-current-article)
11433           (not gnus-article-current)
11434           (not (equal gnus-newsgroup-name (car gnus-article-current))))
11435       (error "No current article selected"))
11436   ;; Remove old bookmark, if one exists.
11437   (let ((old (assq article gnus-newsgroup-bookmarks)))
11438     (if old (setq gnus-newsgroup-bookmarks
11439                   (delq old gnus-newsgroup-bookmarks))))
11440   ;; Set the new bookmark, which is on the form
11441   ;; (article-number . line-number-in-body).
11442   (setq gnus-newsgroup-bookmarks
11443         (cons
11444          (cons article
11445                (save-excursion
11446                  (set-buffer gnus-article-buffer)
11447                  (count-lines
11448                   (min (point)
11449                        (save-excursion
11450                          (goto-char (point-min))
11451                          (search-forward "\n\n" nil t)
11452                          (point)))
11453                   (point))))
11454          gnus-newsgroup-bookmarks))
11455   (gnus-message 6 "A bookmark has been added to the current article."))
11456
11457 (defun gnus-summary-remove-bookmark (article)
11458   "Remove the bookmark from the current article."
11459   (interactive (list (gnus-summary-article-number)))
11460   (gnus-set-global-variables)
11461   ;; Remove old bookmark, if one exists.
11462   (let ((old (assq article gnus-newsgroup-bookmarks)))
11463     (if old
11464         (progn
11465           (setq gnus-newsgroup-bookmarks
11466                 (delq old gnus-newsgroup-bookmarks))
11467           (gnus-message 6 "Removed bookmark."))
11468       (gnus-message 6 "No bookmark in current article."))))
11469
11470 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
11471 (defun gnus-summary-mark-as-dormant (n)
11472   "Mark N articles forward as dormant.
11473 If N is negative, mark backward instead.  The difference between N and
11474 the actual number of articles marked is returned."
11475   (interactive "p")
11476   (gnus-set-global-variables)
11477   (gnus-summary-mark-forward n gnus-dormant-mark))
11478
11479 (defun gnus-summary-set-process-mark (article)
11480   "Set the process mark on ARTICLE and update the summary line."
11481   (setq gnus-newsgroup-processable
11482         (cons article
11483               (delq article gnus-newsgroup-processable)))
11484   (when (gnus-summary-goto-subject article)
11485     (gnus-summary-show-thread)
11486     (gnus-summary-update-secondary-mark article)))
11487
11488 (defun gnus-summary-remove-process-mark (article)
11489   "Remove the process mark from ARTICLE and update the summary line."
11490   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
11491   (when (gnus-summary-goto-subject article)
11492     (gnus-summary-show-thread)
11493     (gnus-summary-update-secondary-mark article)))
11494
11495 (defun gnus-summary-set-saved-mark (article)
11496   "Set the process mark on ARTICLE and update the summary line."
11497   (push article gnus-newsgroup-saved)
11498   (when (gnus-summary-goto-subject article)
11499     (gnus-summary-update-secondary-mark article)))
11500
11501 (defun gnus-summary-mark-forward (n &optional mark no-expire)
11502   "Mark N articles as read forwards.
11503 If N is negative, mark backwards instead.
11504 Mark with MARK.  If MARK is ? , ?! or ??, articles will be
11505 marked as unread.
11506 The difference between N and the actual number of articles marked is
11507 returned."
11508   (interactive "p")
11509   (gnus-set-global-variables)
11510   (let ((backward (< n 0))
11511         (gnus-summary-goto-unread
11512          (and gnus-summary-goto-unread
11513               (not (eq gnus-summary-goto-unread 'never))
11514               (not (memq mark (list gnus-unread-mark
11515                                     gnus-ticked-mark gnus-dormant-mark)))))
11516         (n (abs n))
11517         (mark (or mark gnus-del-mark)))
11518     (while (and (> n 0)
11519                 (gnus-summary-mark-article nil mark no-expire)
11520                 (zerop (gnus-summary-next-subject
11521                         (if backward -1 1)
11522                         (and gnus-summary-goto-unread
11523                              (not (eq gnus-summary-goto-unread 'never)))
11524                         t)))
11525       (setq n (1- n)))
11526     (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
11527     (gnus-summary-recenter)
11528     (gnus-summary-position-point)
11529     (gnus-set-mode-line 'summary)
11530     n))
11531
11532 (defun gnus-summary-mark-article-as-read (mark)
11533   "Mark the current article quickly as read with MARK."
11534   (let ((article (gnus-summary-article-number)))
11535     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11536     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11537     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11538     (setq gnus-newsgroup-reads
11539           (cons (cons article mark) gnus-newsgroup-reads))
11540     ;; Possibly remove from cache, if that is used.
11541     (and gnus-use-cache (gnus-cache-enter-remove-article article))
11542     ;; Allow the backend to change the mark.
11543     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
11544     ;; Check for auto-expiry.
11545     (when (and gnus-newsgroup-auto-expire
11546                (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
11547                    (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
11548                    (= mark gnus-ancient-mark)
11549                    (= mark gnus-read-mark) (= mark gnus-souped-mark)))
11550       (setq mark gnus-expirable-mark)
11551       (push article gnus-newsgroup-expirable))
11552     ;; Set the mark in the buffer.
11553     (gnus-summary-update-mark mark 'unread)
11554     t))
11555
11556 (defun gnus-summary-mark-article-as-unread (mark)
11557   "Mark the current article quickly as unread with MARK."
11558   (let ((article (gnus-summary-article-number)))
11559     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11560     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11561     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
11562     (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
11563     (cond ((= mark gnus-ticked-mark)
11564            (push article gnus-newsgroup-marked))
11565           ((= mark gnus-dormant-mark)
11566            (push article gnus-newsgroup-dormant))
11567           (t
11568            (push article gnus-newsgroup-unreads)))
11569     (setq gnus-newsgroup-reads
11570           (delq (assq article gnus-newsgroup-reads)
11571                 gnus-newsgroup-reads))
11572
11573     ;; See whether the article is to be put in the cache.
11574     (and gnus-use-cache
11575          (vectorp (gnus-summary-article-header article))
11576          (save-excursion
11577            (gnus-cache-possibly-enter-article
11578             gnus-newsgroup-name article
11579             (gnus-summary-article-header article)
11580             (= mark gnus-ticked-mark)
11581             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
11582
11583     ;; Fix the mark.
11584     (gnus-summary-update-mark mark 'unread)
11585     t))
11586
11587 (defun gnus-summary-mark-article (&optional article mark no-expire)
11588   "Mark ARTICLE with MARK.  MARK can be any character.
11589 Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
11590 `??' (dormant) and `?E' (expirable).
11591 If MARK is nil, then the default character `?D' is used.
11592 If ARTICLE is nil, then the article on the current line will be
11593 marked."
11594   ;; The mark might be a string.
11595   (and (stringp mark)
11596        (setq mark (aref mark 0)))
11597   ;; If no mark is given, then we check auto-expiring.
11598   (and (not no-expire)
11599        gnus-newsgroup-auto-expire
11600        (or (not mark)
11601            (and (numberp mark)
11602                 (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
11603                     (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
11604                     (= mark gnus-read-mark) (= mark gnus-souped-mark))))
11605        (setq mark gnus-expirable-mark))
11606   (let* ((mark (or mark gnus-del-mark))
11607          (article (or article (gnus-summary-article-number))))
11608     (or article (error "No article on current line"))
11609     (if (or (= mark gnus-unread-mark)
11610             (= mark gnus-ticked-mark)
11611             (= mark gnus-dormant-mark))
11612         (gnus-mark-article-as-unread article mark)
11613       (gnus-mark-article-as-read article mark))
11614
11615     ;; See whether the article is to be put in the cache.
11616     (and gnus-use-cache
11617          (not (= mark gnus-canceled-mark))
11618          (vectorp (gnus-summary-article-header article))
11619          (save-excursion
11620            (gnus-cache-possibly-enter-article
11621             gnus-newsgroup-name article
11622             (gnus-summary-article-header article)
11623             (= mark gnus-ticked-mark)
11624             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
11625
11626     (if (gnus-summary-goto-subject article nil t)
11627         (let ((buffer-read-only nil))
11628           (gnus-summary-show-thread)
11629           ;; Fix the mark.
11630           (gnus-summary-update-mark mark 'unread)
11631           t))))
11632
11633 (defun gnus-summary-update-secondary-mark (article)
11634   "Update the secondary (read, process, cache) mark."
11635   (gnus-summary-update-mark
11636    (cond ((memq article gnus-newsgroup-processable)
11637           gnus-process-mark)
11638          ((memq article gnus-newsgroup-cached)
11639           gnus-cached-mark)
11640          ((memq article gnus-newsgroup-replied)
11641           gnus-replied-mark)
11642          ((memq article gnus-newsgroup-saved)
11643           gnus-saved-mark)
11644          (t gnus-unread-mark))
11645    'replied)
11646   (when (gnus-visual-p 'summary-highlight 'highlight)
11647     (run-hooks 'gnus-summary-update-hook))
11648   t)
11649
11650 (defun gnus-summary-update-mark (mark type)
11651   (beginning-of-line)
11652   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
11653         (buffer-read-only nil))
11654     (when forward
11655       ;; Go to the right position on the line.
11656       (forward-char forward)
11657       ;; Replace the old mark with the new mark.
11658       (subst-char-in-region (point) (1+ (point)) (following-char) mark)
11659       ;; Optionally update the marks by some user rule.
11660       (when (eq type 'unread)
11661         (gnus-data-set-mark
11662          (gnus-data-find (gnus-summary-article-number)) mark)
11663         (gnus-summary-update-line (eq mark gnus-unread-mark))))))
11664
11665 (defun gnus-mark-article-as-read (article &optional mark)
11666   "Enter ARTICLE in the pertinent lists and remove it from others."
11667   ;; Make the article expirable.
11668   (let ((mark (or mark gnus-del-mark)))
11669     (if (= mark gnus-expirable-mark)
11670         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
11671       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
11672     ;; Remove from unread and marked lists.
11673     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11674     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11675     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11676     (push (cons article mark) gnus-newsgroup-reads)
11677     ;; Possibly remove from cache, if that is used.
11678     (when gnus-use-cache
11679       (gnus-cache-enter-remove-article article))))
11680
11681 (defun gnus-mark-article-as-unread (article &optional mark)
11682   "Enter ARTICLE in the pertinent lists and remove it from others."
11683   (let ((mark (or mark gnus-ticked-mark)))
11684     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11685     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11686     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
11687     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11688     (cond ((= mark gnus-ticked-mark)
11689            (push article gnus-newsgroup-marked))
11690           ((= mark gnus-dormant-mark)
11691            (push article gnus-newsgroup-dormant))
11692           (t
11693            (push article gnus-newsgroup-unreads)))
11694     (setq gnus-newsgroup-reads
11695           (delq (assq article gnus-newsgroup-reads)
11696                 gnus-newsgroup-reads))))
11697
11698 (defalias 'gnus-summary-mark-as-unread-forward
11699   'gnus-summary-tick-article-forward)
11700 (make-obsolete 'gnus-summary-mark-as-unread-forward
11701                'gnus-summary-tick-article-forward)
11702 (defun gnus-summary-tick-article-forward (n)
11703   "Tick N articles forwards.
11704 If N is negative, tick backwards instead.
11705 The difference between N and the number of articles ticked is returned."
11706   (interactive "p")
11707   (gnus-summary-mark-forward n gnus-ticked-mark))
11708
11709 (defalias 'gnus-summary-mark-as-unread-backward
11710   'gnus-summary-tick-article-backward)
11711 (make-obsolete 'gnus-summary-mark-as-unread-backward
11712                'gnus-summary-tick-article-backward)
11713 (defun gnus-summary-tick-article-backward (n)
11714   "Tick N articles backwards.
11715 The difference between N and the number of articles ticked is returned."
11716   (interactive "p")
11717   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
11718
11719 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
11720 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
11721 (defun gnus-summary-tick-article (&optional article clear-mark)
11722   "Mark current article as unread.
11723 Optional 1st argument ARTICLE specifies article number to be marked as unread.
11724 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
11725   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
11726                                        gnus-ticked-mark)))
11727
11728 (defun gnus-summary-mark-as-read-forward (n)
11729   "Mark N articles as read forwards.
11730 If N is negative, mark backwards instead.
11731 The difference between N and the actual number of articles marked is
11732 returned."
11733   (interactive "p")
11734   (gnus-summary-mark-forward n gnus-del-mark t))
11735
11736 (defun gnus-summary-mark-as-read-backward (n)
11737   "Mark the N articles as read backwards.
11738 The difference between N and the actual number of articles marked is
11739 returned."
11740   (interactive "p")
11741   (gnus-summary-mark-forward (- n) gnus-del-mark t))
11742
11743 (defun gnus-summary-mark-as-read (&optional article mark)
11744   "Mark current article as read.
11745 ARTICLE specifies the article to be marked as read.
11746 MARK specifies a string to be inserted at the beginning of the line."
11747   (gnus-summary-mark-article article mark))
11748
11749 (defun gnus-summary-clear-mark-forward (n)
11750   "Clear marks from N articles forward.
11751 If N is negative, clear backward instead.
11752 The difference between N and the number of marks cleared is returned."
11753   (interactive "p")
11754   (gnus-summary-mark-forward n gnus-unread-mark))
11755
11756 (defun gnus-summary-clear-mark-backward (n)
11757   "Clear marks from N articles backward.
11758 The difference between N and the number of marks cleared is returned."
11759   (interactive "p")
11760   (gnus-summary-mark-forward (- n) gnus-unread-mark))
11761
11762 (defun gnus-summary-mark-unread-as-read ()
11763   "Intended to be used by `gnus-summary-mark-article-hook'."
11764   (when (memq gnus-current-article gnus-newsgroup-unreads)
11765     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
11766
11767 (defun gnus-summary-mark-region-as-read (point mark all)
11768   "Mark all unread articles between point and mark as read.
11769 If given a prefix, mark all articles between point and mark as read,
11770 even ticked and dormant ones."
11771   (interactive "r\nP")
11772   (save-excursion
11773     (let (article)
11774       (goto-char point)
11775       (beginning-of-line)
11776       (while (and
11777               (< (point) mark)
11778               (progn
11779                 (when (or all
11780                           (memq (setq article (gnus-summary-article-number))
11781                                 gnus-newsgroup-unreads))
11782                   (gnus-summary-mark-article article gnus-del-mark))
11783                 t)
11784               (gnus-summary-find-next))))))
11785
11786 (defun gnus-summary-mark-below (score mark)
11787   "Mark articles with score less than SCORE with MARK."
11788   (interactive "P\ncMark: ")
11789   (gnus-set-global-variables)
11790   (setq score (if score
11791                   (prefix-numeric-value score)
11792                 (or gnus-summary-default-score 0)))
11793   (save-excursion
11794     (set-buffer gnus-summary-buffer)
11795     (goto-char (point-min))
11796     (while 
11797         (progn
11798           (and (< (gnus-summary-article-score) score)
11799                (gnus-summary-mark-article nil mark))
11800           (gnus-summary-find-next)))))
11801
11802 (defun gnus-summary-kill-below (&optional score)
11803   "Mark articles with score below SCORE as read."
11804   (interactive "P")
11805   (gnus-set-global-variables)
11806   (gnus-summary-mark-below score gnus-killed-mark))
11807
11808 (defun gnus-summary-clear-above (&optional score)
11809   "Clear all marks from articles with score above SCORE."
11810   (interactive "P")
11811   (gnus-set-global-variables)
11812   (gnus-summary-mark-above score gnus-unread-mark))
11813
11814 (defun gnus-summary-tick-above (&optional score)
11815   "Tick all articles with score above SCORE."
11816   (interactive "P")
11817   (gnus-set-global-variables)
11818   (gnus-summary-mark-above score gnus-ticked-mark))
11819
11820 (defun gnus-summary-mark-above (score mark)
11821   "Mark articles with score over SCORE with MARK."
11822   (interactive "P\ncMark: ")
11823   (gnus-set-global-variables)
11824   (setq score (if score
11825                   (prefix-numeric-value score)
11826                 (or gnus-summary-default-score 0)))
11827   (save-excursion
11828     (set-buffer gnus-summary-buffer)
11829     (goto-char (point-min))
11830     (while (and (progn
11831                   (if (> (gnus-summary-article-score) score)
11832                       (gnus-summary-mark-article nil mark))
11833                   t)
11834                 (gnus-summary-find-next)))))
11835
11836 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
11837 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
11838 (defun gnus-summary-limit-include-expunged ()
11839   "Display all the hidden articles that were expunged for low scores."
11840   (interactive)
11841   (gnus-set-global-variables)
11842   (let ((buffer-read-only nil))
11843     (let ((scored gnus-newsgroup-scored)
11844           headers h)
11845       (while scored
11846         (or (gnus-summary-goto-subject (car (car scored)))
11847             (and (setq h (gnus-summary-article-header (car (car scored))))
11848                  (< (cdr (car scored)) gnus-summary-expunge-below)
11849                  (setq headers (cons h headers))))
11850         (setq scored (cdr scored)))
11851       (or headers (error "No expunged articles hidden."))
11852       (goto-char (point-min))
11853       (gnus-summary-prepare-unthreaded (nreverse headers)))
11854     (goto-char (point-min))
11855     (gnus-summary-position-point)))
11856
11857 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
11858   "Mark all articles not marked as unread in this newsgroup as read.
11859 If prefix argument ALL is non-nil, all articles are marked as read.
11860 If QUIETLY is non-nil, no questions will be asked.
11861 If TO-HERE is non-nil, it should be a point in the buffer.  All
11862 articles before this point will be marked as read.
11863 The number of articles marked as read is returned."
11864   (interactive "P")
11865   (gnus-set-global-variables)
11866   (prog1
11867       (if (or quietly
11868               (not gnus-interactive-catchup) ;Without confirmation?
11869               gnus-expert-user
11870               (gnus-y-or-n-p
11871                (if all
11872                    "Mark absolutely all articles as read? "
11873                  "Mark all unread articles as read? ")))
11874           (if (and not-mark
11875                    (not gnus-newsgroup-adaptive)
11876                    (not gnus-newsgroup-auto-expire))
11877               (progn
11878                 (when all
11879                   (setq gnus-newsgroup-marked nil
11880                         gnus-newsgroup-dormant nil))
11881                 (setq gnus-newsgroup-unreads nil))
11882             ;; We actually mark all articles as canceled, which we
11883             ;; have to do when using auto-expiry or adaptive scoring.
11884             (gnus-summary-show-all-threads)
11885             (if (gnus-summary-first-subject (not all))
11886                 (while (and
11887                         (if to-here (< (point) to-here) t)
11888                         (gnus-summary-mark-article-as-read gnus-catchup-mark)
11889                         (gnus-summary-find-next (not all)))))
11890             (unless to-here
11891               (setq gnus-newsgroup-unreads nil))
11892             (gnus-set-mode-line 'summary)))
11893     (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
11894       (if (and (not to-here) (eq 'nnvirtual (car method)))
11895           (nnvirtual-catchup-group
11896            (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
11897     (gnus-summary-position-point)))
11898
11899 (defun gnus-summary-catchup-to-here (&optional all)
11900   "Mark all unticked articles before the current one as read.
11901 If ALL is non-nil, also mark ticked and dormant articles as read."
11902   (interactive "P")
11903   (gnus-set-global-variables)
11904   (save-excursion
11905     (let ((beg (point)))
11906       ;; We check that there are unread articles.
11907       (when (or all (gnus-summary-find-prev))
11908         (gnus-summary-catchup all t beg))))
11909   (gnus-summary-position-point))
11910
11911 (defun gnus-summary-catchup-all (&optional quietly)
11912   "Mark all articles in this newsgroup as read."
11913   (interactive "P")
11914   (gnus-set-global-variables)
11915   (gnus-summary-catchup t quietly))
11916
11917 (defun gnus-summary-catchup-and-exit (&optional all quietly)
11918   "Mark all articles not marked as unread in this newsgroup as read, then exit.
11919 If prefix argument ALL is non-nil, all articles are marked as read."
11920   (interactive "P")
11921   (gnus-set-global-variables)
11922   (gnus-summary-catchup all quietly nil 'fast)
11923   ;; Select next newsgroup or exit.
11924   (if (eq gnus-auto-select-next 'quietly)
11925       (gnus-summary-next-group nil)
11926     (gnus-summary-exit)))
11927
11928 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
11929   "Mark all articles in this newsgroup as read, and then exit."
11930   (interactive "P")
11931   (gnus-set-global-variables)
11932   (gnus-summary-catchup-and-exit t quietly))
11933
11934 ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
11935 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
11936   "Mark all articles in this group as read and select the next group.
11937 If given a prefix, mark all articles, unread as well as ticked, as
11938 read."
11939   (interactive "P")
11940   (gnus-set-global-variables)
11941   (save-excursion
11942     (gnus-summary-catchup all))
11943   (gnus-summary-next-article t))
11944
11945 ;; Thread-based commands.
11946
11947 (defun gnus-summary-articles-in-thread (&optional article)
11948   "Return a list of all articles in the current thread.
11949 If ARTICLE is non-nil, return all articles in the thread that starts
11950 with that article."
11951   (let* ((article (or article (gnus-summary-article-number)))
11952          (data (gnus-data-find-list article))
11953          (top-level (gnus-data-level (car data)))
11954          (top-subject
11955           (cond ((null gnus-thread-operation-ignore-subject)
11956                  (gnus-simplify-subject-re
11957                   (mail-header-subject (gnus-data-header (car data)))))
11958                 ((eq gnus-thread-operation-ignore-subject 'fuzzy)
11959                  (gnus-simplify-subject-fuzzy
11960                   (mail-header-subject (gnus-data-header (car data)))))
11961                 (t nil)))
11962          articles)
11963     (if (not data)
11964         ()                              ; This article doesn't exist.
11965       (while data
11966         (and (or (not top-subject)
11967                  (string= top-subject
11968                           (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
11969                               (gnus-simplify-subject-fuzzy
11970                                (mail-header-subject
11971                                 (gnus-data-header (car data))))
11972                             (gnus-simplify-subject-re
11973                              (mail-header-subject
11974                               (gnus-data-header (car data)))))))
11975              (setq articles (cons (gnus-data-number (car data)) articles)))
11976         (if (and (setq data (cdr data))
11977                  (> (gnus-data-level (car data)) top-level))
11978             ()
11979           (setq data nil)))
11980       ;; Return the list of articles.
11981       (nreverse articles))))
11982
11983 (defun gnus-summary-rethread-current ()
11984   "Rethread the thread the current article is part of."
11985   (interactive)
11986   (gnus-set-global-variables)
11987   (let* ((gnus-show-threads t)
11988          (article (gnus-summary-article-number))
11989          (id (mail-header-id (gnus-summary-article-header)))
11990          (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id)))))
11991     (unless id
11992       (error "No article on the current line"))
11993     (gnus-rebuild-thread id)
11994     (gnus-summary-goto-subject article)))
11995
11996 (defun gnus-summary-reparent-thread ()
11997   "Make current article child of the marked (or previous) article.
11998
11999 Note that the re-threading will only work if `gnus-thread-ignore-subject'
12000 is non-nil or the Subject: of both articles are the same."
12001   (interactive)
12002   (or (not (gnus-group-read-only-p))
12003       (error "The current newsgroup does not support article editing."))
12004   (or (<= (length gnus-newsgroup-processable) 1)
12005       (error "No more than one article may be marked."))
12006   (save-window-excursion
12007     (let ((gnus-article-buffer " *reparent*")
12008           (current-article (gnus-summary-article-number))
12009           ; first grab the marked article, otherwise one line up.
12010           (parent-article (if (not (null gnus-newsgroup-processable))
12011                               (car gnus-newsgroup-processable)
12012                             (save-excursion
12013                               (if (eq (forward-line -1) 0)
12014                                   (gnus-summary-article-number)
12015                                 (error "Beginning of summary buffer."))))))
12016       (or (not (eq current-article parent-article))
12017           (error "An article may not be self-referential."))
12018       (let ((message-id (mail-header-id 
12019                          (gnus-summary-article-header parent-article))))
12020         (or (and message-id (not (equal message-id "")))
12021             (error "No message-id in desired parent."))
12022         (gnus-summary-select-article t t nil current-article)
12023         (set-buffer gnus-article-buffer)
12024         (setq buffer-read-only nil)
12025         (let ((buf (buffer-substring-no-properties (point-min) (point-max))))
12026           (erase-buffer)
12027           (insert buf))
12028         (goto-char (point-min))
12029         (if (search-forward-regexp "^References: " nil t)
12030             (insert message-id " " )
12031           (insert "References: " message-id "\n"))
12032         (or (gnus-request-replace-article current-article
12033                                           (car gnus-article-current)
12034                                           gnus-article-buffer)
12035             (error "Couldn't replace article."))
12036         (set-buffer gnus-summary-buffer)
12037         (gnus-summary-unmark-all-processable)
12038         (gnus-summary-rethread-current)
12039         (message "Article %d is now the child of article %d."
12040                  current-article parent-article)))))
12041
12042 (defun gnus-summary-toggle-threads (&optional arg)
12043   "Toggle showing conversation threads.
12044 If ARG is positive number, turn showing conversation threads on."
12045   (interactive "P")
12046   (gnus-set-global-variables)
12047   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
12048     (setq gnus-show-threads
12049           (if (null arg) (not gnus-show-threads)
12050             (> (prefix-numeric-value arg) 0)))
12051     (gnus-summary-prepare)
12052     (gnus-summary-goto-subject current)
12053     (gnus-summary-position-point)))
12054
12055 (defun gnus-summary-show-all-threads ()
12056   "Show all threads."
12057   (interactive)
12058   (gnus-set-global-variables)
12059   (save-excursion
12060     (let ((buffer-read-only nil))
12061       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
12062   (gnus-summary-position-point))
12063
12064 (defun gnus-summary-show-thread ()
12065   "Show thread subtrees.
12066 Returns nil if no thread was there to be shown."
12067   (interactive)
12068   (gnus-set-global-variables)
12069   (let ((buffer-read-only nil)
12070         (orig (point))
12071         ;; first goto end then to beg, to have point at beg after let
12072         (end (progn (end-of-line) (point)))
12073         (beg (progn (beginning-of-line) (point))))
12074     (prog1
12075         ;; Any hidden lines here?
12076         (search-forward "\r" end t)
12077       (subst-char-in-region beg end ?\^M ?\n t)
12078       (goto-char orig)
12079       (gnus-summary-position-point))))
12080
12081 (defun gnus-summary-hide-all-threads ()
12082   "Hide all thread subtrees."
12083   (interactive)
12084   (gnus-set-global-variables)
12085   (save-excursion
12086     (goto-char (point-min))
12087     (gnus-summary-hide-thread)
12088     (while (zerop (gnus-summary-next-thread 1 t))
12089       (gnus-summary-hide-thread)))
12090   (gnus-summary-position-point))
12091
12092 (defun gnus-summary-hide-thread ()
12093   "Hide thread subtrees.
12094 Returns nil if no threads were there to be hidden."
12095   (interactive)
12096   (gnus-set-global-variables)
12097   (let ((buffer-read-only nil)
12098         (start (point))
12099         (article (gnus-summary-article-number))
12100         end)
12101     ;; Go forward until either the buffer ends or the subthread
12102     ;; ends.
12103     (when (and (not (eobp))
12104                (or (zerop (gnus-summary-next-thread 1 t))
12105                    (goto-char (gnus-data-pos (car (gnus-data-list 'rev))))))
12106       (setq end (point))
12107       (prog1
12108           (if (and (> (point) start)
12109                    (search-backward "\n" start t))
12110               (progn
12111                 (subst-char-in-region start (point) ?\n ?\^M)
12112                 (gnus-summary-goto-subject article))
12113             (goto-char start)
12114             nil)
12115         (gnus-summary-position-point)))))
12116
12117 (defun gnus-summary-go-to-next-thread (&optional previous)
12118   "Go to the same level (or less) next thread.
12119 If PREVIOUS is non-nil, go to previous thread instead.
12120 Return the article number moved to, or nil if moving was impossible."
12121   (let* ((level (gnus-summary-thread-level))
12122          (article (gnus-summary-article-number))
12123          (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
12124          oart)
12125     (while data
12126       (if (<= (gnus-data-level (car data)) level)
12127           (setq oart (gnus-data-number (car data))
12128                 data nil)
12129         (setq data (cdr data))))
12130     (and oart
12131          (gnus-summary-goto-subject oart))))
12132
12133 (defun gnus-summary-next-thread (n &optional silent)
12134   "Go to the same level next N'th thread.
12135 If N is negative, search backward instead.
12136 Returns the difference between N and the number of skips actually
12137 done.
12138
12139 If SILENT, don't output messages."
12140   (interactive "p")
12141   (gnus-set-global-variables)
12142   (let ((backward (< n 0))
12143         (n (abs n))
12144         old dum)
12145     (while (and (> n 0)
12146                 (setq old (save-excursion (forward-line 1) (point)))
12147                 (gnus-summary-go-to-next-thread backward))
12148       (when (and (eq gnus-summary-make-false-root 'dummy)
12149                  (setq dum (text-property-not-all
12150                             old (point) 'gnus-intangible nil)))
12151         (goto-char dum))
12152       (decf n))
12153     (gnus-summary-position-point)
12154     (when (and (not silent) (/= 0 n))
12155       (gnus-message 7 "No more threads"))
12156     n))
12157
12158 (defun gnus-summary-prev-thread (n)
12159   "Go to the same level previous N'th thread.
12160 Returns the difference between N and the number of skips actually
12161 done."
12162   (interactive "p")
12163   (gnus-set-global-variables)
12164   (gnus-summary-next-thread (- n)))
12165
12166 (defun gnus-summary-go-down-thread ()
12167   "Go down one level in the current thread."
12168   (let ((children (gnus-summary-article-children)))
12169     (and children
12170          (gnus-summary-goto-subject (car children)))))
12171
12172 (defun gnus-summary-go-up-thread ()
12173   "Go up one level in the current thread."
12174   (let ((parent (gnus-summary-article-parent)))
12175     (and parent
12176          (gnus-summary-goto-subject parent))))
12177
12178 (defun gnus-summary-down-thread (n)
12179   "Go down thread N steps.
12180 If N is negative, go up instead.
12181 Returns the difference between N and how many steps down that were
12182 taken."
12183   (interactive "p")
12184   (gnus-set-global-variables)
12185   (let ((up (< n 0))
12186         (n (abs n)))
12187     (while (and (> n 0)
12188                 (if up (gnus-summary-go-up-thread)
12189                   (gnus-summary-go-down-thread)))
12190       (setq n (1- n)))
12191     (gnus-summary-position-point)
12192     (if (/= 0 n) (gnus-message 7 "Can't go further"))
12193     n))
12194
12195 (defun gnus-summary-up-thread (n)
12196   "Go up thread N steps.
12197 If N is negative, go up instead.
12198 Returns the difference between N and how many steps down that were
12199 taken."
12200   (interactive "p")
12201   (gnus-set-global-variables)
12202   (gnus-summary-down-thread (- n)))
12203
12204 (defun gnus-summary-top-thread ()
12205   "Go to the top of the thread."
12206   (interactive)
12207   (gnus-set-global-variables)
12208   (while (gnus-summary-go-up-thread))
12209   (gnus-summary-article-number))
12210
12211 (defun gnus-summary-kill-thread (&optional unmark)
12212   "Mark articles under current thread as read.
12213 If the prefix argument is positive, remove any kinds of marks.
12214 If the prefix argument is negative, tick articles instead."
12215   (interactive "P")
12216   (gnus-set-global-variables)
12217   (if unmark
12218       (setq unmark (prefix-numeric-value unmark)))
12219   (let ((articles (gnus-summary-articles-in-thread)))
12220     (save-excursion
12221       ;; Expand the thread.
12222       (gnus-summary-show-thread)
12223       ;; Mark all the articles.
12224       (while articles
12225         (gnus-summary-goto-subject (car articles))
12226         (cond ((null unmark)
12227                (gnus-summary-mark-article-as-read gnus-killed-mark))
12228               ((> unmark 0)
12229                (gnus-summary-mark-article-as-unread gnus-unread-mark))
12230               (t
12231                (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
12232         (setq articles (cdr articles))))
12233     ;; Hide killed subtrees.
12234     (and (null unmark)
12235          gnus-thread-hide-killed
12236          (gnus-summary-hide-thread))
12237     ;; If marked as read, go to next unread subject.
12238     (if (null unmark)
12239         ;; Go to next unread subject.
12240         (gnus-summary-next-subject 1 t)))
12241   (gnus-set-mode-line 'summary))
12242
12243 ;; Summary sorting commands
12244
12245 (defun gnus-summary-sort-by-number (&optional reverse)
12246   "Sort summary buffer by article number.
12247 Argument REVERSE means reverse order."
12248   (interactive "P")
12249   (gnus-summary-sort 'number reverse))
12250
12251 (defun gnus-summary-sort-by-author (&optional reverse)
12252   "Sort summary buffer by author name alphabetically.
12253 If case-fold-search is non-nil, case of letters is ignored.
12254 Argument REVERSE means reverse order."
12255   (interactive "P")
12256   (gnus-summary-sort 'author reverse))
12257
12258 (defun gnus-summary-sort-by-subject (&optional reverse)
12259   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
12260 If case-fold-search is non-nil, case of letters is ignored.
12261 Argument REVERSE means reverse order."
12262   (interactive "P")
12263   (gnus-summary-sort 'subject reverse))
12264
12265 (defun gnus-summary-sort-by-date (&optional reverse)
12266   "Sort summary buffer by date.
12267 Argument REVERSE means reverse order."
12268   (interactive "P")
12269   (gnus-summary-sort 'date reverse))
12270
12271 (defun gnus-summary-sort-by-score (&optional reverse)
12272   "Sort summary buffer by score.
12273 Argument REVERSE means reverse order."
12274   (interactive "P")
12275   (gnus-summary-sort 'score reverse))
12276
12277 (defun gnus-summary-sort (predicate reverse)
12278   "Sort summary buffer by PREDICATE.  REVERSE means reverse order."
12279   (gnus-set-global-variables)
12280   (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
12281          (article (intern (format "gnus-article-sort-by-%s" predicate)))
12282          (gnus-thread-sort-functions
12283           (list
12284            (if (not reverse)
12285                thread
12286              `(lambda (t1 t2)
12287                 (,thread t2 t1)))))
12288          (gnus-article-sort-functions
12289           (list
12290            (if (not reverse)
12291                article
12292              `(lambda (t1 t2)
12293                 (,article t2 t1)))))
12294          (buffer-read-only)
12295          (gnus-summary-prepare-hook nil))
12296     ;; We do the sorting by regenerating the threads.
12297     (gnus-summary-prepare)
12298     ;; Hide subthreads if needed.
12299     (when (and gnus-show-threads gnus-thread-hide-subtree)
12300       (gnus-summary-hide-all-threads)))
12301   ;; If in async mode, we send some info to the backend.
12302   (when gnus-newsgroup-async
12303     (gnus-request-asynchronous
12304      gnus-newsgroup-name gnus-newsgroup-data)))
12305
12306 (defun gnus-sortable-date (date)
12307   "Make sortable string by string-lessp from DATE.
12308 Timezone package is used."
12309   (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S]
12310          (year (aref date 0))
12311          (month (aref date 1))
12312          (day (aref date 2)))
12313     (timezone-make-sortable-date
12314      year month day
12315      (timezone-make-time-string
12316       (aref date 3) (aref date 4) (aref date 5)))))
12317
12318
12319 ;; Summary saving commands.
12320
12321 (defun gnus-summary-save-article (&optional n not-saved)
12322   "Save the current article using the default saver function.
12323 If N is a positive number, save the N next articles.
12324 If N is a negative number, save the N previous articles.
12325 If N is nil and any articles have been marked with the process mark,
12326 save those articles instead.
12327 The variable `gnus-default-article-saver' specifies the saver function."
12328   (interactive "P")
12329   (gnus-set-global-variables)
12330   (let ((articles (gnus-summary-work-articles n))
12331         file header article)
12332     (while articles
12333       (setq header (gnus-summary-article-header
12334                     (setq article (pop articles))))
12335       (if (not (vectorp header))
12336           ;; This is a pseudo-article.
12337           (if (assq 'name header)
12338               (gnus-copy-file (cdr (assq 'name header)))
12339             (gnus-message 1 "Article %d is unsaveable" article))
12340         ;; This is a real article.
12341         (save-window-excursion
12342           (gnus-summary-select-article t nil nil article))
12343         (unless gnus-save-all-headers
12344           ;; Remove headers accoring to `gnus-saved-headers'.
12345           (let ((gnus-visible-headers
12346                  (or gnus-saved-headers gnus-visible-headers)))
12347             (gnus-article-hide-headers nil t)))
12348         ;; Remove any X-Gnus lines.
12349         (save-excursion
12350           (set-buffer gnus-article-buffer)
12351           (save-restriction
12352             (let ((buffer-read-only nil))
12353               (nnheader-narrow-to-headers)
12354               (while (re-search-forward "^X-Gnus" nil t)
12355                 (gnus-delete-line)))))
12356         (save-window-excursion
12357           (if (not gnus-default-article-saver)
12358               (error "No default saver is defined.")
12359             (setq file (funcall
12360                         gnus-default-article-saver
12361                         (cond
12362                          ((not gnus-prompt-before-saving)
12363                           'default)
12364                          ((eq gnus-prompt-before-saving 'always)
12365                           nil)
12366                          (t file))))))
12367         (gnus-summary-remove-process-mark article)
12368         (unless not-saved
12369           (gnus-summary-set-saved-mark article))))
12370     (gnus-summary-position-point)
12371     n))
12372
12373 (defun gnus-summary-pipe-output (&optional arg)
12374   "Pipe the current article to a subprocess.
12375 If N is a positive number, pipe the N next articles.
12376 If N is a negative number, pipe the N previous articles.
12377 If N is nil and any articles have been marked with the process mark,
12378 pipe those articles instead."
12379   (interactive "P")
12380   (gnus-set-global-variables)
12381   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
12382     (gnus-summary-save-article arg t))
12383   (gnus-configure-windows 'pipe))
12384
12385 (defun gnus-summary-save-article-mail (&optional arg)
12386   "Append the current article to an mail file.
12387 If N is a positive number, save the N next articles.
12388 If N is a negative number, save the N previous articles.
12389 If N is nil and any articles have been marked with the process mark,
12390 save those articles instead."
12391   (interactive "P")
12392   (gnus-set-global-variables)
12393   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
12394     (gnus-summary-save-article arg)))
12395
12396 (defun gnus-summary-save-article-rmail (&optional arg)
12397   "Append the current article to an rmail file.
12398 If N is a positive number, save the N next articles.
12399 If N is a negative number, save the N previous articles.
12400 If N is nil and any articles have been marked with the process mark,
12401 save those articles instead."
12402   (interactive "P")
12403   (gnus-set-global-variables)
12404   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
12405     (gnus-summary-save-article arg)))
12406
12407 (defun gnus-summary-save-article-file (&optional arg)
12408   "Append the current article to a file.
12409 If N is a positive number, save the N next articles.
12410 If N is a negative number, save the N previous articles.
12411 If N is nil and any articles have been marked with the process mark,
12412 save those articles instead."
12413   (interactive "P")
12414   (gnus-set-global-variables)
12415   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
12416     (gnus-summary-save-article arg)))
12417
12418 (defun gnus-summary-save-article-body-file (&optional arg)
12419   "Append the current article body to a file.
12420 If N is a positive number, save the N next articles.
12421 If N is a negative number, save the N previous articles.
12422 If N is nil and any articles have been marked with the process mark,
12423 save those articles instead."
12424   (interactive "P")
12425   (gnus-set-global-variables)
12426   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
12427     (gnus-summary-save-article arg)))
12428
12429 (defun gnus-get-split-value (methods)
12430   "Return a value based on the split METHODS."
12431   (let (split-name method result match)
12432     (when methods
12433       (save-excursion
12434         (set-buffer gnus-original-article-buffer)
12435         (save-restriction
12436           (nnheader-narrow-to-headers)
12437           (while methods
12438             (goto-char (point-min))
12439             (setq method (pop methods))
12440             (setq match (pop method))
12441             (when (cond
12442                    ((stringp match)
12443                     ;; Regular expression.
12444                     (condition-case ()
12445                         (re-search-forward match nil t)
12446                       (error nil)))
12447                    ((gnus-functionp match)
12448                     ;; Function.
12449                     (save-restriction
12450                       (widen)
12451                       (setq result (funcall match gnus-newsgroup-name))))
12452                    ((consp match)
12453                     ;; Form.
12454                     (save-restriction
12455                       (widen)
12456                       (setq result (eval match)))))
12457               (setq split-name (append (cdr methods) split-name))
12458               (cond ((stringp result)
12459                      (push result split-name))
12460                     ((consp result)
12461                      (setq split-name (append result split-name)))))))))
12462     split-name))
12463
12464 (defun gnus-read-move-group-name (prompt default articles prefix)
12465   "Read a group name."
12466   (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
12467          (prom
12468           (format "Where do you want to %s %s? "
12469                   prompt
12470                   (if (> (length articles) 1)
12471                       (format "these %d articles" (length articles))
12472                     "this article")))
12473          (to-newsgroup
12474           (cond
12475            ((null split-name)
12476             (completing-read
12477              (concat prom
12478                      (if default
12479                          (format "(default %s) " default)
12480                        ""))
12481              gnus-active-hashtb nil nil prefix))
12482            ((= 1 (length split-name))
12483             (completing-read prom gnus-active-hashtb
12484                              nil nil (cons (car split-name) 0)))
12485            (t
12486             (completing-read
12487              prom (mapcar (lambda (el) (list el)) (nreverse split-name)))))))
12488
12489     (when to-newsgroup
12490       (if (or (string= to-newsgroup "")
12491               (string= to-newsgroup prefix))
12492           (setq to-newsgroup (or default "")))
12493       (or (gnus-active to-newsgroup)
12494           (gnus-activate-group to-newsgroup)
12495           (error "No such group: %s" to-newsgroup)))
12496     to-newsgroup))
12497
12498 (defun gnus-read-save-file-name (prompt default-name)
12499   (let* ((split-name (gnus-get-split-value gnus-split-methods))
12500          (file
12501           ;; Let the split methods have their say.
12502           (cond
12503            ;; No split name was found.
12504            ((null split-name)
12505             (read-file-name
12506              (concat prompt " (default "
12507                      (file-name-nondirectory default-name) ") ")
12508              (file-name-directory default-name)
12509              default-name))
12510            ;; A single split name was found
12511            ((= 1 (length split-name))
12512             (read-file-name
12513              (concat prompt " (default " (car split-name) ") ")
12514              gnus-article-save-directory
12515              (concat gnus-article-save-directory (car split-name))))
12516            ;; A list of splits was found.
12517            (t
12518             (setq split-name (mapcar (lambda (el) (list el))
12519                                      (nreverse split-name)))
12520             (let ((result (completing-read
12521                            (concat prompt " ") split-name nil nil)))
12522               (concat gnus-article-save-directory
12523                       (if (string= result "")
12524                           (car (car split-name))
12525                         result)))))))
12526     ;; If we have read a directory, we append the default file name.
12527     (when (file-directory-p file)
12528       (setq file (concat (file-name-as-directory file)
12529                          (file-name-nondirectory default-name))))
12530     ;; Possibly translate some charaters.
12531     (nnheader-translate-file-chars file)))
12532
12533 (defun gnus-article-archive-name (group)
12534   "Return the first instance of an \"Archive-name\" in the current buffer."
12535   (let ((case-fold-search t))
12536     (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
12537       (match-string 1))))
12538
12539 (defun gnus-summary-save-in-rmail (&optional filename)
12540   "Append this article to Rmail file.
12541 Optional argument FILENAME specifies file name.
12542 Directory to save to is default to `gnus-article-save-directory' which
12543 is initialized from the SAVEDIR environment variable."
12544   (interactive)
12545   (gnus-set-global-variables)
12546   (let ((default-name
12547           (funcall gnus-rmail-save-name gnus-newsgroup-name
12548                    gnus-current-headers gnus-newsgroup-last-rmail)))
12549     (setq filename
12550           (cond ((eq filename 'default)
12551                  default-name)
12552                 (filename filename)
12553                 (t (gnus-read-save-file-name
12554                     "Save in rmail file:" default-name))))
12555     (gnus-make-directory (file-name-directory filename))
12556     (gnus-eval-in-buffer-window
12557      gnus-original-article-buffer
12558      (save-excursion
12559        (save-restriction
12560          (widen)
12561          (gnus-output-to-rmail filename))))
12562     ;; Remember the directory name to save articles
12563     (setq gnus-newsgroup-last-rmail filename)))
12564
12565 (defun gnus-summary-save-in-mail (&optional filename)
12566   "Append this article to Unix mail file.
12567 Optional argument FILENAME specifies file name.
12568 Directory to save to is default to `gnus-article-save-directory' which
12569 is initialized from the SAVEDIR environment variable."
12570   (interactive)
12571   (gnus-set-global-variables)
12572   (let ((default-name
12573           (funcall gnus-mail-save-name gnus-newsgroup-name
12574                    gnus-current-headers gnus-newsgroup-last-mail)))
12575     (setq filename
12576           (cond ((eq filename 'default)
12577                  default-name)
12578                 (filename filename)
12579                 (t (gnus-read-save-file-name
12580                     "Save in Unix mail file:" default-name))))
12581     (setq filename
12582           (expand-file-name filename
12583                             (and default-name
12584                                  (file-name-directory default-name))))
12585     (gnus-make-directory (file-name-directory filename))
12586     (gnus-eval-in-buffer-window
12587      gnus-original-article-buffer
12588      (save-excursion
12589        (save-restriction
12590          (widen)
12591          (if (and (file-readable-p filename) (mail-file-babyl-p filename))
12592              (gnus-output-to-rmail filename)
12593            (let ((mail-use-rfc822 t))
12594              (rmail-output filename 1 t t))))))
12595     ;; Remember the directory name to save articles.
12596     (setq gnus-newsgroup-last-mail filename)))
12597
12598 (defun gnus-summary-save-in-file (&optional filename)
12599   "Append this article to file.
12600 Optional argument FILENAME specifies file name.
12601 Directory to save to is default to `gnus-article-save-directory' which
12602 is initialized from the SAVEDIR environment variable."
12603   (interactive)
12604   (gnus-set-global-variables)
12605   (let ((default-name
12606           (funcall gnus-file-save-name gnus-newsgroup-name
12607                    gnus-current-headers gnus-newsgroup-last-file)))
12608     (setq filename
12609           (cond ((eq filename 'default)
12610                  default-name)
12611                 (filename filename)
12612                 (t (gnus-read-save-file-name
12613                     "Save in file:" default-name))))
12614     (gnus-make-directory (file-name-directory filename))
12615     (gnus-eval-in-buffer-window
12616      gnus-article-buffer
12617      (save-excursion
12618        (save-restriction
12619          (widen)
12620          (gnus-output-to-file filename))))
12621     ;; Remember the directory name to save articles.
12622     (setq gnus-newsgroup-last-file filename)))
12623
12624 (defun gnus-summary-save-body-in-file (&optional filename)
12625   "Append this article body to a file.
12626 Optional argument FILENAME specifies file name.
12627 The directory to save in defaults to `gnus-article-save-directory' which
12628 is initialized from the SAVEDIR environment variable."
12629   (interactive)
12630   (gnus-set-global-variables)
12631   (let ((default-name
12632           (funcall gnus-file-save-name gnus-newsgroup-name
12633                    gnus-current-headers gnus-newsgroup-last-file)))
12634     (setq filename
12635           (cond ((eq filename 'default)
12636                  default-name)
12637                 (filename filename)
12638                 (t (gnus-read-save-file-name
12639                     "Save body in file:" default-name))))
12640     (gnus-make-directory (file-name-directory filename))
12641     (gnus-eval-in-buffer-window
12642      gnus-article-buffer
12643      (save-excursion
12644        (save-restriction
12645          (widen)
12646          (goto-char (point-min))
12647          (and (search-forward "\n\n" nil t)
12648               (narrow-to-region (point) (point-max)))
12649          (gnus-output-to-file filename))))
12650     ;; Remember the directory name to save articles.
12651     (setq gnus-newsgroup-last-file filename)))
12652
12653 (defun gnus-summary-save-in-pipe (&optional command)
12654   "Pipe this article to subprocess."
12655   (interactive)
12656   (gnus-set-global-variables)
12657   (setq command
12658         (cond ((eq command 'default)
12659                gnus-last-shell-command)
12660               (command command)
12661               (t (read-string "Shell command on article: "
12662                               gnus-last-shell-command))))
12663   (if (string-equal command "")
12664       (setq command gnus-last-shell-command))
12665   (gnus-eval-in-buffer-window
12666    gnus-article-buffer
12667    (save-restriction
12668      (widen)
12669      (shell-command-on-region (point-min) (point-max) command nil)))
12670   (setq gnus-last-shell-command command))
12671
12672 ;; Summary extract commands
12673
12674 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
12675   (let ((buffer-read-only nil)
12676         (article (gnus-summary-article-number))
12677         after-article b e)
12678     (or (gnus-summary-goto-subject article)
12679         (error (format "No such article: %d" article)))
12680     (gnus-summary-position-point)
12681     ;; If all commands are to be bunched up on one line, we collect
12682     ;; them here.
12683     (if gnus-view-pseudos-separately
12684         ()
12685       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
12686             files action)
12687         (while ps
12688           (setq action (cdr (assq 'action (car ps))))
12689           (setq files (list (cdr (assq 'name (car ps)))))
12690           (while (and ps (cdr ps)
12691                       (string= (or action "1")
12692                                (or (cdr (assq 'action (car (cdr ps)))) "2")))
12693             (setq files (cons (cdr (assq 'name (car (cdr ps)))) files))
12694             (setcdr ps (cdr (cdr ps))))
12695           (if (not files)
12696               ()
12697             (if (not (string-match "%s" action))
12698                 (setq files (cons " " files)))
12699             (setq files (cons " " files))
12700             (and (assq 'execute (car ps))
12701                  (setcdr (assq 'execute (car ps))
12702                          (funcall (if (string-match "%s" action)
12703                                       'format 'concat)
12704                                   action
12705                                   (mapconcat (lambda (f) f) files " ")))))
12706           (setq ps (cdr ps)))))
12707     (if (and gnus-view-pseudos (not not-view))
12708         (while pslist
12709           (and (assq 'execute (car pslist))
12710                (gnus-execute-command (cdr (assq 'execute (car pslist)))
12711                                      (eq gnus-view-pseudos 'not-confirm)))
12712           (setq pslist (cdr pslist)))
12713       (save-excursion
12714         (while pslist
12715           (setq after-article (or (cdr (assq 'article (car pslist)))
12716                                   (gnus-summary-article-number)))
12717           (gnus-summary-goto-subject after-article)
12718           (forward-line 1)
12719           (setq b (point))
12720           (insert "          " (file-name-nondirectory
12721                                 (cdr (assq 'name (car pslist))))
12722                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
12723           (setq e (point))
12724           (forward-line -1)             ; back to `b'
12725           (add-text-properties
12726            b e (list 'gnus-number gnus-reffed-article-number
12727                      gnus-mouse-face-prop gnus-mouse-face))
12728           (gnus-data-enter
12729            after-article gnus-reffed-article-number
12730            gnus-unread-mark b (car pslist) 0 (- e b))
12731           (push gnus-reffed-article-number gnus-newsgroup-unreads)
12732           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
12733           (setq pslist (cdr pslist)))))))
12734
12735 (defun gnus-pseudos< (p1 p2)
12736   (let ((c1 (cdr (assq 'action p1)))
12737         (c2 (cdr (assq 'action p2))))
12738     (and c1 c2 (string< c1 c2))))
12739
12740 (defun gnus-request-pseudo-article (props)
12741   (cond ((assq 'execute props)
12742          (gnus-execute-command (cdr (assq 'execute props)))))
12743   (let ((gnus-current-article (gnus-summary-article-number)))
12744     (run-hooks 'gnus-mark-article-hook)))
12745
12746 (defun gnus-execute-command (command &optional automatic)
12747   (save-excursion
12748     (gnus-article-setup-buffer)
12749     (set-buffer gnus-article-buffer)
12750     (let ((command (if automatic command (read-string "Command: " command)))
12751           (buffer-read-only nil))
12752       (erase-buffer)
12753       (insert "$ " command "\n\n")
12754       (if gnus-view-pseudo-asynchronously
12755           (start-process "gnus-execute" nil "sh" "-c" command)
12756         (call-process "sh" nil t nil "-c" command)))))
12757
12758 (defun gnus-copy-file (file &optional to)
12759   "Copy FILE to TO."
12760   (interactive
12761    (list (read-file-name "Copy file: " default-directory)
12762          (read-file-name "Copy file to: " default-directory)))
12763   (gnus-set-global-variables)
12764   (or to (setq to (read-file-name "Copy file to: " default-directory)))
12765   (and (file-directory-p to)
12766        (setq to (concat (file-name-as-directory to)
12767                         (file-name-nondirectory file))))
12768   (copy-file file to))
12769
12770 ;; Summary kill commands.
12771
12772 (defun gnus-summary-edit-global-kill (article)
12773   "Edit the \"global\" kill file."
12774   (interactive (list (gnus-summary-article-number)))
12775   (gnus-set-global-variables)
12776   (gnus-group-edit-global-kill article))
12777
12778 (defun gnus-summary-edit-local-kill ()
12779   "Edit a local kill file applied to the current newsgroup."
12780   (interactive)
12781   (gnus-set-global-variables)
12782   (setq gnus-current-headers (gnus-summary-article-header))
12783   (gnus-set-global-variables)
12784   (gnus-group-edit-local-kill
12785    (gnus-summary-article-number) gnus-newsgroup-name))
12786
12787 \f
12788 ;;;
12789 ;;; Gnus article mode
12790 ;;;
12791
12792 (put 'gnus-article-mode 'mode-class 'special)
12793
12794 (if gnus-article-mode-map
12795     nil
12796   (setq gnus-article-mode-map (make-keymap))
12797   (suppress-keymap gnus-article-mode-map)
12798
12799   (gnus-define-keys
12800    gnus-article-mode-map
12801    " " gnus-article-goto-next-page
12802    "\177" gnus-article-goto-prev-page
12803    "\C-c^" gnus-article-refer-article
12804    "h" gnus-article-show-summary
12805    "s" gnus-article-show-summary
12806    "\C-c\C-m" gnus-article-mail
12807    "?" gnus-article-describe-briefly
12808    gnus-mouse-2 gnus-article-push-button
12809    "\r" gnus-article-press-button
12810    "\t" gnus-article-next-button
12811    "\M-\t" gnus-article-prev-button
12812    "\C-c\C-b" gnus-bug)
12813
12814   (substitute-key-definition
12815    'undefined 'gnus-article-read-summary-keys gnus-article-mode-map))
12816
12817
12818 (defun gnus-article-mode ()
12819   "Major mode for displaying an article.
12820
12821 All normal editing commands are switched off.
12822
12823 The following commands are available:
12824
12825 \\<gnus-article-mode-map>
12826 \\[gnus-article-next-page]\t Scroll the article one page forwards
12827 \\[gnus-article-prev-page]\t Scroll the article one page backwards
12828 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
12829 \\[gnus-article-show-summary]\t Display the summary buffer
12830 \\[gnus-article-mail]\t Send a reply to the address near point
12831 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
12832 \\[gnus-info-find-node]\t Go to the Gnus info node"
12833   (interactive)
12834   (when (and menu-bar-mode
12835              (gnus-visual-p 'article-menu 'menu))
12836     (gnus-article-make-menu-bar))
12837   (kill-all-local-variables)
12838   (gnus-simplify-mode-line)
12839   (setq mode-name "Article")
12840   (setq major-mode 'gnus-article-mode)
12841   (make-local-variable 'minor-mode-alist)
12842   (or (assq 'gnus-show-mime minor-mode-alist)
12843       (setq minor-mode-alist
12844             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
12845   (use-local-map gnus-article-mode-map)
12846   (make-local-variable 'page-delimiter)
12847   (setq page-delimiter gnus-page-delimiter)
12848   (buffer-disable-undo (current-buffer))
12849   (setq buffer-read-only t)             ;Disable modification
12850   (run-hooks 'gnus-article-mode-hook))
12851
12852 (defun gnus-article-setup-buffer ()
12853   "Initialize the article buffer."
12854   (let* ((name (if gnus-single-article-buffer "*Article*"
12855                  (concat "*Article " gnus-newsgroup-name "*")))
12856          (original
12857           (progn (string-match "\\*Article" name)
12858                  (concat " *Original Article"
12859                          (substring name (match-end 0))))))
12860     (setq gnus-article-buffer name)
12861     (setq gnus-original-article-buffer original)
12862     ;; This might be a variable local to the summary buffer.
12863     (unless gnus-single-article-buffer
12864       (save-excursion
12865         (set-buffer gnus-summary-buffer)
12866         (setq gnus-article-buffer name)
12867         (setq gnus-original-article-buffer original))
12868       (make-local-variable 'gnus-summary-buffer))
12869     (if (get-buffer name)
12870         (save-excursion
12871           (set-buffer name)
12872           (buffer-disable-undo (current-buffer))
12873           (setq buffer-read-only t)
12874           (gnus-add-current-to-buffer-list)
12875           (or (eq major-mode 'gnus-article-mode)
12876               (gnus-article-mode))
12877           (current-buffer))
12878       (save-excursion
12879         (set-buffer (get-buffer-create name))
12880         (gnus-add-current-to-buffer-list)
12881         (gnus-article-mode)
12882         (current-buffer)))))
12883
12884 ;; Set article window start at LINE, where LINE is the number of lines
12885 ;; from the head of the article.
12886 (defun gnus-article-set-window-start (&optional line)
12887   (set-window-start
12888    (get-buffer-window gnus-article-buffer)
12889    (save-excursion
12890      (set-buffer gnus-article-buffer)
12891      (goto-char (point-min))
12892      (if (not line)
12893          (point-min)
12894        (gnus-message 6 "Moved to bookmark")
12895        (search-forward "\n\n" nil t)
12896        (forward-line line)
12897        (point)))))
12898
12899 (defun gnus-kill-all-overlays ()
12900   "Delete all overlays in the current buffer."
12901   (when (fboundp 'overlay-lists)
12902     (let* ((overlayss (overlay-lists))
12903            (buffer-read-only nil)
12904            (overlays (nconc (car overlayss) (cdr overlayss))))
12905       (while overlays
12906         (delete-overlay (pop overlays))))))
12907
12908 (defun gnus-request-article-this-buffer (article group)
12909   "Get an article and insert it into this buffer."
12910   (prog1
12911       (save-excursion
12912         (erase-buffer)
12913         (gnus-kill-all-overlays)
12914         (setq group (or group gnus-newsgroup-name))
12915
12916         ;; Open server if it has closed.
12917         (gnus-check-server (gnus-find-method-for-group group))
12918
12919         ;; Using `gnus-request-article' directly will insert the article into
12920         ;; `nntp-server-buffer' - so we'll save some time by not having to
12921         ;; copy it from the server buffer into the article buffer.
12922
12923         ;; We only request an article by message-id when we do not have the
12924         ;; headers for it, so we'll have to get those.
12925         (when (stringp article)
12926           (let ((gnus-override-method gnus-refer-article-method))
12927             (gnus-read-header article)))
12928
12929         ;; If the article number is negative, that means that this article
12930         ;; doesn't belong in this newsgroup (possibly), so we find its
12931         ;; message-id and request it by id instead of number.
12932         (when (numberp article)
12933           (save-excursion
12934             (set-buffer gnus-summary-buffer)
12935             (let ((header (gnus-summary-article-header article)))
12936               (if (< article 0)
12937                   (cond 
12938                    ((memq article gnus-newsgroup-sparse)
12939                     ;; This is a sparse gap article.
12940                     (setq article (mail-header-id header)))
12941                    ((vectorp header)
12942                     ;; It's a real article.
12943                     (setq article (mail-header-id header)))
12944                    (t
12945                     ;; It is an extracted pseudo-article.
12946                     (setq article 'pseudo)
12947                     (gnus-request-pseudo-article header))))
12948                 
12949               (let ((method (gnus-find-method-for-group 
12950                              gnus-newsgroup-name)))
12951                 (if (not (eq (car method) 'nneething))
12952                     ()
12953                   (let ((dir (concat (file-name-as-directory (nth 1 method))
12954                                      (mail-header-subject header))))
12955                     (if (file-directory-p dir)
12956                         (progn
12957                           (setq article 'nneething)
12958                           (gnus-group-enter-directory dir)))))))))
12959
12960         (cond
12961          ;; We first check `gnus-original-article-buffer'.
12962          ((and (equal (car gnus-original-article) group)
12963                (eq (cdr gnus-original-article) article))
12964           (insert-buffer-substring gnus-original-article-buffer)
12965           'article)
12966          ;; Check the backlog.
12967          ((and gnus-keep-backlog
12968                (gnus-backlog-request-article group article (current-buffer)))
12969           'article)
12970          ;; Check the cache.
12971          ((and gnus-use-cache
12972                (numberp article)
12973                (gnus-cache-request-article article group))
12974           'article)
12975          ;; Get the article and put into the article buffer.
12976          ((or (stringp article) (numberp article))
12977           (let ((gnus-override-method
12978                  (and (stringp article) gnus-refer-article-method))
12979                 (buffer-read-only nil))
12980             (erase-buffer)
12981             (gnus-kill-all-overlays)
12982             (if (gnus-request-article article group (current-buffer))
12983                 (progn
12984                   (and gnus-keep-backlog
12985                        (gnus-backlog-enter-article
12986                         group article (current-buffer)))
12987                   'article))))
12988          ;; It was a pseudo.
12989          (t article)))
12990
12991     ;; Take the article from the original article buffer
12992     ;; and place it in the buffer it's supposed to be in.
12993     (setq gnus-original-article (cons group article))
12994     (when (equal (buffer-name (current-buffer))
12995                  (buffer-name (get-buffer gnus-article-buffer)))
12996       (save-excursion
12997         (if (get-buffer gnus-original-article-buffer)
12998             (set-buffer (get-buffer gnus-original-article-buffer))
12999           (set-buffer (get-buffer-create gnus-original-article-buffer))
13000           (buffer-disable-undo (current-buffer))
13001           (setq major-mode 'gnus-original-article-mode)
13002           (setq buffer-read-only t)
13003           (gnus-add-current-to-buffer-list))
13004         (let (buffer-read-only)
13005           (erase-buffer)
13006           (insert-buffer-substring gnus-article-buffer))))
13007     
13008     ;; Update sparse articles.
13009     (when (memq article gnus-newsgroup-sparse)
13010       (gnus-summary-update-article article))))
13011
13012 (defun gnus-read-header (id)
13013   "Read the headers of article ID and enter them into the Gnus system."
13014   (let ((group gnus-newsgroup-name)
13015         (headers gnus-newsgroup-headers)
13016         header where)
13017     ;; First we check to see whether the header in question is already
13018     ;; fetched.
13019     (if (stringp id)
13020         ;; This is a Message-ID.
13021         (setq header (gnus-id-to-header id))
13022       ;; This is an article number.
13023       (setq header (gnus-summary-article-header id)))
13024     (if header
13025         ;; We have found the header.
13026         header
13027       ;; We have to really fetch the header to this article.
13028       (when (setq where
13029                   (if (gnus-check-backend-function 'request-head group)
13030                       (gnus-request-head id group)
13031                     (gnus-request-article id group)))
13032         (save-excursion
13033           (set-buffer nntp-server-buffer)
13034           (and (search-forward "\n\n" nil t)
13035                (delete-region (1- (point)) (point-max)))
13036           (goto-char (point-max))
13037           (insert ".\n")
13038           (goto-char (point-min))
13039           (insert "211 "
13040                   (int-to-string
13041                    (cond
13042                     ((numberp id)
13043                      id)
13044                     ((cdr where)
13045                      (cdr where))
13046                     (t
13047                      gnus-reffed-article-number)))
13048                   " Article retrieved.\n"))
13049         (if (not (setq header (car (gnus-get-newsgroup-headers))))
13050             () ; Malformed head.
13051           (if (and (stringp id)
13052                    (not (string= (gnus-group-real-name group)
13053                                  (car where))))
13054               ;; If we fetched by Message-ID and the article came
13055               ;; from a different group, we fudge some bogus article
13056               ;; numbers for this article.
13057               (mail-header-set-number header gnus-reffed-article-number))
13058           (decf gnus-reffed-article-number)
13059           (push header gnus-newsgroup-headers)
13060           (setq gnus-current-headers header)
13061           (push (mail-header-number header) gnus-newsgroup-limit)
13062           header)))))
13063
13064 (defun gnus-article-prepare (article &optional all-headers header)
13065   "Prepare ARTICLE in article mode buffer.
13066 ARTICLE should either be an article number or a Message-ID.
13067 If ARTICLE is an id, HEADER should be the article headers.
13068 If ALL-HEADERS is non-nil, no headers are hidden."
13069   (save-excursion
13070     ;; Make sure we start in a summary buffer.
13071     (unless (eq major-mode 'gnus-summary-mode)
13072       (set-buffer gnus-summary-buffer))
13073     (setq gnus-summary-buffer (current-buffer))
13074     ;; Make sure the connection to the server is alive.
13075     (unless (gnus-server-opened
13076              (gnus-find-method-for-group gnus-newsgroup-name))
13077       (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
13078       (gnus-request-group gnus-newsgroup-name t))
13079     (let* ((article (if header (mail-header-number header) article))
13080            (summary-buffer (current-buffer))
13081            (internal-hook gnus-article-internal-prepare-hook)
13082            (group gnus-newsgroup-name)
13083            result)
13084       (save-excursion
13085         (gnus-article-setup-buffer)
13086         (set-buffer gnus-article-buffer)
13087         ;; Deactivate active regions.
13088         (when (and (boundp 'transient-mark-mode)
13089                    transient-mark-mode)
13090           (setq mark-active nil))
13091         (if (not (setq result (let ((buffer-read-only nil))
13092                                 (gnus-request-article-this-buffer
13093                                  article group))))
13094             ;; There is no such article.
13095             (save-excursion
13096               (when (and (numberp article)
13097                          (not (memq article gnus-newsgroup-sparse)))
13098                 (setq gnus-article-current
13099                       (cons gnus-newsgroup-name article))
13100                 (set-buffer gnus-summary-buffer)
13101                 (setq gnus-current-article article)
13102                 (gnus-summary-mark-article article gnus-canceled-mark))
13103               (unless (memq article gnus-newsgroup-sparse)
13104                 (gnus-message
13105                  1 "No such article (may have expired or been canceled)")
13106                 (ding)
13107                 nil))
13108           (if (or (eq result 'pseudo) (eq result 'nneething))
13109               (progn
13110                 (save-excursion
13111                   (set-buffer summary-buffer)
13112                   (setq gnus-last-article gnus-current-article
13113                         gnus-newsgroup-history (cons gnus-current-article
13114                                                      gnus-newsgroup-history)
13115                         gnus-current-article 0
13116                         gnus-current-headers nil
13117                         gnus-article-current nil)
13118                   (if (eq result 'nneething)
13119                       (gnus-configure-windows 'summary)
13120                     (gnus-configure-windows 'article))
13121                   (gnus-set-global-variables))
13122                 (gnus-set-mode-line 'article))
13123             ;; The result from the `request' was an actual article -
13124             ;; or at least some text that is now displayed in the
13125             ;; article buffer.
13126             (if (and (numberp article)
13127                      (not (eq article gnus-current-article)))
13128                 ;; Seems like a new article has been selected.
13129                 ;; `gnus-current-article' must be an article number.
13130                 (save-excursion
13131                   (set-buffer summary-buffer)
13132                   (setq gnus-last-article gnus-current-article
13133                         gnus-newsgroup-history (cons gnus-current-article
13134                                                      gnus-newsgroup-history)
13135                         gnus-current-article article
13136                         gnus-current-headers
13137                         (gnus-summary-article-header gnus-current-article)
13138                         gnus-article-current
13139                         (cons gnus-newsgroup-name gnus-current-article))
13140                   (unless (vectorp gnus-current-headers)
13141                     (setq gnus-current-headers nil))
13142                   (gnus-summary-show-thread)
13143                   (run-hooks 'gnus-mark-article-hook)
13144                   (gnus-set-mode-line 'summary)
13145                   (and (gnus-visual-p 'article-highlight 'highlight)
13146                        (run-hooks 'gnus-visual-mark-article-hook))
13147                   ;; Set the global newsgroup variables here.
13148                   ;; Suggested by Jim Sisolak
13149                   ;; <sisolak@trans4.neep.wisc.edu>.
13150                   (gnus-set-global-variables)
13151                   (setq gnus-have-all-headers
13152                         (or all-headers gnus-show-all-headers))
13153                   (and gnus-use-cache
13154                        (vectorp (gnus-summary-article-header article))
13155                        (gnus-cache-possibly-enter-article
13156                         group article
13157                         (gnus-summary-article-header article)
13158                         (memq article gnus-newsgroup-marked)
13159                         (memq article gnus-newsgroup-dormant)
13160                         (memq article gnus-newsgroup-unreads)))))
13161             ;; Hooks for getting information from the article.
13162             ;; This hook must be called before being narrowed.
13163             (let (buffer-read-only)
13164               (run-hooks 'internal-hook)
13165               (run-hooks 'gnus-article-prepare-hook)
13166               ;; Decode MIME message.
13167               (if gnus-show-mime
13168                   (if (or (not gnus-strict-mime)
13169                           (gnus-fetch-field "Mime-Version"))
13170                       (funcall gnus-show-mime-method)
13171                     (funcall gnus-decode-encoded-word-method)))
13172               ;; Perform the article display hooks.
13173               (run-hooks 'gnus-article-display-hook))
13174             ;; Do page break.
13175             (goto-char (point-min))
13176             (and gnus-break-pages (gnus-narrow-to-page))
13177             (gnus-set-mode-line 'article)
13178             (gnus-configure-windows 'article)
13179             (goto-char (point-min))
13180             t))))))
13181
13182 (defun gnus-article-show-all-headers ()
13183   "Show all article headers in article mode buffer."
13184   (save-excursion
13185     (gnus-article-setup-buffer)
13186     (set-buffer gnus-article-buffer)
13187     (let ((buffer-read-only nil))
13188       (remove-text-properties (point-min) (point-max)
13189                               gnus-hidden-properties))))
13190
13191 (defun gnus-article-hide-headers-if-wanted ()
13192   "Hide unwanted headers if `gnus-have-all-headers' is nil.
13193 Provided for backwards compatibility."
13194   (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
13195       gnus-inhibit-hiding
13196       (gnus-article-hide-headers)))
13197
13198 (defun gnus-article-hide-headers (&optional arg delete)
13199   "Toggle whether to hide unwanted headers and possibly sort them as well.
13200 If given a negative prefix, always show; if given a positive prefix,
13201 always hide."
13202   (interactive "P")
13203   (unless (gnus-article-check-hidden-text 'headers arg)
13204     ;; This function might be inhibited.
13205     (unless gnus-inhibit-hiding
13206       (save-excursion
13207         (set-buffer gnus-article-buffer)
13208         (save-restriction
13209           (let ((buffer-read-only nil)
13210                 (ignored (when (not (stringp gnus-visible-headers))
13211                            (cond ((stringp gnus-ignored-headers)
13212                                   gnus-ignored-headers)
13213                                  ((listp gnus-ignored-headers)
13214                                   (mapconcat 'identity gnus-ignored-headers
13215                                              "\\|")))))
13216                 (visible
13217                  (cond ((stringp gnus-visible-headers)
13218                         gnus-visible-headers)
13219                        ((listp gnus-visible-headers)
13220                         (mapconcat 'identity gnus-visible-headers "\\|"))))
13221                 want-list beg want-l)
13222             ;; First we narrow to just the headers.
13223             (widen)
13224             (goto-char (point-min))
13225             ;; Hide any "From " lines at the beginning of (mail) articles.
13226             (while (looking-at "From ")
13227               (forward-line 1))
13228             (unless (bobp)
13229               (add-text-properties
13230                (point-min) (point)
13231                (nconc (list 'gnus-type 'headers) gnus-hidden-properties)))
13232             ;; Then treat the rest of the header lines.
13233             (narrow-to-region
13234              (point)
13235              (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
13236             ;; Then we use the two regular expressions
13237             ;; `gnus-ignored-headers' and `gnus-visible-headers' to
13238             ;; select which header lines is to remain visible in the
13239             ;; article buffer.
13240             (goto-char (point-min))
13241             (while (re-search-forward "^[^ \t]*:" nil t)
13242               (beginning-of-line)
13243               ;; We add the headers we want to keep to a list and delete
13244               ;; them from the buffer.
13245               (if (or (and visible (looking-at visible))
13246                       (and ignored (not (looking-at ignored))))
13247                   (progn
13248                     (push (buffer-substring
13249                            (setq beg (point))
13250                            (progn
13251                              (forward-line 1)
13252                              ;; Be sure to get multi-line headers...
13253                              (re-search-forward "^[^ \t]*:" nil t)
13254                              (beginning-of-line)
13255                              (point)))
13256                           want-list)
13257                     (delete-region beg (point)))
13258                 (forward-line 1)))
13259             ;; Sort the headers that we want to display.
13260             (setq want-list (sort want-list 'gnus-article-header-less))
13261             (goto-char (point-min))
13262             (while want-list
13263               (insert (pop want-list)))
13264             ;; We make the unwanted headers invisible.
13265             (if delete
13266                 (delete-region (point-min) (point-max))
13267               ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
13268               (add-text-properties
13269                (point) (point-max)
13270                (nconc (list 'gnus-type 'headers)
13271                       gnus-hidden-properties)))))))))
13272
13273 (defsubst gnus-article-header-rank (header)
13274   "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
13275   (let ((list gnus-sorted-header-list)
13276         (i 0))
13277     (while list
13278       (when (string-match (car list) header)
13279         (setq list nil))
13280       (setq list (cdr list))
13281       (incf i))
13282     i))
13283
13284 (defun gnus-article-header-less (h1 h2)
13285   "Say whether string H1 is \"less\" than string H2."
13286   (< (gnus-article-header-rank h1)
13287      (gnus-article-header-rank h2)))
13288
13289 (defun gnus-article-hide-boring-headers (&optional arg)
13290   "Toggle hiding of headers that aren't very interesting.
13291 If given a negative prefix, always show; if given a positive prefix,
13292 always hide."
13293   (interactive "P")
13294   (unless (gnus-article-check-hidden-text 'boring-headers arg)
13295     (save-excursion
13296       (set-buffer gnus-article-buffer)
13297       (save-restriction
13298         (let ((buffer-read-only nil)
13299               (list gnus-boring-article-headers)
13300               (inhibit-point-motion-hooks t)
13301               elem)
13302           (nnheader-narrow-to-headers)
13303           (while list
13304             (setq elem (pop list))
13305             (goto-char (point-min))
13306             (cond
13307              ;; Hide empty headers.
13308              ((eq elem 'empty)
13309               (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t)
13310                 (forward-line -1)
13311                 (add-text-properties
13312                  (progn (beginning-of-line) (point))
13313                  (progn 
13314                    (end-of-line)
13315                    (if (re-search-forward "^[^ \t]" nil t)
13316                        (match-beginning 0)
13317                      (point-max)))
13318                  (nconc (list 'gnus-type 'boring-headers)
13319                         gnus-hidden-properties))))
13320              ;; Hide boring Newsgroups header.
13321              ((eq elem 'newsgroups)
13322               (when (equal (mail-fetch-field "newsgroups")
13323                            (gnus-group-real-name gnus-newsgroup-name))
13324                 (gnus-article-hide-header "newsgroups")))
13325              ((eq elem 'followup-to)
13326               (when (equal (mail-fetch-field "followup-to")
13327                            (mail-fetch-field "newsgroups"))
13328                 (gnus-article-hide-header "followup-to")))
13329              ((eq elem 'reply-to)
13330               (let ((from (mail-fetch-field "from"))
13331                     (reply-to (mail-fetch-field "reply-to")))
13332                 (when (and
13333                        from reply-to
13334                        (equal 
13335                         (nth 1 (mail-extract-address-components from))
13336                         (nth 1 (mail-extract-address-components reply-to))))
13337                   (gnus-article-hide-header "reply-to"))))
13338              ((eq elem 'date)
13339               (let ((date (mail-fetch-field "date")))
13340                 (when (and date
13341                            (< (gnus-days-between date (current-time-string))
13342                               4))
13343                   (gnus-article-hide-header "date")))))))))))
13344
13345 (defun gnus-article-hide-header (header)
13346   (save-excursion
13347     (goto-char (point-min))
13348     (when (re-search-forward (concat "^" header ":") nil t)
13349       (add-text-properties
13350        (progn (beginning-of-line) (point))
13351        (progn 
13352          (end-of-line)
13353          (if (re-search-forward "^[^ \t]" nil t)
13354              (match-beginning 0)
13355            (point-max)))
13356        (nconc (list 'gnus-type 'boring-headers)
13357               gnus-hidden-properties)))))
13358
13359 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
13360 (defun gnus-article-treat-overstrike ()
13361   "Translate overstrikes into bold text."
13362   (interactive)
13363   (save-excursion
13364     (set-buffer gnus-article-buffer)
13365     (let ((buffer-read-only nil))
13366       (while (search-forward "\b" nil t)
13367         (let ((next (following-char))
13368               (previous (char-after (- (point) 2))))
13369           (cond ((eq next previous)
13370                  (put-text-property (- (point) 2) (point) 'invisible t)
13371                  (put-text-property (point) (1+ (point)) 'face 'bold))
13372                 ((eq next ?_)
13373                  (put-text-property (1- (point)) (1+ (point)) 'invisible t)
13374                  (put-text-property
13375                   (- (point) 2) (1- (point)) 'face 'underline))
13376                 ((eq previous ?_)
13377                  (put-text-property (- (point) 2) (point) 'invisible t)
13378                  (put-text-property
13379                   (point) (1+ (point))  'face 'underline))))))))
13380
13381 (defun gnus-article-word-wrap ()
13382   "Format too long lines."
13383   (interactive)
13384   (save-excursion
13385     (set-buffer gnus-article-buffer)
13386     (let ((buffer-read-only nil)
13387           p)
13388       (widen)
13389       (goto-char (point-min))
13390       (search-forward "\n\n" nil t)
13391       (end-of-line 1)
13392       (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
13393             (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
13394             (adaptive-fill-mode t))
13395         (while (not (eobp))
13396           (and (>= (current-column) (min fill-column (window-width)))
13397                (/= (preceding-char) ?:)
13398                (fill-paragraph nil))
13399           (end-of-line 2))))))
13400
13401 (defun gnus-article-remove-cr ()
13402   "Remove carriage returns from an article."
13403   (interactive)
13404   (save-excursion
13405     (set-buffer gnus-article-buffer)
13406     (let ((buffer-read-only nil))
13407       (goto-char (point-min))
13408       (while (search-forward "\r" nil t)
13409         (replace-match "" t t)))))
13410
13411 (defun gnus-article-remove-trailing-blank-lines ()
13412   "Remove all trailing blank lines from the article."
13413   (interactive)
13414   (save-excursion
13415     (set-buffer gnus-article-buffer)
13416     (let ((buffer-read-only nil))
13417       (goto-char (point-max))
13418       (delete-region
13419        (point)
13420        (progn
13421          (while (looking-at "^[ \t]*$")
13422            (forward-line -1))
13423          (forward-line 1)
13424          (point))))))
13425
13426 (defun gnus-article-display-x-face (&optional force)
13427   "Look for an X-Face header and display it if present."
13428   (interactive (list 'force))
13429   (save-excursion
13430     (set-buffer gnus-article-buffer)
13431     ;; Delete the old process, if any.
13432     (when (process-status "gnus-x-face")
13433       (delete-process "gnus-x-face"))
13434     (let ((inhibit-point-motion-hooks t)
13435           (case-fold-search nil)
13436           from)
13437       (save-restriction
13438         (nnheader-narrow-to-headers)
13439         (setq from (mail-fetch-field "from"))
13440         (goto-char (point-min))
13441         (when (and gnus-article-x-face-command
13442                    (or force
13443                        ;; Check whether this face is censored.
13444                        (not gnus-article-x-face-too-ugly)
13445                        (and gnus-article-x-face-too-ugly from
13446                             (not (string-match gnus-article-x-face-too-ugly
13447                                                from))))
13448                    ;; Has to be present.
13449                    (re-search-forward "^X-Face: " nil t))
13450           ;; We now have the area of the buffer where the X-Face is stored.
13451           (let ((beg (point))
13452                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
13453             ;; We display the face.
13454             (if (symbolp gnus-article-x-face-command)
13455                 ;; The command is a lisp function, so we call it.
13456                 (if (gnus-functionp gnus-article-x-face-command)
13457                     (funcall gnus-article-x-face-command beg end)
13458                   (error "%s is not a function" gnus-article-x-face-command))
13459               ;; The command is a string, so we interpret the command
13460               ;; as a, well, command, and fork it off.
13461               (let ((process-connection-type nil))
13462                 (process-kill-without-query
13463                  (start-process
13464                   "gnus-x-face" nil "sh" "-c" gnus-article-x-face-command))
13465                 (process-send-region "gnus-x-face" beg end)
13466                 (process-send-eof "gnus-x-face")))))))))
13467
13468 (defun gnus-headers-decode-quoted-printable ()
13469   "Hack to remove QP encoding from headers."
13470   (let ((case-fold-search t)
13471         (inhibit-point-motion-hooks t)
13472         string)
13473     (goto-char (point-min))
13474     (while (re-search-forward "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
13475       (setq string (match-string 1))
13476       (narrow-to-region (match-beginning 0) (match-end 0))
13477       (delete-region (point-min) (point-max))
13478       (insert string)
13479       (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
13480       (subst-char-in-region (point-min) (point-max) ?_ ? )
13481       (widen)
13482       (goto-char (point-min)))))
13483
13484 (defun gnus-article-de-quoted-unreadable (&optional force)
13485   "Do a naive translation of a quoted-printable-encoded article.
13486 This is in no way, shape or form meant as a replacement for real MIME
13487 processing, but is simply a stop-gap measure until MIME support is
13488 written.
13489 If FORCE, decode the article whether it is marked as quoted-printable
13490 or not."
13491   (interactive (list 'force))
13492   (save-excursion
13493     (set-buffer gnus-article-buffer)
13494     (let ((case-fold-search t)
13495           (buffer-read-only nil)
13496           (type (gnus-fetch-field "content-transfer-encoding")))
13497       (when (or force
13498                 (and type (string-match "quoted-printable" type)))
13499         (goto-char (point-min))
13500         (search-forward "\n\n" nil 'move)
13501         (gnus-mime-decode-quoted-printable (point) (point-max))
13502         (gnus-headers-decode-quoted-printable)))))
13503
13504 (defun gnus-mime-decode-quoted-printable (from to)
13505   "Decode Quoted-Printable in the region between FROM and TO."
13506   (goto-char from)
13507   (while (search-forward "=" to t)
13508     (cond ((eq (following-char) ?\n)
13509            (delete-char -1)
13510            (delete-char 1))
13511           ((looking-at "[0-9A-F][0-9A-F]")
13512            (delete-char -1)
13513            (insert (hexl-hex-string-to-integer
13514                     (buffer-substring (point) (+ 2 (point)))))
13515            (delete-char 2))
13516           ((looking-at "=")
13517            (delete-char 1))
13518           ((gnus-message 3 "Malformed MIME quoted-printable message")))))
13519
13520 (defun gnus-article-hide-pgp (&optional arg)
13521   "Toggle hiding of any PGP headers and signatures in the current article.
13522 If given a negative prefix, always show; if given a positive prefix,
13523 always hide."
13524   (interactive "P")
13525   (unless (gnus-article-check-hidden-text 'pgp arg)
13526     (save-excursion
13527       (set-buffer gnus-article-buffer)
13528       (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties))
13529             buffer-read-only beg end)
13530         (widen)
13531         (goto-char (point-min))
13532         ;; Hide the "header".
13533         (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
13534              (add-text-properties (match-beginning 0) (match-end 0) props))
13535         (setq beg (point))
13536         ;; Hide the actual signature.
13537         (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
13538              (setq end (match-beginning 0))
13539              (add-text-properties
13540               (match-beginning 0)
13541               (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
13542                   (match-end 0)
13543                 ;; Perhaps we shouldn't hide to the end of the buffer
13544                 ;; if there is no end to the signature?
13545                 (point-max))
13546               props))
13547         ;; Hide "- " PGP quotation markers.
13548         (when (and beg end)
13549           (narrow-to-region beg end)
13550           (goto-char (point-min))
13551           (while (re-search-forward "^- " nil t)
13552             (add-text-properties (match-beginning 0) (match-end 0) props))
13553           (widen))))))
13554
13555 (defun gnus-article-hide-signature (&optional arg)
13556   "Hide the signature in the current article.
13557 If given a negative prefix, always show; if given a positive prefix,
13558 always hide."
13559   (interactive "P")
13560   (unless (gnus-article-check-hidden-text 'signature arg)
13561     (save-excursion
13562       (set-buffer gnus-article-buffer)
13563       (save-restriction
13564         (let ((buffer-read-only nil))
13565           (when (gnus-narrow-to-signature)
13566             (add-text-properties
13567              (point-min) (point-max)
13568              (nconc (list 'gnus-type 'signature)
13569                     gnus-hidden-properties))))))))
13570
13571 (defvar gnus-signature-limit nil
13572   "Provide a limit to what is considered a signature.
13573 If it is a number, no signature may not be longer (in characters) than
13574 that number.  If it is a function, the function will be called without
13575 any parameters, and if it returns nil, there is no signature in the
13576 buffer.  If it is a string, it will be used as a regexp.  If it
13577 matches, the text in question is not a signature.")
13578
13579 (defun gnus-narrow-to-signature ()
13580   "Narrow to the signature."
13581   (widen)
13582   (goto-char (point-max))
13583   (when (re-search-backward gnus-signature-separator nil t)
13584     (forward-line 1)
13585     (when (or (null gnus-signature-limit)
13586               (and (numberp gnus-signature-limit)
13587                    (< (- (point-max) (point)) gnus-signature-limit))
13588               (and (gnus-functionp gnus-signature-limit)
13589                    (funcall gnus-signature-limit))
13590               (and (stringp gnus-signature-limit)
13591                    (not (re-search-forward gnus-signature-limit nil t))))
13592       (narrow-to-region (point) (point-max))
13593       t)))
13594
13595 (defun gnus-article-check-hidden-text (type arg)
13596   "Return nil if hiding is necessary."
13597   (save-excursion
13598     (set-buffer gnus-article-buffer)
13599     (let ((hide (gnus-article-hidden-text-p type)))
13600       (cond ((or (and (null arg) (eq hide 'hidden))
13601                  (and arg (< 0 (prefix-numeric-value arg))))
13602              (gnus-article-show-hidden-text type))
13603             ((eq hide 'shown)
13604              (gnus-article-show-hidden-text type t))
13605             (t nil)))))
13606
13607 (defun gnus-article-hidden-text-p (type)
13608   "Say whether the current buffer contains hidden text of type TYPE."
13609   (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type))
13610         prop)
13611     (when pos
13612       (if (get-text-property pos 'invisible)
13613           'hidden
13614         'shown))))
13615
13616 (defun gnus-article-hide (&optional arg force)
13617   "Hide all the gruft in the current article.
13618 This means that PGP stuff, signatures, cited text and (some)
13619 headers will be hidden.
13620 If given a prefix, show the hidden text instead."
13621   (interactive (list current-prefix-arg 'force))
13622   (gnus-article-hide-headers arg)
13623   (gnus-article-hide-pgp arg)
13624   (gnus-article-hide-citation-maybe arg force)
13625   (gnus-article-hide-signature arg))
13626
13627 (defun gnus-article-show-hidden-text (type &optional hide)
13628   "Show all hidden text of type TYPE.
13629 If HIDE, hide the text instead."
13630   (save-excursion
13631     (set-buffer gnus-article-buffer)
13632     (let ((buffer-read-only nil)
13633           (inhibit-point-motion-hooks t)
13634           (beg (point)))
13635       (while (gnus-goto-char (text-property-any
13636                               beg (point-max) 'gnus-type type))
13637         (if hide
13638             (add-text-properties (point) (setq beg (1+ (point)))
13639                                  gnus-hidden-properties)
13640           (remove-text-properties (point) (setq beg (1+ (point)))
13641                                   gnus-hidden-properties)))
13642       t)))
13643
13644 (defvar gnus-article-time-units
13645   `((year . ,(* 365.25 24 60 60))
13646     (week . ,(* 7 24 60 60))
13647     (day . ,(* 24 60 60))
13648     (hour . ,(* 60 60))
13649     (minute . 60)
13650     (second . 1))
13651   "Mapping from time units to seconds.")
13652
13653 (defun gnus-article-date-ut (&optional type highlight)
13654   "Convert DATE date to universal time in the current article.
13655 If TYPE is `local', convert to local time; if it is `lapsed', output
13656 how much time has lapsed since DATE."
13657   (interactive (list 'ut t))
13658   (let* ((header (or gnus-current-headers
13659                      (gnus-summary-article-header) ""))
13660          (date (and (vectorp header) (mail-header-date header)))
13661          (date-regexp "^Date: \\|^X-Sent: ")
13662          (now (current-time))
13663          (inhibit-point-motion-hooks t))
13664     (when (and date (not (string= date "")))
13665       (save-excursion
13666         (set-buffer gnus-article-buffer)
13667         (save-restriction
13668           (nnheader-narrow-to-headers)
13669           (let ((buffer-read-only nil))
13670             ;; Delete any old Date headers.
13671             (if (zerop (nnheader-remove-header date-regexp t))
13672                 (beginning-of-line)
13673               (goto-char (point-max)))
13674             (insert
13675              (cond
13676               ;; Convert to the local timezone.  We have to slap a
13677               ;; `condition-case' round the calls to the timezone
13678               ;; functions since they aren't particularly resistant to
13679               ;; buggy dates.
13680               ((eq type 'local)
13681                (concat "Date: " (condition-case ()
13682                                     (timezone-make-date-arpa-standard date)
13683                                   (error date))
13684                        "\n"))
13685               ;; Convert to Universal Time.
13686               ((eq type 'ut)
13687                (concat "Date: "
13688                        (condition-case ()
13689                            (timezone-make-date-arpa-standard date nil "UT")
13690                          (error date))
13691                        "\n"))
13692               ;; Get the original date from the article.
13693               ((eq type 'original)
13694                (concat "Date: " date "\n"))
13695               ;; Do an X-Sent lapsed format.
13696               ((eq type 'lapsed)
13697                ;; If the date is seriously mangled, the timezone
13698                ;; functions are liable to bug out, so we condition-case
13699                ;; the entire thing.
13700                (let* ((real-time
13701                        (condition-case ()
13702                            (gnus-time-minus
13703                             (gnus-encode-date
13704                              (timezone-make-date-arpa-standard
13705                               (current-time-string now)
13706                               (current-time-zone now) "UT"))
13707                             (gnus-encode-date
13708                              (timezone-make-date-arpa-standard
13709                               date nil "UT")))
13710                          (error '(0 0))))
13711                       (real-sec (+ (* (float (car real-time)) 65536)
13712                                    (cadr real-time)))
13713                       (sec (abs real-sec))
13714                       num prev)
13715                  (if (zerop sec)
13716                      "X-Sent: Now\n"
13717                    (concat
13718                     "X-Sent: "
13719                     ;; This is a bit convoluted, but basically we go
13720                     ;; through the time units for years, weeks, etc,
13721                     ;; and divide things to see whether that results
13722                     ;; in positive answers.
13723                     (mapconcat
13724                      (lambda (unit)
13725                        (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
13726                            ;; The (remaining) seconds are too few to
13727                            ;; be divided into this time unit.
13728                            ""
13729                          ;; It's big enough, so we output it.
13730                          (setq sec (- sec (* num (cdr unit))))
13731                          (prog1
13732                              (concat (if prev ", " "") (int-to-string
13733                                                         (floor num))
13734                                      " " (symbol-name (car unit))
13735                                      (if (> num 1) "s" ""))
13736                            (setq prev t))))
13737                      gnus-article-time-units "")
13738                     ;; If dates are odd, then it might appear like the
13739                     ;; article was sent in the future.
13740                     (if (> real-sec 0)
13741                         " ago\n"
13742                       " in the future\n")))))
13743               (t
13744                (error "Unknown conversion type: %s" type)))))
13745           ;; Do highlighting.
13746           (when (and highlight (gnus-visual-p 'article-highlight 'highlight))
13747             (gnus-article-highlight-headers)))))))
13748
13749 (defun gnus-article-date-local (&optional highlight)
13750   "Convert the current article date to the local timezone."
13751   (interactive (list t))
13752   (gnus-article-date-ut 'local highlight))
13753
13754 (defun gnus-article-date-original (&optional highlight)
13755   "Convert the current article date to what it was originally.
13756 This is only useful if you have used some other date conversion
13757 function and want to see what the date was before converting."
13758   (interactive (list t))
13759   (gnus-article-date-ut 'original highlight))
13760
13761 (defun gnus-article-date-lapsed (&optional highlight)
13762   "Convert the current article date to time lapsed since it was sent."
13763   (interactive (list t))
13764   (gnus-article-date-ut 'lapsed highlight))
13765
13766 (defun gnus-article-maybe-highlight ()
13767   "Do some article highlighting if `gnus-visual' is non-nil."
13768   (if (gnus-visual-p 'article-highlight 'highlight)
13769       (gnus-article-highlight-some)))
13770
13771 ;; Article savers.
13772
13773 (defun gnus-output-to-rmail (file-name)
13774   "Append the current article to an Rmail file named FILE-NAME."
13775   (require 'rmail)
13776   ;; Most of these codes are borrowed from rmailout.el.
13777   (setq file-name (expand-file-name file-name))
13778   (setq rmail-default-rmail-file file-name)
13779   (let ((artbuf (current-buffer))
13780         (tmpbuf (get-buffer-create " *Gnus-output*")))
13781     (save-excursion
13782       (or (get-file-buffer file-name)
13783           (file-exists-p file-name)
13784           (if (gnus-yes-or-no-p
13785                (concat "\"" file-name "\" does not exist, create it? "))
13786               (let ((file-buffer (create-file-buffer file-name)))
13787                 (save-excursion
13788                   (set-buffer file-buffer)
13789                   (rmail-insert-rmail-file-header)
13790                   (let ((require-final-newline nil))
13791                     (write-region (point-min) (point-max) file-name t 1)))
13792                 (kill-buffer file-buffer))
13793             (error "Output file does not exist")))
13794       (set-buffer tmpbuf)
13795       (buffer-disable-undo (current-buffer))
13796       (erase-buffer)
13797       (insert-buffer-substring artbuf)
13798       (gnus-convert-article-to-rmail)
13799       ;; Decide whether to append to a file or to an Emacs buffer.
13800       (let ((outbuf (get-file-buffer file-name)))
13801         (if (not outbuf)
13802             (append-to-file (point-min) (point-max) file-name)
13803           ;; File has been visited, in buffer OUTBUF.
13804           (set-buffer outbuf)
13805           (let ((buffer-read-only nil)
13806                 (msg (and (boundp 'rmail-current-message)
13807                           (symbol-value 'rmail-current-message))))
13808             ;; If MSG is non-nil, buffer is in RMAIL mode.
13809             (if msg
13810                 (progn (widen)
13811                        (narrow-to-region (point-max) (point-max))))
13812             (insert-buffer-substring tmpbuf)
13813             (if msg
13814                 (progn
13815                   (goto-char (point-min))
13816                   (widen)
13817                   (search-backward "\^_")
13818                   (narrow-to-region (point) (point-max))
13819                   (goto-char (1+ (point-min)))
13820                   (rmail-count-new-messages t)
13821                   (rmail-show-message msg)))))))
13822     (kill-buffer tmpbuf)))
13823
13824 (defun gnus-output-to-file (file-name)
13825   "Append the current article to a file named FILE-NAME."
13826   (setq file-name (expand-file-name file-name))
13827   (let ((artbuf (current-buffer))
13828         (tmpbuf (get-buffer-create " *Gnus-output*")))
13829     (save-excursion
13830       (set-buffer tmpbuf)
13831       (buffer-disable-undo (current-buffer))
13832       (erase-buffer)
13833       (insert-buffer-substring artbuf)
13834       ;; Append newline at end of the buffer as separator, and then
13835       ;; save it to file.
13836       (goto-char (point-max))
13837       (insert "\n")
13838       (append-to-file (point-min) (point-max) file-name))
13839     (kill-buffer tmpbuf)))
13840
13841 (defun gnus-convert-article-to-rmail ()
13842   "Convert article in current buffer to Rmail message format."
13843   (let ((buffer-read-only nil))
13844     ;; Convert article directly into Babyl format.
13845     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
13846     (goto-char (point-min))
13847     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
13848     (while (search-forward "\n\^_" nil t) ;single char
13849       (replace-match "\n^_" t t))       ;2 chars: "^" and "_"
13850     (goto-char (point-max))
13851     (insert "\^_")))
13852
13853 (defun gnus-narrow-to-page (&optional arg)
13854   "Narrow the article buffer to a page.
13855 If given a numerical ARG, move forward ARG pages."
13856   (interactive "P")
13857   (setq arg (if arg (prefix-numeric-value arg) 0))
13858   (save-excursion
13859     (set-buffer gnus-article-buffer)
13860     (goto-char (point-min))
13861     (widen)
13862     (when (gnus-visual-p 'page-marker)
13863       (let ((buffer-read-only nil))
13864         (gnus-remove-text-with-property 'gnus-prev)
13865         (gnus-remove-text-with-property 'gnus-next)))
13866     (when
13867         (cond ((< arg 0)
13868                (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
13869               ((> arg 0)
13870                (re-search-forward page-delimiter nil 'move arg)))
13871       (goto-char (match-end 0)))
13872     (narrow-to-region
13873      (point)
13874      (if (re-search-forward page-delimiter nil 'move)
13875          (match-beginning 0)
13876        (point)))
13877     (when (and (gnus-visual-p 'page-marker)
13878                (not (= (point-min) 1)))
13879       (save-excursion
13880         (goto-char (point-min))
13881         (gnus-insert-prev-page-button)))
13882     (when (and (gnus-visual-p 'page-marker)
13883                (not (= (1- (point-max)) (buffer-size))))
13884       (save-excursion
13885         (goto-char (point-max))
13886         (gnus-insert-next-page-button)))))
13887
13888
13889 ;; Article mode commands
13890
13891 (defun gnus-article-goto-next-page ()
13892   "Show the next page of the article."
13893   (interactive)
13894   (when (gnus-article-next-page)
13895     (gnus-article-read-summary-keys nil ?n)))
13896
13897 (defun gnus-article-goto-prev-page ()
13898   "Show the next page of the article."
13899   (interactive)
13900   (if (bobp) (gnus-article-read-summary-keys nil ?n)
13901     (gnus-article-prev-page nil)))
13902
13903 (defun gnus-article-next-page (&optional lines)
13904   "Show the next page of the current article.
13905 If end of article, return non-nil.  Otherwise return nil.
13906 Argument LINES specifies lines to be scrolled up."
13907   (interactive "p")
13908   (move-to-window-line -1)
13909   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
13910   (if (save-excursion
13911         (end-of-line)
13912         (and (pos-visible-in-window-p)  ;Not continuation line.
13913              (eobp)))
13914       ;; Nothing in this page.
13915       (if (or (not gnus-break-pages)
13916               (save-excursion
13917                 (save-restriction
13918                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
13919           t                             ;Nothing more.
13920         (gnus-narrow-to-page 1)         ;Go to next page.
13921         nil)
13922     ;; More in this page.
13923     (condition-case ()
13924         (scroll-up lines)
13925       (end-of-buffer
13926        ;; Long lines may cause an end-of-buffer error.
13927        (goto-char (point-max))))
13928     nil))
13929
13930 (defun gnus-article-prev-page (&optional lines)
13931   "Show previous page of current article.
13932 Argument LINES specifies lines to be scrolled down."
13933   (interactive "p")
13934   (move-to-window-line 0)
13935   (if (and gnus-break-pages
13936            (bobp)
13937            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
13938       (progn
13939         (gnus-narrow-to-page -1)        ;Go to previous page.
13940         (goto-char (point-max))
13941         (recenter -1))
13942     (condition-case ()
13943         (scroll-down lines)
13944       (error nil))))
13945
13946 (defun gnus-article-refer-article ()
13947   "Read article specified by message-id around point."
13948   (interactive)
13949   (let ((point (point)))
13950     (search-forward ">" nil t)          ;Move point to end of "<....>".
13951     (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
13952         (let ((message-id (match-string 1)))
13953           (goto-char point)
13954           (set-buffer gnus-summary-buffer)
13955           (gnus-summary-refer-article message-id))
13956       (goto-char (point))
13957       (error "No references around point"))))
13958
13959 (defun gnus-article-show-summary ()
13960   "Reconfigure windows to show summary buffer."
13961   (interactive)
13962   (gnus-configure-windows 'article)
13963   (gnus-summary-goto-subject gnus-current-article))
13964
13965 (defun gnus-article-describe-briefly ()
13966   "Describe article mode commands briefly."
13967   (interactive)
13968   (gnus-message 6
13969                 (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")))
13970
13971 (defun gnus-article-summary-command ()
13972   "Execute the last keystroke in the summary buffer."
13973   (interactive)
13974   (let ((obuf (current-buffer))
13975         (owin (current-window-configuration))
13976         func)
13977     (switch-to-buffer gnus-summary-buffer 'norecord)
13978     (setq func (lookup-key (current-local-map) (this-command-keys)))
13979     (call-interactively func)
13980     (set-buffer obuf)
13981     (set-window-configuration owin)
13982     (set-window-point (get-buffer-window (current-buffer)) (point))))
13983
13984 (defun gnus-article-summary-command-nosave ()
13985   "Execute the last keystroke in the summary buffer."
13986   (interactive)
13987   (let (func)
13988     (pop-to-buffer gnus-summary-buffer 'norecord)
13989     (setq func (lookup-key (current-local-map) (this-command-keys)))
13990     (call-interactively func)))
13991
13992 (defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
13993   "Read a summary buffer key sequence and execute it from the article buffer."
13994   (interactive "P")
13995   (let ((nosaves
13996          '("q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F"
13997            "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
13998            "=" "^" "\M-^"))
13999         keys)
14000     (save-excursion
14001       (set-buffer gnus-summary-buffer)
14002       (push (or key last-command-event) unread-command-events)
14003       (setq keys (read-key-sequence nil)))
14004     (message "")
14005
14006     (if (member keys nosaves)
14007         (let (func)
14008           (pop-to-buffer gnus-summary-buffer 'norecord)
14009           (if (setq func (lookup-key (current-local-map) keys))
14010               (call-interactively func)
14011             (ding)))
14012       (let ((obuf (current-buffer))
14013             (owin (current-window-configuration))
14014             (opoint (point))
14015             func in-buffer)
14016         (if not-restore-window
14017             (pop-to-buffer gnus-summary-buffer 'norecord)
14018           (switch-to-buffer gnus-summary-buffer 'norecord))
14019         (setq in-buffer (current-buffer))
14020         (if (setq func (lookup-key (current-local-map) keys))
14021             (call-interactively func)
14022           (ding))
14023         (when (eq in-buffer (current-buffer))
14024           (set-buffer obuf)
14025           (unless not-restore-window
14026             (set-window-configuration owin))
14027           (set-window-point (get-buffer-window (current-buffer)) opoint))))))
14028
14029 \f
14030 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
14031
14032 ;;;###autoload
14033 (defalias 'gnus-batch-kill 'gnus-batch-score)
14034 ;;;###autoload
14035 (defun gnus-batch-score ()
14036   "Run batched scoring.
14037 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
14038 Newsgroups is a list of strings in Bnews format.  If you want to score
14039 the comp hierarchy, you'd say \"comp.all\".  If you would not like to
14040 score the alt hierarchy, you'd say \"!alt.all\"."
14041   (interactive)
14042   (let* ((yes-and-no
14043           (gnus-newsrc-parse-options
14044            (apply (function concat)
14045                   (mapcar (lambda (g) (concat g " "))
14046                           command-line-args-left))))
14047          (gnus-expert-user t)
14048          (nnmail-spool-file nil)
14049          (gnus-use-dribble-file nil)
14050          (yes (car yes-and-no))
14051          (no (cdr yes-and-no))
14052          group newsrc entry
14053          ;; Disable verbose message.
14054          gnus-novice-user gnus-large-newsgroup)
14055     ;; Eat all arguments.
14056     (setq command-line-args-left nil)
14057     ;; Start Gnus.
14058     (gnus)
14059     ;; Apply kills to specified newsgroups in command line arguments.
14060     (setq newsrc (cdr gnus-newsrc-alist))
14061     (while newsrc
14062       (setq group (car (car newsrc)))
14063       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
14064       (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
14065                (and (car entry)
14066                     (or (eq (car entry) t)
14067                         (not (zerop (car entry)))))
14068                (if yes (string-match yes group) t)
14069                (or (null no) (not (string-match no group))))
14070           (progn
14071             (gnus-summary-read-group group nil t nil t)
14072             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
14073                  (gnus-summary-exit))))
14074       (setq newsrc (cdr newsrc)))
14075     ;; Exit Emacs.
14076     (switch-to-buffer gnus-group-buffer)
14077     (gnus-group-save-newsrc)))
14078
14079 (defun gnus-apply-kill-file ()
14080   "Apply a kill file to the current newsgroup.
14081 Returns the number of articles marked as read."
14082   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
14083           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
14084       (gnus-apply-kill-file-internal)
14085     0))
14086
14087 (defun gnus-kill-save-kill-buffer ()
14088   (save-excursion
14089     (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
14090       (if (get-file-buffer file)
14091           (progn
14092             (set-buffer (get-file-buffer file))
14093             (and (buffer-modified-p) (save-buffer))
14094             (kill-buffer (current-buffer)))))))
14095
14096 (defvar gnus-kill-file-name "KILL"
14097   "Suffix of the kill files.")
14098
14099 (defun gnus-newsgroup-kill-file (newsgroup)
14100   "Return the name of a kill file name for NEWSGROUP.
14101 If NEWSGROUP is nil, return the global kill file name instead."
14102   (cond ((or (null newsgroup)
14103              (string-equal newsgroup ""))
14104          ;; The global KILL file is placed at top of the directory.
14105          (expand-file-name gnus-kill-file-name
14106                            (or gnus-kill-files-directory "~/News")))
14107         ((gnus-use-long-file-name 'not-kill)
14108          ;; Append ".KILL" to newsgroup name.
14109          (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
14110                                    "." gnus-kill-file-name)
14111                            (or gnus-kill-files-directory "~/News")))
14112         (t
14113          ;; Place "KILL" under the hierarchical directory.
14114          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
14115                                    "/" gnus-kill-file-name)
14116                            (or gnus-kill-files-directory "~/News")))))
14117
14118 \f
14119 ;;;
14120 ;;; Dribble file
14121 ;;;
14122
14123 (defvar gnus-dribble-ignore nil)
14124 (defvar gnus-dribble-eval-file nil)
14125
14126 (defun gnus-dribble-file-name ()
14127   "Return the dribble file for the current .newsrc."
14128   (concat
14129    (if gnus-dribble-directory
14130        (concat (file-name-as-directory gnus-dribble-directory)
14131                (file-name-nondirectory gnus-current-startup-file))
14132      gnus-current-startup-file)
14133    "-dribble"))
14134
14135 (defun gnus-dribble-enter (string)
14136   "Enter STRING into the dribble buffer."
14137   (if (and (not gnus-dribble-ignore)
14138            gnus-dribble-buffer
14139            (buffer-name gnus-dribble-buffer))
14140       (let ((obuf (current-buffer)))
14141         (set-buffer gnus-dribble-buffer)
14142         (insert string "\n")
14143         (set-window-point (get-buffer-window (current-buffer)) (point-max))
14144         (set-buffer obuf))))
14145
14146 (defun gnus-dribble-read-file ()
14147   "Read the dribble file from disk."
14148   (let ((dribble-file (gnus-dribble-file-name)))
14149     (save-excursion
14150       (set-buffer (setq gnus-dribble-buffer
14151                         (get-buffer-create
14152                          (file-name-nondirectory dribble-file))))
14153       (gnus-add-current-to-buffer-list)
14154       (erase-buffer)
14155       (setq buffer-file-name dribble-file)
14156       (auto-save-mode t)
14157       (buffer-disable-undo (current-buffer))
14158       (bury-buffer (current-buffer))
14159       (set-buffer-modified-p nil)
14160       (let ((auto (make-auto-save-file-name))
14161             (gnus-dribble-ignore t))
14162         (when (or (file-exists-p auto) (file-exists-p dribble-file))
14163           ;; Load whichever file is newest -- the auto save file
14164           ;; or the "real" file.
14165           (if (file-newer-than-file-p auto dribble-file)
14166               (insert-file-contents auto)
14167             (insert-file-contents dribble-file))
14168           (unless (zerop (buffer-size))
14169             (set-buffer-modified-p t))
14170           ;; Set the file modes to reflect the .newsrc file modes.
14171           (save-buffer)
14172           (when (file-exists-p gnus-current-startup-file)
14173             (set-file-modes dribble-file
14174                             (file-modes gnus-current-startup-file)))
14175           ;; Possibly eval the file later.
14176           (when (gnus-y-or-n-p
14177                  "Auto-save file exists.  Do you want to read it? ")
14178             (setq gnus-dribble-eval-file t)))))))
14179
14180 (defun gnus-dribble-eval-file ()
14181   (if (not gnus-dribble-eval-file)
14182       ()
14183     (setq gnus-dribble-eval-file nil)
14184     (save-excursion
14185       (let ((gnus-dribble-ignore t))
14186         (set-buffer gnus-dribble-buffer)
14187         (eval-buffer (current-buffer))))))
14188
14189 (defun gnus-dribble-delete-file ()
14190   (if (file-exists-p (gnus-dribble-file-name))
14191       (delete-file (gnus-dribble-file-name)))
14192   (if gnus-dribble-buffer
14193       (save-excursion
14194         (set-buffer gnus-dribble-buffer)
14195         (let ((auto (make-auto-save-file-name)))
14196           (if (file-exists-p auto)
14197               (delete-file auto))
14198           (erase-buffer)
14199           (set-buffer-modified-p nil)))))
14200
14201 (defun gnus-dribble-save ()
14202   (if (and gnus-dribble-buffer
14203            (buffer-name gnus-dribble-buffer))
14204       (save-excursion
14205         (set-buffer gnus-dribble-buffer)
14206         (save-buffer))))
14207
14208 (defun gnus-dribble-clear ()
14209   (save-excursion
14210     (if (gnus-buffer-exists-p gnus-dribble-buffer)
14211         (progn
14212           (set-buffer gnus-dribble-buffer)
14213           (erase-buffer)
14214           (set-buffer-modified-p nil)
14215           (setq buffer-saved-size (buffer-size))))))
14216
14217 ;;;
14218 ;;; Server Communication
14219 ;;;
14220
14221 (defun gnus-start-news-server (&optional confirm)
14222   "Open a method for getting news.
14223 If CONFIRM is non-nil, the user will be asked for an NNTP server."
14224   (let (how)
14225     (if gnus-current-select-method
14226         ;; Stream is already opened.
14227         nil
14228       ;; Open NNTP server.
14229       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
14230       (if confirm
14231           (progn
14232             ;; Read server name with completion.
14233             (setq gnus-nntp-server
14234                   (completing-read "NNTP server: "
14235                                    (mapcar (lambda (server) (list server))
14236                                            (cons (list gnus-nntp-server)
14237                                                  gnus-secondary-servers))
14238                                    nil nil gnus-nntp-server))))
14239
14240       (if (and gnus-nntp-server
14241                (stringp gnus-nntp-server)
14242                (not (string= gnus-nntp-server "")))
14243           (setq gnus-select-method
14244                 (cond ((or (string= gnus-nntp-server "")
14245                            (string= gnus-nntp-server "::"))
14246                        (list 'nnspool (system-name)))
14247                       ((string-match "^:" gnus-nntp-server)
14248                        (list 'nnmh gnus-nntp-server
14249                              (list 'nnmh-directory
14250                                    (file-name-as-directory
14251                                     (expand-file-name
14252                                      (concat "~/" (substring
14253                                                    gnus-nntp-server 1)))))
14254                              (list 'nnmh-get-new-mail nil)))
14255                       (t
14256                        (list 'nntp gnus-nntp-server)))))
14257
14258       (setq how (car gnus-select-method))
14259       (cond ((eq how 'nnspool)
14260              (require 'nnspool)
14261              (gnus-message 5 "Looking up local news spool..."))
14262             ((eq how 'nnmh)
14263              (require 'nnmh)
14264              (gnus-message 5 "Looking up mh spool..."))
14265             (t
14266              (require 'nntp)))
14267       (setq gnus-current-select-method gnus-select-method)
14268       (run-hooks 'gnus-open-server-hook)
14269       (or
14270        ;; gnus-open-server-hook might have opened it
14271        (gnus-server-opened gnus-select-method)
14272        (gnus-open-server gnus-select-method)
14273        (gnus-y-or-n-p
14274         (format
14275          "%s (%s) open error: '%s'.     Continue? "
14276          (car gnus-select-method) (cadr gnus-select-method)
14277          (gnus-status-message gnus-select-method)))
14278        (progn
14279          (gnus-message 1 "Couldn't open server on %s"
14280                        (nth 1 gnus-select-method))
14281          (ding)
14282          nil)))))
14283
14284 (defun gnus-check-group (group)
14285   "Try to make sure that the server where GROUP exists is alive."
14286   (let ((method (gnus-find-method-for-group group)))
14287     (or (gnus-server-opened method)
14288         (gnus-open-server method))))
14289
14290 (defun gnus-check-server (&optional method)
14291   "Check whether the connection to METHOD is down.
14292 If METHOD is nil, use `gnus-select-method'.
14293 If it is down, start it up (again)."
14294   (let ((method (or method gnus-select-method)))
14295     ;; Transform virtual server names into select methods.
14296     (when (stringp method)
14297       (setq method (gnus-server-to-method method)))
14298     (if (gnus-server-opened method)
14299         ;; The stream is already opened.
14300         t
14301       ;; Open the server.
14302       (gnus-message 5 "Opening %s server on %s..." (car method) (nth 1 method))
14303       (run-hooks 'gnus-open-server-hook)
14304       (prog1
14305           (gnus-open-server method)
14306         (message "")))))
14307
14308 (defun gnus-get-function (method function)
14309   "Return a function symbol based on METHOD and FUNCTION."
14310   ;; Translate server names into methods.
14311   (unless method
14312     (error "Attempted use of a nil select method"))
14313   (when (stringp method)
14314     (setq method (gnus-server-to-method method)))
14315   (let ((func (intern (format "%s-%s" (car method) function))))
14316     ;; If the functions isn't bound, we require the backend in
14317     ;; question.
14318     (unless (fboundp func)
14319       (require (car method))
14320       (unless (fboundp func)
14321         ;; This backend doesn't implement this function.
14322         (error "No such function: %s" func)))
14323     func))
14324
14325 ;;; Interface functions to the backends.
14326
14327 (defun gnus-open-server (method)
14328   "Open a connection to METHOD."
14329   (let ((elem (assoc method gnus-opened-servers)))
14330     ;; If this method was previously denied, we just return nil.
14331     (if (eq (nth 1 elem) 'denied)
14332         (progn
14333           (gnus-message 1 "Denied server")
14334           nil)
14335       ;; Open the server.
14336       (let ((result
14337              (funcall (gnus-get-function method 'open-server)
14338                       (nth 1 method) (nthcdr 2 method))))
14339         ;; If this hasn't been opened before, we add it to the list.
14340         (unless elem
14341           (setq elem (list method nil)
14342                 gnus-opened-servers (cons elem gnus-opened-servers)))
14343         ;; Set the status of this server.
14344         (setcar (cdr elem) (if result 'ok 'denied))
14345         ;; Return the result from the "open" call.
14346         result))))
14347
14348 (defun gnus-close-server (method)
14349   "Close the connection to METHOD."
14350   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
14351
14352 (defun gnus-request-list (method)
14353   "Request the active file from METHOD."
14354   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
14355
14356 (defun gnus-request-list-newsgroups (method)
14357   "Request the newsgroups file from METHOD."
14358   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
14359
14360 (defun gnus-request-newgroups (date method)
14361   "Request all new groups since DATE from METHOD."
14362   (funcall (gnus-get-function method 'request-newgroups)
14363            date (nth 1 method)))
14364
14365 (defun gnus-server-opened (method)
14366   "Check whether a connection to METHOD has been opened."
14367   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
14368
14369 (defun gnus-status-message (method)
14370   "Return the status message from METHOD.
14371 If METHOD is a string, it is interpreted as a group name.   The method
14372 this group uses will be queried."
14373   (let ((method (if (stringp method) (gnus-find-method-for-group method)
14374                   method)))
14375     (funcall (gnus-get-function method 'status-message) (nth 1 method))))
14376
14377 (defun gnus-request-group (group &optional dont-check method)
14378   "Request GROUP.  If DONT-CHECK, no information is required."
14379   (let ((method (or method (gnus-find-method-for-group group))))
14380     (funcall (gnus-get-function method 'request-group)
14381              (gnus-group-real-name group) (nth 1 method) dont-check)))
14382
14383 (defun gnus-request-asynchronous (group &optional articles)
14384   "Request that GROUP behave asynchronously.
14385 ARTICLES is the `data' of the group."
14386   (let ((method (gnus-find-method-for-group group)))
14387     (funcall (gnus-get-function method 'request-asynchronous)
14388              (gnus-group-real-name group) (nth 1 method) articles)))
14389
14390 (defun gnus-list-active-group (group)
14391   "Request active information on GROUP."
14392   (let ((method (gnus-find-method-for-group group))
14393         (func 'list-active-group))
14394     (when (gnus-check-backend-function func group)
14395       (funcall (gnus-get-function method func)
14396                (gnus-group-real-name group) (nth 1 method)))))
14397
14398 (defun gnus-request-group-description (group)
14399   "Request a description of GROUP."
14400   (let ((method (gnus-find-method-for-group group))
14401         (func 'request-group-description))
14402     (when (gnus-check-backend-function func group)
14403       (funcall (gnus-get-function method func)
14404                (gnus-group-real-name group) (nth 1 method)))))
14405
14406 (defun gnus-close-group (group)
14407   "Request the GROUP be closed."
14408   (let ((method (gnus-find-method-for-group group)))
14409     (funcall (gnus-get-function method 'close-group)
14410              (gnus-group-real-name group) (nth 1 method))))
14411
14412 (defun gnus-retrieve-headers (articles group &optional fetch-old)
14413   "Request headers for ARTICLES in GROUP.
14414 If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
14415   (let ((method (gnus-find-method-for-group group)))
14416     (if (and gnus-use-cache (numberp (car articles)))
14417         (gnus-cache-retrieve-headers articles group fetch-old)
14418       (funcall (gnus-get-function method 'retrieve-headers)
14419                articles (gnus-group-real-name group) (nth 1 method)
14420                fetch-old))))
14421
14422 (defun gnus-retrieve-groups (groups method)
14423   "Request active information on GROUPS from METHOD."
14424   (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
14425
14426 (defun gnus-request-type (group &optional article)
14427   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
14428   (let ((method (gnus-find-method-for-group group)))
14429     (if (not (gnus-check-backend-function 'request-type (car method)))
14430         'unknown
14431       (funcall (gnus-get-function method 'request-type)
14432                (gnus-group-real-name group) article))))
14433
14434 (defun gnus-request-update-mark (group article mark)
14435   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
14436   (let ((method (gnus-find-method-for-group group)))
14437     (if (not (gnus-check-backend-function 'request-update-mark (car method)))
14438         mark
14439       (funcall (gnus-get-function method 'request-update-mark)
14440                (gnus-group-real-name group) article mark))))
14441
14442 (defun gnus-request-article (article group &optional buffer)
14443   "Request the ARTICLE in GROUP.
14444 ARTICLE can either be an article number or an article Message-ID.
14445 If BUFFER, insert the article in that group."
14446   (let ((method (gnus-find-method-for-group group)))
14447     (funcall (gnus-get-function method 'request-article)
14448              article (gnus-group-real-name group) (nth 1 method) buffer)))
14449
14450 (defun gnus-request-head (article group)
14451   "Request the head of ARTICLE in GROUP."
14452   (let ((method (gnus-find-method-for-group group)))
14453     (funcall (gnus-get-function method 'request-head)
14454              article (gnus-group-real-name group) (nth 1 method))))
14455
14456 (defun gnus-request-body (article group)
14457   "Request the body of ARTICLE in GROUP."
14458   (let ((method (gnus-find-method-for-group group)))
14459     (funcall (gnus-get-function method 'request-body)
14460              article (gnus-group-real-name group) (nth 1 method))))
14461
14462 (defun gnus-request-post (method)
14463   "Post the current buffer using METHOD."
14464   (funcall (gnus-get-function method 'request-post) (nth 1 method)))
14465
14466 (defun gnus-request-scan (group method)
14467   "Request a SCAN being performed in GROUP from METHOD.
14468 If GROUP is nil, all groups on METHOD are scanned."
14469   (let ((method (if group (gnus-find-method-for-group group) method)))
14470     (funcall (gnus-get-function method 'request-scan)
14471              (and group (gnus-group-real-name group)) (nth 1 method))))
14472
14473 (defsubst gnus-request-update-info (info method)
14474   "Request that METHOD update INFO."
14475   (when (gnus-check-backend-function 'request-update-info (car method))
14476     (funcall (gnus-get-function method 'request-update-info)
14477              (gnus-group-real-name (gnus-info-group info))
14478              info (nth 1 method))))
14479
14480 (defun gnus-request-expire-articles (articles group &optional force)
14481   (let ((method (gnus-find-method-for-group group)))
14482     (funcall (gnus-get-function method 'request-expire-articles)
14483              articles (gnus-group-real-name group) (nth 1 method)
14484              force)))
14485
14486 (defun gnus-request-move-article
14487   (article group server accept-function &optional last)
14488   (let ((method (gnus-find-method-for-group group)))
14489     (funcall (gnus-get-function method 'request-move-article)
14490              article (gnus-group-real-name group)
14491              (nth 1 method) accept-function last)))
14492
14493 (defun gnus-request-accept-article (group &optional last method)
14494   ;; Make sure there's a newline at the end of the article.
14495   (goto-char (point-max))
14496   (unless (bolp)
14497     (insert "\n"))
14498   (let ((func (if (symbolp group) group
14499                 (car (or method (gnus-find-method-for-group group))))))
14500     (funcall (intern (format "%s-request-accept-article" func))
14501              (if (stringp group) (gnus-group-real-name group) group)
14502              last)))
14503
14504 (defun gnus-request-replace-article (article group buffer)
14505   (let ((func (car (gnus-find-method-for-group group))))
14506     (funcall (intern (format "%s-request-replace-article" func))
14507              article (gnus-group-real-name group) buffer)))
14508
14509 (defun gnus-request-associate-buffer (group)
14510   (let ((method (gnus-find-method-for-group group)))
14511     (funcall (gnus-get-function method 'request-associate-buffer)
14512              (gnus-group-real-name group))))
14513
14514 (defun gnus-request-restore-buffer (article group)
14515   "Request a new buffer restored to the state of ARTICLE."
14516   (let ((method (gnus-find-method-for-group group)))
14517     (funcall (gnus-get-function method 'request-restore-buffer)
14518              article (gnus-group-real-name group) (nth 1 method))))
14519
14520 (defun gnus-request-create-group (group &optional method)
14521   (let ((method (or method (gnus-find-method-for-group group))))
14522     (funcall (gnus-get-function method 'request-create-group)
14523              (gnus-group-real-name group) (nth 1 method))))
14524
14525 (defun gnus-request-delete-group (group &optional force)
14526   (let ((method (gnus-find-method-for-group group)))
14527     (funcall (gnus-get-function method 'request-delete-group)
14528              (gnus-group-real-name group) force (nth 1 method))))
14529
14530 (defun gnus-request-rename-group (group new-name)
14531   (let ((method (gnus-find-method-for-group group)))
14532     (funcall (gnus-get-function method 'request-rename-group)
14533              (gnus-group-real-name group)
14534              (gnus-group-real-name new-name) (nth 1 method))))
14535
14536 (defun gnus-member-of-valid (symbol group)
14537   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
14538   (memq symbol (assoc
14539                 (symbol-name (car (gnus-find-method-for-group group)))
14540                 gnus-valid-select-methods)))
14541
14542 (defun gnus-method-option-p (method option)
14543   "Return non-nil if select METHOD has OPTION as a parameter."
14544   (memq option (assoc (format "%s" (car method))
14545                       gnus-valid-select-methods)))
14546
14547 (defun gnus-server-extend-method (group method)
14548   ;; This function "extends" a virtual server.  If the server is
14549   ;; "hello", and the select method is ("hello" (my-var "something"))
14550   ;; in the group "alt.alt", this will result in a new virtual server
14551   ;; called "hello+alt.alt".
14552   (let ((entry
14553          (gnus-copy-sequence
14554           (if (equal (car method) "native") gnus-select-method
14555             (cdr (assoc (car method) gnus-server-alist))))))
14556     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
14557     (nconc entry (cdr method))))
14558
14559 (defun gnus-find-method-for-group (group &optional info)
14560   "Find the select method that GROUP uses."
14561   (or gnus-override-method
14562       (and (not group)
14563            gnus-select-method)
14564       (let ((info (or info (gnus-get-info group)))
14565             method)
14566         (if (or (not info)
14567                 (not (setq method (gnus-info-method info))))
14568             (setq method gnus-select-method)
14569           (setq method
14570                 (cond ((stringp method)
14571                        (gnus-server-to-method method))
14572                       ((stringp (car method))
14573                        (gnus-server-extend-method group method))
14574                       (t
14575                        method))))
14576         (gnus-server-add-address method))))
14577
14578 (defun gnus-check-backend-function (func group)
14579   "Check whether GROUP supports function FUNC."
14580   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
14581                   group)))
14582     (fboundp (intern (format "%s-%s" method func)))))
14583
14584 (defun gnus-methods-using (feature)
14585   "Find all methods that have FEATURE."
14586   (let ((valids gnus-valid-select-methods)
14587         outs)
14588     (while valids
14589       (if (memq feature (car valids))
14590           (setq outs (cons (car valids) outs)))
14591       (setq valids (cdr valids)))
14592     outs))
14593
14594 ;;;
14595 ;;; Active & Newsrc File Handling
14596 ;;;
14597
14598 (defun gnus-setup-news (&optional rawfile level)
14599   "Setup news information.
14600 If RAWFILE is non-nil, the .newsrc file will also be read.
14601 If LEVEL is non-nil, the news will be set up at level LEVEL."
14602   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
14603     ;; Clear some variables to re-initialize news information.
14604     (if init (setq gnus-newsrc-alist nil
14605                    gnus-active-hashtb nil))
14606
14607     ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
14608     (if init (gnus-read-newsrc-file rawfile))
14609
14610     ;; If we don't read the complete active file, we fill in the
14611     ;; hashtb here.
14612     (if (or (null gnus-read-active-file)
14613             (eq gnus-read-active-file 'some))
14614         (gnus-update-active-hashtb-from-killed))
14615
14616     ;; Read the active file and create `gnus-active-hashtb'.
14617     ;; If `gnus-read-active-file' is nil, then we just create an empty
14618     ;; hash table.  The partial filling out of the hash table will be
14619     ;; done in `gnus-get-unread-articles'.
14620     (and gnus-read-active-file
14621          (not level)
14622          (gnus-read-active-file))
14623
14624     (or gnus-active-hashtb
14625         (setq gnus-active-hashtb (make-vector 4095 0)))
14626
14627     ;; Initialize the cache.
14628     (when gnus-use-cache
14629       (gnus-cache-open))
14630
14631     ;; Possibly eval the dribble file.
14632     (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
14633
14634     (gnus-update-format-specifications)
14635
14636     ;; Find new newsgroups and treat them.
14637     (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level)
14638              (gnus-check-server gnus-select-method))
14639         (gnus-find-new-newsgroups))
14640
14641     ;; Find the number of unread articles in each non-dead group.
14642     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
14643       (gnus-get-unread-articles level))
14644
14645     (if (and init gnus-check-bogus-newsgroups
14646              gnus-read-active-file (not level)
14647              (gnus-server-opened gnus-select-method))
14648         (gnus-check-bogus-newsgroups))))
14649
14650 (defun gnus-find-new-newsgroups (&optional arg)
14651   "Search for new newsgroups and add them.
14652 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
14653 The `-n' option line from .newsrc is respected.
14654 If ARG (the prefix), use the `ask-server' method to query
14655 the server for new groups."
14656   (interactive "P")
14657   (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups)))
14658                        (null gnus-read-active-file)
14659                        (eq gnus-read-active-file 'some))
14660                    'ask-server gnus-check-new-newsgroups)))
14661     (unless (gnus-check-first-time-used)
14662       (if (or (consp check)
14663               (eq check 'ask-server))
14664           (gnus-ask-server-for-new-groups)
14665         (let ((groups 0)
14666               group new-newsgroups)
14667           (gnus-message 5 "Looking for new newsgroups...")
14668           (or gnus-have-read-active-file (gnus-read-active-file))
14669           (setq gnus-newsrc-last-checked-date (current-time-string))
14670           (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed))
14671           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
14672           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
14673           (mapatoms
14674            (lambda (sym)
14675              (if (or (null (setq group (symbol-name sym)))
14676                      (not (boundp sym))
14677                      (null (symbol-value sym))
14678                      (gnus-gethash group gnus-killed-hashtb)
14679                      (gnus-gethash group gnus-newsrc-hashtb))
14680                  ()
14681                (let ((do-sub (gnus-matches-options-n group)))
14682                  (cond
14683                   ((eq do-sub 'subscribe)
14684                    (setq groups (1+ groups))
14685                    (gnus-sethash group group gnus-killed-hashtb)
14686                    (funcall gnus-subscribe-options-newsgroup-method group))
14687                   ((eq do-sub 'ignore)
14688                    nil)
14689                   (t
14690                    (setq groups (1+ groups))
14691                    (gnus-sethash group group gnus-killed-hashtb)
14692                    (if gnus-subscribe-hierarchical-interactive
14693                        (setq new-newsgroups (cons group new-newsgroups))
14694                      (funcall gnus-subscribe-newsgroup-method group)))))))
14695            gnus-active-hashtb)
14696           (if new-newsgroups
14697               (gnus-subscribe-hierarchical-interactive new-newsgroups))
14698           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
14699           (if (> groups 0)
14700               (gnus-message 6 "%d new newsgroup%s arrived."
14701                             groups (if (> groups 1) "s have" " has"))
14702             (gnus-message 6 "No new newsgroups.")))))))
14703
14704 (defun gnus-matches-options-n (group)
14705   ;; Returns `subscribe' if the group is to be unconditionally
14706   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
14707   ;; no match for the group.
14708
14709   ;; First we check the two user variables.
14710   (cond
14711    ((and gnus-options-subscribe
14712          (string-match gnus-options-subscribe group))
14713     'subscribe)
14714    ((and gnus-auto-subscribed-groups
14715          (string-match gnus-auto-subscribed-groups group))
14716     'subscribe)
14717    ((and gnus-options-not-subscribe
14718          (string-match gnus-options-not-subscribe group))
14719     'ignore)
14720    ;; Then we go through the list that was retrieved from the .newsrc
14721    ;; file.  This list has elements on the form
14722    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
14723    ;; is in the reverse order of the options line) is returned.
14724    (t
14725     (let ((regs gnus-newsrc-options-n))
14726       (while (and regs
14727                   (not (string-match (car (car regs)) group)))
14728         (setq regs (cdr regs)))
14729       (and regs (cdr (car regs)))))))
14730
14731 (defun gnus-ask-server-for-new-groups ()
14732   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
14733          (methods (cons gnus-select-method
14734                         (cons
14735                          gnus-message-archive-method
14736                          (append
14737                           (and (consp gnus-check-new-newsgroups)
14738                                gnus-check-new-newsgroups)
14739                           gnus-secondary-select-methods))))
14740          (groups 0)
14741          (new-date (current-time-string))
14742          group new-newsgroups got-new method hashtb
14743          gnus-override-subscribe-method)
14744     ;; Go through both primary and secondary select methods and
14745     ;; request new newsgroups.
14746     (while (setq method (gnus-server-get-method nil (pop methods)))
14747       (setq gnus-override-subscribe-method method)
14748       (when (and (gnus-check-server method)
14749                  (gnus-request-newgroups date method))
14750         (save-excursion
14751           (setq got-new t)
14752           (setq hashtb (gnus-make-hashtable 100))
14753           (set-buffer nntp-server-buffer)
14754           ;; Enter all the new groups into a hashtable.
14755           (gnus-active-to-gnus-format method hashtb 'ignore)))
14756       ;; Now all new groups from `method' are in `hashtb'.
14757       (mapatoms
14758        (lambda (group-sym)
14759          (if (or (null (setq group (symbol-name group-sym)))
14760                  (null (symbol-value group-sym))
14761                  (gnus-gethash group gnus-newsrc-hashtb)
14762                  (member group gnus-zombie-list)
14763                  (member group gnus-killed-list))
14764              ;; The group is already known.
14765              ()
14766            ;; Make this group active.
14767            (when (symbol-value group-sym)
14768              (gnus-set-active group (symbol-value group-sym)))
14769            ;; Check whether we want it or not.
14770            (let ((do-sub (gnus-matches-options-n group)))
14771              (cond
14772               ((eq do-sub 'subscribe)
14773                (incf groups)
14774                (gnus-sethash group group gnus-killed-hashtb)
14775                (funcall gnus-subscribe-options-newsgroup-method group))
14776               ((eq do-sub 'ignore)
14777                nil)
14778               (t
14779                (incf groups)
14780                (gnus-sethash group group gnus-killed-hashtb)
14781                (if gnus-subscribe-hierarchical-interactive
14782                    (push group new-newsgroups)
14783                  (funcall gnus-subscribe-newsgroup-method group)))))))
14784        hashtb)
14785       (when new-newsgroups
14786         (gnus-subscribe-hierarchical-interactive new-newsgroups)))
14787     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
14788     (when (> groups 0)
14789       (gnus-message 6 "%d new newsgroup%s arrived."
14790                     groups (if (> groups 1) "s have" " has")))
14791     (and got-new (setq gnus-newsrc-last-checked-date new-date))
14792     got-new))
14793
14794 (defun gnus-check-first-time-used ()
14795   (if (or (> (length gnus-newsrc-alist) 1)
14796           (file-exists-p gnus-startup-file)
14797           (file-exists-p (concat gnus-startup-file ".el"))
14798           (file-exists-p (concat gnus-startup-file ".eld")))
14799       nil
14800     (gnus-message 6 "First time user; subscribing you to default groups")
14801     (or gnus-have-read-active-file (gnus-read-active-file))
14802     (setq gnus-newsrc-last-checked-date (current-time-string))
14803     (let ((groups gnus-default-subscribed-newsgroups)
14804           group)
14805       (if (eq groups t)
14806           nil
14807         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
14808         (mapatoms
14809          (lambda (sym)
14810            (if (null (setq group (symbol-name sym)))
14811                ()
14812              (let ((do-sub (gnus-matches-options-n group)))
14813                (cond
14814                 ((eq do-sub 'subscribe)
14815                  (gnus-sethash group group gnus-killed-hashtb)
14816                  (funcall gnus-subscribe-options-newsgroup-method group))
14817                 ((eq do-sub 'ignore)
14818                  nil)
14819                 (t
14820                  (setq gnus-killed-list (cons group gnus-killed-list)))))))
14821          gnus-active-hashtb)
14822         (while groups
14823           (if (gnus-active (car groups))
14824               (gnus-group-change-level
14825                (car groups) gnus-level-default-subscribed gnus-level-killed))
14826           (setq groups (cdr groups)))
14827         (gnus-group-make-help-group)
14828         (and gnus-novice-user
14829              (gnus-message 7 "`A k' to list killed groups"))))))
14830
14831 (defun gnus-subscribe-group (group previous &optional method)
14832   (gnus-group-change-level
14833    (if method
14834        (list t group gnus-level-default-subscribed nil nil method)
14835      group)
14836    gnus-level-default-subscribed gnus-level-killed previous t))
14837
14838 ;; `gnus-group-change-level' is the fundamental function for changing
14839 ;; subscription levels of newsgroups.  This might mean just changing
14840 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
14841 ;; again, which subscribes/unsubscribes a group, which is equally
14842 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
14843 ;; from 8-9 to 1-7 means that you remove the group from the list of
14844 ;; killed (or zombie) groups and add them to the (kinda) subscribed
14845 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
14846 ;; which is trivial.
14847 ;; ENTRY can either be a string (newsgroup name) or a list (if
14848 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
14849 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
14850 ;; entries.
14851 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
14852 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
14853 ;; after.
14854 (defun gnus-group-change-level (entry level &optional oldlevel
14855                                       previous fromkilled)
14856   (let (group info active num)
14857     ;; Glean what info we can from the arguments
14858     (if (consp entry)
14859         (if fromkilled (setq group (nth 1 entry))
14860           (setq group (car (nth 2 entry))))
14861       (setq group entry))
14862     (if (and (stringp entry)
14863              oldlevel
14864              (< oldlevel gnus-level-zombie))
14865         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
14866     (if (and (not oldlevel)
14867              (consp entry))
14868         (setq oldlevel (car (cdr (nth 2 entry)))))
14869     (if (stringp previous)
14870         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
14871
14872     (if (and (>= oldlevel gnus-level-zombie)
14873              (gnus-gethash group gnus-newsrc-hashtb))
14874         ;; We are trying to subscribe a group that is already
14875         ;; subscribed.
14876         ()                              ; Do nothing.
14877
14878       (or (gnus-ephemeral-group-p group)
14879           (gnus-dribble-enter
14880            (format "(gnus-group-change-level %S %S %S %S %S)"
14881                    group level oldlevel (car (nth 2 previous)) fromkilled)))
14882
14883       ;; Then we remove the newgroup from any old structures, if needed.
14884       ;; If the group was killed, we remove it from the killed or zombie
14885       ;; list.  If not, and it is in fact going to be killed, we remove
14886       ;; it from the newsrc hash table and assoc.
14887       (cond ((>= oldlevel gnus-level-zombie)
14888              (if (= oldlevel gnus-level-zombie)
14889                  (setq gnus-zombie-list (delete group gnus-zombie-list))
14890                (setq gnus-killed-list (delete group gnus-killed-list))))
14891             (t
14892              (if (and (>= level gnus-level-zombie)
14893                       entry)
14894                  (progn
14895                    (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
14896                    (if (nth 3 entry)
14897                        (setcdr (gnus-gethash (car (nth 3 entry))
14898                                              gnus-newsrc-hashtb)
14899                                (cdr entry)))
14900                    (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
14901
14902       ;; Finally we enter (if needed) the list where it is supposed to
14903       ;; go, and change the subscription level.  If it is to be killed,
14904       ;; we enter it into the killed or zombie list.
14905       (cond ((>= level gnus-level-zombie)
14906              ;; Remove from the hash table.
14907              (gnus-sethash group nil gnus-newsrc-hashtb)
14908              ;; We do not enter foreign groups into the list of dead
14909              ;; groups.
14910              (unless (gnus-group-foreign-p group)
14911                (if (= level gnus-level-zombie)
14912                    (setq gnus-zombie-list (cons group gnus-zombie-list))
14913                  (setq gnus-killed-list (cons group gnus-killed-list)))))
14914             (t
14915              ;; If the list is to be entered into the newsrc assoc, and
14916              ;; it was killed, we have to create an entry in the newsrc
14917              ;; hashtb format and fix the pointers in the newsrc assoc.
14918              (if (>= oldlevel gnus-level-zombie)
14919                  (progn
14920                    (if (listp entry)
14921                        (progn
14922                          (setq info (cdr entry))
14923                          (setq num (car entry)))
14924                      (setq active (gnus-active group))
14925                      (setq num
14926                            (if active (- (1+ (cdr active)) (car active)) t))
14927                      ;; Check whether the group is foreign.  If so, the
14928                      ;; foreign select method has to be entered into the
14929                      ;; info.
14930                      (let ((method (or gnus-override-subscribe-method
14931                                        (gnus-group-method-name group))))
14932                        (if (eq method gnus-select-method)
14933                            (setq info (list group level nil))
14934                          (setq info (list group level nil nil method)))))
14935                    (or previous
14936                        (setq previous
14937                              (let ((p gnus-newsrc-alist))
14938                                (while (cdr (cdr p))
14939                                  (setq p (cdr p)))
14940                                p)))
14941                    (setq entry (cons info (cdr (cdr previous))))
14942                    (if (cdr previous)
14943                        (progn
14944                          (setcdr (cdr previous) entry)
14945                          (gnus-sethash group (cons num (cdr previous))
14946                                        gnus-newsrc-hashtb))
14947                      (setcdr previous entry)
14948                      (gnus-sethash group (cons num previous)
14949                                    gnus-newsrc-hashtb))
14950                    (if (cdr entry)
14951                        (setcdr (gnus-gethash (car (car (cdr entry)))
14952                                              gnus-newsrc-hashtb)
14953                                entry)))
14954                ;; It was alive, and it is going to stay alive, so we
14955                ;; just change the level and don't change any pointers or
14956                ;; hash table entries.
14957                (setcar (cdr (car (cdr (cdr entry)))) level))))
14958       (when gnus-group-change-level-function
14959         (funcall gnus-group-change-level-function group level oldlevel)))))
14960
14961 (defun gnus-kill-newsgroup (newsgroup)
14962   "Obsolete function.  Kills a newsgroup."
14963   (gnus-group-change-level
14964    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
14965
14966 (defun gnus-check-bogus-newsgroups (&optional confirm)
14967   "Remove bogus newsgroups.
14968 If CONFIRM is non-nil, the user has to confirm the deletion of every
14969 newsgroup."
14970   (let ((newsrc (cdr gnus-newsrc-alist))
14971         bogus group entry info)
14972     (gnus-message 5 "Checking bogus newsgroups...")
14973     (unless gnus-have-read-active-file
14974       (gnus-read-active-file))
14975     (when (member gnus-select-method gnus-have-read-active-file)
14976       ;; Find all bogus newsgroup that are subscribed.
14977       (while newsrc
14978         (setq info (pop newsrc)
14979               group (gnus-info-group info))
14980         (unless (or (gnus-active group) ; Active
14981                     (gnus-info-method info) ; Foreign
14982                     (and confirm
14983                          (not (gnus-y-or-n-p
14984                                (format "Remove bogus newsgroup: %s " group)))))
14985           ;; Found a bogus newsgroup.
14986           (push group bogus)))
14987       ;; Remove all bogus subscribed groups by first killing them, and
14988       ;; then removing them from the list of killed groups.
14989       (while bogus
14990         (when (setq entry (gnus-gethash (setq group (pop bogus))
14991                                         gnus-newsrc-hashtb))
14992           (gnus-group-change-level entry gnus-level-killed)
14993           (setq gnus-killed-list (delete group gnus-killed-list))))
14994       ;; Then we remove all bogus groups from the list of killed and
14995       ;; zombie groups.  They are are removed without confirmation.
14996       (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
14997             killed)
14998         (while dead-lists
14999           (setq killed (symbol-value (car dead-lists)))
15000           (while killed
15001             (unless (gnus-active (setq group (pop killed)))
15002               ;; The group is bogus.
15003               ;; !!!Slow as hell.
15004               (set (car dead-lists)
15005                    (delete group (symbol-value (car dead-lists))))))
15006           (setq dead-lists (cdr dead-lists))))
15007       (gnus-message 5 "Checking bogus newsgroups...done"))))
15008
15009 (defun gnus-check-duplicate-killed-groups ()
15010   "Remove duplicates from the list of killed groups."
15011   (interactive)
15012   (let ((killed gnus-killed-list))
15013     (while killed
15014       (gnus-message 9 "%d" (length killed))
15015       (setcdr killed (delete (car killed) (cdr killed)))
15016       (setq killed (cdr killed)))))
15017
15018 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
15019 ;; and compute how many unread articles there are in each group.
15020 (defun gnus-get-unread-articles (&optional level)
15021   (let* ((newsrc (cdr gnus-newsrc-alist))
15022          (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
15023          (foreign-level
15024           (min
15025            (cond ((and gnus-activate-foreign-newsgroups
15026                        (not (numberp gnus-activate-foreign-newsgroups)))
15027                   (1+ gnus-level-subscribed))
15028                  ((numberp gnus-activate-foreign-newsgroups)
15029                   gnus-activate-foreign-newsgroups)
15030                  (t 0))
15031            level))
15032          info group active virtuals method fmethod)
15033     (gnus-message 5 "Checking new news...")
15034
15035     (while newsrc
15036       (setq info (car newsrc)
15037             group (gnus-info-group info)
15038             active (gnus-active group))
15039
15040       ;; Check newsgroups.  If the user doesn't want to check them, or
15041       ;; they can't be checked (for instance, if the news server can't
15042       ;; be reached) we just set the number of unread articles in this
15043       ;; newsgroup to t.  This means that Gnus thinks that there are
15044       ;; unread articles, but it has no idea how many.
15045       (if (and (setq method (gnus-info-method info))
15046                (not (gnus-server-equal
15047                      gnus-select-method
15048                      (setq fmethod (gnus-server-get-method nil method))))
15049                (not (gnus-secondary-method-p method)))
15050           ;; These groups are foreign.  Check the level.
15051           (if (<= (gnus-info-level info) foreign-level)
15052               (setq active (gnus-activate-group (gnus-info-group info) 'scan)))
15053
15054         ;; These groups are native or secondary.
15055         (if (<= (gnus-info-level info) level)
15056             (or gnus-read-active-file
15057                 (setq active (gnus-activate-group
15058                               (gnus-info-group info) 'scan)))))
15059
15060       (if active
15061           (gnus-get-unread-articles-in-group info active t)
15062         ;; The group couldn't be reached, so we nix out the number of
15063         ;; unread articles and stuff.
15064         (gnus-set-active group nil)
15065         (setcar (gnus-gethash group gnus-newsrc-hashtb) t))
15066
15067       (setq newsrc (cdr newsrc)))
15068
15069     (gnus-message 5 "Checking new news...done")))
15070
15071 ;; Create a hash table out of the newsrc alist.  The `car's of the
15072 ;; alist elements are used as keys.
15073 (defun gnus-make-hashtable-from-newsrc-alist ()
15074   (let ((alist gnus-newsrc-alist)
15075         (ohashtb gnus-newsrc-hashtb)
15076         prev)
15077     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
15078     (setq alist
15079           (setq prev (setq gnus-newsrc-alist
15080                            (if (equal (car (car gnus-newsrc-alist))
15081                                       "dummy.group")
15082                                gnus-newsrc-alist
15083                              (cons (list "dummy.group" 0 nil) alist)))))
15084     (while alist
15085       (gnus-sethash
15086        (car (car alist))
15087        (cons (and ohashtb (car (gnus-gethash (car (car alist)) ohashtb)))
15088              prev)
15089        gnus-newsrc-hashtb)
15090       (setq prev alist
15091             alist (cdr alist)))))
15092
15093 (defun gnus-make-hashtable-from-killed ()
15094   "Create a hash table from the killed and zombie lists."
15095   (let ((lists '(gnus-killed-list gnus-zombie-list))
15096         list)
15097     (setq gnus-killed-hashtb
15098           (gnus-make-hashtable
15099            (+ (length gnus-killed-list) (length gnus-zombie-list))))
15100     (while lists
15101       (setq list (symbol-value (car lists)))
15102       (setq lists (cdr lists))
15103       (while list
15104         (gnus-sethash (car list) (car list) gnus-killed-hashtb)
15105         (setq list (cdr list))))))
15106
15107 (defun gnus-get-unread-articles-in-group (info active &optional update)
15108   ;; Allow the backend to update the info in the group.
15109   (when update
15110     (gnus-request-update-info
15111      info (gnus-find-method-for-group (gnus-info-group info))))
15112   (let* ((range (gnus-info-read info))
15113          (num 0)
15114          (marked (gnus-info-marks info)))
15115     ;; If a cache is present, we may have to alter the active info.
15116     (and gnus-use-cache
15117          (gnus-cache-possibly-alter-active (gnus-info-group info) active))
15118     ;; Modify the list of read articles according to what articles
15119     ;; are available; then tally the unread articles and add the
15120     ;; number to the group hash table entry.
15121     (cond
15122      ((zerop (cdr active))
15123       (setq num 0))
15124      ((not range)
15125       (setq num (- (1+ (cdr active)) (car active))))
15126      ((not (listp (cdr range)))
15127       ;; Fix a single (num . num) range according to the
15128       ;; active hash table.
15129       ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
15130       (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
15131       (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
15132       ;; Compute number of unread articles.
15133       (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
15134      (t
15135       ;; The read list is a list of ranges.  Fix them according to
15136       ;; the active hash table.
15137       ;; First peel off any elements that are below the lower
15138       ;; active limit.
15139       (while (and (cdr range)
15140                   (>= (car active)
15141                       (or (and (atom (car (cdr range))) (car (cdr range)))
15142                           (car (car (cdr range))))))
15143         (if (numberp (car range))
15144             (setcar range
15145                     (cons (car range)
15146                           (or (and (numberp (car (cdr range)))
15147                                    (car (cdr range)))
15148                               (cdr (car (cdr range))))))
15149           (setcdr (car range)
15150                   (or (and (numberp (nth 1 range)) (nth 1 range))
15151                       (cdr (car (cdr range))))))
15152         (setcdr range (cdr (cdr range))))
15153       ;; Adjust the first element to be the same as the lower limit.
15154       (if (and (not (atom (car range)))
15155                (< (cdr (car range)) (car active)))
15156           (setcdr (car range) (1- (car active))))
15157       ;; Then we want to peel off any elements that are higher
15158       ;; than the upper active limit.
15159       (let ((srange range))
15160         ;; Go past all legal elements.
15161         (while (and (cdr srange)
15162                     (<= (or (and (atom (car (cdr srange)))
15163                                  (car (cdr srange)))
15164                             (car (car (cdr srange)))) (cdr active)))
15165           (setq srange (cdr srange)))
15166         (if (cdr srange)
15167             ;; Nuke all remaining illegal elements.
15168             (setcdr srange nil))
15169
15170         ;; Adjust the final element.
15171         (if (and (not (atom (car srange)))
15172                  (> (cdr (car srange)) (cdr active)))
15173             (setcdr (car srange) (cdr active))))
15174       ;; Compute the number of unread articles.
15175       (while range
15176         (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
15177                                     (cdr (car range))))
15178                             (or (and (atom (car range)) (car range))
15179                                 (car (car range))))))
15180         (setq range (cdr range)))
15181       (setq num (max 0 (- (cdr active) num)))))
15182     ;; Set the number of unread articles.
15183     (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)
15184     num))
15185
15186 (defun gnus-activate-group (group &optional scan)
15187   ;; Check whether a group has been activated or not.
15188   ;; If SCAN, request a scan of that group as well.
15189   (let ((method (gnus-find-method-for-group group))
15190         active)
15191     (and (gnus-check-server method)
15192          ;; We escape all bugs and quit here to make it possible to
15193          ;; continue if a group is so out-there that it reports bugs
15194          ;; and stuff.
15195          (progn
15196            (and scan
15197                 (gnus-check-backend-function 'request-scan (car method))
15198                 (gnus-request-scan group method))
15199            t)
15200          (condition-case ()
15201              (gnus-request-group group)
15202         ;   (error nil)
15203            (quit nil))
15204          (save-excursion
15205            (set-buffer nntp-server-buffer)
15206            (goto-char (point-min))
15207            ;; Parse the result we got from `gnus-request-group'.
15208            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
15209                 (progn
15210                   (goto-char (match-beginning 1))
15211                   (gnus-set-active
15212                    group (setq active (cons (read (current-buffer))
15213                                             (read (current-buffer)))))
15214                   ;; Return the new active info.
15215                   active))))))
15216
15217 (defun gnus-update-read-articles (group unread)
15218   "Update the list of read and ticked articles in GROUP using the
15219 UNREAD and TICKED lists.
15220 Note: UNSELECTED has to be sorted over `<'.
15221 Returns whether the updating was successful."
15222   (let* ((active (or gnus-newsgroup-active (gnus-active group)))
15223          (entry (gnus-gethash group gnus-newsrc-hashtb))
15224          (info (nth 2 entry))
15225          (marked (gnus-info-marks info))
15226          (prev 1)
15227          (unread (sort (copy-sequence unread) '<))
15228          read)
15229     (if (or (not info) (not active))
15230         ;; There is no info on this group if it was, in fact,
15231         ;; killed.  Gnus stores no information on killed groups, so
15232         ;; there's nothing to be done.
15233         ;; One could store the information somewhere temporarily,
15234         ;; perhaps...  Hmmm...
15235         ()
15236       ;; Remove any negative articles numbers.
15237       (while (and unread (< (car unread) 0))
15238         (setq unread (cdr unread)))
15239       ;; Remove any expired article numbers
15240       (while (and unread (< (car unread) (car active)))
15241         (setq unread (cdr unread)))
15242       ;; Compute the ranges of read articles by looking at the list of
15243       ;; unread articles.
15244       (while unread
15245         (if (/= (car unread) prev)
15246             (setq read (cons (if (= prev (1- (car unread))) prev
15247                                (cons prev (1- (car unread)))) read)))
15248         (setq prev (1+ (car unread)))
15249         (setq unread (cdr unread)))
15250       (when (<= prev (cdr active))
15251         (setq read (cons (cons prev (cdr active)) read)))
15252       ;; Enter this list into the group info.
15253       (gnus-info-set-read
15254        info (if (> (length read) 1) (nreverse read) read))
15255       ;; Set the number of unread articles in gnus-newsrc-hashtb.
15256       (gnus-get-unread-articles-in-group info (gnus-active group))
15257       t)))
15258
15259 (defun gnus-make-articles-unread (group articles)
15260   "Mark ARTICLES in GROUP as unread."
15261   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
15262                           (gnus-gethash (gnus-group-real-name group)
15263                                         gnus-newsrc-hashtb))))
15264          (ranges (gnus-info-read info))
15265          news article)
15266     (while articles
15267       (when (gnus-member-of-range
15268              (setq article (pop articles)) ranges)
15269         (setq news (cons article news))))
15270     (when news
15271       (gnus-info-set-read
15272        info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
15273       (gnus-group-update-group group t))))
15274
15275 ;; Enter all dead groups into the hashtb.
15276 (defun gnus-update-active-hashtb-from-killed ()
15277   (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
15278         (lists (list gnus-killed-list gnus-zombie-list))
15279         killed)
15280     (while lists
15281       (setq killed (car lists))
15282       (while killed
15283         (gnus-sethash (car killed) nil hashtb)
15284         (setq killed (cdr killed)))
15285       (setq lists (cdr lists)))))
15286
15287 ;; Get the active file(s) from the backend(s).
15288 (defun gnus-read-active-file ()
15289   (gnus-group-set-mode-line)
15290   (let ((methods (nconc (copy-sequence
15291                          (if (gnus-check-server gnus-select-method)
15292                              ;; The native server is available.
15293                              (cons gnus-select-method 
15294                                    gnus-secondary-select-methods)
15295                            ;; The native server is down, so we just do the
15296                            ;; secondary ones.
15297                            gnus-secondary-select-methods))
15298                         (list gnus-message-archive-method)))
15299         list-type)
15300     (setq gnus-have-read-active-file nil)
15301     (save-excursion
15302       (set-buffer nntp-server-buffer)
15303       (while methods
15304         (let* ((method (gnus-server-get-method nil (car methods)))
15305                (where (nth 1 method))
15306                (mesg (format "Reading active file%s via %s..."
15307                              (if (and where (not (zerop (length where))))
15308                                  (concat " from " where) "")
15309                              (car method))))
15310           (gnus-message 5 mesg)
15311           (if (not (gnus-check-server method))
15312               ()
15313             ;; Request that the backend scan its incoming messages.
15314             (and (gnus-check-backend-function 'request-scan (car method))
15315                  (gnus-request-scan nil method))
15316             (cond
15317              ((and (eq gnus-read-active-file 'some)
15318                    (gnus-check-backend-function 'retrieve-groups (car method)))
15319               (let ((newsrc (cdr gnus-newsrc-alist))
15320                     (gmethod (gnus-server-get-method nil method))
15321                     groups)
15322                 (while newsrc
15323                   (and (gnus-server-equal
15324                         (gnus-find-method-for-group
15325                          (car (car newsrc)) (car newsrc))
15326                         gmethod)
15327                        (setq groups (cons (gnus-group-real-name
15328                                            (car (car newsrc))) groups)))
15329                   (setq newsrc (cdr newsrc)))
15330                 (gnus-check-server method)
15331                 (setq list-type (gnus-retrieve-groups groups method))
15332                 (cond
15333                  ((not list-type)
15334                   (gnus-message
15335                    1 "Cannot read partial active file from %s server."
15336                    (car method))
15337                   (ding)
15338                   (sit-for 2))
15339                  ((eq list-type 'active)
15340                   (gnus-active-to-gnus-format method gnus-active-hashtb))
15341                  (t
15342                   (gnus-groups-to-gnus-format method gnus-active-hashtb)))))
15343              (t
15344               (if (not (gnus-request-list method))
15345                   (progn
15346                     (unless (equal method gnus-message-archive-method)
15347                       (gnus-message 1 "Cannot read active file from %s server."
15348                                     (car method))
15349                       (ding)))
15350                 (gnus-active-to-gnus-format method)
15351                 ;; We mark this active file as read.
15352                 (setq gnus-have-read-active-file
15353                       (cons method gnus-have-read-active-file))
15354                 (gnus-message 5 "%sdone" mesg))))))
15355         (setq methods (cdr methods))))))
15356
15357 ;; Read an active file and place the results in `gnus-active-hashtb'.
15358 (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors)
15359   (unless method
15360     (setq method gnus-select-method))
15361   (let ((cur (current-buffer))
15362         (hashtb (or hashtb
15363                     (if (and gnus-active-hashtb
15364                              (not (equal method gnus-select-method)))
15365                         gnus-active-hashtb
15366                       (setq gnus-active-hashtb
15367                             (if (equal method gnus-select-method)
15368                                 (gnus-make-hashtable
15369                                  (count-lines (point-min) (point-max)))
15370                               (gnus-make-hashtable 4096))))))
15371         (flag-hashtb (gnus-make-hashtable 60)))
15372     ;; Delete unnecessary lines.
15373     (goto-char (point-min))
15374     (while (search-forward "\nto." nil t)
15375       (delete-region (1+ (match-beginning 0))
15376                      (progn (forward-line 1) (point))))
15377     (or (string= gnus-ignored-newsgroups "")
15378         (progn
15379           (goto-char (point-min))
15380           (delete-matching-lines gnus-ignored-newsgroups)))
15381     ;; Make the group names readable as a lisp expression even if they
15382     ;; contain special characters.
15383     ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
15384     (goto-char (point-max))
15385     (while (re-search-backward "[][';?()#]" nil t)
15386       (insert ?\\))
15387     ;; If these are groups from a foreign select method, we insert the
15388     ;; group prefix in front of the group names.
15389     (and method (not (gnus-server-equal
15390                       (gnus-server-get-method nil method)
15391                       (gnus-server-get-method nil gnus-select-method)))
15392          (let ((prefix (gnus-group-prefixed-name "" method)))
15393            (goto-char (point-min))
15394            (while (and (not (eobp))
15395                        (progn (insert prefix)
15396                               (zerop (forward-line 1)))))))
15397     ;; Store the active file in a hash table.
15398     (goto-char (point-min))
15399     (if (string-match "%[oO]" gnus-group-line-format)
15400         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
15401         ;; If we want information on moderated groups, we use this
15402         ;; loop...
15403         (let* ((mod-hashtb (make-vector 7 0))
15404                (m (intern "m" mod-hashtb))
15405                group max min)
15406           (while (not (eobp))
15407             (condition-case nil
15408                 (progn
15409                   (narrow-to-region (point) (gnus-point-at-eol))
15410                   (setq group (let ((obarray hashtb)) (read cur)))
15411                   (if (and (numberp (setq max (read cur)))
15412                            (numberp (setq min (read cur)))
15413                            (progn
15414                              (skip-chars-forward " \t")
15415                              (not
15416                               (or (= (following-char) ?=)
15417                                   (= (following-char) ?x)
15418                                   (= (following-char) ?j)))))
15419                       (set group (cons min max))
15420                     (set group nil))
15421                   ;; Enter moderated groups into a list.
15422                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
15423                       (setq gnus-moderated-list
15424                             (cons (symbol-name group) gnus-moderated-list))))
15425               (error
15426                (and group
15427                     (symbolp group)
15428                     (set group nil))))
15429             (widen)
15430             (forward-line 1)))
15431       ;; And if we do not care about moderation, we use this loop,
15432       ;; which is faster.
15433       (let (group max min)
15434         (while (not (eobp))
15435           (condition-case ()
15436               (progn
15437                 (narrow-to-region (point) (gnus-point-at-eol))
15438                 ;; group gets set to a symbol interned in the hash table
15439                 ;; (what a hack!!) - jwz
15440                 (setq group (let ((obarray hashtb)) (read cur)))
15441                 (if (and (numberp (setq max (read cur)))
15442                          (numberp (setq min (read cur)))
15443                          (progn
15444                            (skip-chars-forward " \t")
15445                            (not
15446                             (or (= (following-char) ?=)
15447                                 (= (following-char) ?x)
15448                                 (= (following-char) ?j)))))
15449                     (set group (cons min max))
15450                   (set group nil)))
15451             (error
15452              (progn
15453                (and group
15454                     (symbolp group)
15455                     (set group nil))
15456                (or ignore-errors
15457                    (gnus-message 3 "Warning - illegal active: %s"
15458                                  (buffer-substring
15459                                   (gnus-point-at-bol) (gnus-point-at-eol)))))))
15460           (widen)
15461           (forward-line 1))))))
15462
15463 (defun gnus-groups-to-gnus-format (method &optional hashtb)
15464   ;; Parse a "groups" active file.
15465   (let ((cur (current-buffer))
15466         (hashtb (or hashtb
15467                     (if (and method gnus-active-hashtb)
15468                         gnus-active-hashtb
15469                       (setq gnus-active-hashtb
15470                             (gnus-make-hashtable
15471                              (count-lines (point-min) (point-max)))))))
15472         (prefix (and method
15473                      (not (gnus-server-equal
15474                            (gnus-server-get-method nil method)
15475                            (gnus-server-get-method nil gnus-select-method)))
15476                      (gnus-group-prefixed-name "" method))))
15477
15478     (goto-char (point-min))
15479     ;; We split this into to separate loops, one with the prefix
15480     ;; and one without to speed the reading up somewhat.
15481     (if prefix
15482         (let (min max opoint group)
15483           (while (not (eobp))
15484             (condition-case ()
15485                 (progn
15486                   (read cur) (read cur)
15487                   (setq min (read cur)
15488                         max (read cur)
15489                         opoint (point))
15490                   (skip-chars-forward " \t")
15491                   (insert prefix)
15492                   (goto-char opoint)
15493                   (set (let ((obarray hashtb)) (read cur))
15494                        (cons min max)))
15495               (error (and group (symbolp group) (set group nil))))
15496             (forward-line 1)))
15497       (let (min max group)
15498         (while (not (eobp))
15499           (condition-case ()
15500               (if (= (following-char) ?2)
15501                   (progn
15502                     (read cur) (read cur)
15503                     (setq min (read cur)
15504                           max (read cur))
15505                     (set (setq group (let ((obarray hashtb)) (read cur)))
15506                          (cons min max))))
15507             (error (and group (symbolp group) (set group nil))))
15508           (forward-line 1))))))
15509
15510 (defun gnus-read-newsrc-file (&optional force)
15511   "Read startup file.
15512 If FORCE is non-nil, the .newsrc file is read."
15513   ;; Reset variables that might be defined in the .newsrc.eld file.
15514   (let ((variables gnus-variable-list))
15515     (while variables
15516       (set (car variables) nil)
15517       (setq variables (cdr variables))))
15518   (let* ((newsrc-file gnus-current-startup-file)
15519          (quick-file (concat newsrc-file ".el")))
15520     (save-excursion
15521       ;; We always load the .newsrc.eld file.  If always contains
15522       ;; much information that can not be gotten from the .newsrc
15523       ;; file (ticked articles, killed groups, foreign methods, etc.)
15524       (gnus-read-newsrc-el-file quick-file)
15525
15526       (if (or force
15527               (and (file-newer-than-file-p newsrc-file quick-file)
15528                    (file-newer-than-file-p newsrc-file
15529                                            (concat quick-file "d")))
15530               (not gnus-newsrc-alist))
15531           ;; We read the .newsrc file.  Note that if there if a
15532           ;; .newsrc.eld file exists, it has already been read, and
15533           ;; the `gnus-newsrc-hashtb' has been created.  While reading
15534           ;; the .newsrc file, Gnus will only use the information it
15535           ;; can find there for changing the data already read -
15536           ;; ie. reading the .newsrc file will not trash the data
15537           ;; already read (except for read articles).
15538           (save-excursion
15539             (gnus-message 5 "Reading %s..." newsrc-file)
15540             (set-buffer (find-file-noselect newsrc-file))
15541             (buffer-disable-undo (current-buffer))
15542             (gnus-newsrc-to-gnus-format)
15543             (kill-buffer (current-buffer))
15544             (gnus-message 5 "Reading %s...done" newsrc-file)))
15545
15546       ;; Read any slave files.
15547       (or gnus-slave
15548           (gnus-master-read-slave-newsrc)))))
15549
15550 (defun gnus-read-newsrc-el-file (file)
15551   (let ((ding-file (concat file "d")))
15552     ;; We always, always read the .eld file.
15553     (gnus-message 5 "Reading %s..." ding-file)
15554     (let (gnus-newsrc-assoc)
15555       (condition-case nil
15556           (load ding-file t t t)
15557         (error
15558          (gnus-message 1 "Error in %s" ding-file)
15559          (ding)))
15560       (when gnus-newsrc-assoc
15561         (setq gnus-newsrc-alist gnus-newsrc-assoc)))
15562     (gnus-make-hashtable-from-newsrc-alist)
15563     (when (file-newer-than-file-p file ding-file)
15564       ;; Old format quick file
15565       (gnus-message 5 "Reading %s..." file)
15566       ;; The .el file is newer than the .eld file, so we read that one
15567       ;; as well.
15568       (gnus-read-old-newsrc-el-file file))))
15569
15570 ;; Parse the old-style quick startup file
15571 (defun gnus-read-old-newsrc-el-file (file)
15572   (let (newsrc killed marked group m)
15573     (prog1
15574         (let ((gnus-killed-assoc nil)
15575               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
15576           (prog1
15577               (condition-case nil
15578                   (load file t t t)
15579                 (error nil))
15580             (setq newsrc gnus-newsrc-assoc
15581                   killed gnus-killed-assoc
15582                   marked gnus-marked-assoc)))
15583       (setq gnus-newsrc-alist nil)
15584       (while newsrc
15585         (setq group (car newsrc))
15586         (let ((info (gnus-get-info (car group))))
15587           (if info
15588               (progn
15589                 (gnus-info-set-read info (cdr (cdr group)))
15590                 (gnus-info-set-level
15591                  info (if (nth 1 group) gnus-level-default-subscribed
15592                         gnus-level-default-unsubscribed))
15593                 (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
15594             (setq gnus-newsrc-alist
15595                   (cons
15596                    (setq info
15597                          (list (car group)
15598                                (if (nth 1 group) gnus-level-default-subscribed
15599                                  gnus-level-default-unsubscribed)
15600                                (cdr (cdr group))))
15601                    gnus-newsrc-alist)))
15602           (if (setq m (assoc (car group) marked))
15603               (gnus-info-set-marks
15604                info (cons (list (cons 'tick (gnus-compress-sequence
15605                                              (sort (cdr m) '<) t)))
15606                           nil))))
15607         (setq newsrc (cdr newsrc)))
15608       (setq newsrc killed)
15609       (while newsrc
15610         (setcar newsrc (car (car newsrc)))
15611         (setq newsrc (cdr newsrc)))
15612       (setq gnus-killed-list killed))
15613     ;; The .el file version of this variable does not begin with
15614     ;; "options", while the .eld version does, so we just add it if it
15615     ;; isn't there.
15616     (and
15617      gnus-newsrc-options
15618      (progn
15619        (and (not (string-match "^ *options" gnus-newsrc-options))
15620             (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
15621        (and (not (string-match "\n$" gnus-newsrc-options))
15622             (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
15623        ;; Finally, if we read some options lines, we parse them.
15624        (or (string= gnus-newsrc-options "")
15625            (gnus-newsrc-parse-options gnus-newsrc-options))))
15626
15627     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
15628     (gnus-make-hashtable-from-newsrc-alist)))
15629
15630 (defun gnus-make-newsrc-file (file)
15631   "Make server dependent file name by catenating FILE and server host name."
15632   (let* ((file (expand-file-name file nil))
15633          (real-file (concat file "-" (nth 1 gnus-select-method))))
15634     (if (or (file-exists-p real-file)
15635             (file-exists-p (concat real-file ".el"))
15636             (file-exists-p (concat real-file ".eld")))
15637         real-file file)))
15638
15639 (defun gnus-newsrc-to-gnus-format ()
15640   (setq gnus-newsrc-options "")
15641   (setq gnus-newsrc-options-n nil)
15642
15643   (or gnus-active-hashtb
15644       (setq gnus-active-hashtb (make-vector 4095 0)))
15645   (let ((buf (current-buffer))
15646         (already-read (> (length gnus-newsrc-alist) 1))
15647         group subscribed options-symbol newsrc Options-symbol
15648         symbol reads num1)
15649     (goto-char (point-min))
15650     ;; We intern the symbol `options' in the active hashtb so that we
15651     ;; can `eq' against it later.
15652     (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
15653     (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
15654
15655     (while (not (eobp))
15656       ;; We first read the first word on the line by narrowing and
15657       ;; then reading into `gnus-active-hashtb'.  Most groups will
15658       ;; already exist in that hashtb, so this will save some string
15659       ;; space.
15660       (narrow-to-region
15661        (point)
15662        (progn (skip-chars-forward "^ \t!:\n") (point)))
15663       (goto-char (point-min))
15664       (setq symbol
15665             (and (/= (point-min) (point-max))
15666                  (let ((obarray gnus-active-hashtb)) (read buf))))
15667       (widen)
15668       ;; Now, the symbol we have read is either `options' or a group
15669       ;; name.  If it is an options line, we just add it to a string.
15670       (cond
15671        ((or (eq symbol options-symbol)
15672             (eq symbol Options-symbol))
15673         (setq gnus-newsrc-options
15674               ;; This concating is quite inefficient, but since our
15675               ;; thorough studies show that approx 99.37% of all
15676               ;; .newsrc files only contain a single options line, we
15677               ;; don't give a damn, frankly, my dear.
15678               (concat gnus-newsrc-options
15679                       (buffer-substring
15680                        (gnus-point-at-bol)
15681                        ;; Options may continue on the next line.
15682                        (or (and (re-search-forward "^[^ \t]" nil 'move)
15683                                 (progn (beginning-of-line) (point)))
15684                            (point)))))
15685         (forward-line -1))
15686        (symbol
15687         ;; Group names can be just numbers.  
15688         (when (numberp symbol) 
15689           (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
15690         (or (boundp symbol) (set symbol nil))
15691         ;; It was a group name.
15692         (setq subscribed (= (following-char) ?:)
15693               group (symbol-name symbol)
15694               reads nil)
15695         (if (eolp)
15696             ;; If the line ends here, this is clearly a buggy line, so
15697             ;; we put point a the beginning of line and let the cond
15698             ;; below do the error handling.
15699             (beginning-of-line)
15700           ;; We skip to the beginning of the ranges.
15701           (skip-chars-forward "!: \t"))
15702         ;; We are now at the beginning of the list of read articles.
15703         ;; We read them range by range.
15704         (while
15705             (cond
15706              ((looking-at "[0-9]+")
15707               ;; We narrow and read a number instead of buffer-substring/
15708               ;; string-to-int because it's faster.  narrow/widen is
15709               ;; faster than save-restriction/narrow, and save-restriction
15710               ;; produces a garbage object.
15711               (setq num1 (progn
15712                            (narrow-to-region (match-beginning 0) (match-end 0))
15713                            (read buf)))
15714               (widen)
15715               ;; If the next character is a dash, then this is a range.
15716               (if (= (following-char) ?-)
15717                   (progn
15718                     ;; We read the upper bound of the range.
15719                     (forward-char 1)
15720                     (if (not (looking-at "[0-9]+"))
15721                         ;; This is a buggy line, by we pretend that
15722                         ;; it's kinda OK.  Perhaps the user should be
15723                         ;; dinged?
15724                         (setq reads (cons num1 reads))
15725                       (setq reads
15726                             (cons
15727                              (cons num1
15728                                    (progn
15729                                      (narrow-to-region (match-beginning 0)
15730                                                        (match-end 0))
15731                                      (read buf)))
15732                              reads))
15733                       (widen)))
15734                 ;; It was just a simple number, so we add it to the
15735                 ;; list of ranges.
15736                 (setq reads (cons num1 reads)))
15737               ;; If the next char in ?\n, then we have reached the end
15738               ;; of the line and return nil.
15739               (/= (following-char) ?\n))
15740              ((= (following-char) ?\n)
15741               ;; End of line, so we end.
15742               nil)
15743              (t
15744               ;; Not numbers and not eol, so this might be a buggy
15745               ;; line...
15746               (or (eobp)
15747                   ;; If it was eob instead of ?\n, we allow it.
15748                   (progn
15749                     ;; The line was buggy.
15750                     (setq group nil)
15751                     (gnus-message 3 "Mangled line: %s"
15752                                   (buffer-substring (gnus-point-at-bol)
15753                                                     (gnus-point-at-eol)))
15754                     (ding)
15755                     (sit-for 1)))
15756               nil))
15757           ;; Skip past ", ".  Spaces are illegal in these ranges, but
15758           ;; we allow them, because it's a common mistake to put a
15759           ;; space after the comma.
15760           (skip-chars-forward ", "))
15761
15762         ;; We have already read .newsrc.eld, so we gently update the
15763         ;; data in the hash table with the information we have just
15764         ;; read.
15765         (when group
15766           (let ((info (gnus-get-info group))
15767                 level)
15768             (if info
15769                 ;; There is an entry for this file in the alist.
15770                 (progn
15771                   (gnus-info-set-read info (nreverse reads))
15772                   ;; We update the level very gently.  In fact, we
15773                   ;; only change it if there's been a status change
15774                   ;; from subscribed to unsubscribed, or vice versa.
15775                   (setq level (gnus-info-level info))
15776                   (cond ((and (<= level gnus-level-subscribed)
15777                               (not subscribed))
15778                          (setq level (if reads
15779                                          gnus-level-default-unsubscribed
15780                                        (1+ gnus-level-default-unsubscribed))))
15781                         ((and (> level gnus-level-subscribed) subscribed)
15782                          (setq level gnus-level-default-subscribed)))
15783                   (gnus-info-set-level info level))
15784               ;; This is a new group.
15785               (setq info (list group
15786                                (if subscribed
15787                                    gnus-level-default-subscribed
15788                                  (if reads
15789                                      (1+ gnus-level-subscribed)
15790                                    gnus-level-default-unsubscribed))
15791                                (nreverse reads))))
15792             (setq newsrc (cons info newsrc))))))
15793       (forward-line 1))
15794
15795     (setq newsrc (nreverse newsrc))
15796
15797     (if (not already-read)
15798         ()
15799       ;; We now have two newsrc lists - `newsrc', which is what we
15800       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
15801       ;; what we've read from .newsrc.eld.  We have to merge these
15802       ;; lists.  We do this by "attaching" any (foreign) groups in the
15803       ;; gnus-newsrc-alist to the (native) group that precedes them.
15804       (let ((rc (cdr gnus-newsrc-alist))
15805             (prev gnus-newsrc-alist)
15806             entry mentry)
15807         (while rc
15808           (or (null (nth 4 (car rc)))   ; It's a native group.
15809               (assoc (car (car rc)) newsrc) ; It's already in the alist.
15810               (if (setq entry (assoc (car (car prev)) newsrc))
15811                   (setcdr (setq mentry (memq entry newsrc))
15812                           (cons (car rc) (cdr mentry)))
15813                 (setq newsrc (cons (car rc) newsrc))))
15814           (setq prev rc
15815                 rc (cdr rc)))))
15816
15817     (setq gnus-newsrc-alist newsrc)
15818     ;; We make the newsrc hashtb.
15819     (gnus-make-hashtable-from-newsrc-alist)
15820
15821     ;; Finally, if we read some options lines, we parse them.
15822     (or (string= gnus-newsrc-options "")
15823         (gnus-newsrc-parse-options gnus-newsrc-options))))
15824
15825 ;; Parse options lines to find "options -n !all rec.all" and stuff.
15826 ;; The return value will be a list on the form
15827 ;; ((regexp1 . ignore)
15828 ;;  (regexp2 . subscribe)...)
15829 ;; When handling new newsgroups, groups that match a `ignore' regexp
15830 ;; will be ignored, and groups that match a `subscribe' regexp will be
15831 ;; subscribed.  A line like
15832 ;; options -n !all rec.all
15833 ;; will lead to a list that looks like
15834 ;; (("^rec\\..+" . subscribe)
15835 ;;  ("^.+" . ignore))
15836 ;; So all "rec.*" groups will be subscribed, while all the other
15837 ;; groups will be ignored.  Note that "options -n !all rec.all" is very
15838 ;; different from "options -n rec.all !all".
15839 (defun gnus-newsrc-parse-options (options)
15840   (let (out eol)
15841     (save-excursion
15842       (gnus-set-work-buffer)
15843       (insert (regexp-quote options))
15844       ;; First we treat all continuation lines.
15845       (goto-char (point-min))
15846       (while (re-search-forward "\n[ \t]+" nil t)
15847         (replace-match " " t t))
15848       ;; Then we transform all "all"s into ".+"s.
15849       (goto-char (point-min))
15850       (while (re-search-forward "\\ball\\b" nil t)
15851         (replace-match ".+" t t))
15852       (goto-char (point-min))
15853       ;; We remove all other options than the "-n" ones.
15854       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
15855         (replace-match " ")
15856         (forward-char -1))
15857       (goto-char (point-min))
15858
15859       ;; We are only interested in "options -n" lines - we
15860       ;; ignore the other option lines.
15861       (while (re-search-forward "[ \t]-n" nil t)
15862         (setq eol
15863               (or (save-excursion
15864                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
15865                          (- (point) 2)))
15866                   (gnus-point-at-eol)))
15867         ;; Search for all "words"...
15868         (while (re-search-forward "[^ \t,\n]+" eol t)
15869           (if (= (char-after (match-beginning 0)) ?!)
15870               ;; If the word begins with a bang (!), this is a "not"
15871               ;; spec.  We put this spec (minus the bang) and the
15872               ;; symbol `ignore' into the list.
15873               (setq out (cons (cons (concat
15874                                      "^" (buffer-substring
15875                                           (1+ (match-beginning 0))
15876                                           (match-end 0)))
15877                                     'ignore) out))
15878             ;; There was no bang, so this is a "yes" spec.
15879             (setq out (cons (cons (concat "^" (match-string 0))
15880                                   'subscribe) out)))))
15881
15882       (setq gnus-newsrc-options-n out))))
15883
15884 (defun gnus-save-newsrc-file (&optional force)
15885   "Save .newsrc file."
15886   ;; Note: We cannot save .newsrc file if all newsgroups are removed
15887   ;; from the variable gnus-newsrc-alist.
15888   (when (and (or gnus-newsrc-alist gnus-killed-list)
15889              gnus-current-startup-file)
15890     (save-excursion
15891       (if (and (or gnus-use-dribble-file gnus-slave)
15892                (not force)
15893                (or (not gnus-dribble-buffer)
15894                    (not (buffer-name gnus-dribble-buffer))
15895                    (zerop (save-excursion
15896                             (set-buffer gnus-dribble-buffer)
15897                             (buffer-size)))))
15898           (gnus-message 4 "(No changes need to be saved)")
15899         (run-hooks 'gnus-save-newsrc-hook)
15900         (if gnus-slave
15901             (gnus-slave-save-newsrc)
15902           ;; Save .newsrc.
15903           (when gnus-save-newsrc-file
15904             (gnus-message 5 "Saving %s..." gnus-current-startup-file)
15905             (gnus-gnus-to-newsrc-format)
15906             (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
15907           ;; Save .newsrc.eld.
15908           (set-buffer (get-buffer-create " *Gnus-newsrc*"))
15909           (make-local-variable 'version-control)
15910           (setq version-control 'never)
15911           (setq buffer-file-name
15912                 (concat gnus-current-startup-file ".eld"))
15913           (gnus-add-current-to-buffer-list)
15914           (buffer-disable-undo (current-buffer))
15915           (erase-buffer)
15916           (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
15917           (gnus-gnus-to-quick-newsrc-format)
15918           (run-hooks 'gnus-save-quick-newsrc-hook)
15919           (save-buffer)
15920           (kill-buffer (current-buffer))
15921           (gnus-message
15922            5 "Saving %s.eld...done" gnus-current-startup-file))
15923         (gnus-dribble-delete-file)))))
15924
15925 (defun gnus-gnus-to-quick-newsrc-format ()
15926   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
15927   (insert ";; Gnus startup file.\n")
15928   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
15929   (insert ";; to read .newsrc.\n")
15930   (insert "(setq gnus-newsrc-file-version "
15931           (prin1-to-string gnus-version) ")\n")
15932   (let ((variables
15933          (if gnus-save-killed-list gnus-variable-list
15934            ;; Remove the `gnus-killed-list' from the list of variables
15935            ;; to be saved, if required.
15936            (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
15937         ;; Peel off the "dummy" group.
15938         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
15939         variable)
15940     ;; Insert the variables into the file.
15941     (while variables
15942       (when (and (boundp (setq variable (pop variables)))
15943                  (symbol-value variable))
15944         (insert "(setq " (symbol-name variable) " '"
15945                 (prin1-to-string (symbol-value variable)) ")\n")))))
15946
15947 (defun gnus-gnus-to-newsrc-format ()
15948   ;; Generate and save the .newsrc file.
15949   (let ((newsrc (cdr gnus-newsrc-alist))
15950         info ranges range)
15951     (save-excursion
15952       (set-buffer (create-file-buffer gnus-current-startup-file))
15953       (setq buffer-file-name gnus-current-startup-file)
15954       (buffer-disable-undo (current-buffer))
15955       (erase-buffer)
15956       ;; Write options.
15957       (if gnus-newsrc-options (insert gnus-newsrc-options))
15958       ;; Write subscribed and unsubscribed.
15959       (while newsrc
15960         (setq info (car newsrc))
15961         (if (not (gnus-info-method info))
15962             ;; Don't write foreign groups to .newsrc.
15963             (progn
15964               (insert (gnus-info-group info)
15965                       (if (> (gnus-info-level info) gnus-level-subscribed)
15966                           "!" ":"))
15967               (if (setq ranges (gnus-info-read info))
15968                   (progn
15969                     (insert " ")
15970                     (if (not (listp (cdr ranges)))
15971                         (if (= (car ranges) (cdr ranges))
15972                             (insert (int-to-string (car ranges)))
15973                           (insert (int-to-string (car ranges)) "-"
15974                                   (int-to-string (cdr ranges))))
15975                       (while ranges
15976                         (setq range (car ranges)
15977                               ranges (cdr ranges))
15978                         (if (or (atom range) (= (car range) (cdr range)))
15979                             (insert (int-to-string
15980                                      (or (and (atom range) range)
15981                                          (car range))))
15982                           (insert (int-to-string (car range)) "-"
15983                                   (int-to-string (cdr range))))
15984                         (if ranges (insert ","))))))
15985               (insert "\n")))
15986         (setq newsrc (cdr newsrc)))
15987       (make-local-variable 'version-control)
15988       (setq version-control 'never)
15989       ;; It has been reported that sometime the modtime on the .newsrc
15990       ;; file seems to be off.  We really do want to overwrite it, so
15991       ;; we clear the modtime here before saving.  It's a bit odd,
15992       ;; though...
15993       ;; sometimes the modtime clear isn't sufficient.  most brute force:
15994       ;; delete the silly thing entirely first.  but this fails to provide
15995       ;; such niceties as .newsrc~ creation.
15996       (if gnus-modtime-botch
15997           (delete-file gnus-startup-file)
15998         (clear-visited-file-modtime))
15999       (run-hooks 'gnus-save-standard-newsrc-hook)
16000       (save-buffer)
16001       (kill-buffer (current-buffer)))))
16002
16003
16004 ;;; Slave functions.
16005
16006 (defun gnus-slave-save-newsrc ()
16007   (save-excursion
16008     (set-buffer gnus-dribble-buffer)
16009     (let ((slave-name
16010            (make-temp-name (concat gnus-current-startup-file "-slave-"))))
16011       (write-region (point-min) (point-max) slave-name nil 'nomesg))))
16012
16013 (defun gnus-master-read-slave-newsrc ()
16014   (let ((slave-files
16015          (directory-files
16016           (file-name-directory gnus-current-startup-file)
16017           t (concat
16018              "^" (regexp-quote
16019                   (concat
16020                    (file-name-nondirectory gnus-current-startup-file)
16021                    "-slave-")))
16022           t))
16023         file)
16024     (if (not slave-files)
16025         ()                              ; There are no slave files to read.
16026       (gnus-message 7 "Reading slave newsrcs...")
16027       (save-excursion
16028         (set-buffer (get-buffer-create " *gnus slave*"))
16029         (buffer-disable-undo (current-buffer))
16030         (setq slave-files
16031               (sort (mapcar (lambda (file)
16032                               (list (nth 5 (file-attributes file)) file))
16033                             slave-files)
16034                     (lambda (f1 f2)
16035                       (or (< (car (car f1)) (car (car f2)))
16036                           (< (nth 1 (car f1)) (nth 1 (car f2)))))))
16037         (while slave-files
16038           (erase-buffer)
16039           (setq file (nth 1 (car slave-files)))
16040           (insert-file-contents file)
16041           (if (condition-case ()
16042                   (progn
16043                     (eval-buffer (current-buffer))
16044                     t)
16045                 (error
16046                  (gnus-message 3 "Possible error in %s" file)
16047                  (ding)
16048                  (sit-for 2)
16049                  nil))
16050               (or gnus-slave ; Slaves shouldn't delete these files.
16051                   (condition-case ()
16052                       (delete-file file)
16053                     (error nil))))
16054           (setq slave-files (cdr slave-files))))
16055       (gnus-message 7 "Reading slave newsrcs...done"))))
16056
16057
16058 ;;; Group description.
16059
16060 (defun gnus-read-all-descriptions-files ()
16061   (let ((methods (cons gnus-select-method 
16062                        (cons gnus-message-archive-method
16063                              gnus-secondary-select-methods))))
16064     (while methods
16065       (gnus-read-descriptions-file (car methods))
16066       (setq methods (cdr methods)))
16067     t))
16068
16069 (defun gnus-read-descriptions-file (&optional method)
16070   (let ((method (or method gnus-select-method)))
16071     ;; We create the hashtable whether we manage to read the desc file
16072     ;; to avoid trying to re-read after a failed read.
16073     (or gnus-description-hashtb
16074         (setq gnus-description-hashtb
16075               (gnus-make-hashtable (length gnus-active-hashtb))))
16076     ;; Mark this method's desc file as read.
16077     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
16078                   gnus-description-hashtb)
16079
16080     (gnus-message 5 "Reading descriptions file via %s..." (car method))
16081     (cond
16082      ((not (gnus-check-server method))
16083       (gnus-message 1 "Couldn't open server")
16084       nil)
16085      ((not (gnus-request-list-newsgroups method))
16086       (gnus-message 1 "Couldn't read newsgroups descriptions")
16087       nil)
16088      (t
16089       (let (group)
16090         (save-excursion
16091           (save-restriction
16092             (set-buffer nntp-server-buffer)
16093             (goto-char (point-min))
16094             (if (or (search-forward "\n.\n" nil t)
16095                     (goto-char (point-max)))
16096                 (progn
16097                   (beginning-of-line)
16098                   (narrow-to-region (point-min) (point))))
16099             (goto-char (point-min))
16100             (while (not (eobp))
16101               ;; If we get an error, we set group to 0, which is not a
16102               ;; symbol...
16103               (setq group
16104                     (condition-case ()
16105                         (let ((obarray gnus-description-hashtb))
16106                           ;; Group is set to a symbol interned in this
16107                           ;; hash table.
16108                           (read nntp-server-buffer))
16109                       (error 0)))
16110               (skip-chars-forward " \t")
16111               ;; ...  which leads to this line being effectively ignored.
16112               (and (symbolp group)
16113                    (set group (buffer-substring
16114                                (point) (progn (end-of-line) (point)))))
16115               (forward-line 1))))
16116         (gnus-message 5 "Reading descriptions file...done")
16117         t)))))
16118
16119 (defun gnus-group-get-description (group)
16120   "Get the description of a group by sending XGTITLE to the server."
16121   (when (gnus-request-group-description group)
16122     (save-excursion
16123       (set-buffer nntp-server-buffer)
16124       (goto-char (point-min))
16125       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
16126         (match-string 1)))))
16127
16128 ;;;
16129 ;;; Buffering of read articles.
16130 ;;;
16131
16132 (defvar gnus-backlog-buffer " *Gnus Backlog*")
16133 (defvar gnus-backlog-articles nil)
16134 (defvar gnus-backlog-hashtb nil)
16135
16136 (defun gnus-backlog-buffer ()
16137   "Return the backlog buffer."
16138   (or (get-buffer gnus-backlog-buffer)
16139       (save-excursion
16140         (set-buffer (get-buffer-create gnus-backlog-buffer))
16141         (buffer-disable-undo (current-buffer))
16142         (setq buffer-read-only t)
16143         (gnus-add-current-to-buffer-list)
16144         (get-buffer gnus-backlog-buffer))))
16145
16146 (defun gnus-backlog-setup ()
16147   "Initialize backlog variables."
16148   (unless gnus-backlog-hashtb
16149     (setq gnus-backlog-hashtb (make-vector 1023 0))))
16150
16151 (defun gnus-backlog-shutdown ()
16152   "Clear all backlog variables and buffers."
16153   (when (get-buffer gnus-backlog-buffer)
16154     (kill-buffer gnus-backlog-buffer))
16155   (setq gnus-backlog-hashtb nil
16156         gnus-backlog-articles nil))
16157
16158 (defun gnus-backlog-enter-article (group number buffer)
16159   (gnus-backlog-setup)
16160   (let ((ident (intern (concat group ":" (int-to-string number))
16161                        gnus-backlog-hashtb))
16162         b)
16163     (if (memq ident gnus-backlog-articles)
16164         () ; It's already kept.
16165       ;; Remove the oldest article, if necessary.
16166       (and (numberp gnus-keep-backlog)
16167            (>= (length gnus-backlog-articles) gnus-keep-backlog)
16168            (gnus-backlog-remove-oldest-article))
16169       (setq gnus-backlog-articles (cons ident gnus-backlog-articles))
16170       ;; Insert the new article.
16171       (save-excursion
16172         (set-buffer (gnus-backlog-buffer))
16173         (let (buffer-read-only)
16174           (goto-char (point-max))
16175           (or (bolp) (insert "\n"))
16176           (setq b (point))
16177           (insert-buffer-substring buffer)
16178           ;; Tag the beginning of the article with the ident.
16179           (put-text-property b (1+ b) 'gnus-backlog ident))))))
16180
16181 (defun gnus-backlog-remove-oldest-article ()
16182   (save-excursion
16183     (set-buffer (gnus-backlog-buffer))
16184     (goto-char (point-min))
16185     (if (zerop (buffer-size))
16186         () ; The buffer is empty.
16187       (let ((ident (get-text-property (point) 'gnus-backlog))
16188             buffer-read-only)
16189         ;; Remove the ident from the list of articles.
16190         (when ident
16191           (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
16192         ;; Delete the article itself.
16193         (delete-region
16194          (point) (next-single-property-change
16195                   (1+ (point)) 'gnus-backlog nil (point-max)))))))
16196
16197 (defun gnus-backlog-request-article (group number buffer)
16198   (gnus-backlog-setup)
16199   (let ((ident (intern (concat group ":" (int-to-string number))
16200                        gnus-backlog-hashtb))
16201         beg end)
16202     (when (memq ident gnus-backlog-articles)
16203       ;; It was in the backlog.
16204       (save-excursion
16205         (set-buffer (gnus-backlog-buffer))
16206         (if (not (setq beg (text-property-any
16207                             (point-min) (point-max) 'gnus-backlog
16208                             ident)))
16209             ;; It wasn't in the backlog after all.
16210             (progn
16211               (setq gnus-backlog-articles (delq ident gnus-backlog-articles))
16212               nil)
16213           ;; Find the end (i. e., the beginning of the next article).
16214           (setq end
16215                 (next-single-property-change
16216                  (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
16217       (let ((buffer-read-only nil))
16218         (erase-buffer)
16219         (insert-buffer-substring gnus-backlog-buffer beg end)
16220         t))))
16221
16222 ;; Allow redefinition of Gnus functions.
16223
16224 (gnus-ems-redefine)
16225
16226 (provide 'gnus)
16227
16228 ;;; gnus.el ends here