*** empty log message ***
[gnus] / lisp / gnus.el
1 ;;; gnus.el --- a newsreader for GNU Emacs
2 ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
3
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Keywords: news
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Commentary:
26
27 ;;; Code:
28
29 (eval '(run-hooks 'gnus-load-hook))
30
31 (require 'mail-utils)
32 (require 'timezone)
33 (require 'nnheader)
34 (require 'message)
35
36 (eval-when-compile (require 'cl))
37
38 ;; Site dependent variables.  These variables should be defined in
39 ;; paths.el.
40
41 (defvar gnus-default-nntp-server nil
42   "Specify a default NNTP server.
43 This variable should be defined in paths.el, and should never be set
44 by the user.
45 If you want to change servers, you should use `gnus-select-method'.
46 See the documentation to that variable.")
47
48 (defvar gnus-backup-default-subscribed-newsgroups
49   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
50   "Default default new newsgroups the first time Gnus is run.
51 Should be set in paths.el, and shouldn't be touched by the user.")
52
53 (defvar gnus-local-domain nil
54   "Local domain name without a host name.
55 The DOMAINNAME environment variable is used instead if it is defined.
56 If the `system-name' function returns the full Internet name, there is
57 no need to set this variable.")
58
59 (defvar gnus-local-organization nil
60   "String with a description of what organization (if any) the user belongs to.
61 The ORGANIZATION environment variable is used instead if it is defined.
62 If this variable contains a function, this function will be called
63 with the current newsgroup name as the argument.  The function should
64 return a string.
65
66 In any case, if the string (either in the variable, in the environment
67 variable, or returned by the function) is a file name, the contents of
68 this file will be used as the organization.")
69
70 ;; Customization variables
71
72 ;; Don't touch this variable.
73 (defvar gnus-nntp-service "nntp"
74   "*NNTP service name (\"nntp\" or 119).
75 This is an obsolete variable, which is scarcely used.  If you use an
76 nntp server for your newsgroup and want to change the port number
77 used to 899, you would say something along these lines:
78
79  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
80
81 (defvar gnus-nntpserver-file "/etc/nntpserver"
82   "*A file with only the name of the nntp server in it.")
83
84 ;; This function is used to check both the environment variable
85 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
86 ;; an nntp server name default.
87 (defun gnus-getenv-nntpserver ()
88   (or (getenv "NNTPSERVER")
89       (and (file-readable-p gnus-nntpserver-file)
90            (save-excursion
91              (set-buffer (get-buffer-create " *gnus nntp*"))
92              (buffer-disable-undo (current-buffer))
93              (insert-file-contents gnus-nntpserver-file)
94              (let ((name (buffer-string)))
95                (prog1
96                    (if (string-match "^[ \t\n]*$" name)
97                        nil
98                      name)
99                  (kill-buffer (current-buffer))))))))
100
101 (defvar gnus-select-method
102   (nconc
103    (list 'nntp (or (condition-case ()
104                        (gnus-getenv-nntpserver)
105                      (error nil))
106                    (if (and gnus-default-nntp-server
107                             (not (string= gnus-default-nntp-server "")))
108                        gnus-default-nntp-server)
109                    (system-name)))
110    (if (or (null gnus-nntp-service)
111            (equal gnus-nntp-service "nntp"))
112        nil
113      (list gnus-nntp-service)))
114   "*Default method for selecting a newsgroup.
115 This variable should be a list, where the first element is how the
116 news is to be fetched, the second is the address.
117
118 For instance, if you want to get your news via NNTP from
119 \"flab.flab.edu\", you could say:
120
121 (setq gnus-select-method '(nntp \"flab.flab.edu\"))
122
123 If you want to use your local spool, say:
124
125 (setq gnus-select-method (list 'nnspool (system-name)))
126
127 If you use this variable, you must set `gnus-nntp-server' to nil.
128
129 There is a lot more to know about select methods and virtual servers -
130 see the manual for details.")
131
132 (defvar gnus-message-archive-method 
133   '(nnfolder "archive" (nnfolder-directory "~/Mail/archive/")
134              (nnfolder-active-file "~/Mail/archive/active")
135              (nnfolder-get-new-mail nil)
136              (nnfolder-inhibit-expiry t))
137   "*Method used for archiving messages you've sent.
138 This should be a mail method.")
139
140 (defvar gnus-refer-article-method nil
141   "*Preferred method for fetching an article by Message-ID.
142 If you are reading news from the local spool (with nnspool), fetching
143 articles by Message-ID is painfully slow.  By setting this method to an
144 nntp method, you might get acceptable results.
145
146 The value of this variable must be a valid select method as discussed
147 in the documentation of `gnus-select-method'.")
148
149 (defvar gnus-secondary-select-methods nil
150   "*A list of secondary methods that will be used for reading news.
151 This is a list where each element is a complete select method (see
152 `gnus-select-method').
153
154 If, for instance, you want to read your mail with the nnml backend,
155 you could set this variable:
156
157 (setq gnus-secondary-select-methods '((nnml \"\")))")
158
159 (defvar gnus-secondary-servers nil
160   "*List of NNTP servers that the user can choose between interactively.
161 To make Gnus query you for a server, you have to give `gnus' a
162 non-numeric prefix - `C-u M-x gnus', in short.")
163
164 (defvar gnus-nntp-server nil
165   "*The name of the host running the NNTP server.
166 This variable is semi-obsolete.  Use the `gnus-select-method'
167 variable instead.")
168
169 (defvar gnus-startup-file "~/.newsrc"
170   "*Your `.newsrc' file.
171 `.newsrc-SERVER' will be used instead if that exists.")
172
173 (defvar gnus-init-file "~/.gnus"
174   "*Your Gnus elisp startup file.
175 If a file with the .el or .elc suffixes exist, it will be read
176 instead.")
177
178 (defvar gnus-group-faq-directory
179   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
180     "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
181     "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
182     "/ftp@rtfm.mit.edu:/pub/usenet/news.answers/"
183     "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
184     "/ftp@ftp.sunet.se:/pub/usenet/"
185     "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
186     "/ftp@hwarang.postech.ac.kr:/pub/usenet/news.answers/"
187     "/ftp@ftp.hk.super.net:/mirror/faqs/")
188   "*Directory where the group FAQs are stored.
189 This will most commonly be on a remote machine, and the file will be
190 fetched by ange-ftp.
191
192 This variable can also be a list of directories.  In that case, the
193 first element in the list will be used by default, and the others will
194 be used as backup sites.
195
196 Note that Gnus uses an aol machine as the default directory.  If this
197 feels fundamentally unclean, just think of it as a way to finally get
198 something of value back from them.
199
200 If the default site is too slow, try one of these:
201
202    North America: mirrors.aol.com                /pub/rtfm/usenet
203                   ftp.seas.gwu.edu               /pub/rtfm
204                   rtfm.mit.edu                   /pub/usenet/news.answers
205    Europe:        ftp.uni-paderborn.de           /pub/FAQ
206                   src.doc.ic.ac.uk               /usenet/news-FAQS
207                   ftp.sunet.se                   /pub/usenet
208    Asia:          nctuccca.edu.tw                /USENET/FAQ
209                   hwarang.postech.ac.kr          /pub/usenet/news.answers
210                   ftp.hk.super.net               /mirror/faqs")
211
212 (defvar gnus-group-archive-directory
213   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
214   "*The address of the (ding) archives.")
215
216 (defvar gnus-group-recent-archive-directory
217   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
218   "*The address of the most recent (ding) articles.")
219
220 (defvar gnus-default-subscribed-newsgroups nil
221   "*This variable lists what newsgroups should be subscribed the first time Gnus is used.
222 It should be a list of strings.
223 If it is `t', Gnus will not do anything special the first time it is
224 started; it'll just use the normal newsgroups subscription methods.")
225
226 (defvar gnus-use-cross-reference t
227   "*Non-nil means that cross referenced articles will be marked as read.
228 If nil, ignore cross references.  If t, mark articles as read in
229 subscribed newsgroups.  If neither t nor nil, mark as read in all
230 newsgroups.")
231
232 (defvar gnus-single-article-buffer t
233   "*If non-nil, display all articles in the same buffer.
234 If nil, each group will get its own article buffer.")
235
236 (defvar gnus-use-dribble-file t
237   "*Non-nil means that Gnus will use a dribble file to store user updates.
238 If Emacs should crash without saving the .newsrc files, complete
239 information can be restored from the dribble file.")
240
241 (defvar gnus-dribble-directory nil
242   "*The directory where dribble files will be saved.
243 If this variable is nil, the directory where the .newsrc files are
244 saved will be used.")
245
246 (defvar gnus-asynchronous nil
247   "*If non-nil, Gnus will supply backends with data needed for async article fetching.")
248
249 (defvar gnus-kill-summary-on-exit t
250   "*If non-nil, kill the summary buffer when you exit from it.
251 If nil, the summary will become a \"*Dead Summary*\" buffer, and
252 it will be killed sometime later.")
253
254 (defvar gnus-large-newsgroup 200
255   "*The number of articles which indicates a large newsgroup.
256 If the number of articles in a newsgroup is greater than this value,
257 confirmation is required for selecting the newsgroup.")
258
259 ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
260 (defvar gnus-no-groups-message "No news is horrible news"
261   "*Message displayed by Gnus when no groups are available.")
262
263 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
264   "*Non-nil means that the default name of a file to save articles in is the group name.
265 If it's nil, the directory form of the group name is used instead.
266
267 If this variable is a list, and the list contains the element
268 `not-score', long file names will not be used for score files; if it
269 contains the element `not-save', long file names will not be used for
270 saving; and if it contains the element `not-kill', long file names
271 will not be used for kill files.")
272
273 (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
274   "*Name of the directory articles will be saved in (default \"~/News\").
275 Initialized from the SAVEDIR environment variable.")
276
277 (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
278   "*Name of the directory where kill files will be stored (default \"~/News\").
279 Initialized from the SAVEDIR environment variable.")
280
281 (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
282   "*A function to save articles in your favorite format.
283 The function must be interactively callable (in other words, it must
284 be an Emacs command).
285
286 Gnus provides the following functions:
287
288 * gnus-summary-save-in-rmail (Rmail format)
289 * gnus-summary-save-in-mail (Unix mail format)
290 * gnus-summary-save-in-folder (MH folder)
291 * gnus-summary-save-in-file (article format).
292 * gnus-summary-save-in-vm (use VM's folder format).")
293
294 (defvar gnus-prompt-before-saving 'always
295   "*This variable says how much prompting is to be done when saving articles.
296 If it is nil, no prompting will be done, and the articles will be
297 saved to the default files.  If this variable is `always', each and
298 every article that is saved will be preceded by a prompt, even when
299 saving large batches of articles.  If this variable is neither nil not
300 `always', there the user will be prompted once for a file name for
301 each invocation of the saving commands.")
302
303 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
304   "*A function generating a file name to save articles in Rmail format.
305 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
306
307 (defvar gnus-mail-save-name (function gnus-plain-save-name)
308   "*A function generating a file name to save articles in Unix mail format.
309 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
310
311 (defvar gnus-folder-save-name (function gnus-folder-save-name)
312   "*A function generating a file name to save articles in MH folder.
313 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
314
315 (defvar gnus-file-save-name (function gnus-numeric-save-name)
316   "*A function generating a file name to save articles in article format.
317 The function is called with NEWSGROUP, HEADERS, and optional
318 LAST-FILE.")
319
320 (defvar gnus-split-methods
321   '((gnus-article-archive-name))
322   "*Variable used to suggest where articles are to be saved.
323 For instance, if you would like to save articles related to Gnus in
324 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
325 you could set this variable to something like:
326
327  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
328    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
329
330 This variable is an alist where the where the key is the match and the
331 value is a list of possible files to save in if the match is non-nil.
332
333 If the match is a string, it is used as a regexp match on the
334 article.  If the match is a symbol, that symbol will be funcalled
335 from the buffer of the article to be saved with the newsgroup as the
336 parameter.  If it is a list, it will be evaled in the same buffer.
337
338 If this form or function returns a string, this string will be used as
339 a possible file name; and if it returns a non-nil list, that list will
340 be used as possible file names.")
341
342 (defvar gnus-move-split-methods nil
343   "*Variable used to suggest where articles are to be moved to.
344 It uses the same syntax as the `gnus-split-methods' variable.")
345
346 (defvar gnus-save-score nil
347   "*If non-nil, save group scoring info.")
348
349 (defvar gnus-use-adaptive-scoring nil
350   "*If non-nil, use some adaptive scoring scheme.")
351
352 (defvar gnus-use-cache nil
353   "*If nil, Gnus will ignore the article cache.
354 If `passive', it will allow entering (and reading) articles
355 explicitly entered into the cache.  If anything else, use the
356 cache to the full extent of the law.")
357
358 (defvar gnus-use-trees nil
359   "*If non-nil, display a thread tree buffer.")
360
361 (defvar gnus-use-grouplens nil
362   "*If non-nil, use GroupLens ratings.")
363
364 (defvar gnus-keep-backlog nil
365   "*If non-nil, Gnus will keep read articles for later re-retrieval.
366 If it is a number N, then Gnus will only keep the last N articles
367 read.  If it is neither nil nor a number, Gnus will keep all read
368 articles.  This is not a good idea.")
369
370 (defvar gnus-use-nocem nil
371   "*If non-nil, Gnus will read NoCeM cancel messages.")
372
373 (defvar gnus-use-demon nil
374   "If non-nil, Gnus might use some demons.")
375
376 (defvar gnus-use-scoring t
377   "*If non-nil, enable scoring.")
378
379 (defvar gnus-use-picons nil
380   "*If non-nil, display picons.")
381
382 (defvar gnus-fetch-old-headers nil
383   "*Non-nil means that Gnus will try to build threads by grabbing old headers.
384 If an unread article in the group refers to an older, already read (or
385 just marked as read) article, the old article will not normally be
386 displayed in the Summary buffer.  If this variable is non-nil, Gnus
387 will attempt to grab the headers to the old articles, and thereby
388 build complete threads.  If it has the value `some', only enough
389 headers to connect otherwise loose threads will be displayed.
390 This variable can also be a number.  In that case, no more than that
391 number of old headers will be fetched.
392
393 The server has to support NOV for any of this to work.")
394
395 ;see gnus-cus.el
396 ;(defvar gnus-visual t
397 ;  "*If non-nil, will do various highlighting.
398 ;If nil, no mouse highlights (or any other highlights) will be
399 ;performed.  This might speed up Gnus some when generating large group
400 ;and summary buffers.")
401
402 (defvar gnus-novice-user t
403   "*Non-nil means that you are a usenet novice.
404 If non-nil, verbose messages may be displayed and confirmations may be
405 required.")
406
407 (defvar gnus-expert-user nil
408   "*Non-nil means that you will never be asked for confirmation about anything.
409 And that means *anything*.")
410
411 (defvar gnus-verbose 7
412   "*Integer that says how verbose Gnus should be.
413 The higher the number, the more messages Gnus will flash to say what
414 it's doing.  At zero, Gnus will be totally mute; at five, Gnus will
415 display most important messages; and at ten, Gnus will keep on
416 jabbering all the time.")
417
418 (defvar gnus-keep-same-level nil
419   "*Non-nil means that the next newsgroup after the current will be on the same level.
420 When you type, for instance, `n' after reading the last article in the
421 current newsgroup, you will go to the next newsgroup.  If this variable
422 is nil, the next newsgroup will be the next from the group
423 buffer.
424 If this variable is non-nil, Gnus will either put you in the
425 next newsgroup with the same level, or, if no such newsgroup is
426 available, the next newsgroup with the lowest possible level higher
427 than the current level.
428 If this variable is `best', Gnus will make the next newsgroup the one
429 with the best level.")
430
431 (defvar gnus-summary-make-false-root 'adopt
432   "*nil means that Gnus won't gather loose threads.
433 If the root of a thread has expired or been read in a previous
434 session, the information necessary to build a complete thread has been
435 lost.  Instead of having many small sub-threads from this original thread
436 scattered all over the summary buffer, Gnus can gather them.
437
438 If non-nil, Gnus will try to gather all loose sub-threads from an
439 original thread into one large thread.
440
441 If this variable is non-nil, it should be one of `none', `adopt',
442 `dummy' or `empty'.
443
444 If this variable is `none', Gnus will not make a false root, but just
445 present the sub-threads after another.
446 If this variable is `dummy', Gnus will create a dummy root that will
447 have all the sub-threads as children.
448 If this variable is `adopt', Gnus will make one of the \"children\"
449 the parent and mark all the step-children as such.
450 If this variable is `empty', the \"children\" are printed with empty
451 subject fields.  (Or rather, they will be printed with a string
452 given by the `gnus-summary-same-subject' variable.)")
453
454 (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
455   "*A regexp to match subjects to be excluded from loose thread gathering.
456 As loose thread gathering is done on subjects only, that means that
457 there can be many false gatherings performed.  By rooting out certain
458 common subjects, gathering might become saner.")
459
460 (defvar gnus-summary-gather-subject-limit nil
461   "*Maximum length of subject comparisons when gathering loose threads.
462 Use nil to compare full subjects.  Setting this variable to a low
463 number will help gather threads that have been corrupted by
464 newsreaders chopping off subject lines, but it might also mean that
465 unrelated articles that have subject that happen to begin with the
466 same few characters will be incorrectly gathered.
467
468 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
469 comparing subjects.")
470
471 (defvar gnus-simplify-ignored-prefixes nil
472   "*Regexp, matches for which are removed from subject lines when simplifying.")
473
474 (defvar gnus-build-sparse-threads nil
475   "*If non-nil, fill in the gaps in threads.
476 If `some', only fill in the gaps that are needed to tie loose threads
477 together.  If `more', fill in all leaf nodes that Gnus can find.  If
478 non-nil and non-`some', fill in all gaps that Gnus manages to guess.")
479
480 (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
481   "Function used for gathering loose threads.
482 There are two pre-defined functions: `gnus-gather-threads-by-subject',
483 which only takes Subjects into consideration; and
484 `gnus-gather-threads-by-references', which compared the References
485 headers of the articles to find matches.")
486
487 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
488 (defvar gnus-summary-same-subject ""
489   "*String indicating that the current article has the same subject as the previous.
490 This variable will only be used if the value of
491 `gnus-summary-make-false-root' is `empty'.")
492
493 (defvar gnus-summary-goto-unread t
494   "*If non-nil, marking commands will go to the next unread article.
495 If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article,
496 whether it is read or not.")
497
498 (defvar gnus-group-goto-unread t
499   "*If non-nil, movement commands will go to the next unread and subscribed group.")
500
501 (defvar gnus-goto-next-group-when-activating t
502   "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.")
503
504 (defvar gnus-check-new-newsgroups t
505   "*Non-nil means that Gnus will add new newsgroups at startup.
506 If this variable is `ask-server', Gnus will ask the server for new
507 groups since the last time it checked.  This means that the killed list
508 is no longer necessary, so you could set `gnus-save-killed-list' to
509 nil.
510
511 A variant is to have this variable be a list of select methods.  Gnus
512 will then use the `ask-server' method on all these select methods to
513 query for new groups from all those servers.
514
515 Eg.
516   (setq gnus-check-new-newsgroups
517         '((nntp \"some.server\") (nntp \"other.server\")))
518
519 If this variable is nil, then you have to tell Gnus explicitly to
520 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
521
522 (defvar gnus-check-bogus-newsgroups nil
523   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
524 If this variable is nil, then you have to tell Gnus explicitly to
525 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
526
527 (defvar gnus-read-active-file t
528   "*Non-nil means that Gnus will read the entire active file at startup.
529 If this variable is nil, Gnus will only know about the groups in your
530 `.newsrc' file.
531
532 If this variable is `some', Gnus will try to only read the relevant
533 parts of the active file from the server.  Not all servers support
534 this, and it might be quite slow with other servers, but this should
535 generally be faster than both the t and nil value.
536
537 If you set this variable to nil or `some', you probably still want to
538 be told about new newsgroups that arrive.  To do that, set
539 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
540 properly with all servers.")
541
542 (defvar gnus-level-subscribed 5
543   "*Groups with levels less than or equal to this variable are subscribed.")
544
545 (defvar gnus-level-unsubscribed 7
546   "*Groups with levels less than or equal to this variable are unsubscribed.
547 Groups with levels less than `gnus-level-subscribed', which should be
548 less than this variable, are subscribed.")
549
550 (defvar gnus-level-zombie 8
551   "*Groups with this level are zombie groups.")
552
553 (defvar gnus-level-killed 9
554   "*Groups with this level are killed.")
555
556 (defvar gnus-level-default-subscribed 3
557   "*New subscribed groups will be subscribed at this level.")
558
559 (defvar gnus-level-default-unsubscribed 6
560   "*New unsubscribed groups will be unsubscribed at this level.")
561
562 (defvar gnus-activate-level (1+ gnus-level-subscribed)
563   "*Groups higher than this level won't be activated on startup.
564 Setting this variable to something log might save lots of time when
565 you have many groups that you aren't interested in.")
566
567 (defvar gnus-activate-foreign-newsgroups 4
568   "*If nil, Gnus will not check foreign newsgroups at startup.
569 If it is non-nil, it should be a number between one and nine.  Foreign
570 newsgroups that have a level lower or equal to this number will be
571 activated on startup.  For instance, if you want to active all
572 subscribed newsgroups, but not the rest, you'd set this variable to
573 `gnus-level-subscribed'.
574
575 If you subscribe to lots of newsgroups from different servers, startup
576 might take a while.  By setting this variable to nil, you'll save time,
577 but you won't be told how many unread articles there are in the
578 groups.")
579
580 (defvar gnus-save-newsrc-file t
581   "*Non-nil means that Gnus will save the `.newsrc' file.
582 Gnus always saves its own startup file, which is called
583 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
584 be readily understood by other newsreaders.  If you don't plan on
585 using other newsreaders, set this variable to nil to save some time on
586 exit.")
587
588 (defvar gnus-save-killed-list t
589   "*If non-nil, save the list of killed groups to the startup file.
590 If you set this variable to nil, you'll save both time (when starting
591 and quitting) and space (both memory and disk), but it will also mean
592 that Gnus has no record of which groups are new and which are old, so
593 the automatic new newsgroups subscription methods become meaningless.
594
595 You should always set `gnus-check-new-newsgroups' to `ask-server' or
596 nil if you set this variable to nil.")
597
598 (defvar gnus-interactive-catchup t
599   "*If non-nil, require your confirmation when catching up a group.")
600
601 (defvar gnus-interactive-post t
602   "*If non-nil, group name will be asked for when posting.")
603
604 (defvar gnus-interactive-exit t
605   "*If non-nil, require your confirmation when exiting Gnus.")
606
607 (defvar gnus-kill-killed t
608   "*If non-nil, Gnus will apply kill files to already killed articles.
609 If it is nil, Gnus will never apply kill files to articles that have
610 already been through the scoring process, which might very well save lots
611 of time.")
612
613 (defvar gnus-extract-address-components 'gnus-extract-address-components
614   "*Function for extracting address components from a From header.
615 Two pre-defined function exist: `gnus-extract-address-components',
616 which is the default, quite fast, and too simplistic solution, and
617 `mail-extract-address-components', which works much better, but is
618 slower.")
619
620 (defvar gnus-summary-default-score 0
621   "*Default article score level.
622 If this variable is nil, scoring will be disabled.")
623
624 (defvar gnus-summary-zcore-fuzz 0
625   "*Fuzziness factor for the zcore in the summary buffer.
626 Articles with scores closer than this to `gnus-summary-default-score'
627 will not be marked.")
628
629 (defvar gnus-simplify-subject-fuzzy-regexp nil
630   "*Strings to be removed when doing fuzzy matches.
631 This can either be a regular expression or list of regular expressions
632 that will be removed from subject strings if fuzzy subject
633 simplification is selected.")
634
635 (defvar gnus-permanently-visible-groups nil
636   "*Regexp to match groups that should always be listed in the group buffer.
637 This means that they will still be listed when there are no unread
638 articles in the groups.")
639
640 (defvar gnus-list-groups-with-ticked-articles t
641   "*If non-nil, list groups that have only ticked articles.
642 If nil, only list groups that have unread articles.")
643
644 (defvar gnus-group-default-list-level gnus-level-subscribed
645   "*Default listing level.
646 Ignored if `gnus-group-use-permanent-levels' is non-nil.")
647
648 (defvar gnus-group-use-permanent-levels nil
649   "*If non-nil, once you set a level, Gnus will use this level.")
650
651 (defvar gnus-group-list-inactive-groups t
652   "*If non-nil, inactive groups will be listed.")
653
654 (defvar gnus-show-mime nil
655   "*If non-nil, do mime processing of articles.
656 The articles will simply be fed to the function given by
657 `gnus-show-mime-method'.")
658
659 (defvar gnus-strict-mime t
660   "*If nil, MIME-decode even if there is no Mime-Version header in the article.")
661
662 (defvar gnus-show-mime-method 'metamail-buffer
663   "*Function to process a MIME message.
664 The function is called from the article buffer.")
665
666 (defvar gnus-decode-encoded-word-method (lambda ())
667   "*Function to decode a MIME encoded-words.
668 The function is called from the article buffer.")
669
670 (defvar gnus-show-threads t
671   "*If non-nil, display threads in summary mode.")
672
673 (defvar gnus-thread-hide-subtree nil
674   "*If non-nil, hide all threads initially.
675 If threads are hidden, you have to run the command
676 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
677 to expose hidden threads.")
678
679 (defvar gnus-thread-hide-killed t
680   "*If non-nil, hide killed threads automatically.")
681
682 (defvar gnus-thread-ignore-subject nil
683   "*If non-nil, ignore subjects and do all threading based on the Reference header.
684 If nil, which is the default, articles that have different subjects
685 from their parents will start separate threads.")
686
687 (defvar gnus-thread-operation-ignore-subject t
688   "*If non-nil, subjects will be ignored when doing thread commands.
689 This affects commands like `gnus-summary-kill-thread' and
690 `gnus-summary-lower-thread'.
691
692 If this variable is nil, articles in the same thread with different
693 subjects will not be included in the operation in question.  If this
694 variable is `fuzzy', only articles that have subjects that are fuzzily
695 equal will be included.")
696
697 (defvar gnus-thread-indent-level 4
698   "*Number that says how much each sub-thread should be indented.")
699
700 (defvar gnus-ignored-newsgroups
701   (purecopy (mapconcat 'identity
702                        '("^to\\."       ; not "real" groups
703                          "^[0-9. \t]+ " ; all digits in name
704                          "[][\"#'()]"   ; bogus characters
705                          )
706                        "\\|"))
707   "*A regexp to match uninteresting newsgroups in the active file.
708 Any lines in the active file matching this regular expression are
709 removed from the newsgroup list before anything else is done to it,
710 thus making them effectively non-existent.")
711
712 (defvar gnus-ignored-headers
713   "^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:"
714   "*All headers that match this regexp will be hidden.
715 This variable can also be a list of regexps of headers to be ignored.
716 If `gnus-visible-headers' is non-nil, this variable will be ignored.")
717
718 (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-"
719   "*All headers that do not match this regexp will be hidden.
720 This variable can also be a list of regexp of headers to remain visible.
721 If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
722
723 (defvar gnus-sorted-header-list
724   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
725     "^Cc:" "^Date:" "^Organization:")
726   "*This variable is a list of regular expressions.
727 If it is non-nil, headers that match the regular expressions will
728 be placed first in the article buffer in the sequence specified by
729 this list.")
730
731 (defvar gnus-boring-article-headers
732   '(empty followup-to reply-to)
733   "*Headers that are only to be displayed if they have interesting data.
734 Possible values in this list are `empty', `newsgroups', `followup-to',
735 `reply-to', and `date'.")
736
737 (defvar gnus-show-all-headers nil
738   "*If non-nil, don't hide any headers.")
739
740 (defvar gnus-save-all-headers t
741   "*If non-nil, don't remove any headers before saving.")
742
743 (defvar gnus-saved-headers gnus-visible-headers
744   "*Headers to keep if `gnus-save-all-headers' is nil.
745 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
746 If that variable is nil, however, all headers that match this regexp
747 will be kept while the rest will be deleted before saving.")
748
749 (defvar gnus-inhibit-startup-message nil
750   "*If non-nil, the startup message will not be displayed.")
751
752 (defvar gnus-signature-separator "^-- *$"
753   "Regexp matching signature separator.")
754
755 (defvar gnus-signature-limit nil
756   "Provide a limit to what is considered a signature.
757 If it is a number, no signature may not be longer (in characters) than
758 that number.  If it is a function, the function will be called without
759 any parameters, and if it returns nil, there is no signature in the
760 buffer.  If it is a string, it will be used as a regexp.  If it
761 matches, the text in question is not a signature.")
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 In particular, if `vertical' do only vertical recentering.  If non-nil
799 and non-`vertical', do both horizontal and vertical recentering.")
800
801 (defvar gnus-break-pages t
802   "*If non-nil, do page breaking on articles.
803 The page delimiter is specified by the `gnus-page-delimiter'
804 variable.")
805
806 (defvar gnus-page-delimiter "^\^L"
807   "*Regexp describing what to use as article page delimiters.
808 The default value is \"^\^L\", which is a form linefeed at the
809 beginning of a line.")
810
811 (defvar gnus-use-full-window t
812   "*If non-nil, use the entire Emacs screen.")
813
814 (defvar gnus-window-configuration nil
815   "Obsolete variable.  See `gnus-buffer-configuration'.")
816
817 (defvar gnus-window-min-width 2
818   "*Minimum width of Gnus buffers.")
819
820 (defvar gnus-window-min-height 1
821   "*Minimum height of Gnus buffers.")
822
823 (defvar gnus-buffer-configuration
824   '((group
825      (vertical 1.0
826                (group 1.0 point)
827                (if gnus-carpal '(group-carpal 4))))
828     (summary
829      (vertical 1.0
830                (summary 1.0 point)
831                (if gnus-carpal '(summary-carpal 4))))
832     (article
833      (cond 
834       (gnus-use-picons
835        '(frame 1.0
836                (vertical 1.0
837                          (summary 0.25 point)
838                          (if gnus-carpal '(summary-carpal 4))
839                          (article 1.0))
840                (vertical ((height . 5) (width . 15)
841                           (user-position . t)
842                           (left . -1) (top . 1))
843                          (picons 1.0))))
844       (gnus-use-trees
845        '(vertical 1.0
846                   (summary 0.25 point)
847                   (tree 0.25)
848                   (article 1.0)))
849       (t
850        '(vertical 1.0
851                  (summary 0.25 point)
852                  (if gnus-carpal '(summary-carpal 4))
853                  (if gnus-use-trees '(tree 0.25))
854                  (article 1.0)))))
855     (server
856      (vertical 1.0
857                (server 1.0 point)
858                (if gnus-carpal '(server-carpal 2))))
859     (browse
860      (vertical 1.0
861                (browse 1.0 point)
862                (if gnus-carpal '(browse-carpal 2))))
863     (message
864      (vertical 1.0
865                (message 1.0 point)))
866     (pick
867      (vertical 1.0
868                (article 1.0 point)))
869     (info
870      (vertical 1.0
871                (info 1.0 point)))
872     (summary-faq
873      (vertical 1.0
874                (summary 0.25)
875                (faq 1.0 point)))
876     (edit-group
877      (vertical 1.0
878                (group 0.5)
879                (edit-group 1.0 point)))
880     (edit-server
881      (vertical 1.0
882                (server 0.5)
883                (edit-server 1.0 point)))
884     (edit-score
885      (vertical 1.0
886                (summary 0.25)
887                (edit-score 1.0 point)))
888     (post
889      (vertical 1.0
890                (post 1.0 point)))
891     (reply
892      (vertical 1.0
893                (article-copy 0.5)
894                (message 1.0 point)))
895     (forward
896      (vertical 1.0
897                (message 1.0 point)))
898     (reply-yank
899      (vertical 1.0
900                (message 1.0 point)))
901     (mail-bounce
902      (vertical 1.0
903                (article 0.5)
904                (message 1.0 point)))
905     (draft
906      (vertical 1.0
907                (draft 1.0 point)))
908     (pipe
909      (vertical 1.0
910                (summary 0.25 point)
911                (if gnus-carpal '(summary-carpal 4))
912                ("*Shell Command Output*" 1.0)))
913     (bug
914      (vertical 1.0
915                ("*Gnus Help Bug*" 0.5)
916                ("*Gnus Bug*" 1.0 point)))
917     (compose-bounce
918      (vertical 1.0
919                (article 0.5)
920                (message 1.0 point))))
921   "Window configuration for all possible Gnus buffers.
922 This variable is a list of lists.  Each of these lists has a NAME and
923 a RULE.  The NAMEs are commonsense names like `group', which names a
924 rule used when displaying the group buffer; `summary', which names a
925 rule for what happens when you enter a group and do not display an
926 article buffer; and so on.  See the value of this variable for a
927 complete list of NAMEs.
928
929 Each RULE is a list of vectors.  The first element in this vector is
930 the name of the buffer to be displayed; the second element is the
931 percentage of the screen this buffer is to occupy (a number in the
932 0.0-0.99 range); the optional third element is `point', which should
933 be present to denote which buffer point is to go to after making this
934 buffer configuration.")
935
936 (defvar gnus-window-to-buffer
937   '((group . gnus-group-buffer)
938     (summary . gnus-summary-buffer)
939     (article . gnus-article-buffer)
940     (server . gnus-server-buffer)
941     (browse . "*Gnus Browse Server*")
942     (edit-group . gnus-group-edit-buffer)
943     (edit-server . gnus-server-edit-buffer)
944     (group-carpal . gnus-carpal-group-buffer)
945     (summary-carpal . gnus-carpal-summary-buffer)
946     (server-carpal . gnus-carpal-server-buffer)
947     (browse-carpal . gnus-carpal-browse-buffer)
948     (edit-score . gnus-score-edit-buffer)
949     (message . gnus-message-buffer)
950     (faq . gnus-faq-buffer)
951     (picons . "*Picons*")
952     (tree . gnus-tree-buffer)
953     (info . gnus-info-buffer)
954     (article-copy . gnus-article-copy)
955     (draft . gnus-draft-buffer))
956   "Mapping from short symbols to buffer names or buffer variables.")
957
958 (defvar gnus-carpal nil
959   "*If non-nil, display clickable icons.")
960
961 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
962   "*Function called with a group name when new group is detected.
963 A few pre-made functions are supplied: `gnus-subscribe-randomly'
964 inserts new groups at the beginning of the list of groups;
965 `gnus-subscribe-alphabetically' inserts new groups in strict
966 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
967 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
968 for your decision; `gnus-subscribe-killed' kills all new groups.")
969
970 ;; Suggested by a bug report by Hallvard B Furuseth.
971 ;; <h.b.furuseth@usit.uio.no>.
972 (defvar gnus-subscribe-options-newsgroup-method
973   (function gnus-subscribe-alphabetically)
974   "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
975 If, for instance, you want to subscribe to all newsgroups in the
976 \"no\" and \"alt\" hierarchies, you'd put the following in your
977 .newsrc file:
978
979 options -n no.all alt.all
980
981 Gnus will the subscribe all new newsgroups in these hierarchies with
982 the subscription method in this variable.")
983
984 (defvar gnus-subscribe-hierarchical-interactive nil
985   "*If non-nil, Gnus will offer to subscribe hierarchically.
986 When a new hierarchy appears, Gnus will ask the user:
987
988 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
989
990 If the user pressed `d', Gnus will descend the hierarchy, `y' will
991 subscribe to all newsgroups in the hierarchy and `s' will skip this
992 hierarchy in its entirety.")
993
994 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
995   "*Function used for sorting the group buffer.
996 This function will be called with group info entries as the arguments
997 for the groups to be sorted.  Pre-made functions include
998 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
999 `gnus-group-sort-by-level', `gnus-group-sort-by-score', and
1000 `gnus-group-sort-by-rank'.
1001
1002 This variable can also be a list of sorting functions.  In that case,
1003 the most significant sort function should be the last function in the
1004 list.")
1005
1006 ;; Mark variables suggested by Thomas Michanek
1007 ;; <Thomas.Michanek@telelogic.se>.
1008 (defvar gnus-unread-mark ? 
1009   "*Mark used for unread articles.")
1010 (defvar gnus-ticked-mark ?!
1011   "*Mark used for ticked articles.")
1012 (defvar gnus-dormant-mark ??
1013   "*Mark used for dormant articles.")
1014 (defvar gnus-del-mark ?r
1015   "*Mark used for del'd articles.")
1016 (defvar gnus-read-mark ?R
1017   "*Mark used for read articles.")
1018 (defvar gnus-expirable-mark ?E
1019   "*Mark used for expirable articles.")
1020 (defvar gnus-killed-mark ?K
1021   "*Mark used for killed articles.")
1022 (defvar gnus-souped-mark ?F
1023   "*Mark used for killed articles.")
1024 (defvar gnus-kill-file-mark ?X
1025   "*Mark used for articles killed by kill files.")
1026 (defvar gnus-low-score-mark ?Y
1027   "*Mark used for articles with a low score.")
1028 (defvar gnus-catchup-mark ?C
1029   "*Mark used for articles that are caught up.")
1030 (defvar gnus-replied-mark ?A
1031   "*Mark used for articles that have been replied to.")
1032 (defvar gnus-cached-mark ?*
1033   "*Mark used for articles that are in the cache.")
1034 (defvar gnus-saved-mark ?S
1035   "*Mark used for articles that have been saved to.")
1036 (defvar gnus-process-mark ?#
1037   "*Process mark.")
1038 (defvar gnus-ancient-mark ?O
1039   "*Mark used for ancient articles.")
1040 (defvar gnus-sparse-mark ?Q
1041   "*Mark used for sparsely reffed articles.")
1042 (defvar gnus-canceled-mark ?G
1043   "*Mark used for canceled articles.")
1044 (defvar gnus-score-over-mark ?+
1045   "*Score mark used for articles with high scores.")
1046 (defvar gnus-score-below-mark ?-
1047   "*Score mark used for articles with low scores.")
1048 (defvar gnus-empty-thread-mark ? 
1049   "*There is no thread under the article.")
1050 (defvar gnus-not-empty-thread-mark ?=
1051   "*There is a thread under the article.")
1052
1053 (defvar gnus-view-pseudo-asynchronously nil
1054   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
1055
1056 (defvar gnus-view-pseudos nil
1057   "*If `automatic', pseudo-articles will be viewed automatically.
1058 If `not-confirm', pseudos will be viewed automatically, and the user
1059 will not be asked to confirm the command.")
1060
1061 (defvar gnus-view-pseudos-separately t
1062   "*If non-nil, one pseudo-article will be created for each file to be viewed.
1063 If nil, all files that use the same viewing command will be given as a
1064 list of parameters to that command.")
1065
1066 (defvar gnus-insert-pseudo-articles t
1067   "*If non-nil, insert pseudo-articles when decoding articles.")
1068
1069 (defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)%l\n"
1070   "*Format of group lines.
1071 It works along the same lines as a normal formatting string,
1072 with some simple extensions.
1073
1074 %M    Only marked articles (character, \"*\" or \" \")
1075 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
1076 %L    Level of subscribedness (integer)
1077 %N    Number of unread articles (integer)
1078 %I    Number of dormant articles (integer)
1079 %i    Number of ticked and dormant (integer)
1080 %T    Number of ticked articles (integer)
1081 %R    Number of read articles (integer)
1082 %t    Total number of articles (integer)
1083 %y    Number of unread, unticked articles (integer)
1084 %G    Group name (string)
1085 %g    Qualified group name (string)
1086 %D    Group description (string)
1087 %s    Select method (string)
1088 %o    Moderated group (char, \"m\")
1089 %p    Process mark (char)
1090 %O    Moderated group (string, \"(m)\" or \"\")
1091 %P    Topic indentation (string)
1092 %l    Whether there are GroupLens predictions for this group (string)
1093 %n    Select from where (string)
1094 %z    A string that look like `<%s:%n>' if a foreign select method is used
1095 %u    User defined specifier.  The next character in the format string should
1096       be a letter.  Gnus will call the function gnus-user-format-function-X,
1097       where X is the letter following %u.  The function will be passed the
1098       current header as argument.  The function should return a string, which
1099       will be inserted into the buffer just like information from any other
1100       group specifier.
1101
1102 Text between %( and %) will be highlighted with `gnus-mouse-face' when
1103 the mouse point move inside the area.  There can only be one such area.
1104
1105 Note that this format specification is not always respected.  For
1106 reasons of efficiency, when listing killed groups, this specification
1107 is ignored altogether.  If the spec is changed considerably, your
1108 output may end up looking strange when listing both alive and killed
1109 groups.
1110
1111 If you use %o or %O, reading the active file will be slower and quite
1112 a bit of extra memory will be used. %D will also worsen performance.
1113 Also note that if you change the format specification to include any
1114 of these specs, you must probably re-start Gnus to see them go into
1115 effect.")
1116
1117 (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
1118   "*The format specification of the lines in the summary buffer.
1119
1120 It works along the same lines as a normal formatting string,
1121 with some simple extensions.
1122
1123 %N   Article number, left padded with spaces (string)
1124 %S   Subject (string)
1125 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
1126 %n   Name of the poster (string)
1127 %a   Extracted name of the poster (string)
1128 %A   Extracted address of the poster (string)
1129 %F   Contents of the From: header (string)
1130 %x   Contents of the Xref: header (string)
1131 %D   Date of the article (string)
1132 %d   Date of the article (string) in DD-MMM format
1133 %M   Message-id of the article (string)
1134 %r   References of the article (string)
1135 %c   Number of characters in the article (integer)
1136 %L   Number of lines in the article (integer)
1137 %I   Indentation based on thread level (a string of spaces)
1138 %T   A string with two possible values: 80 spaces if the article
1139      is on thread level two or larger and 0 spaces on level one
1140 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
1141 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
1142 %[   Opening bracket (character, \"[\" or \"<\")
1143 %]   Closing bracket (character, \"]\" or \">\")
1144 %>   Spaces of length thread-level (string)
1145 %<   Spaces of length (- 20 thread-level) (string)
1146 %i   Article score (number)
1147 %z   Article zcore (character)
1148 %t   Number of articles under the current thread (number).
1149 %e   Whether the thread is empty or not (character).
1150 %l   GroupLens score (number)
1151 %u   User defined specifier.  The next character in the format string should
1152      be a letter.  Gnus will call the function gnus-user-format-function-X,
1153      where X is the letter following %u.  The function will be passed the
1154      current header as argument.  The function should return a string, which
1155      will be inserted into the summary just like information from any other
1156      summary specifier.
1157
1158 Text between %( and %) will be highlighted with `gnus-mouse-face'
1159 when the mouse point is placed inside the area.  There can only be one
1160 such area.
1161
1162 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1163 with care.  For reasons of efficiency, Gnus will compute what column
1164 these characters will end up in, and \"hard-code\" that.  This means that
1165 it is illegal to have these specs after a variable-length spec.  Well,
1166 you might not be arrested, but your summary buffer will look strange,
1167 which is bad enough.
1168
1169 The smart choice is to have these specs as for to the left as
1170 possible.
1171
1172 This restriction may disappear in later versions of Gnus.")
1173
1174 (defvar gnus-summary-dummy-line-format
1175   "*  %(:                          :%) %S\n"
1176   "*The format specification for the dummy roots in the summary buffer.
1177 It works along the same lines as a normal formatting string,
1178 with some simple extensions.
1179
1180 %S  The subject")
1181
1182 (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
1183   "*The format specification for the summary mode line.
1184 It works along the same lines as a normal formatting string,
1185 with some simple extensions:
1186
1187 %G  Group name
1188 %p  Unprefixed group name
1189 %A  Current article number
1190 %V  Gnus version
1191 %U  Number of unread articles in the group
1192 %e  Number of unselected articles in the group
1193 %Z  A string with unread/unselected article counts
1194 %g  Shortish group name
1195 %S  Subject of the current article
1196 %u  User-defined spec
1197 %s  Current score file name
1198 %d  Number of dormant articles
1199 %r  Number of articles that have been marked as read in this session
1200 %E  Number of articles expunged by the score files")
1201
1202 (defvar gnus-article-mode-line-format "Gnus: %%b %S"
1203   "*The format specification for the article mode line.
1204 See `gnus-summary-mode-line-format' for a closer description.")
1205
1206 (defvar gnus-group-mode-line-format "Gnus: %%b {%M:%S}"
1207   "*The format specification for the group mode line.
1208 It works along the same lines as a normal formatting string,
1209 with some simple extensions:
1210
1211 %S   The native news server.
1212 %M   The native select method.")
1213
1214 (defvar gnus-valid-select-methods
1215   '(("nntp" post address prompt-address)
1216     ("nnspool" post address)
1217     ("nnvirtual" post-mail virtual prompt-address)
1218     ("nnmbox" mail respool address)
1219     ("nnml" mail respool address)
1220     ("nnmh" mail respool address)
1221     ("nndir" post-mail prompt-address address)
1222     ("nneething" none address prompt-address)
1223     ("nndoc" none address prompt-address)
1224     ("nnbabyl" mail address respool)
1225     ("nnkiboze" post address virtual)
1226     ("nnsoup" post-mail address)
1227     ("nndraft" post-mail)
1228     ("nnfolder" mail respool address))
1229   "An alist of valid select methods.
1230 The first element of each list lists should be a string with the name
1231 of the select method.  The other elements may be be the category of
1232 this method (ie. `post', `mail', `none' or whatever) or other
1233 properties that this method has (like being respoolable).
1234 If you implement a new select method, all you should have to change is
1235 this variable.  I think.")
1236
1237 (defvar gnus-updated-mode-lines '(group article summary tree)
1238   "*List of buffers that should update their mode lines.
1239 The list may contain the symbols `group', `article' and `summary'.  If
1240 the corresponding symbol is present, Gnus will keep that mode line
1241 updated with information that may be pertinent.
1242 If this variable is nil, screen refresh may be quicker.")
1243
1244 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1245 (defvar gnus-mode-non-string-length nil
1246   "*Max length of mode-line non-string contents.
1247 If this is nil, Gnus will take space as is needed, leaving the rest
1248 of the modeline intact.")
1249
1250 ;see gnus-cus.el
1251 ;(defvar gnus-mouse-face 'highlight
1252 ;  "*Face used for mouse highlighting in Gnus.
1253 ;No mouse highlights will be done if `gnus-visual' is nil.")
1254
1255 (defvar gnus-summary-mark-below nil
1256   "*Mark all articles with a score below this variable as read.
1257 This variable is local to each summary buffer and usually set by the
1258 score file.")
1259
1260 (defvar gnus-article-sort-functions '(gnus-article-sort-by-number)
1261   "*List of functions used for sorting articles in the summary buffer.
1262 This variable is only used when not using a threaded display.")
1263
1264 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
1265   "*List of functions used for sorting threads in the summary buffer.
1266 By default, threads are sorted by article number.
1267
1268 Each function takes two threads and return non-nil if the first thread
1269 should be sorted before the other.  If you use more than one function,
1270 the primary sort function should be the last.  You should probably
1271 always include `gnus-thread-sort-by-number' in the list of sorting
1272 functions -- preferably first.
1273
1274 Ready-mady functions include `gnus-thread-sort-by-number',
1275 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
1276 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
1277 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
1278
1279 (defvar gnus-thread-score-function '+
1280   "*Function used for calculating the total score of a thread.
1281
1282 The function is called with the scores of the article and each
1283 subthread and should then return the score of the thread.
1284
1285 Some functions you can use are `+', `max', or `min'.")
1286
1287 (defvar gnus-summary-expunge-below nil
1288   "All articles that have a score less than this variable will be expunged.")
1289
1290 (defvar gnus-thread-expunge-below nil
1291   "All threads that have a total score less than this variable will be expunged.
1292 See `gnus-thread-score-function' for en explanation of what a
1293 \"thread score\" is.")
1294
1295 (defvar gnus-auto-subscribed-groups
1296   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
1297   "*All new groups that match this regexp will be subscribed automatically.
1298 Note that this variable only deals with new groups.  It has no effect
1299 whatsoever on old groups.")
1300
1301 (defvar gnus-options-subscribe nil
1302   "*All new groups matching this regexp will be subscribed unconditionally.
1303 Note that this variable deals only with new newsgroups.  This variable
1304 does not affect old newsgroups.")
1305
1306 (defvar gnus-options-not-subscribe nil
1307   "*All new groups matching this regexp will be ignored.
1308 Note that this variable deals only with new newsgroups.  This variable
1309 does not affect old (already subscribed) newsgroups.")
1310
1311 (defvar gnus-auto-expirable-newsgroups nil
1312   "*Groups in which to automatically mark read articles as expirable.
1313 If non-nil, this should be a regexp that should match all groups in
1314 which to perform auto-expiry.  This only makes sense for mail groups.")
1315
1316 (defvar gnus-total-expirable-newsgroups nil
1317   "*Groups in which to perform expiry of all read articles.
1318 Use with extreme caution.  All groups that match this regexp will be
1319 expiring - which means that all read articles will be deleted after
1320 (say) one week.  (This only goes for mail groups and the like, of
1321 course.)")
1322
1323 (defvar gnus-group-uncollapsed-levels 1
1324   "Number of group name elements to leave alone when making a short group name.")
1325
1326 (defvar gnus-hidden-properties '(invisible t intangible t)
1327   "Property list to use for hiding text.")
1328
1329 (defvar gnus-modtime-botch nil
1330   "*Non-nil means .newsrc should be deleted prior to save.  
1331 Its use is due to the bogus appearance that .newsrc was modified on
1332 disc.")
1333
1334 ;; Hooks.
1335
1336 (defvar gnus-group-mode-hook nil
1337   "*A hook for Gnus group mode.")
1338
1339 (defvar gnus-summary-mode-hook nil
1340   "*A hook for Gnus summary mode.
1341 This hook is run before any variables are set in the summary buffer.")
1342
1343 (defvar gnus-article-mode-hook nil
1344   "*A hook for Gnus article mode.")
1345
1346 (defvar gnus-summary-prepare-exit-hook nil
1347   "*A hook called when preparing to exit from the summary buffer.
1348 It calls `gnus-summary-expire-articles' by default.")
1349 (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
1350
1351 (defvar gnus-summary-exit-hook nil
1352   "*A hook called on exit from the summary buffer.")
1353
1354 (defvar gnus-group-catchup-group-hook nil
1355   "*A hook run when catching up a group from the group buffer.")
1356
1357 (defvar gnus-open-server-hook nil
1358   "*A hook called just before opening connection to the news server.")
1359
1360 (defvar gnus-load-hook nil
1361   "*A hook run while Gnus is loaded.")
1362
1363 (defvar gnus-startup-hook nil
1364   "*A hook called at startup.
1365 This hook is called after Gnus is connected to the NNTP server.")
1366
1367 (defvar gnus-get-new-news-hook nil
1368   "*A hook run just before Gnus checks for new news.")
1369
1370 (defvar gnus-after-getting-new-news-hook nil
1371   "*A hook run after 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-after-exiting-gnus-hook nil
1478   "*A hook called after exiting Gnus.")
1479
1480 (defvar gnus-save-newsrc-hook nil
1481   "*A hook called before saving any of the newsrc files.")
1482
1483 (defvar gnus-save-quick-newsrc-hook nil
1484   "*A hook called just before saving the quick newsrc file.
1485 Can be used to turn version control on or off.")
1486
1487 (defvar gnus-save-standard-newsrc-hook nil
1488   "*A hook called just before saving the standard newsrc file.
1489 Can be used to turn version control on or off.")
1490
1491 (defvar gnus-summary-update-hook
1492   (list 'gnus-summary-highlight-line)
1493   "*A hook called when a summary line is changed.
1494 The hook will not be called if `gnus-visual' is nil.
1495
1496 The default function `gnus-summary-highlight-line' will
1497 highlight the line according to the `gnus-summary-highlight'
1498 variable.")
1499
1500 (defvar gnus-group-update-hook '(gnus-group-highlight-line)
1501   "*A hook called when a group line is changed.
1502 The hook will not be called if `gnus-visual' is nil.
1503
1504 The default function `gnus-group-highlight-line' will
1505 highlight the line according to the `gnus-group-highlight'
1506 variable.")
1507
1508 (defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
1509   "*A hook called when an article is selected for the first time.
1510 The hook is intended to mark an article as read (or unread)
1511 automatically when it is selected.")
1512
1513 (defvar gnus-group-change-level-function nil
1514   "Function run when a group level is changed.
1515 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.")
1516
1517 ;; Remove any hilit infestation.
1518 (add-hook 'gnus-startup-hook
1519           (lambda ()
1520             (remove-hook 'gnus-summary-prepare-hook
1521                          'hilit-rehighlight-buffer-quietly)
1522             (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
1523             (setq gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read))
1524             (remove-hook 'gnus-article-prepare-hook
1525                          'hilit-rehighlight-buffer-quietly)))
1526
1527 \f
1528 ;; Internal variables
1529
1530 (defvar gnus-server-alist nil
1531   "List of available servers.")
1532
1533 (defvar gnus-group-indentation-function nil)
1534
1535 (defvar gnus-topic-indentation "") ;; Obsolete variable.
1536
1537 (defvar gnus-goto-missing-group-function nil)
1538
1539 (defvar gnus-override-subscribe-method nil)
1540
1541 (defvar gnus-group-goto-next-group-function nil
1542   "Function to override finding the next group after listing groups.")
1543
1544 (defconst gnus-article-mark-lists
1545   '((marked . tick) (replied . reply)
1546     (expirable . expire) (killed . killed)
1547     (bookmarks . bookmark) (dormant . dormant)
1548     (scored . score) (saved . save)
1549     (cached . cache)
1550     ))
1551
1552 ;; Avoid highlighting in kill files.
1553 (defvar gnus-summary-inhibit-highlight nil)
1554 (defvar gnus-newsgroup-selected-overlay nil)
1555
1556 (defvar gnus-inhibit-hiding nil)
1557 (defvar gnus-group-indentation "")
1558 (defvar gnus-inhibit-limiting nil)
1559 (defvar gnus-created-frames nil)
1560
1561 (defvar gnus-article-mode-map nil)
1562 (defvar gnus-dribble-buffer nil)
1563 (defvar gnus-headers-retrieved-by nil)
1564 (defvar gnus-article-reply nil)
1565 (defvar gnus-override-method nil)
1566 (defvar gnus-article-check-size nil)
1567
1568 (defvar gnus-current-score-file nil)
1569 (defvar gnus-newsgroup-adaptive-score-file nil)
1570 (defvar gnus-scores-exclude-files nil)
1571
1572 (defvar gnus-opened-servers nil)
1573
1574 (defvar gnus-current-move-group nil)
1575
1576 (defvar gnus-newsgroup-dependencies nil)
1577 (defvar gnus-newsgroup-async nil)
1578 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1579
1580 (defvar gnus-newsgroup-adaptive nil)
1581
1582 (defvar gnus-summary-display-table nil)
1583 (defvar gnus-summary-display-article-function nil)
1584
1585 (defvar gnus-summary-highlight-line-function nil
1586   "Function called after highlighting a summary line.")
1587
1588 (defvar gnus-group-line-format-alist
1589   `((?M gnus-tmp-marked-mark ?c)
1590     (?S gnus-tmp-subscribed ?c)
1591     (?L gnus-tmp-level ?d)
1592     (?N (cond ((eq number t) "*" )
1593               ((numberp number) 
1594                (int-to-string
1595                 (+ number
1596                    (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1597                    (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
1598               (t number)) ?s)
1599     (?R gnus-tmp-number-of-read ?s)
1600     (?t gnus-tmp-number-total ?d)
1601     (?y gnus-tmp-number-of-unread ?s)
1602     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
1603     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
1604     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1605            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
1606     (?g gnus-tmp-group ?s)
1607     (?G gnus-tmp-qualified-group ?s)
1608     (?c (gnus-short-group-name gnus-tmp-group) ?s)
1609     (?D gnus-tmp-newsgroup-description ?s)
1610     (?o gnus-tmp-moderated ?c)
1611     (?O gnus-tmp-moderated-string ?s)
1612     (?p gnus-tmp-process-marked ?c)
1613     (?s gnus-tmp-news-server ?s)
1614     (?n gnus-tmp-news-method ?s)
1615     (?P gnus-group-indentation ?s)
1616     (?l gnus-tmp-grouplens ?s)
1617     (?z gnus-tmp-news-method-string ?s)
1618     (?u gnus-tmp-user-defined ?s)))
1619
1620 (defvar gnus-summary-line-format-alist
1621   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1622     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1623     (?s gnus-tmp-subject-or-nil ?s)
1624     (?n gnus-tmp-name ?s)
1625     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1626         ?s)
1627     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
1628             gnus-tmp-from) ?s)
1629     (?F gnus-tmp-from ?s)
1630     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1631     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1632     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1633     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1634     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1635     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1636     (?L gnus-tmp-lines ?d)
1637     (?I gnus-tmp-indentation ?s)
1638     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1639     (?R gnus-tmp-replied ?c)
1640     (?\[ gnus-tmp-opening-bracket ?c)
1641     (?\] gnus-tmp-closing-bracket ?c)
1642     (?\> (make-string gnus-tmp-level ? ) ?s)
1643     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1644     (?i gnus-tmp-score ?d)
1645     (?z gnus-tmp-score-char ?c)
1646     (?l (bbb-grouplens-score gnus-tmp-header) ?s)
1647     (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
1648     (?U gnus-tmp-unread ?c)
1649     (?t (gnus-summary-number-of-articles-in-thread
1650          (and (boundp 'thread) (car thread)) gnus-tmp-level)
1651         ?d)
1652     (?e (gnus-summary-number-of-articles-in-thread
1653          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1654         ?c)
1655     (?u gnus-tmp-user-defined ?s))
1656   "An alist of format specifications that can appear in summary lines,
1657 and what variables they correspond with, along with the type of the
1658 variable (string, integer, character, etc).")
1659
1660 (defvar gnus-summary-dummy-line-format-alist
1661   `((?S gnus-tmp-subject ?s)
1662     (?N gnus-tmp-number ?d)
1663     (?u gnus-tmp-user-defined ?s)))
1664
1665 (defvar gnus-summary-mode-line-format-alist
1666   `((?G gnus-tmp-group-name ?s)
1667     (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1668     (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1669     (?A gnus-tmp-article-number ?d)
1670     (?Z gnus-tmp-unread-and-unselected ?s)
1671     (?V gnus-version ?s)
1672     (?U gnus-tmp-unread ?d)
1673     (?S gnus-tmp-subject ?s)
1674     (?e gnus-tmp-unselected ?d)
1675     (?u gnus-tmp-user-defined ?s)
1676     (?d (length gnus-newsgroup-dormant) ?d)
1677     (?t (length gnus-newsgroup-marked) ?d)
1678     (?r (length gnus-newsgroup-reads) ?d)
1679     (?E gnus-newsgroup-expunged-tally ?d)
1680     (?s (gnus-current-score-file-nondirectory) ?s)))
1681
1682 (defvar gnus-article-mode-line-format-alist
1683   gnus-summary-mode-line-format-alist)
1684
1685 (defvar gnus-group-mode-line-format-alist
1686   `((?S gnus-tmp-news-server ?s)
1687     (?M gnus-tmp-news-method ?s)
1688     (?u gnus-tmp-user-defined ?s)))
1689
1690 (defvar gnus-have-read-active-file nil)
1691
1692 (defconst gnus-maintainer
1693   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1694   "The mail address of the Gnus maintainers.")
1695
1696 (defconst gnus-version "September Gnus v0.63"
1697   "Version number for this version of Gnus.")
1698
1699 (defvar gnus-info-nodes
1700   '((gnus-group-mode            "(gnus)The Group Buffer")
1701     (gnus-summary-mode          "(gnus)The Summary Buffer")
1702     (gnus-article-mode          "(gnus)The Article Buffer"))
1703   "Assoc list of major modes and related Info nodes.")
1704
1705 (defvar gnus-group-buffer "*Group*")
1706 (defvar gnus-summary-buffer "*Summary*")
1707 (defvar gnus-article-buffer "*Article*")
1708 (defvar gnus-server-buffer "*Server*")
1709
1710 (defvar gnus-work-buffer " *gnus work*")
1711
1712 (defvar gnus-original-article-buffer " *Original Article*")
1713 (defvar gnus-original-article nil)
1714
1715 (defvar gnus-buffer-list nil
1716   "Gnus buffers that should be killed on exit.")
1717
1718 (defvar gnus-slave nil
1719   "Whether this Gnus is a slave or not.")
1720
1721 (defvar gnus-variable-list
1722   '(gnus-newsrc-options gnus-newsrc-options-n
1723     gnus-newsrc-last-checked-date
1724     gnus-newsrc-alist gnus-server-alist
1725     gnus-killed-list gnus-zombie-list
1726     gnus-topic-topology gnus-topic-alist
1727     gnus-format-specs)
1728   "Gnus variables saved in the quick startup file.")
1729
1730 (defvar gnus-newsrc-options nil
1731   "Options line in the .newsrc file.")
1732
1733 (defvar gnus-newsrc-options-n nil
1734   "List of regexps representing groups to be subscribed/ignored unconditionally.")
1735
1736 (defvar gnus-newsrc-last-checked-date nil
1737   "Date Gnus last asked server for new newsgroups.")
1738
1739 (defvar gnus-topic-topology nil
1740   "The complete topic hierarchy.")
1741
1742 (defvar gnus-topic-alist nil
1743   "The complete topic-group alist.")
1744
1745 (defvar gnus-newsrc-alist nil
1746   "Assoc list of read articles.
1747 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1748
1749 (defvar gnus-newsrc-hashtb nil
1750   "Hashtable of gnus-newsrc-alist.")
1751
1752 (defvar gnus-killed-list nil
1753   "List of killed newsgroups.")
1754
1755 (defvar gnus-killed-hashtb nil
1756   "Hash table equivalent of gnus-killed-list.")
1757
1758 (defvar gnus-zombie-list nil
1759   "List of almost dead newsgroups.")
1760
1761 (defvar gnus-description-hashtb nil
1762   "Descriptions of newsgroups.")
1763
1764 (defvar gnus-list-of-killed-groups nil
1765   "List of newsgroups that have recently been killed by the user.")
1766
1767 (defvar gnus-active-hashtb nil
1768   "Hashtable of active articles.")
1769
1770 (defvar gnus-moderated-list nil
1771   "List of moderated newsgroups.")
1772
1773 (defvar gnus-group-marked nil)
1774
1775 (defvar gnus-current-startup-file nil
1776   "Startup file for the current host.")
1777
1778 (defvar gnus-last-search-regexp nil
1779   "Default regexp for article search command.")
1780
1781 (defvar gnus-last-shell-command nil
1782   "Default shell command on article.")
1783
1784 (defvar gnus-current-select-method nil
1785   "The current method for selecting a newsgroup.")
1786
1787 (defvar gnus-group-list-mode nil)
1788
1789 (defvar gnus-article-internal-prepare-hook nil)
1790
1791 (defvar gnus-newsgroup-name nil)
1792 (defvar gnus-newsgroup-begin nil)
1793 (defvar gnus-newsgroup-end nil)
1794 (defvar gnus-newsgroup-last-rmail nil)
1795 (defvar gnus-newsgroup-last-mail nil)
1796 (defvar gnus-newsgroup-last-folder nil)
1797 (defvar gnus-newsgroup-last-file nil)
1798 (defvar gnus-newsgroup-auto-expire nil)
1799 (defvar gnus-newsgroup-active nil)
1800
1801 (defvar gnus-newsgroup-data nil)
1802 (defvar gnus-newsgroup-data-reverse nil)
1803 (defvar gnus-newsgroup-limit nil)
1804 (defvar gnus-newsgroup-limits nil)
1805
1806 (defvar gnus-newsgroup-unreads nil
1807   "List of unread articles in the current newsgroup.")
1808
1809 (defvar gnus-newsgroup-unselected nil
1810   "List of unselected unread articles in the current newsgroup.")
1811
1812 (defvar gnus-newsgroup-reads nil
1813   "Alist of read articles and article marks in the current newsgroup.")
1814
1815 (defvar gnus-newsgroup-expunged-tally nil)
1816
1817 (defvar gnus-newsgroup-marked nil
1818   "List of ticked articles in the current newsgroup (a subset of unread art).")
1819
1820 (defvar gnus-newsgroup-killed nil
1821   "List of ranges of articles that have been through the scoring process.")
1822
1823 (defvar gnus-newsgroup-cached nil
1824   "List of articles that come from the article cache.")
1825
1826 (defvar gnus-newsgroup-saved nil
1827   "List of articles that have been saved.")
1828
1829 (defvar gnus-newsgroup-kill-headers nil)
1830
1831 (defvar gnus-newsgroup-replied nil
1832   "List of articles that have been replied to in the current newsgroup.")
1833
1834 (defvar gnus-newsgroup-expirable nil
1835   "List of articles in the current newsgroup that can be expired.")
1836
1837 (defvar gnus-newsgroup-processable nil
1838   "List of articles in the current newsgroup that can be processed.")
1839
1840 (defvar gnus-newsgroup-bookmarks nil
1841   "List of articles in the current newsgroup that have bookmarks.")
1842
1843 (defvar gnus-newsgroup-dormant nil
1844   "List of dormant articles in the current newsgroup.")
1845
1846 (defvar gnus-newsgroup-scored nil
1847   "List of scored articles in the current newsgroup.")
1848
1849 (defvar gnus-newsgroup-headers nil
1850   "List of article headers in the current newsgroup.")
1851
1852 (defvar gnus-newsgroup-threads nil)
1853
1854 (defvar gnus-newsgroup-prepared nil
1855   "Whether the current group has been prepared properly.")
1856
1857 (defvar gnus-newsgroup-ancient nil
1858   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1859
1860 (defvar gnus-newsgroup-sparse nil)
1861
1862 (defvar gnus-current-article nil)
1863 (defvar gnus-article-current nil)
1864 (defvar gnus-current-headers nil)
1865 (defvar gnus-have-all-headers nil)
1866 (defvar gnus-last-article nil)
1867 (defvar gnus-newsgroup-history nil)
1868 (defvar gnus-current-kill-article nil)
1869
1870 ;; Save window configuration.
1871 (defvar gnus-prev-winconf nil)
1872
1873 (defvar gnus-summary-mark-positions nil)
1874 (defvar gnus-group-mark-positions nil)
1875
1876 (defvar gnus-reffed-article-number nil)
1877
1878 ;;; Let the byte-compiler know that we know about this variable.
1879 (defvar rmail-default-rmail-file)
1880
1881 (defvar gnus-cache-removable-articles nil)
1882
1883 (defvar gnus-dead-summary nil)
1884
1885 (defconst gnus-summary-local-variables
1886   '(gnus-newsgroup-name
1887     gnus-newsgroup-begin gnus-newsgroup-end
1888     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1889     gnus-newsgroup-last-folder gnus-newsgroup-last-file
1890     gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1891     gnus-newsgroup-unselected gnus-newsgroup-marked
1892     gnus-newsgroup-reads gnus-newsgroup-saved
1893     gnus-newsgroup-replied gnus-newsgroup-expirable
1894     gnus-newsgroup-processable gnus-newsgroup-killed
1895     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1896     gnus-newsgroup-headers gnus-newsgroup-threads
1897     gnus-newsgroup-prepared gnus-summary-highlight-line-function
1898     gnus-current-article gnus-current-headers gnus-have-all-headers
1899     gnus-last-article gnus-article-internal-prepare-hook
1900     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1901     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1902     gnus-newsgroup-async 
1903     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
1904     gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
1905     gnus-newsgroup-history gnus-newsgroup-ancient
1906     gnus-newsgroup-sparse
1907     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1908     gnus-newsgroup-adaptive-score-file
1909     (gnus-newsgroup-expunged-tally . 0)
1910     gnus-cache-removable-articles gnus-newsgroup-cached
1911     gnus-newsgroup-data gnus-newsgroup-data-reverse
1912     gnus-newsgroup-limit gnus-newsgroup-limits)
1913   "Variables that are buffer-local to the summary buffers.")
1914
1915 (defconst gnus-bug-message
1916   "Sending a bug report to the Gnus Towers.
1917 ========================================
1918
1919 The buffer below is a mail buffer.  When you press `C-c C-c', it will
1920 be sent to the Gnus Bug Exterminators.
1921
1922 At the bottom of the buffer you'll see lots of variable settings.
1923 Please do not delete those.  They will tell the Bug People what your
1924 environment is, so that it will be easier to locate the bugs.
1925
1926 If you have found a bug that makes Emacs go \"beep\", set
1927 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
1928 and include the backtrace in your bug report.
1929
1930 Please describe the bug in annoying, painstaking detail.
1931
1932 Thank you for your help in stamping out bugs.
1933 ")
1934
1935 ;;; End of variables.
1936
1937 ;; Define some autoload functions Gnus might use.
1938 (eval-and-compile
1939
1940   ;; This little mapcar goes through the list below and marks the
1941   ;; symbols in question as autoloaded functions.
1942   (mapcar
1943    (lambda (package)
1944      (let ((interactive (nth 1 (memq ':interactive package))))
1945        (mapcar
1946         (lambda (function)
1947           (let (keymap)
1948             (when (consp function)
1949               (setq keymap (car (memq 'keymap function)))
1950               (setq function (car function)))
1951             (autoload function (car package) nil interactive keymap)))
1952         (if (eq (nth 1 package) ':interactive)
1953             (cdddr package)
1954           (cdr package)))))
1955    '(("metamail" metamail-buffer)
1956      ("info" Info-goto-node)
1957      ("hexl" hexl-hex-string-to-integer)
1958      ("pp" pp pp-to-string pp-eval-expression)
1959      ("mail-extr" mail-extract-address-components)
1960      ("nnmail" nnmail-split-fancy nnmail-article-group)
1961      ("nnvirtual" nnvirtual-catchup-group)
1962      ("timezone" timezone-make-date-arpa-standard timezone-fix-time
1963       timezone-make-sortable-date timezone-make-time-string)
1964      ("sendmail" mail-position-on-field mail-setup)
1965      ("rmailout" rmail-output)
1966      ("rnewspost" news-mail-other-window news-reply-yank-original
1967       news-caesar-buffer-body)
1968      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
1969       rmail-show-message)
1970      ("gnus-soup" :interactive t
1971       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
1972       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1973      ("nnsoup" nnsoup-pack-replies)
1974      ("gnus-scomo" :interactive t gnus-score-mode)
1975      ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
1976       gnus-Folder-save-name gnus-folder-save-name)
1977      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
1978      ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
1979       gnus-server-make-menu-bar gnus-article-make-menu-bar
1980       gnus-browse-make-menu-bar gnus-highlight-selected-summary
1981       gnus-summary-highlight-line gnus-carpal-setup-buffer
1982       gnus-group-highlight-line
1983       gnus-article-add-button gnus-insert-next-page-button
1984       gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu)
1985      ("gnus-vis" :interactive t
1986       gnus-article-push-button gnus-article-press-button
1987       gnus-article-highlight gnus-article-highlight-some
1988       gnus-article-highlight-headers gnus-article-highlight-signature
1989       gnus-article-add-buttons gnus-article-add-buttons-to-head
1990       gnus-article-next-button gnus-article-prev-button)
1991      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
1992       gnus-demon-add-disconnection gnus-demon-add-handler
1993       gnus-demon-remove-handler)
1994      ("gnus-demon" :interactive t
1995       gnus-demon-init gnus-demon-cancel)
1996      ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
1997       gnus-tree-open gnus-tree-close)
1998      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
1999       gnus-nocem-unwanted-article-p)
2000      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
2001      ("gnus-srvr" gnus-browse-foreign-server)
2002      ("gnus-cite" :interactive t
2003       gnus-article-highlight-citation gnus-article-hide-citation-maybe
2004       gnus-article-hide-citation gnus-article-fill-cited-article)
2005      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
2006       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
2007       gnus-execute gnus-expunge)
2008      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
2009       gnus-cache-possibly-remove-articles gnus-cache-request-article
2010       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
2011       gnus-cache-enter-remove-article gnus-cached-article-p
2012       gnus-cache-open gnus-cache-close gnus-cache-update-article)
2013      ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
2014       gnus-cache-remove-article)
2015      ("gnus-score" :interactive t
2016       gnus-summary-increase-score gnus-summary-lower-score
2017       gnus-score-flush-cache gnus-score-close
2018       gnus-score-raise-same-subject-and-select
2019       gnus-score-raise-same-subject gnus-score-default
2020       gnus-score-raise-thread gnus-score-lower-same-subject-and-select
2021       gnus-score-lower-same-subject gnus-score-lower-thread
2022       gnus-possibly-score-headers)
2023      ("gnus-score"
2024       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
2025       gnus-current-score-file-nondirectory gnus-score-adaptive
2026       gnus-score-find-trace gnus-score-file-name)
2027      ("gnus-edit" :interactive t gnus-score-customize)
2028      ("gnus-topic" :interactive t gnus-topic-mode)
2029      ("gnus-topic" gnus-topic-remove-group)
2030      ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
2031      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
2032      ("gnus-uu" :interactive t
2033       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
2034       gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
2035       gnus-uu-mark-by-regexp gnus-uu-mark-all
2036       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
2037       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
2038       gnus-uu-decode-unshar-and-save gnus-uu-decode-save
2039       gnus-uu-decode-binhex gnus-uu-decode-uu-view
2040       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
2041       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
2042       gnus-uu-decode-binhex-view)
2043      ("gnus-msg" (gnus-summary-send-map keymap)
2044       gnus-mail-yank-original gnus-mail-send-and-exit
2045       gnus-sendmail-setup-mail gnus-article-mail
2046       gnus-inews-message-id gnus-new-mail gnus-mail-reply)
2047      ("gnus-msg" :interactive t
2048       gnus-group-post-news gnus-group-mail gnus-summary-post-news
2049       gnus-summary-followup gnus-summary-followup-with-original
2050       gnus-summary-followup-and-reply
2051       gnus-summary-followup-and-reply-with-original
2052       gnus-summary-cancel-article gnus-summary-supersede-article
2053       gnus-post-news gnus-inews-news gnus-cancel-news
2054       gnus-summary-reply gnus-summary-reply-with-original
2055       gnus-summary-mail-forward gnus-summary-mail-other-window
2056       gnus-bug)
2057      ("gnus-picon" :interactive t gnus-article-display-picons
2058       gnus-group-display-picons gnus-picons-article-display-x-face)
2059      ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p 
2060       gnus-grouplens-mode)
2061      ("gnus-vm" gnus-vm-mail-setup)
2062      ("gnus-vm" :interactive t gnus-summary-save-in-vm
2063       gnus-summary-save-article-vm gnus-yank-article))))
2064
2065 \f
2066
2067 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2068 ;; If you want the cursor to go somewhere else, set these two
2069 ;; functions in some startup hook to whatever you want.
2070 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
2071 (defalias 'gnus-group-position-point 'gnus-goto-colon)
2072
2073 ;;; Various macros and substs.
2074
2075 (defun gnus-header-from (header)
2076   (mail-header-from header))
2077
2078 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
2079   "Pop to BUFFER, evaluate FORMS, and then return to the original window."
2080   (let ((tempvar (make-symbol "GnusStartBufferWindow")))
2081     `(let ((,tempvar (selected-window)))
2082        (unwind-protect
2083            (progn
2084              (pop-to-buffer ,buffer)
2085              ,@forms)
2086          (select-window ,tempvar)))))
2087
2088 (defmacro gnus-gethash (string hashtable)
2089   "Get hash value of STRING in HASHTABLE."
2090   `(symbol-value (intern-soft ,string ,hashtable)))
2091
2092 (defmacro gnus-sethash (string value hashtable)
2093   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2094   `(set (intern ,string ,hashtable) ,value))
2095
2096 (defmacro gnus-intern-safe (string hashtable)
2097   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2098   `(let ((symbol (intern ,string ,hashtable)))
2099      (or (boundp symbol)
2100          (set symbol nil))
2101      symbol))
2102
2103 (defmacro gnus-group-unread (group)
2104   "Get the currently computed number of unread articles in GROUP."
2105   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
2106
2107 (defmacro gnus-group-entry (group)
2108   "Get the newsrc entry for GROUP."
2109   `(gnus-gethash ,group gnus-newsrc-hashtb))
2110
2111 (defmacro gnus-active (group)
2112   "Get active info on GROUP."
2113   `(gnus-gethash ,group gnus-active-hashtb))
2114
2115 (defmacro gnus-set-active (group active)
2116   "Set GROUP's active info."
2117   `(gnus-sethash ,group ,active gnus-active-hashtb))
2118
2119 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2120 ;;   function `substring' might cut on a middle of multi-octet
2121 ;;   character.
2122 (defun gnus-truncate-string (str width)
2123   (substring str 0 width))
2124
2125 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
2126 ;; to limit the length of a string.  This function is necessary since
2127 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
2128 (defsubst gnus-limit-string (str width)
2129   (if (> (length str) width)
2130       (substring str 0 width)
2131     str))
2132
2133 (defsubst gnus-simplify-subject-re (subject)
2134   "Remove \"Re:\" from subject lines."
2135   (if (string-match "^[Rr][Ee]: *" subject)
2136       (substring subject (match-end 0))
2137     subject))
2138
2139 (defsubst gnus-functionp (form)
2140   "Return non-nil if FORM is funcallable."
2141   (or (and (symbolp form) (fboundp form))
2142       (and (listp form) (eq (car form) 'lambda))))
2143
2144 (defsubst gnus-goto-char (point)
2145   (and point (goto-char point)))
2146
2147 (defmacro gnus-buffer-exists-p (buffer)
2148   `(let ((buffer ,buffer))
2149      (and buffer
2150           (funcall (if (stringp buffer) 'get-buffer 'buffer-name)
2151                    buffer))))
2152
2153 (defmacro gnus-kill-buffer (buffer)
2154   `(let ((buf ,buffer))
2155      (if (gnus-buffer-exists-p buf)
2156          (kill-buffer buf))))
2157
2158 (defsubst gnus-point-at-bol ()
2159   "Return point at the beginning of the line."
2160   (let ((p (point)))
2161     (beginning-of-line)
2162     (prog1
2163         (point)
2164       (goto-char p))))
2165
2166 (defsubst gnus-point-at-eol ()
2167   "Return point at the end of the line."
2168   (let ((p (point)))
2169     (end-of-line)
2170     (prog1
2171         (point)
2172       (goto-char p))))
2173
2174 (defun gnus-alive-p ()
2175   "Say whether Gnus is running or not."
2176   (and gnus-group-buffer
2177        (get-buffer gnus-group-buffer)))
2178
2179 ;; Delete the current line (and the next N lines.);
2180 (defmacro gnus-delete-line (&optional n)
2181   `(delete-region (progn (beginning-of-line) (point))
2182                   (progn (forward-line ,(or n 1)) (point))))
2183
2184 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
2185 (defvar gnus-init-inhibit nil)
2186 (defun gnus-read-init-file (&optional inhibit-next)
2187   (if gnus-init-inhibit
2188       (setq gnus-init-inhibit nil)
2189     (setq gnus-init-inhibit inhibit-next)
2190     (and gnus-init-file
2191          (or (and (file-exists-p gnus-init-file)
2192                   ;; Don't try to load a directory.
2193                   (not (file-directory-p gnus-init-file)))
2194              (file-exists-p (concat gnus-init-file ".el"))
2195              (file-exists-p (concat gnus-init-file ".elc")))
2196          (condition-case var
2197              (load gnus-init-file nil t)
2198            (error
2199             (error "Error in %s: %s" gnus-init-file var))))))
2200
2201 ;; Info access macros.
2202
2203 (defmacro gnus-info-group (info)
2204   `(nth 0 ,info))
2205 (defmacro gnus-info-rank (info)
2206   `(nth 1 ,info))
2207 (defmacro gnus-info-read (info)
2208   `(nth 2 ,info))
2209 (defmacro gnus-info-marks (info)
2210   `(nth 3 ,info))
2211 (defmacro gnus-info-method (info)
2212   `(nth 4 ,info))
2213 (defmacro gnus-info-params (info)
2214   `(nth 5 ,info))
2215
2216 (defmacro gnus-info-level (info)
2217   `(let ((rank (gnus-info-rank ,info)))
2218      (if (consp rank)
2219          (car rank)
2220        rank)))
2221 (defmacro gnus-info-score (info)
2222   `(let ((rank (gnus-info-rank ,info)))
2223      (or (and (consp rank) (cdr rank)) 0)))
2224
2225 (defmacro gnus-info-set-group (info group)
2226   `(setcar ,info ,group))
2227 (defmacro gnus-info-set-rank (info rank)
2228   `(setcar (nthcdr 1 ,info) ,rank))
2229 (defmacro gnus-info-set-read (info read)
2230   `(setcar (nthcdr 2 ,info) ,read))
2231 (defmacro gnus-info-set-marks (info marks)
2232   `(setcar (nthcdr 3 ,info) ,marks))
2233 (defmacro gnus-info-set-method (info method)
2234   `(setcar (nthcdr 4 ,info) ,method))
2235 (defmacro gnus-info-set-params (info params)
2236   `(setcar (nthcdr 5 ,info) ,params))
2237
2238 (defmacro gnus-info-set-level (info level)
2239   `(let ((rank (cdr ,info)))
2240      (if (consp (car rank))
2241          (setcar (car rank) ,level)
2242        (setcar rank ,level))))
2243 (defmacro gnus-info-set-score (info score)
2244   `(let ((rank (cdr ,info)))
2245      (if (consp (car rank))
2246          (setcdr (car rank) ,score)
2247        (setcar rank (cons (car rank) ,score)))))
2248
2249 (defmacro gnus-get-info (group)
2250   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2251
2252 (defun gnus-byte-code (func)
2253   "Return a form that can be `eval'ed based on FUNC."
2254   (let ((fval (symbol-function func)))
2255     (if (byte-code-function-p fval)
2256         (let ((flist (append fval nil)))
2257           (setcar flist 'byte-code)
2258           flist)
2259       (cons 'progn (cddr fval)))))
2260
2261 ;;; Load the compatability functions.
2262
2263 (require 'gnus-cus)
2264 (require 'gnus-ems)
2265
2266 \f
2267 ;;;
2268 ;;; Shutdown
2269 ;;;
2270
2271 (defvar gnus-shutdown-alist nil)
2272
2273 (defun gnus-add-shutdown (function &rest symbols)
2274   "Run FUNCTION whenever one of SYMBOLS is shut down."
2275   (push (cons function symbols) gnus-shutdown-alist))
2276
2277 (defun gnus-shutdown (symbol)
2278   "Shut down everything that waits for SYMBOL."
2279   (let ((alist gnus-shutdown-alist)
2280         entry)
2281     (while (setq entry (pop alist))
2282       (when (memq symbol (cdr entry))
2283         (funcall (car entry))))))
2284
2285 \f
2286
2287 ;; Format specs.  The chunks below are the machine-generated forms
2288 ;; that are to be evaled as the result of the default format strings.
2289 ;; We write them in here to get them byte-compiled.  That way the
2290 ;; default actions will be quite fast, while still retaining the full
2291 ;; flexibility of the user-defined format specs.
2292
2293 ;; First we have lots of dummy defvars to let the compiler know these
2294 ;; are really dynamic variables.
2295
2296 (defvar gnus-tmp-unread)
2297 (defvar gnus-tmp-replied)
2298 (defvar gnus-tmp-score-char)
2299 (defvar gnus-tmp-indentation)
2300 (defvar gnus-tmp-opening-bracket)
2301 (defvar gnus-tmp-lines)
2302 (defvar gnus-tmp-name)
2303 (defvar gnus-tmp-closing-bracket)
2304 (defvar gnus-tmp-subject-or-nil)
2305 (defvar gnus-tmp-subject)
2306 (defvar gnus-tmp-marked)
2307 (defvar gnus-tmp-marked-mark)
2308 (defvar gnus-tmp-subscribed)
2309 (defvar gnus-tmp-process-marked)
2310 (defvar gnus-tmp-number-of-unread)
2311 (defvar gnus-tmp-group-name)
2312 (defvar gnus-tmp-group)
2313 (defvar gnus-tmp-article-number)
2314 (defvar gnus-tmp-unread-and-unselected)
2315 (defvar gnus-tmp-news-method)
2316 (defvar gnus-tmp-news-server)
2317 (defvar gnus-tmp-article-number)
2318 (defvar gnus-mouse-face)
2319 (defvar gnus-mouse-face-prop)
2320
2321 (defun gnus-summary-line-format-spec ()
2322   (insert gnus-tmp-unread gnus-tmp-replied
2323           gnus-tmp-score-char gnus-tmp-indentation)
2324   (put-text-property
2325    (point)
2326    (progn
2327      (insert
2328       gnus-tmp-opening-bracket
2329       (format "%4d: %-20s"
2330               gnus-tmp-lines
2331               (if (> (length gnus-tmp-name) 20)
2332                   (substring gnus-tmp-name 0 20)
2333                 gnus-tmp-name))
2334       gnus-tmp-closing-bracket)
2335      (point))
2336    gnus-mouse-face-prop gnus-mouse-face)
2337   (insert " " gnus-tmp-subject-or-nil "\n"))
2338
2339 (defvar gnus-summary-line-format-spec
2340   (gnus-byte-code 'gnus-summary-line-format-spec))
2341
2342 (defun gnus-summary-dummy-line-format-spec ()
2343   (insert "*  ")
2344   (put-text-property
2345    (point)
2346    (progn
2347      (insert ":                          :")
2348      (point))
2349    gnus-mouse-face-prop gnus-mouse-face)
2350   (insert " " gnus-tmp-subject "\n"))
2351
2352 (defvar gnus-summary-dummy-line-format-spec
2353   (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
2354
2355 (defun gnus-group-line-format-spec ()
2356   (insert gnus-tmp-marked-mark gnus-tmp-subscribed
2357           gnus-tmp-process-marked
2358           gnus-group-indentation
2359           (format "%5s: " gnus-tmp-number-of-unread))
2360   (put-text-property
2361    (point)
2362    (progn
2363      (insert gnus-tmp-group "\n")
2364      (1- (point)))
2365    gnus-mouse-face-prop gnus-mouse-face))
2366 (defvar gnus-group-line-format-spec
2367   (gnus-byte-code 'gnus-group-line-format-spec))
2368
2369 (defvar gnus-format-specs
2370   `((version . ,emacs-version)
2371     (group ,gnus-group-line-format ,gnus-group-line-format-spec)
2372     (summary-dummy ,gnus-summary-dummy-line-format
2373                    ,gnus-summary-dummy-line-format-spec)
2374     (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec)))
2375
2376 (defvar gnus-article-mode-line-format-spec nil)
2377 (defvar gnus-summary-mode-line-format-spec nil)
2378 (defvar gnus-group-mode-line-format-spec nil)
2379
2380 ;;; Phew.  All that gruft is over, fortunately.
2381
2382 \f
2383 ;;;
2384 ;;; Gnus Utility Functions
2385 ;;;
2386
2387 (defun gnus-extract-address-components (from)
2388   (let (name address)
2389     ;; First find the address - the thing with the @ in it.  This may
2390     ;; not be accurate in mail addresses, but does the trick most of
2391     ;; the time in news messages.
2392     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
2393         (setq address (substring from (match-beginning 0) (match-end 0))))
2394     ;; Then we check whether the "name <address>" format is used.
2395     (and address
2396          ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2397          ;; Linear white space is not required.
2398          (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
2399          (and (setq name (substring from 0 (match-beginning 0)))
2400               ;; Strip any quotes from the name.
2401               (string-match "\".*\"" name)
2402               (setq name (substring name 1 (1- (match-end 0))))))
2403     ;; If not, then "address (name)" is used.
2404     (or name
2405         (and (string-match "(.+)" from)
2406              (setq name (substring from (1+ (match-beginning 0))
2407                                    (1- (match-end 0)))))
2408         (and (string-match "()" from)
2409              (setq name address))
2410         ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
2411         ;; XOVER might not support folded From headers.
2412         (and (string-match "(.*" from)
2413              (setq name (substring from (1+ (match-beginning 0))
2414                                    (match-end 0)))))
2415     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2416     (list (or name from) (or address from))))
2417
2418 (defun gnus-fetch-field (field)
2419   "Return the value of the header FIELD of current article."
2420   (save-excursion
2421     (save-restriction
2422       (let ((case-fold-search t))
2423         (nnheader-narrow-to-headers)
2424         (mail-fetch-field field)))))
2425
2426 (defun gnus-goto-colon ()
2427   (beginning-of-line)
2428   (search-forward ":" (gnus-point-at-eol) t))
2429
2430 ;;;###autoload
2431 (defun gnus-update-format (var)
2432   "Update the format specification near point."
2433   (interactive
2434    (list
2435     (save-excursion
2436       (eval-defun nil)
2437       ;; Find the end of the current word.
2438       (re-search-forward "[ \t\n]" nil t)
2439       ;; Search backward.
2440       (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
2441         (match-string 1)))))
2442   (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
2443                               (match-string 1 var))))
2444          (entry (assq type gnus-format-specs))
2445          value spec)
2446     (when entry
2447       (setq gnus-format-specs (delq entry gnus-format-specs)))
2448     (set
2449      (intern (format "%s-spec" var))
2450      (gnus-parse-format (setq value (symbol-value (intern var)))
2451                         (symbol-value (intern (format "%s-alist" var)))
2452                         (not (string-match "mode" var))))
2453     (setq spec (symbol-value (intern (format "%s-spec" var))))
2454     (push (list type value spec) gnus-format-specs)
2455
2456     (pop-to-buffer "*Gnus Format*")
2457     (erase-buffer)
2458     (lisp-interaction-mode)
2459     (insert (pp-to-string spec))))
2460
2461 (defun gnus-update-format-specifications (&optional force)
2462   "Update all (necessary) format specifications."
2463   ;; Make the indentation array.
2464   (gnus-make-thread-indent-array)
2465
2466   ;; See whether all the stored info needs to be flushed.
2467   (when (or force
2468             (not (equal emacs-version
2469                         (cdr (assq 'version gnus-format-specs)))))
2470     (setq gnus-format-specs nil))
2471
2472   ;; Go through all the formats and see whether they need updating.
2473   (let ((types '(summary summary-dummy group
2474                          summary-mode group-mode article-mode))
2475         new-format entry type val)
2476     (while (setq type (pop types))
2477       ;; Jump to the proper buffer to find out the value of
2478       ;; the variable, if possible.  (It may be buffer-local.)
2479       (save-excursion
2480         (let ((buffer (intern (format "gnus-%s-buffer" type)))
2481               val)
2482           (when (and (boundp buffer)
2483                      (setq val (symbol-value buffer))
2484                      (get-buffer val)
2485                      (buffer-name (get-buffer val)))
2486             (set-buffer (get-buffer val)))
2487           (setq new-format (symbol-value
2488                             (intern (format "gnus-%s-line-format" type))))))
2489       (setq entry (cdr (assq type gnus-format-specs)))
2490       (if (and entry
2491                (equal (car entry) new-format))
2492           ;; Use the old format.
2493           (set (intern (format "gnus-%s-line-format-spec" type))
2494                (cadr entry))
2495         ;; This is a new format.
2496         (setq val
2497               (if (not (stringp new-format))
2498                   ;; This is a function call or something.
2499                   new-format
2500                 ;; This is a "real" format.
2501                 (gnus-parse-format
2502                  new-format
2503                  (symbol-value
2504                   (intern (format "gnus-%s-line-format-alist"
2505                                   (if (eq type 'article-mode)
2506                                       'summary-mode type))))
2507                  (not (string-match "mode$" (symbol-name type))))))
2508         ;; Enter the new format spec into the list.
2509         (if entry
2510             (progn
2511               (setcar (cdr entry) val)
2512               (setcar entry new-format))
2513           (push (list type new-format val) gnus-format-specs))
2514         (set (intern (format "gnus-%s-line-format-spec" type)) val))))
2515
2516   (unless (assq 'version gnus-format-specs)
2517     (push (cons 'version emacs-version) gnus-format-specs))
2518
2519   (gnus-update-group-mark-positions)
2520   (gnus-update-summary-mark-positions))
2521
2522 (defun gnus-update-summary-mark-positions ()
2523   "Compute where the summary marks are to go."
2524   (save-excursion
2525     (let ((gnus-replied-mark 129)
2526           (gnus-score-below-mark 130)
2527           (gnus-score-over-mark 130)
2528           (thread nil)
2529           (gnus-visual nil)
2530           pos)
2531       (gnus-set-work-buffer)
2532       (gnus-summary-insert-line
2533        [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
2534       (goto-char (point-min))
2535       (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
2536                                          (- (point) 2)))))
2537       (goto-char (point-min))
2538       (push (cons 'replied (and (search-forward "\201" nil t) (- (point) 2)))
2539             pos)
2540       (goto-char (point-min))
2541       (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
2542             pos)
2543       (setq gnus-summary-mark-positions pos))))
2544
2545 (defun gnus-update-group-mark-positions ()
2546   (save-excursion
2547     (let ((gnus-process-mark 128)
2548           (gnus-group-marked '("dummy.group")))
2549       (gnus-set-active "dummy.group" '(0 . 0))
2550       (gnus-set-work-buffer)
2551       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
2552       (goto-char (point-min))
2553       (setq gnus-group-mark-positions
2554             (list (cons 'process (and (search-forward "\200" nil t)
2555                                       (- (point) 2))))))))
2556
2557 (defvar gnus-mouse-face-0 'highlight)
2558 (defvar gnus-mouse-face-1 'highlight)
2559 (defvar gnus-mouse-face-2 'highlight)
2560 (defvar gnus-mouse-face-3 'highlight)
2561 (defvar gnus-mouse-face-4 'highlight)
2562
2563 (defun gnus-mouse-face-function (form type)
2564   `(put-text-property
2565     (point) (progn ,@form (point))
2566     gnus-mouse-face-prop
2567     ,(if (equal type 0)
2568          'gnus-mouse-face
2569        `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
2570
2571 (defvar gnus-face-0 'bold)
2572 (defvar gnus-face-1 'italic)
2573 (defvar gnus-face-2 'bold-italic)
2574 (defvar gnus-face-3 'bold)
2575 (defvar gnus-face-4 'bold)
2576
2577 (defun gnus-face-face-function (form type)
2578   `(put-text-property
2579     (point) (progn ,@form (point))
2580     'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
2581
2582 (defun gnus-max-width-function (el max-width)
2583   (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
2584   (if (symbolp el)
2585       `(if (> (length ,el) ,max-width)
2586            (substring ,el 0 ,max-width)
2587          ,el)
2588     `(let ((val (eval ,el)))
2589        (if (numberp val)
2590            (setq val (int-to-string val)))
2591        (if (> (length val) ,max-width)
2592            (substring val 0 ,max-width)
2593          val))))
2594
2595 (defun gnus-parse-format (format spec-alist &optional insert)
2596   ;; This function parses the FORMAT string with the help of the
2597   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
2598   ;; string.  If the FORMAT string contains the specifiers %( and %)
2599   ;; the text between them will have the mouse-face text property.
2600   (if (string-match
2601        "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
2602        format)
2603       (gnus-parse-complex-format format spec-alist)
2604     ;; This is a simple format.
2605     (gnus-parse-simple-format format spec-alist insert)))
2606
2607 (defun gnus-parse-complex-format (format spec-alist)
2608   (save-excursion
2609     (gnus-set-work-buffer)
2610     (insert format)
2611     (goto-char (point-min))
2612     (while (re-search-forward "\"" nil t)
2613       (replace-match "\\\"" nil t))
2614     (goto-char (point-min))
2615     (insert "(\"")
2616     (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
2617       (let ((number (if (match-beginning 1)
2618                         (match-string 1) "0"))
2619             (delim (aref (match-string 2) 0)))
2620         (if (or (= delim ?\() (= delim ?\{))
2621             (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
2622                                    " " number " \""))
2623           (replace-match "\")\""))))
2624     (goto-char (point-max))
2625     (insert "\")")
2626     (goto-char (point-min))
2627     (let ((form (read (current-buffer))))
2628       (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
2629
2630 (defun gnus-complex-form-to-spec (form spec-alist)
2631   (delq nil
2632         (mapcar
2633          (lambda (sform)
2634            (if (stringp sform)
2635                (gnus-parse-simple-format sform spec-alist t)
2636              (funcall (intern (format "gnus-%s-face-function" (car sform)))
2637                       (gnus-complex-form-to-spec (cddr sform) spec-alist)
2638                       (nth 1 sform))))
2639          form)))
2640
2641 (defun gnus-parse-simple-format (format spec-alist &optional insert)
2642   ;; This function parses the FORMAT string with the help of the
2643   ;; SPEC-ALIST and returns a list that can be eval'ed to return a
2644   ;; string.
2645   (let ((max-width 0)
2646         spec flist fstring newspec elem beg result dontinsert)
2647     (save-excursion
2648       (gnus-set-work-buffer)
2649       (insert format)
2650       (goto-char (point-min))
2651       (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
2652                                 nil t)
2653         (if (= (setq spec (string-to-char (match-string 2))) ?%)
2654               (setq newspec "%"
2655                     beg (1+ (match-beginning 0)))
2656           ;; First check if there are any specs that look anything like
2657           ;; "%12,12A", ie. with a "max width specification".  These have
2658           ;; to be treated specially.
2659           (if (setq beg (match-beginning 1))
2660               (setq max-width
2661                     (string-to-int
2662                      (buffer-substring
2663                       (1+ (match-beginning 1)) (match-end 1))))
2664             (setq max-width 0)
2665             (setq beg (match-beginning 2)))
2666           ;; Find the specification from `spec-alist'.
2667           (unless (setq elem (cdr (assq spec spec-alist)))
2668             (setq elem '("*" ?s)))
2669           ;; Treat user defined format specifiers specially.
2670           (when (eq (car elem) 'gnus-tmp-user-defined)
2671             (setq elem
2672                   (list
2673                    (list (intern (concat "gnus-user-format-function-"
2674                                          (match-string 3)))
2675                          'gnus-tmp-header) ?s))
2676             (delete-region (match-beginning 3) (match-end 3)))
2677           (if (not (zerop max-width))
2678               (let ((el (car elem)))
2679                 (cond ((= (cadr elem) ?c)
2680                        (setq el (list 'char-to-string el)))
2681                       ((= (cadr elem) ?d)
2682                        (setq el (list 'int-to-string el))))
2683                 (setq flist (cons (gnus-max-width-function el max-width)
2684                                   flist))
2685                 (setq newspec ?s))
2686             (progn
2687               (setq flist (cons (car elem) flist))
2688               (setq newspec (cadr elem)))))
2689         ;; Remove the old specification (and possibly a ",12" string).
2690         (delete-region beg (match-end 2))
2691         ;; Insert the new specification.
2692         (goto-char beg)
2693         (insert newspec))
2694       (setq fstring (buffer-substring 1 (point-max))))
2695     ;; Do some postprocessing to increase efficiency.
2696     (setq
2697      result
2698      (cond
2699       ;; Emptyness.
2700       ((string= fstring "")
2701        nil)
2702       ;; Not a format string.
2703       ((not (string-match "%" fstring))
2704        (list fstring))
2705       ;; A format string with just a single string spec.
2706       ((string= fstring "%s")
2707        (list (car flist)))
2708       ;; A single character.
2709       ((string= fstring "%c")
2710        (list (car flist)))
2711       ;; A single number.
2712       ((string= fstring "%d")
2713        (setq dontinsert)
2714        (if insert
2715            (list `(princ ,(car flist)))
2716          (list `(int-to-string ,(car flist)))))
2717       ;; Just lots of chars and strings.
2718       ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
2719        (nreverse flist))
2720       ;; A single string spec at the beginning of the spec.
2721       ((string-match "\\`%[sc][^%]+\\'" fstring)
2722        (list (car flist) (substring fstring 2)))
2723       ;; A single string spec in the middle of the spec.
2724       ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
2725        (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
2726       ;; A single string spec in the end of the spec.
2727       ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
2728        (list (match-string 1 fstring) (car flist)))
2729       ;; A more complex spec.
2730       (t
2731        (list (cons 'format (cons fstring (nreverse flist)))))))
2732
2733     (if insert
2734         (when result
2735           (if dontinsert
2736               result
2737             (cons 'insert result)))
2738       (cond ((stringp result)
2739              result)
2740             ((consp result)
2741              (cons 'concat result))
2742             (t "")))))
2743
2744 (defun gnus-eval-format (format &optional alist props)
2745   "Eval the format variable FORMAT, using ALIST.
2746 If PROPS, insert the result."
2747   (let ((form (gnus-parse-format format alist props)))
2748     (if props
2749         (add-text-properties (point) (progn (eval form) (point)) props)
2750       (eval form))))
2751
2752 (defun gnus-remove-text-with-property (prop)
2753   "Delete all text in the current buffer with text property PROP."
2754   (save-excursion
2755     (goto-char (point-min))
2756     (while (not (eobp))
2757       (while (get-text-property (point) prop)
2758         (delete-char 1))
2759       (goto-char (next-single-property-change (point) prop nil (point-max))))))
2760
2761 (defun gnus-set-work-buffer ()
2762   (if (get-buffer gnus-work-buffer)
2763       (progn
2764         (set-buffer gnus-work-buffer)
2765         (erase-buffer))
2766     (set-buffer (get-buffer-create gnus-work-buffer))
2767     (kill-all-local-variables)
2768     (buffer-disable-undo (current-buffer))
2769     (gnus-add-current-to-buffer-list)))
2770
2771 ;; Article file names when saving.
2772
2773 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
2774   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2775 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
2776 Otherwise, it is like ~/News/news/group/num."
2777   (let ((default
2778           (expand-file-name
2779            (concat (if (gnus-use-long-file-name 'not-save)
2780                        (gnus-capitalize-newsgroup newsgroup)
2781                      (gnus-newsgroup-directory-form newsgroup))
2782                    "/" (int-to-string (mail-header-number headers)))
2783            (or gnus-article-save-directory "~/News"))))
2784     (if (and last-file
2785              (string-equal (file-name-directory default)
2786                            (file-name-directory last-file))
2787              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2788         default
2789       (or last-file default))))
2790
2791 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
2792   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2793 If variable `gnus-use-long-file-name' is non-nil, it is
2794 ~/News/news.group/num.  Otherwise, it is like ~/News/news/group/num."
2795   (let ((default
2796           (expand-file-name
2797            (concat (if (gnus-use-long-file-name 'not-save)
2798                        newsgroup
2799                      (gnus-newsgroup-directory-form newsgroup))
2800                    "/" (int-to-string (mail-header-number headers)))
2801            (or gnus-article-save-directory "~/News"))))
2802     (if (and last-file
2803              (string-equal (file-name-directory default)
2804                            (file-name-directory last-file))
2805              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2806         default
2807       (or last-file default))))
2808
2809 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
2810   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2811 If variable `gnus-use-long-file-name' is non-nil, it is
2812 ~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
2813   (or last-file
2814       (expand-file-name
2815        (if (gnus-use-long-file-name 'not-save)
2816            (gnus-capitalize-newsgroup newsgroup)
2817          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2818        (or gnus-article-save-directory "~/News"))))
2819
2820 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2821   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2822 If variable `gnus-use-long-file-name' is non-nil, it is
2823 ~/News/news.group.  Otherwise, it is like ~/News/news/group/news."
2824   (or last-file
2825       (expand-file-name
2826        (if (gnus-use-long-file-name 'not-save)
2827            newsgroup
2828          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2829        (or gnus-article-save-directory "~/News"))))
2830
2831 ;; For subscribing new newsgroup
2832
2833 (defun gnus-subscribe-hierarchical-interactive (groups)
2834   (let ((groups (sort groups 'string<))
2835         prefixes prefix start ans group starts)
2836     (while groups
2837       (setq prefixes (list "^"))
2838       (while (and groups prefixes)
2839         (while (not (string-match (car prefixes) (car groups)))
2840           (setq prefixes (cdr prefixes)))
2841         (setq prefix (car prefixes))
2842         (setq start (1- (length prefix)))
2843         (if (and (string-match "[^\\.]\\." (car groups) start)
2844                  (cdr groups)
2845                  (setq prefix
2846                        (concat "^" (substring (car groups) 0 (match-end 0))))
2847                  (string-match prefix (cadr groups)))
2848             (progn
2849               (setq prefixes (cons prefix prefixes))
2850               (message "Descend hierarchy %s? ([y]nsq): "
2851                        (substring prefix 1 (1- (length prefix))))
2852               (setq ans (read-char))
2853               (cond ((= ans ?n)
2854                      (while (and groups
2855                                  (string-match prefix
2856                                                (setq group (car groups))))
2857                        (setq gnus-killed-list
2858                              (cons group gnus-killed-list))
2859                        (gnus-sethash group group gnus-killed-hashtb)
2860                        (setq groups (cdr groups)))
2861                      (setq starts (cdr starts)))
2862                     ((= ans ?s)
2863                      (while (and groups
2864                                  (string-match prefix
2865                                                (setq group (car groups))))
2866                        (gnus-sethash group group gnus-killed-hashtb)
2867                        (gnus-subscribe-alphabetically (car groups))
2868                        (setq groups (cdr groups)))
2869                      (setq starts (cdr starts)))
2870                     ((= ans ?q)
2871                      (while groups
2872                        (setq group (car groups))
2873                        (setq gnus-killed-list (cons group gnus-killed-list))
2874                        (gnus-sethash group group gnus-killed-hashtb)
2875                        (setq groups (cdr groups))))
2876                     (t nil)))
2877           (message "Subscribe %s? ([n]yq)" (car groups))
2878           (setq ans (read-char))
2879           (setq group (car groups))
2880           (cond ((= ans ?y)
2881                  (gnus-subscribe-alphabetically (car groups))
2882                  (gnus-sethash group group gnus-killed-hashtb))
2883                 ((= ans ?q)
2884                  (while groups
2885                    (setq group (car groups))
2886                    (setq gnus-killed-list (cons group gnus-killed-list))
2887                    (gnus-sethash group group gnus-killed-hashtb)
2888                    (setq groups (cdr groups))))
2889                 (t
2890                  (setq gnus-killed-list (cons group gnus-killed-list))
2891                  (gnus-sethash group group gnus-killed-hashtb)))
2892           (setq groups (cdr groups)))))))
2893
2894 (defun gnus-subscribe-randomly (newsgroup)
2895   "Subscribe new NEWSGROUP by making it the first newsgroup."
2896   (gnus-subscribe-newsgroup newsgroup))
2897
2898 (defun gnus-subscribe-alphabetically (newgroup)
2899   "Subscribe new NEWSGROUP and insert it in alphabetical order."
2900   (let ((groups (cdr gnus-newsrc-alist))
2901         before)
2902     (while (and (not before) groups)
2903       (if (string< newgroup (caar groups))
2904           (setq before (caar groups))
2905         (setq groups (cdr groups))))
2906     (gnus-subscribe-newsgroup newgroup before)))
2907
2908 (defun gnus-subscribe-hierarchically (newgroup)
2909   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
2910   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2911   (save-excursion
2912     (set-buffer (find-file-noselect gnus-current-startup-file))
2913     (let ((groupkey newgroup)
2914           before)
2915       (while (and (not before) groupkey)
2916         (goto-char (point-min))
2917         (let ((groupkey-re
2918                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
2919           (while (and (re-search-forward groupkey-re nil t)
2920                       (progn
2921                         (setq before (match-string 1))
2922                         (string< before newgroup)))))
2923         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
2924         (setq groupkey
2925               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
2926                   (substring groupkey (match-beginning 1) (match-end 1)))))
2927       (gnus-subscribe-newsgroup newgroup before))))
2928
2929 (defun gnus-subscribe-interactively (group)
2930   "Subscribe the new GROUP interactively.
2931 It is inserted in hierarchical newsgroup order if subscribed.  If not,
2932 it is killed."
2933   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
2934       (gnus-subscribe-hierarchically group)
2935     (push group gnus-killed-list)))
2936
2937 (defun gnus-subscribe-zombies (group)
2938   "Make the new GROUP into a zombie group."
2939   (push group gnus-zombie-list))
2940
2941 (defun gnus-subscribe-killed (group)
2942   "Make the new GROUP a killed group."
2943   (push group gnus-killed-list))
2944
2945 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
2946   "Subscribe new NEWSGROUP.
2947 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
2948 the first newsgroup."
2949   ;; We subscribe the group by changing its level to `subscribed'.
2950   (gnus-group-change-level
2951    newsgroup gnus-level-default-subscribed
2952    gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
2953   (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
2954
2955 ;; For directories
2956
2957 (defun gnus-newsgroup-directory-form (newsgroup)
2958   "Make hierarchical directory name from NEWSGROUP name."
2959   (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
2960         (len (length newsgroup))
2961         idx)
2962     ;; If this is a foreign group, we don't want to translate the
2963     ;; entire name.
2964     (if (setq idx (string-match ":" newsgroup))
2965         (aset newsgroup idx ?/)
2966       (setq idx 0))
2967     ;; Replace all occurrences of `.' with `/'.
2968     (while (< idx len)
2969       (if (= (aref newsgroup idx) ?.)
2970           (aset newsgroup idx ?/))
2971       (setq idx (1+ idx)))
2972     newsgroup))
2973
2974 (defun gnus-newsgroup-savable-name (group)
2975   ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
2976   ;; with dots.
2977   (nnheader-replace-chars-in-string group ?/ ?.))
2978
2979 (defun gnus-make-directory (dir)
2980   "Make DIRECTORY recursively."
2981   ;; Why don't we use `(make-directory dir 'parents)'?  That's just one
2982   ;; of the many mysteries of the universe.
2983   (let* ((dir (expand-file-name dir default-directory))
2984          dirs err)
2985     (if (string-match "/$" dir)
2986         (setq dir (substring dir 0 (match-beginning 0))))
2987     ;; First go down the path until we find a directory that exists.
2988     (while (not (file-exists-p dir))
2989       (setq dirs (cons dir dirs))
2990       (string-match "/[^/]+$" dir)
2991       (setq dir (substring dir 0 (match-beginning 0))))
2992     ;; Then create all the subdirs.
2993     (while (and dirs (not err))
2994       (condition-case ()
2995           (make-directory (car dirs))
2996         (error (setq err t)))
2997       (setq dirs (cdr dirs)))
2998     ;; We return whether we were successful or not.
2999     (not dirs)))
3000
3001 (defun gnus-capitalize-newsgroup (newsgroup)
3002   "Capitalize NEWSGROUP name."
3003   (and (not (zerop (length newsgroup)))
3004        (concat (char-to-string (upcase (aref newsgroup 0)))
3005                (substring newsgroup 1))))
3006
3007 ;; Various... things.
3008
3009 (defun gnus-simplify-subject (subject &optional re-only)
3010   "Remove `Re:' and words in parentheses.
3011 If RE-ONLY is non-nil, strip leading `Re:'s only."
3012   (let ((case-fold-search t))           ;Ignore case.
3013     ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
3014     (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
3015       (setq subject (substring subject (match-end 0))))
3016     ;; Remove uninteresting prefixes.
3017     (if (and (not re-only)
3018              gnus-simplify-ignored-prefixes
3019              (string-match gnus-simplify-ignored-prefixes subject))
3020         (setq subject (substring subject (match-end 0))))
3021     ;; Remove words in parentheses from end.
3022     (unless re-only
3023       (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
3024         (setq subject (substring subject 0 (match-beginning 0)))))
3025     ;; Return subject string.
3026     subject))
3027
3028 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
3029 ;; all whitespace.
3030 ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
3031 (defun gnus-simplify-buffer-fuzzy ()
3032   (goto-char (point-min))
3033   (while (search-forward "\t" nil t)
3034     (replace-match " " t t))
3035   (goto-char (point-min))
3036   (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t)
3037   (goto-char (match-beginning 0))
3038   (while (or
3039           (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
3040           (looking-at "^[[].*: .*[]]$"))
3041     (goto-char (point-min))
3042     (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
3043                               nil t)
3044       (replace-match "" t t))
3045     (goto-char (point-min))
3046     (while (re-search-forward "^[[].*: .*[]]$" nil t)
3047       (goto-char (match-end 0))
3048       (delete-char -1)
3049       (delete-region
3050        (progn (goto-char (match-beginning 0)))
3051        (re-search-forward ":"))))
3052   (goto-char (point-min))
3053   (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t)
3054     (replace-match "" t t))
3055   (goto-char (point-min))
3056   (while (re-search-forward "  +" nil t)
3057     (replace-match " " t t))
3058   (goto-char (point-min))
3059   (while (re-search-forward " $" nil t)
3060     (replace-match "" t t))
3061   (goto-char (point-min))
3062   (while (re-search-forward "^ +" nil t)
3063     (replace-match "" t t))
3064   (goto-char (point-min))
3065   (when gnus-simplify-subject-fuzzy-regexp
3066     (if (listp gnus-simplify-subject-fuzzy-regexp)
3067         (let ((list gnus-simplify-subject-fuzzy-regexp))
3068           (while list
3069             (goto-char (point-min))
3070             (while (re-search-forward (car list) nil t)
3071               (replace-match "" t t))
3072             (setq list (cdr list))))
3073       (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
3074         (replace-match "" t t)))))
3075
3076 (defun gnus-simplify-subject-fuzzy (subject)
3077   "Siplify a subject string fuzzily."
3078   (save-excursion
3079     (gnus-set-work-buffer)
3080     (let ((case-fold-search t))
3081       (insert subject)
3082       (inline (gnus-simplify-buffer-fuzzy))
3083       (buffer-string))))
3084
3085 ;; Add the current buffer to the list of buffers to be killed on exit.
3086 (defun gnus-add-current-to-buffer-list ()
3087   (or (memq (current-buffer) gnus-buffer-list)
3088       (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
3089
3090 (defun gnus-string> (s1 s2)
3091   (not (or (string< s1 s2)
3092            (string= s1 s2))))
3093
3094 ;;; General various misc type functions.
3095
3096 (defun gnus-clear-system ()
3097   "Clear all variables and buffers."
3098   ;; Clear Gnus variables.
3099   (let ((variables gnus-variable-list))
3100     (while variables
3101       (set (car variables) nil)
3102       (setq variables (cdr variables))))
3103   ;; Clear other internal variables.
3104   (setq gnus-list-of-killed-groups nil
3105         gnus-have-read-active-file nil
3106         gnus-newsrc-alist nil
3107         gnus-newsrc-hashtb nil
3108         gnus-killed-list nil
3109         gnus-zombie-list nil
3110         gnus-killed-hashtb nil
3111         gnus-active-hashtb nil
3112         gnus-moderated-list nil
3113         gnus-description-hashtb nil
3114         gnus-current-headers nil
3115         gnus-thread-indent-array nil
3116         gnus-newsgroup-headers nil
3117         gnus-newsgroup-name nil
3118         gnus-server-alist nil
3119         gnus-group-list-mode nil
3120         gnus-opened-servers nil
3121         gnus-current-select-method nil)
3122   (gnus-shutdown 'gnus)
3123   ;; Kill the startup file.
3124   (and gnus-current-startup-file
3125        (get-file-buffer gnus-current-startup-file)
3126        (kill-buffer (get-file-buffer gnus-current-startup-file)))
3127   ;; Clear the dribble buffer.
3128   (gnus-dribble-clear)
3129   ;; Kill global KILL file buffer.
3130   (when (get-file-buffer (gnus-newsgroup-kill-file nil))
3131     (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
3132   (gnus-kill-buffer nntp-server-buffer)
3133   ;; Kill Gnus buffers.
3134   (while gnus-buffer-list
3135     (gnus-kill-buffer (pop gnus-buffer-list)))
3136   ;; Remove Gnus frames.
3137   (while gnus-created-frames
3138     (when (frame-live-p (car gnus-created-frames))
3139       ;; We slap a condition-case around this `delete-frame' to ensure 
3140       ;; agains errors if we try do delete the single frame that's left.
3141       (condition-case ()
3142           (delete-frame (car gnus-created-frames))
3143         (error nil)))
3144     (pop gnus-created-frames)))
3145
3146 (defun gnus-windows-old-to-new (setting)
3147   ;; First we take care of the really, really old Gnus 3 actions.
3148   (when (symbolp setting)
3149     (setq setting
3150           ;; Take care of ooold GNUS 3.x values.
3151           (cond ((eq setting 'SelectArticle) 'article)
3152                 ((memq setting '(SelectSubject ExpandSubject)) 'summary)
3153                 ((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group)
3154                 (t setting))))
3155   (if (or (listp setting)
3156           (not (and gnus-window-configuration
3157                     (memq setting '(group summary article)))))
3158       setting
3159     (let* ((setting (if (eq setting 'group)
3160                         (if (assq 'newsgroup gnus-window-configuration)
3161                             'newsgroup
3162                           'newsgroups) setting))
3163            (elem (cadr (assq setting gnus-window-configuration)))
3164            (total (apply '+ elem))
3165            (types '(group summary article))
3166            (pbuf (if (eq setting 'newsgroups) 'group 'summary))
3167            (i 0)
3168            perc
3169            out)
3170       (while (< i 3)
3171         (or (not (numberp (nth i elem)))
3172             (zerop (nth i elem))
3173             (progn
3174               (setq perc  (/ (float (nth 0 elem)) total))
3175               (setq out (cons (if (eq pbuf (nth i types))
3176                                   (vector (nth i types) perc 'point)
3177                                 (vector (nth i types) perc))
3178                               out))))
3179         (setq i (1+ i)))
3180       (list (nreverse out)))))
3181
3182 ;;;###autoload
3183 (defun gnus-add-configuration (conf)
3184   "Add the window configuration CONF to `gnus-buffer-configuration'."
3185   (setq gnus-buffer-configuration
3186         (cons conf (delq (assq (car conf) gnus-buffer-configuration)
3187                          gnus-buffer-configuration))))
3188
3189 (defvar gnus-frame-list nil)
3190
3191 (defun gnus-configure-frame (split &optional window)
3192   "Split WINDOW according to SPLIT."
3193   (unless window
3194     (setq window (get-buffer-window (current-buffer))))
3195   (select-window window)
3196   ;; This might be an old-stylee buffer config.
3197   (when (vectorp split)
3198     (setq split (append split nil)))
3199   (when (or (consp (car split))
3200             (vectorp (car split)))
3201     (push 1.0 split)
3202     (push 'vertical split))
3203   ;; The SPLIT might be something that is to be evaled to
3204   ;; return a new SPLIT.
3205   (while (and (not (assq (car split) gnus-window-to-buffer))
3206               (gnus-functionp (car split)))
3207     (setq split (eval split)))
3208   (let* ((type (car split))
3209          (subs (cddr split))
3210          (len (if (eq type 'horizontal) (window-width) (window-height)))
3211          (total 0)
3212          (window-min-width (or gnus-window-min-width window-min-width))
3213          (window-min-height (or gnus-window-min-height window-min-height))
3214          s result new-win rest comp-subs size sub)
3215     (cond
3216      ;; Nothing to do here.
3217      ((null split))
3218      ;; Don't switch buffers.
3219      ((null type)
3220       (and (memq 'point split) window))
3221      ;; This is a buffer to be selected.
3222      ((not (memq type '(frame horizontal vertical)))
3223       (let ((buffer (cond ((stringp type) type)
3224                           (t (cdr (assq type gnus-window-to-buffer)))))
3225             buf)
3226         (unless buffer
3227           (error "Illegal buffer type: %s" type))
3228         (unless (setq buf (get-buffer (if (symbolp buffer)
3229                                           (symbol-value buffer) buffer)))
3230           (setq buf (get-buffer-create (if (symbolp buffer)
3231                                            (symbol-value buffer) buffer))))
3232         (switch-to-buffer buf)
3233         ;; We return the window if it has the `point' spec.
3234         (and (memq 'point split) window)))
3235      ;; This is a frame split.
3236      ((eq type 'frame)
3237       (unless gnus-frame-list
3238         (setq gnus-frame-list (list (window-frame
3239                                      (get-buffer-window (current-buffer))))))
3240       (let ((i 0)
3241             params frame fresult)
3242         (while (< i (length subs))
3243           ;; Frame parameter is gotten from the sub-split.
3244           (setq params (cadr (elt subs i)))
3245           ;; It should be a list.
3246           (unless (listp params)
3247             (setq params nil))
3248           ;; Create a new frame?
3249           (unless (setq frame (elt gnus-frame-list i))
3250             (nconc gnus-frame-list (list (setq frame (make-frame params))))
3251             (push frame gnus-created-frames))
3252           ;; Is the old frame still alive?
3253           (unless (frame-live-p frame)
3254             (setcar (nthcdr i gnus-frame-list)
3255                     (setq frame (make-frame params))))
3256           ;; Select the frame in question and do more splits there.
3257           (select-frame frame)
3258           (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
3259           (incf i))
3260         ;; Select the frame that has the selected buffer.
3261         (when fresult
3262           (select-frame (window-frame fresult)))))
3263      ;; This is a normal split.
3264      (t
3265       (when (> (length subs) 0)
3266         ;; First we have to compute the sizes of all new windows.
3267         (while subs
3268           (setq sub (append (pop subs) nil))
3269           (while (and (not (assq (car sub) gnus-window-to-buffer))
3270                       (gnus-functionp (car sub)))
3271             (setq sub (eval sub)))
3272           (when sub
3273             (push sub comp-subs)
3274             (setq size (cadar comp-subs))
3275             (cond ((equal size 1.0)
3276                    (setq rest (car comp-subs))
3277                    (setq s 0))
3278                   ((floatp size)
3279                    (setq s (floor (* size len))))
3280                   ((integerp size)
3281                    (setq s size))
3282                   (t
3283                    (error "Illegal size: %s" size)))
3284             ;; Try to make sure that we are inside the safe limits.
3285             (cond ((zerop s))
3286                   ((eq type 'horizontal)
3287                    (setq s (max s window-min-width)))
3288                   ((eq type 'vertical)
3289                    (setq s (max s window-min-height))))
3290             (setcar (cdar comp-subs) s)
3291             (incf total s)))
3292         ;; Take care of the "1.0" spec.
3293         (if rest
3294             (setcar (cdr rest) (- len total))
3295           (error "No 1.0 specs in %s" split))
3296         ;; The we do the actual splitting in a nice recursive
3297         ;; fashion.
3298         (setq comp-subs (nreverse comp-subs))
3299         (while comp-subs
3300           (if (null (cdr comp-subs))
3301               (setq new-win window)
3302             (setq new-win
3303                   (split-window window (cadar comp-subs)
3304                                 (eq type 'horizontal))))
3305           (setq result (or (gnus-configure-frame
3306                             (car comp-subs) window) result))
3307           (select-window new-win)
3308           (setq window new-win)
3309           (setq comp-subs (cdr comp-subs))))
3310       ;; Return the proper window, if any.
3311       (when result
3312         (select-window result))))))
3313
3314 (defvar gnus-frame-split-p nil)
3315
3316 (defun gnus-configure-windows (setting &optional force)
3317   (setq setting (gnus-windows-old-to-new setting))
3318   (let ((split (if (symbolp setting)
3319                    (cadr (assq setting gnus-buffer-configuration))
3320                  setting))
3321         all-visible)
3322
3323     (setq gnus-frame-split-p nil)
3324
3325     (unless split
3326       (error "No such setting: %s" setting))
3327
3328     (if (and (setq all-visible (gnus-all-windows-visible-p split))
3329              (not force))
3330         ;; All the windows mentioned are already visible, so we just
3331         ;; put point in the assigned buffer, and do not touch the
3332         ;; winconf.
3333         (select-window all-visible)
3334
3335       ;; Either remove all windows or just remove all Gnus windows.
3336       (let ((frame (selected-frame)))
3337         (unwind-protect
3338             (if gnus-use-full-window
3339                 ;; We want to remove all other windows.
3340                 (if (not gnus-frame-split-p)
3341                     ;; This is not a `frame' split, so we ignore the
3342                     ;; other frames.  
3343                     (delete-other-windows)
3344                   ;; This is a `frame' split, so we delete all windows
3345                   ;; on all frames.
3346                   (mapcar 
3347                    (lambda (frame)
3348                      (unless (eq (cdr (assq 'minibuffer
3349                                             (frame-parameters frame)))
3350                                  'only)
3351                        (select-frame frame)
3352                        (delete-other-windows)))
3353                    (frame-list)))
3354               ;; Just remove some windows.
3355               (gnus-remove-some-windows)
3356               (switch-to-buffer nntp-server-buffer))
3357           (select-frame frame)))
3358
3359       (switch-to-buffer nntp-server-buffer)
3360       (gnus-configure-frame split (get-buffer-window (current-buffer))))))
3361
3362 (defun gnus-all-windows-visible-p (split)
3363   "Say whether all buffers in SPLIT are currently visible.
3364 In particular, the value returned will be the window that
3365 should have point."
3366   (let ((stack (list split))
3367         (all-visible t)
3368         type buffer win buf)
3369     (while (and (setq split (pop stack))
3370                 all-visible)
3371       ;; Be backwards compatible.
3372       (when (vectorp split)
3373         (setq split (append split nil)))
3374       (when (or (consp (car split))
3375                 (vectorp (car split)))
3376         (push 1.0 split)
3377         (push 'vertical split))
3378       ;; The SPLIT might be something that is to be evaled to
3379       ;; return a new SPLIT.
3380       (while (and (not (assq (car split) gnus-window-to-buffer))
3381                   (gnus-functionp (car split)))
3382         (setq split (eval split)))
3383
3384       (setq type (elt split 0))
3385       (cond
3386        ;; Nothing here.
3387        ((null split) t)
3388        ;; A buffer.
3389        ((not (memq type '(horizontal vertical frame)))
3390         (setq buffer (cond ((stringp type) type)
3391                            (t (cdr (assq type gnus-window-to-buffer)))))
3392         (unless buffer
3393           (error "Illegal buffer type: %s" type))
3394         (when (setq buf (get-buffer (if (symbolp buffer)
3395                                         (symbol-value buffer)
3396                                       buffer)))
3397           (setq win (get-buffer-window buf t)))
3398         (if win
3399             (when (memq 'point split)
3400                 (setq all-visible win))
3401           (setq all-visible nil)))
3402        (t
3403         (when (eq type 'frame)
3404           (setq gnus-frame-split-p t))
3405         (setq stack (append (cddr split) stack)))))
3406     (unless (eq all-visible t)
3407       all-visible)))
3408
3409 (defun gnus-window-top-edge (&optional window)
3410   (nth 1 (window-edges window)))
3411
3412 (defun gnus-remove-some-windows ()
3413   (let ((buffers gnus-window-to-buffer)
3414         buf bufs lowest-buf lowest)
3415     (save-excursion
3416       ;; Remove windows on all known Gnus buffers.
3417       (while buffers
3418         (setq buf (cdar buffers))
3419         (if (symbolp buf)
3420             (setq buf (and (boundp buf) (symbol-value buf))))
3421         (and buf
3422              (get-buffer-window buf)
3423              (progn
3424                (setq bufs (cons buf bufs))
3425                (pop-to-buffer buf)
3426                (if (or (not lowest)
3427                        (< (gnus-window-top-edge) lowest))
3428                    (progn
3429                      (setq lowest (gnus-window-top-edge))
3430                      (setq lowest-buf buf)))))
3431         (setq buffers (cdr buffers)))
3432       ;; Remove windows on *all* summary buffers.
3433       (walk-windows
3434        (lambda (win)
3435          (let ((buf (window-buffer win)))
3436            (if (string-match    "^\\*Summary" (buffer-name buf))
3437                (progn
3438                  (setq bufs (cons buf bufs))
3439                  (pop-to-buffer buf)
3440                  (if (or (not lowest)
3441                          (< (gnus-window-top-edge) lowest))
3442                      (progn
3443                        (setq lowest-buf buf)
3444                        (setq lowest (gnus-window-top-edge)))))))))
3445       (and lowest-buf
3446            (progn
3447              (pop-to-buffer lowest-buf)
3448              (switch-to-buffer nntp-server-buffer)))
3449       (while bufs
3450         (and (not (eq (car bufs) lowest-buf))
3451              (delete-windows-on (car bufs)))
3452         (setq bufs (cdr bufs))))))
3453
3454 (defun gnus-version ()
3455   "Version numbers of this version of Gnus."
3456   (interactive)
3457   (let ((methods gnus-valid-select-methods)
3458         (mess gnus-version)
3459         meth)
3460     ;; Go through all the legal select methods and add their version
3461     ;; numbers to the total version string.  Only the backends that are
3462     ;; currently in use will have their message numbers taken into
3463     ;; consideration.
3464     (while methods
3465       (setq meth (intern (concat (caar methods) "-version")))
3466       (and (boundp meth)
3467            (stringp (symbol-value meth))
3468            (setq mess (concat mess "; " (symbol-value meth))))
3469       (setq methods (cdr methods)))
3470     (gnus-message 2 mess)))
3471
3472 (defun gnus-info-find-node ()
3473   "Find Info documentation of Gnus."
3474   (interactive)
3475   ;; Enlarge info window if needed.
3476   (let ((mode major-mode)
3477         gnus-info-buffer)
3478     (Info-goto-node (cadr (assq mode gnus-info-nodes)))
3479     (setq gnus-info-buffer (current-buffer))
3480     (gnus-configure-windows 'info)))
3481
3482 (defun gnus-days-between (date1 date2)
3483   ;; Return the number of days between date1 and date2.
3484   (- (gnus-day-number date1) (gnus-day-number date2)))
3485
3486 (defun gnus-day-number (date)
3487   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
3488                      (timezone-parse-date date))))
3489     (timezone-absolute-from-gregorian
3490      (nth 1 dat) (nth 2 dat) (car dat))))
3491
3492 (defun gnus-encode-date (date)
3493   "Convert DATE to internal time."
3494   (let* ((parse (timezone-parse-date date))
3495          (date (mapcar (lambda (d) (and d (string-to-int d))) parse))
3496          (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
3497     (encode-time (caddr time) (cadr time) (car time)
3498                  (caddr date) (cadr date) (car date) (nth 4 date))))
3499
3500 (defun gnus-time-minus (t1 t2)
3501   "Subtract two internal times."
3502   (let ((borrow (< (cadr t1) (cadr t2))))
3503     (list (- (car t1) (car t2) (if borrow 1 0))
3504           (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
3505
3506 (defun gnus-file-newer-than (file date)
3507   (let ((fdate (nth 5 (file-attributes file))))
3508     (or (> (car fdate) (car date))
3509         (and (= (car fdate) (car date))
3510              (> (nth 1 fdate) (nth 1 date))))))
3511
3512 (defmacro gnus-local-set-keys (&rest plist)
3513   "Set the keys in PLIST in the current keymap."
3514   `(gnus-define-keys-1 (current-local-map) ',plist))
3515
3516 (defmacro gnus-define-keys (keymap &rest plist)
3517   "Define all keys in PLIST in KEYMAP."
3518   `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
3519
3520 (put 'gnus-define-keys 'lisp-indent-function 1)
3521 (put 'gnus-define-keys 'lisp-indent-hook 1)
3522 (put 'gnus-define-keymap 'lisp-indent-function 1)
3523 (put 'gnus-define-keymap 'lisp-indent-hook 1)
3524
3525 (defmacro gnus-define-keymap (keymap &rest plist)
3526   "Define all keys in PLIST in KEYMAP."
3527   `(gnus-define-keys-1 ,keymap (quote ,plist)))
3528
3529 (defun gnus-define-keys-1 (keymap plist)
3530   (when (null keymap)
3531     (error "Can't set keys in a null keymap"))
3532   (cond ((symbolp keymap)
3533          (setq keymap (symbol-value keymap)))
3534         ((keymapp keymap))
3535         ((listp keymap)
3536          (set (car keymap) nil)
3537          (define-prefix-command (car keymap))
3538          (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
3539          (setq keymap (symbol-value (car keymap)))))
3540   (let (key)
3541     (while plist
3542       (when (symbolp (setq key (pop plist)))
3543         (setq key (symbol-value key)))
3544       (define-key keymap key (pop plist)))))
3545
3546 (defun gnus-group-read-only-p (&optional group)
3547   "Check whether GROUP supports editing or not.
3548 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
3549 that that variable is buffer-local to the summary buffers."
3550   (let ((group (or group gnus-newsgroup-name)))
3551     (not (gnus-check-backend-function 'request-replace-article group))))
3552
3553 (defun gnus-group-total-expirable-p (group)
3554   "Check whether GROUP is total-expirable or not."
3555   (let ((params (gnus-info-params (gnus-get-info group))))
3556     (or (memq 'total-expire params)
3557         (cdr (assq 'total-expire params)) ; (total-expire . t)
3558         (and gnus-total-expirable-newsgroups ; Check var.
3559              (string-match gnus-total-expirable-newsgroups group)))))
3560
3561 (defun gnus-group-auto-expirable-p (group)
3562   "Check whether GROUP is total-expirable or not."
3563   (let ((params (gnus-info-params (gnus-get-info group))))
3564     (or (memq 'auto-expire params)
3565         (cdr (assq 'auto-expire params)) ; (auto-expire . t)
3566         (and gnus-auto-expirable-newsgroups ; Check var.
3567              (string-match gnus-auto-expirable-newsgroups group)))))
3568
3569 (defun gnus-virtual-group-p (group)
3570   "Say whether GROUP is virtual or not."
3571   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
3572                         gnus-valid-select-methods)))
3573
3574 (defun gnus-news-group-p (group &optional article)
3575   "Return non-nil if GROUP (and ARTICLE) come from a news server."
3576   (or (gnus-member-of-valid 'post group) ; Ordinary news group.
3577       (and (gnus-member-of-valid 'post-mail group) ; Combined group.
3578            (eq (gnus-request-type group article) 'news))))
3579
3580 (defsubst gnus-simplify-subject-fully (subject)
3581   "Simplify a subject string according to the user's wishes."
3582   (cond
3583    ((null gnus-summary-gather-subject-limit)
3584     (gnus-simplify-subject-re subject))
3585    ((eq gnus-summary-gather-subject-limit 'fuzzy)
3586     (gnus-simplify-subject-fuzzy subject))
3587    ((numberp gnus-summary-gather-subject-limit)
3588     (gnus-limit-string (gnus-simplify-subject-re subject)
3589                        gnus-summary-gather-subject-limit))
3590    (t
3591     subject)))
3592
3593 (defsubst gnus-subject-equal (s1 s2 &optional simple-first)
3594   "Check whether two subjects are equal.  If optional argument
3595 simple-first is t, first argument is already simplified."
3596   (cond
3597    ((null simple-first)
3598     (equal (gnus-simplify-subject-fully s1)
3599            (gnus-simplify-subject-fully s2)))
3600    (t
3601     (equal s1
3602            (gnus-simplify-subject-fully s2)))))
3603
3604 ;; Returns a list of writable groups.
3605 (defun gnus-writable-groups ()
3606   (let ((alist gnus-newsrc-alist)
3607         groups group)
3608     (while (setq group (car (pop alist)))
3609       (unless (gnus-group-read-only-p group)
3610         (push group groups)))
3611     (nreverse groups)))
3612
3613 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
3614 ;; the echo area.
3615 (defun gnus-y-or-n-p (prompt)
3616   (prog1
3617       (y-or-n-p prompt)
3618     (message "")))
3619
3620 (defun gnus-yes-or-no-p (prompt)
3621   (prog1
3622       (yes-or-no-p prompt)
3623     (message "")))
3624
3625 ;; Check whether to use long file names.
3626 (defun gnus-use-long-file-name (symbol)
3627   ;; The variable has to be set...
3628   (and gnus-use-long-file-name
3629        ;; If it isn't a list, then we return t.
3630        (or (not (listp gnus-use-long-file-name))
3631            ;; If it is a list, and the list contains `symbol', we
3632            ;; return nil.
3633            (not (memq symbol gnus-use-long-file-name)))))
3634
3635 ;; I suspect there's a better way, but I haven't taken the time to do
3636 ;; it yet. -erik selberg@cs.washington.edu
3637 (defun gnus-dd-mmm (messy-date)
3638   "Return a string like DD-MMM from a big messy string"
3639   (let ((datevec (timezone-parse-date messy-date)))
3640     (format "%2s-%s"
3641             (condition-case ()
3642                 ;; Make sure leading zeroes are stripped.
3643                 (number-to-string (string-to-number (aref datevec 2)))
3644               (error "??"))
3645             (capitalize
3646              (or (car
3647                   (nth (1- (string-to-number (aref datevec 1)))
3648                        timezone-months-assoc))
3649                  "???")))))
3650
3651 ;; Make a hash table (default and minimum size is 255).
3652 ;; Optional argument HASHSIZE specifies the table size.
3653 (defun gnus-make-hashtable (&optional hashsize)
3654   (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
3655
3656 ;; Make a number that is suitable for hashing; bigger than MIN and one
3657 ;; less than 2^x.
3658 (defun gnus-create-hash-size (min)
3659   (let ((i 1))
3660     (while (< i min)
3661       (setq i (* 2 i)))
3662     (1- i)))
3663
3664 ;; Show message if message has a lower level than `gnus-verbose'.
3665 ;; Guideline for numbers:
3666 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
3667 ;; for things that take a long time, 7 - not very important messages
3668 ;; on stuff, 9 - messages inside loops.
3669 (defun gnus-message (level &rest args)
3670   (if (<= level gnus-verbose)
3671       (apply 'message args)
3672     ;; We have to do this format thingy here even if the result isn't
3673     ;; shown - the return value has to be the same as the return value
3674     ;; from `message'.
3675     (apply 'format args)))
3676
3677 ;; Generate a unique new group name.
3678 (defun gnus-generate-new-group-name (leaf)
3679   (let ((name leaf)
3680         (num 0))
3681     (while (gnus-gethash name gnus-newsrc-hashtb)
3682       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3683     name))
3684
3685 (defsubst gnus-hide-text (b e props)
3686   "Set text PROPS on the B to E region, extending `intangble' 1 past B."
3687   (add-text-properties b e props)
3688   (when (memq 'intangible props)
3689     (put-text-property (max (1- b) (point-min))
3690                        b 'intangible (cddr (memq 'intangible props)))))
3691
3692 (defsubst gnus-unhide-text (b e)
3693   "Remove hidden text properties from region between B and E."
3694   (remove-text-properties b e gnus-hidden-properties)
3695   (when (memq 'intangible gnus-hidden-properties)
3696     (put-text-property (max (1- b) (point-min))
3697                        b 'intangible nil)))
3698
3699 (defun gnus-hide-text-type (b e type)
3700   "Hide text of TYPE between B and E."
3701   (gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties))))
3702
3703 ;; Find out whether the gnus-visual TYPE is wanted.
3704 (defun gnus-visual-p (&optional type class)
3705   (and gnus-visual                      ; Has to be non-nil, at least.
3706        (if (not type)                   ; We don't care about type.
3707            gnus-visual
3708          (if (listp gnus-visual)        ; It's a list, so we check it.
3709              (or (memq type gnus-visual)
3710                  (memq class gnus-visual))
3711            t))))
3712
3713 (defun gnus-parent-id (references)
3714   "Return the last Message-ID in REFERENCES."
3715   (when (and references
3716              (string-match "\\(<[^<>]+>\\)[ \t\n]*\\'" references))
3717     (substring references (match-beginning 1) (match-end 1))))
3718
3719 (defun gnus-split-references (references)
3720   "Return a list of Message-IDs in REFERENCES."
3721   (let ((beg 0)
3722         ids)
3723     (while (string-match "<[^>]+>" references beg)
3724       (push (substring references (match-beginning 0) (setq beg (match-end 0)))
3725             ids))
3726     (nreverse ids)))
3727
3728 (defun gnus-buffer-live-p (buffer)
3729   "Say whether BUFFER is alive or not."
3730   (and buffer
3731        (get-buffer buffer)
3732        (buffer-name (get-buffer buffer))))
3733
3734 (defun gnus-ephemeral-group-p (group)
3735   "Say whether GROUP is ephemeral or not."
3736   (gnus-group-get-parameter group 'quit-config))
3737
3738 (defun gnus-group-quit-config (group)
3739   "Return the quit-config of GROUP."
3740   (gnus-group-get-parameter group 'quit-config))
3741
3742 (defun gnus-simplify-mode-line ()
3743   "Make mode lines a bit simpler."
3744   (setq mode-line-modified "-- ")
3745   (when (listp mode-line-format)
3746     (make-local-variable 'mode-line-format)
3747     (setq mode-line-format (copy-sequence mode-line-format))
3748     (when (equal (nth 3 mode-line-format) "   ")
3749       (setcar (nthcdr 3 mode-line-format) " "))))
3750
3751 ;;; List and range functions
3752
3753 (defun gnus-last-element (list)
3754   "Return last element of LIST."
3755   (while (cdr list)
3756     (setq list (cdr list)))
3757   (car list))
3758
3759 (defun gnus-copy-sequence (list)
3760   "Do a complete, total copy of a list."
3761   (if (and (consp list) (not (consp (cdr list))))
3762       (cons (car list) (cdr list))
3763     (mapcar (lambda (elem) (if (consp elem)
3764                                (if (consp (cdr elem))
3765                                    (gnus-copy-sequence elem)
3766                                  (cons (car elem) (cdr elem)))
3767                              elem))
3768             list)))
3769
3770 (defun gnus-set-difference (list1 list2)
3771   "Return a list of elements of LIST1 that do not appear in LIST2."
3772   (let ((list1 (copy-sequence list1)))
3773     (while list2
3774       (setq list1 (delq (car list2) list1))
3775       (setq list2 (cdr list2)))
3776     list1))
3777
3778 (defun gnus-sorted-complement (list1 list2)
3779   "Return a list of elements of LIST1 that do not appear in LIST2.
3780 Both lists have to be sorted over <."
3781   (let (out)
3782     (if (or (null list1) (null list2))
3783         (or list1 list2)
3784       (while (and list1 list2)
3785         (cond ((= (car list1) (car list2))
3786                (setq list1 (cdr list1)
3787                      list2 (cdr list2)))
3788               ((< (car list1) (car list2))
3789                (setq out (cons (car list1) out))
3790                (setq list1 (cdr list1)))
3791               (t
3792                (setq out (cons (car list2) out))
3793                (setq list2 (cdr list2)))))
3794       (nconc (nreverse out) (or list1 list2)))))
3795
3796 (defun gnus-intersection (list1 list2)
3797   (let ((result nil))
3798     (while list2
3799       (if (memq (car list2) list1)
3800           (setq result (cons (car list2) result)))
3801       (setq list2 (cdr list2)))
3802     result))
3803
3804 (defun gnus-sorted-intersection (list1 list2)
3805   ;; LIST1 and LIST2 have to be sorted over <.
3806   (let (out)
3807     (while (and list1 list2)
3808       (cond ((= (car list1) (car list2))
3809              (setq out (cons (car list1) out)
3810                    list1 (cdr list1)
3811                    list2 (cdr list2)))
3812             ((< (car list1) (car list2))
3813              (setq list1 (cdr list1)))
3814             (t
3815              (setq list2 (cdr list2)))))
3816     (nreverse out)))
3817
3818 (defun gnus-set-sorted-intersection (list1 list2)
3819   ;; LIST1 and LIST2 have to be sorted over <.
3820   ;; This function modifies LIST1.
3821   (let* ((top (cons nil list1))
3822          (prev top))
3823     (while (and list1 list2)
3824       (cond ((= (car list1) (car list2))
3825              (setq prev list1
3826                    list1 (cdr list1)
3827                    list2 (cdr list2)))
3828             ((< (car list1) (car list2))
3829              (setcdr prev (cdr list1))
3830              (setq list1 (cdr list1)))
3831             (t
3832              (setq list2 (cdr list2)))))
3833     (setcdr prev nil)
3834     (cdr top)))
3835
3836 (defun gnus-compress-sequence (numbers &optional always-list)
3837   "Convert list of numbers to a list of ranges or a single range.
3838 If ALWAYS-LIST is non-nil, this function will always release a list of
3839 ranges."
3840   (let* ((first (car numbers))
3841          (last (car numbers))
3842          result)
3843     (if (null numbers)
3844         nil
3845       (if (not (listp (cdr numbers)))
3846           numbers
3847         (while numbers
3848           (cond ((= last (car numbers)) nil) ;Omit duplicated number
3849                 ((= (1+ last) (car numbers)) ;Still in sequence
3850                  (setq last (car numbers)))
3851                 (t                      ;End of one sequence
3852                  (setq result
3853                        (cons (if (= first last) first
3854                                (cons first last)) result))
3855                  (setq first (car numbers))
3856                  (setq last  (car numbers))))
3857           (setq numbers (cdr numbers)))
3858         (if (and (not always-list) (null result))
3859             (if (= first last) (list first) (cons first last))
3860           (nreverse (cons (if (= first last) first (cons first last))
3861                           result)))))))
3862
3863 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
3864 (defun gnus-uncompress-range (ranges)
3865   "Expand a list of ranges into a list of numbers.
3866 RANGES is either a single range on the form `(num . num)' or a list of
3867 these ranges."
3868   (let (first last result)
3869     (cond
3870      ((null ranges)
3871       nil)
3872      ((not (listp (cdr ranges)))
3873       (setq first (car ranges))
3874       (setq last (cdr ranges))
3875       (while (<= first last)
3876         (setq result (cons first result))
3877         (setq first (1+ first)))
3878       (nreverse result))
3879      (t
3880       (while ranges
3881         (if (atom (car ranges))
3882             (if (numberp (car ranges))
3883                 (setq result (cons (car ranges) result)))
3884           (setq first (caar ranges))
3885           (setq last  (cdar ranges))
3886           (while (<= first last)
3887             (setq result (cons first result))
3888             (setq first (1+ first))))
3889         (setq ranges (cdr ranges)))
3890       (nreverse result)))))
3891
3892 (defun gnus-add-to-range (ranges list)
3893   "Return a list of ranges that has all articles from both RANGES and LIST.
3894 Note: LIST has to be sorted over `<'."
3895   (if (not ranges)
3896       (gnus-compress-sequence list t)
3897     (setq list (copy-sequence list))
3898     (or (listp (cdr ranges))
3899         (setq ranges (list ranges)))
3900     (let ((out ranges)
3901           ilist lowest highest temp)
3902       (while (and ranges list)
3903         (setq ilist list)
3904         (setq lowest (or (and (atom (car ranges)) (car ranges))
3905                          (caar ranges)))
3906         (while (and list (cdr list) (< (cadr list) lowest))
3907           (setq list (cdr list)))
3908         (if (< (car ilist) lowest)
3909             (progn
3910               (setq temp list)
3911               (setq list (cdr list))
3912               (setcdr temp nil)
3913               (setq out (nconc (gnus-compress-sequence ilist t) out))))
3914         (setq highest (or (and (atom (car ranges)) (car ranges))
3915                           (cdar ranges)))
3916         (while (and list (<= (car list) highest))
3917           (setq list (cdr list)))
3918         (setq ranges (cdr ranges)))
3919       (if list
3920           (setq out (nconc (gnus-compress-sequence list t) out)))
3921       (setq out (sort out (lambda (r1 r2)
3922                             (< (or (and (atom r1) r1) (car r1))
3923                                (or (and (atom r2) r2) (car r2))))))
3924       (setq ranges out)
3925       (while ranges
3926         (if (atom (car ranges))
3927             (if (cdr ranges)
3928                 (if (atom (cadr ranges))
3929                     (if (= (1+ (car ranges)) (cadr ranges))
3930                         (progn
3931                           (setcar ranges (cons (car ranges)
3932                                                (cadr ranges)))
3933                           (setcdr ranges (cddr ranges))))
3934                   (if (= (1+ (car ranges)) (caadr ranges))
3935                       (progn
3936                         (setcar (cadr ranges) (car ranges))
3937                         (setcar ranges (cadr ranges))
3938                         (setcdr ranges (cddr ranges))))))
3939           (if (cdr ranges)
3940               (if (atom (cadr ranges))
3941                   (if (= (1+ (cdar ranges)) (cadr ranges))
3942                       (progn
3943                         (setcdr (car ranges) (cadr ranges))
3944                         (setcdr ranges (cddr ranges))))
3945                 (if (= (1+ (cdar ranges)) (caadr ranges))
3946                     (progn
3947                       (setcdr (car ranges) (cdadr ranges))
3948                       (setcdr ranges (cddr ranges)))))))
3949         (setq ranges (cdr ranges)))
3950       out)))
3951
3952 (defun gnus-remove-from-range (ranges list)
3953   "Return a list of ranges that has all articles from LIST removed from RANGES.
3954 Note: LIST has to be sorted over `<'."
3955   ;; !!! This function shouldn't look like this, but I've got a headache.
3956   (gnus-compress-sequence
3957    (gnus-sorted-complement
3958     (gnus-uncompress-range ranges) list)))
3959
3960 (defun gnus-member-of-range (number ranges)
3961   (if (not (listp (cdr ranges)))
3962       (and (>= number (car ranges))
3963            (<= number (cdr ranges)))
3964     (let ((not-stop t))
3965       (while (and ranges
3966                   (if (numberp (car ranges))
3967                       (>= number (car ranges))
3968                     (>= number (caar ranges)))
3969                   not-stop)
3970         (if (if (numberp (car ranges))
3971                 (= number (car ranges))
3972               (and (>= number (caar ranges))
3973                    (<= number (cdar ranges))))
3974             (setq not-stop nil))
3975         (setq ranges (cdr ranges)))
3976       (not not-stop))))
3977
3978 (defun gnus-range-length (range)
3979   "Return the length RANGE would have if uncompressed."
3980   (length (gnus-uncompress-range range)))
3981
3982 (defun gnus-sublist-p (list sublist)
3983   "Test whether all elements in SUBLIST are members of LIST."
3984   (let ((sublistp t))
3985     (while sublist
3986       (unless (memq (pop sublist) list)
3987         (setq sublistp nil
3988               sublist nil)))
3989     sublistp))
3990
3991 \f
3992 ;;;
3993 ;;; Gnus group mode
3994 ;;;
3995
3996 (defvar gnus-group-mode-map nil)
3997 (put 'gnus-group-mode 'mode-class 'special)
3998
3999 (unless gnus-group-mode-map
4000   (setq gnus-group-mode-map (make-keymap))
4001   (suppress-keymap gnus-group-mode-map)
4002
4003   (gnus-define-keys gnus-group-mode-map
4004     " " gnus-group-read-group
4005     "=" gnus-group-select-group
4006     "\r" gnus-group-select-group
4007     "\M-\r" gnus-group-quick-select-group
4008     "j" gnus-group-jump-to-group
4009     "n" gnus-group-next-unread-group
4010     "p" gnus-group-prev-unread-group
4011     "\177" gnus-group-prev-unread-group
4012     [delete] gnus-group-prev-unread-group
4013     "N" gnus-group-next-group
4014     "P" gnus-group-prev-group
4015     "\M-n" gnus-group-next-unread-group-same-level
4016     "\M-p" gnus-group-prev-unread-group-same-level
4017     "," gnus-group-best-unread-group
4018     "." gnus-group-first-unread-group
4019     "u" gnus-group-unsubscribe-current-group
4020     "U" gnus-group-unsubscribe-group
4021     "c" gnus-group-catchup-current
4022     "C" gnus-group-catchup-current-all
4023     "l" gnus-group-list-groups
4024     "L" gnus-group-list-all-groups
4025     "m" gnus-group-mail
4026     "g" gnus-group-get-new-news
4027     "\M-g" gnus-group-get-new-news-this-group
4028     "R" gnus-group-restart
4029     "r" gnus-group-read-init-file
4030     "B" gnus-group-browse-foreign-server
4031     "b" gnus-group-check-bogus-groups
4032     "F" gnus-find-new-newsgroups
4033     "\C-c\C-d" gnus-group-describe-group
4034     "\M-d" gnus-group-describe-all-groups
4035     "\C-c\C-a" gnus-group-apropos
4036     "\C-c\M-\C-a" gnus-group-description-apropos
4037     "a" gnus-group-post-news
4038     "\ek" gnus-group-edit-local-kill
4039     "\eK" gnus-group-edit-global-kill
4040     "\C-k" gnus-group-kill-group
4041     "\C-y" gnus-group-yank-group
4042     "\C-w" gnus-group-kill-region
4043     "\C-x\C-t" gnus-group-transpose-groups
4044     "\C-c\C-l" gnus-group-list-killed
4045     "\C-c\C-x" gnus-group-expire-articles
4046     "\C-c\M-\C-x" gnus-group-expire-all-groups
4047     "V" gnus-version
4048     "s" gnus-group-save-newsrc
4049     "z" gnus-group-suspend
4050     "Z" gnus-group-clear-dribble
4051     "q" gnus-group-exit
4052     "Q" gnus-group-quit
4053     "?" gnus-group-describe-briefly
4054     "\C-c\C-i" gnus-info-find-node
4055     "\M-e" gnus-group-edit-group-method
4056     "^" gnus-group-enter-server-mode
4057     gnus-mouse-2 gnus-mouse-pick-group
4058     "<" beginning-of-buffer
4059     ">" end-of-buffer
4060     "\C-c\C-b" gnus-bug
4061     "\C-c\C-s" gnus-group-sort-groups
4062     "t" gnus-topic-mode
4063     "\C-c\M-g" gnus-activate-all-groups
4064     "\M-&" gnus-group-universal-argument
4065     "#" gnus-group-mark-group
4066     "\M-#" gnus-group-unmark-group)
4067
4068   (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
4069     "m" gnus-group-mark-group
4070     "u" gnus-group-unmark-group
4071     "w" gnus-group-mark-region
4072     "m" gnus-group-mark-buffer
4073     "r" gnus-group-mark-regexp
4074     "U" gnus-group-unmark-all-groups)
4075
4076   (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
4077     "d" gnus-group-make-directory-group
4078     "h" gnus-group-make-help-group
4079     "a" gnus-group-make-archive-group
4080     "k" gnus-group-make-kiboze-group
4081     "m" gnus-group-make-group
4082     "E" gnus-group-edit-group
4083     "e" gnus-group-edit-group-method
4084     "p" gnus-group-edit-group-parameters
4085     "v" gnus-group-add-to-virtual
4086     "V" gnus-group-make-empty-virtual
4087     "D" gnus-group-enter-directory
4088     "f" gnus-group-make-doc-group
4089     "r" gnus-group-rename-group
4090     "\177" gnus-group-delete-group
4091     [delete] gnus-group-delete-group)
4092
4093    (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
4094      "b" gnus-group-brew-soup
4095      "w" gnus-soup-save-areas
4096      "s" gnus-soup-send-replies
4097      "p" gnus-soup-pack-packet
4098      "r" nnsoup-pack-replies)
4099
4100    (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
4101      "s" gnus-group-sort-groups
4102      "a" gnus-group-sort-groups-by-alphabet
4103      "u" gnus-group-sort-groups-by-unread
4104      "l" gnus-group-sort-groups-by-level
4105      "v" gnus-group-sort-groups-by-score
4106      "r" gnus-group-sort-groups-by-rank
4107      "m" gnus-group-sort-groups-by-method)
4108
4109    (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
4110      "k" gnus-group-list-killed
4111      "z" gnus-group-list-zombies
4112      "s" gnus-group-list-groups
4113      "u" gnus-group-list-all-groups
4114      "A" gnus-group-list-active
4115      "a" gnus-group-apropos
4116      "d" gnus-group-description-apropos
4117      "m" gnus-group-list-matching
4118      "M" gnus-group-list-all-matching
4119      "l" gnus-group-list-level)
4120
4121    (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
4122      "f" gnus-score-flush-cache)
4123
4124    (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
4125      "f" gnus-group-fetch-faq)
4126
4127    (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
4128      "l" gnus-group-set-current-level
4129      "t" gnus-group-unsubscribe-current-group
4130      "s" gnus-group-unsubscribe-group
4131      "k" gnus-group-kill-group
4132      "y" gnus-group-yank-group
4133      "w" gnus-group-kill-region
4134      "\C-k" gnus-group-kill-level
4135      "z" gnus-group-kill-all-zombies))
4136
4137 (defun gnus-group-mode ()
4138   "Major mode for reading news.
4139
4140 All normal editing commands are switched off.
4141 \\<gnus-group-mode-map>
4142 The group buffer lists (some of) the groups available.  For instance,
4143 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
4144 lists all zombie groups.
4145
4146 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
4147 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
4148
4149 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
4150
4151 The following commands are available:
4152
4153 \\{gnus-group-mode-map}"
4154   (interactive)
4155   (when (and menu-bar-mode
4156              (gnus-visual-p 'group-menu 'menu))
4157     (gnus-group-make-menu-bar))
4158   (kill-all-local-variables)
4159   (gnus-simplify-mode-line)
4160   (setq major-mode 'gnus-group-mode)
4161   (setq mode-name "Group")
4162   (gnus-group-set-mode-line)
4163   (setq mode-line-process nil)
4164   (use-local-map gnus-group-mode-map)
4165   (buffer-disable-undo (current-buffer))
4166   (setq truncate-lines t)
4167   (setq buffer-read-only t)
4168   (run-hooks 'gnus-group-mode-hook))
4169
4170 (defun gnus-mouse-pick-group (e)
4171   "Enter the group under the mouse pointer."
4172   (interactive "e")
4173   (mouse-set-point e)
4174   (gnus-group-read-group nil))
4175
4176 ;; Look at LEVEL and find out what the level is really supposed to be.
4177 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
4178 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
4179 (defun gnus-group-default-level (&optional level number-or-nil)
4180   (cond
4181    (gnus-group-use-permanent-levels
4182     (setq gnus-group-default-list-level
4183           (or level gnus-group-default-list-level))
4184     (or gnus-group-default-list-level gnus-level-subscribed))
4185    (number-or-nil
4186     level)
4187    (t
4188     (or level gnus-group-default-list-level gnus-level-subscribed))))
4189
4190 ;;;###autoload
4191 (defun gnus-slave-no-server (&optional arg)
4192   "Read network news as a slave, without connecting to local server"
4193   (interactive "P")
4194   (gnus-no-server arg t))
4195
4196 ;;;###autoload
4197 (defun gnus-no-server (&optional arg slave)
4198   "Read network news.
4199 If ARG is a positive number, Gnus will use that as the
4200 startup level.  If ARG is nil, Gnus will be started at level 2.
4201 If ARG is non-nil and not a positive number, Gnus will
4202 prompt the user for the name of an NNTP server to use.
4203 As opposed to `gnus', this command will not connect to the local server."
4204   (interactive "P")
4205   (let ((gnus-group-use-permanent-levels t))
4206     (gnus (or arg (1- gnus-level-default-subscribed)) t slave))
4207   (make-local-variable 'gnus-group-use-permanent-levels)
4208   (setq gnus-group-use-permanent-levels t))
4209
4210 ;;;###autoload
4211 (defun gnus-slave (&optional arg)
4212   "Read news as a slave."
4213   (interactive "P")
4214   (gnus arg nil 'slave))
4215
4216 ;;;###autoload
4217 (defun gnus-other-frame (&optional arg)
4218   "Pop up a frame to read news."
4219   (interactive "P")
4220   (if (get-buffer gnus-group-buffer)
4221       (let ((pop-up-frames t))
4222         (gnus arg))
4223     (select-frame (make-frame))
4224     (gnus arg)))
4225
4226 ;;;###autoload
4227 (defun gnus (&optional arg dont-connect slave)
4228   "Read network news.
4229 If ARG is non-nil and a positive number, Gnus will use that as the
4230 startup level.  If ARG is non-nil and not a positive number, Gnus will
4231 prompt the user for the name of an NNTP server to use."
4232   (interactive "P")
4233
4234   (if (get-buffer gnus-group-buffer)
4235       (progn
4236         (switch-to-buffer gnus-group-buffer)
4237         (gnus-group-get-new-news))
4238
4239     (gnus-clear-system)
4240     (nnheader-init-server-buffer)
4241     (gnus-read-init-file)
4242     (setq gnus-slave slave)
4243
4244     (gnus-group-setup-buffer)
4245     (let ((buffer-read-only nil))
4246       (erase-buffer)
4247       (if (not gnus-inhibit-startup-message)
4248           (progn
4249             (gnus-group-startup-message)
4250             (sit-for 0))))
4251
4252     (let ((level (and (numberp arg) (> arg 0) arg))
4253           did-connect)
4254       (unwind-protect
4255           (progn
4256             (or dont-connect
4257                 (setq did-connect
4258                       (gnus-start-news-server (and arg (not level))))))
4259         (if (and (not dont-connect)
4260                  (not did-connect))
4261             (gnus-group-quit)
4262           (run-hooks 'gnus-startup-hook)
4263           ;; NNTP server is successfully open.
4264
4265           ;; Find the current startup file name.
4266           (setq gnus-current-startup-file
4267                 (gnus-make-newsrc-file gnus-startup-file))
4268
4269           ;; Read the dribble file.
4270           (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
4271
4272           ;; Allow using GroupLens predictions.
4273           (when gnus-use-grouplens
4274             (bbb-login)
4275             (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
4276
4277           (gnus-summary-make-display-table)
4278           ;; Do the actual startup.
4279           (gnus-setup-news nil level dont-connect)
4280           ;; Generate the group buffer.
4281           (gnus-group-list-groups level)
4282           (gnus-group-first-unread-group)
4283           (gnus-configure-windows 'group)
4284           (gnus-group-set-mode-line))))))
4285
4286 (defun gnus-unload ()
4287   "Unload all Gnus features."
4288   (interactive)
4289   (or (boundp 'load-history)
4290       (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
4291   (let ((history load-history)
4292         feature)
4293     (while history
4294       (and (string-match "^\\(gnus\\|nn\\)" (caar history))
4295            (setq feature (cdr (assq 'provide (car history))))
4296            (unload-feature feature 'force))
4297       (setq history (cdr history)))))
4298
4299 (defun gnus-compile ()
4300   "Byte-compile the user-defined format specs."
4301   (interactive)
4302   (let ((entries gnus-format-specs)
4303         entry gnus-tmp-func)
4304     (save-excursion
4305       (gnus-message 7 "Compiling format specs...")
4306
4307       (while entries
4308         (setq entry (pop entries))
4309         (if (eq (car entry) 'version)
4310             (setq gnus-format-specs (delq entry gnus-format-specs))
4311           (when (and (listp (caddr entry))
4312                      (not (eq 'byte-code (caaddr entry))))
4313             (fset 'gnus-tmp-func
4314                   `(lambda () ,(caddr entry)))
4315             (byte-compile 'gnus-tmp-func)
4316             (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
4317
4318       (push (cons 'version emacs-version) gnus-format-specs)
4319
4320       (gnus-message 7 "Compiling user specs...done"))))
4321
4322 (defun gnus-indent-rigidly (start end arg)
4323   "Indent rigidly using only spaces and no tabs."
4324   (save-excursion
4325     (save-restriction
4326       (narrow-to-region start end)
4327       (indent-rigidly start end arg)
4328       (goto-char (point-min))
4329       (while (search-forward "\t" nil t)
4330         (replace-match "        " t t)))))
4331
4332 (defun gnus-group-startup-message (&optional x y)
4333   "Insert startup message in current buffer."
4334   ;; Insert the message.
4335   (erase-buffer)
4336   (insert
4337    (format "              %s
4338           _    ___ _             _
4339           _ ___ __ ___  __    _ ___
4340           __   _     ___    __  ___
4341               _           ___     _
4342              _  _ __             _
4343              ___   __            _
4344                    __           _
4345                     _      _   _
4346                    _      _    _
4347                       _  _    _
4348                   __  ___
4349                  _   _ _     _
4350                 _   _
4351               _    _
4352              _    _
4353             _
4354           __
4355
4356 "
4357            ""))
4358   ;; And then hack it.
4359   (gnus-indent-rigidly (point-min) (point-max)
4360                        (/ (max (- (window-width) (or x 46)) 0) 2))
4361   (goto-char (point-min))
4362   (forward-line 1)
4363   (let* ((pheight (count-lines (point-min) (point-max)))
4364          (wheight (window-height))
4365          (rest (- wheight pheight)))
4366     (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
4367   ;; Fontify some.
4368   (goto-char (point-min))
4369   (and (search-forward "Praxis" nil t)
4370        (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
4371   (goto-char (point-min))
4372   (let* ((mode-string (gnus-group-set-mode-line)))
4373     (setq mode-line-buffer-identification
4374           (list (concat gnus-version (substring (car mode-string) 4))))
4375     (set-buffer-modified-p t)))
4376
4377 (defun gnus-group-setup-buffer ()
4378   (or (get-buffer gnus-group-buffer)
4379       (progn
4380         (switch-to-buffer gnus-group-buffer)
4381         (gnus-add-current-to-buffer-list)
4382         (gnus-group-mode)
4383         (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
4384
4385 (defun gnus-group-list-groups (&optional level unread lowest)
4386   "List newsgroups with level LEVEL or lower that have unread articles.
4387 Default is all subscribed groups.
4388 If argument UNREAD is non-nil, groups with no unread articles are also
4389 listed."
4390   (interactive (list (if current-prefix-arg
4391                          (prefix-numeric-value current-prefix-arg)
4392                        (or
4393                         (gnus-group-default-level nil t)
4394                         gnus-group-default-list-level
4395                         gnus-level-subscribed))))
4396   (or level
4397       (setq level (car gnus-group-list-mode)
4398             unread (cdr gnus-group-list-mode)))
4399   (setq level (gnus-group-default-level level))
4400   (gnus-group-setup-buffer)             ;May call from out of group buffer
4401   (gnus-update-format-specifications)
4402   (let ((case-fold-search nil)
4403         (props (text-properties-at (gnus-point-at-bol)))
4404         (group (gnus-group-group-name)))
4405     (set-buffer gnus-group-buffer)
4406     (funcall gnus-group-prepare-function level unread lowest)
4407     (if (zerop (buffer-size))
4408         (gnus-message 5 gnus-no-groups-message)
4409       (goto-char (point-max))
4410       (when (or (not gnus-group-goto-next-group-function)
4411                 (not (funcall gnus-group-goto-next-group-function 
4412                               group props)))
4413         (if (not group)
4414             ;; Go to the first group with unread articles.
4415             (gnus-group-search-forward t)
4416           ;; Find the right group to put point on.  If the current group
4417           ;; has disappeared in the new listing, try to find the next
4418           ;; one.        If no next one can be found, just leave point at the
4419           ;; first newsgroup in the buffer.
4420           (if (not (gnus-goto-char
4421                     (text-property-any
4422                      (point-min) (point-max)
4423                      'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
4424               (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
4425                 (while (and newsrc
4426                             (not (gnus-goto-char
4427                                   (text-property-any
4428                                    (point-min) (point-max) 'gnus-group
4429                                    (gnus-intern-safe
4430                                     (caar newsrc) gnus-active-hashtb)))))
4431                   (setq newsrc (cdr newsrc)))
4432                 (or newsrc (progn (goto-char (point-max))
4433                                   (forward-line -1)))))))
4434       ;; Adjust cursor point.
4435       (gnus-group-position-point))))
4436
4437 (defun gnus-group-list-level (level &optional all)
4438   "List groups on LEVEL.
4439 If ALL (the prefix), also list groups that have no unread articles."
4440   (interactive "nList groups on level: \nP")
4441   (gnus-group-list-groups level all level))
4442
4443 (defun gnus-group-prepare-flat (level &optional all lowest regexp)
4444   "List all newsgroups with unread articles of level LEVEL or lower.
4445 If ALL is non-nil, list groups that have no unread articles.
4446 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
4447 If REGEXP, only list groups matching REGEXP."
4448   (set-buffer gnus-group-buffer)
4449   (let ((buffer-read-only nil)
4450         (newsrc (cdr gnus-newsrc-alist))
4451         (lowest (or lowest 1))
4452         info clevel unread group params)
4453     (erase-buffer)
4454     (if (< lowest gnus-level-zombie)
4455         ;; List living groups.
4456         (while newsrc
4457           (setq info (car newsrc)
4458                 group (gnus-info-group info)
4459                 params (gnus-info-params info)
4460                 newsrc (cdr newsrc)
4461                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
4462           (and unread                   ; This group might be bogus
4463                (or (not regexp)
4464                    (string-match regexp group))
4465                (<= (setq clevel (gnus-info-level info)) level)
4466                (>= clevel lowest)
4467                (or all                  ; We list all groups?
4468                    (if (eq unread t)    ; Unactivated?
4469                        gnus-group-list-inactive-groups ; We list unactivated 
4470                      (> unread 0))      ; We list groups with unread articles
4471                    (and gnus-list-groups-with-ticked-articles
4472                         (cdr (assq 'tick (gnus-info-marks info))))
4473                                         ; And groups with tickeds
4474                    ;; Check for permanent visibility.
4475                    (and gnus-permanently-visible-groups
4476                         (string-match gnus-permanently-visible-groups
4477                                       group))
4478                    (memq 'visible params)
4479                    (cdr (assq 'visible params)))
4480                (gnus-group-insert-group-line
4481                 group (gnus-info-level info)
4482                 (gnus-info-marks info) unread (gnus-info-method info)))))
4483
4484     ;; List dead groups.
4485     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
4486          (gnus-group-prepare-flat-list-dead
4487           (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
4488           gnus-level-zombie ?Z
4489           regexp))
4490     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
4491          (gnus-group-prepare-flat-list-dead
4492           (setq gnus-killed-list (sort gnus-killed-list 'string<))
4493           gnus-level-killed ?K regexp))
4494
4495     (gnus-group-set-mode-line)
4496     (setq gnus-group-list-mode (cons level all))
4497     (run-hooks 'gnus-group-prepare-hook)))
4498
4499 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
4500   ;; List zombies and killed lists somewhat faster, which was
4501   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
4502   ;; this by ignoring the group format specification altogether.
4503   (let (group)
4504     (if regexp
4505         ;; This loop is used when listing groups that match some
4506         ;; regexp.
4507         (while groups
4508           (setq group (pop groups))
4509           (when (string-match regexp group)
4510             (add-text-properties
4511              (point) (prog1 (1+ (point))
4512                        (insert " " mark "     *: " group "\n"))
4513              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4514                    'gnus-unread t
4515                    'gnus-level level))))
4516       ;; This loop is used when listing all groups.
4517       (while groups
4518         (add-text-properties
4519          (point) (prog1 (1+ (point))
4520                    (insert " " mark "     *: "
4521                            (setq group (pop groups)) "\n"))
4522          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4523                'gnus-unread t
4524                'gnus-level level))))))
4525
4526 (defmacro gnus-group-real-name (group)
4527   "Find the real name of a foreign newsgroup."
4528   `(let ((gname ,group))
4529      (if (string-match ":[^:]+$" gname)
4530          (substring gname (1+ (match-beginning 0)))
4531        gname)))
4532
4533 (defsubst gnus-server-add-address (method)
4534   (let ((method-name (symbol-name (car method))))
4535     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
4536              (not (assq (intern (concat method-name "-address")) method)))
4537         (append method (list (list (intern (concat method-name "-address"))
4538                                    (nth 1 method))))
4539       method)))
4540
4541 (defsubst gnus-server-get-method (group method)
4542   ;; Input either a server name, and extended server name, or a
4543   ;; select method, and return a select method.
4544   (cond ((stringp method)
4545          (gnus-server-to-method method))
4546         ((and (stringp (car method)) group)
4547          (gnus-server-extend-method group method))
4548         ((and method (not group)
4549               (equal (cadr method) ""))
4550          method)
4551         (t
4552          (gnus-server-add-address method))))
4553
4554 (defun gnus-server-to-method (server)
4555   "Map virtual server names to select methods."
4556   (or 
4557    ;; Perhaps this is the native server?
4558    (and (equal server "native") gnus-select-method)
4559    ;; It should be in the server alist.
4560    (cdr (assoc server gnus-server-alist))
4561    ;; If not, we look through all the opened server
4562    ;; to see whether we can find it there.
4563    (let ((opened gnus-opened-servers))
4564      (while (and opened
4565                  (not (equal server (format "%s:%s" (caaar opened)
4566                                             (cadaar opened)))))
4567        (pop opened))
4568      (caar opened))))
4569
4570 (defmacro gnus-method-equal (ss1 ss2)
4571   "Say whether two servers are equal."
4572   `(let ((s1 ,ss1)
4573          (s2 ,ss2))
4574      (or (equal s1 s2)
4575          (and (= (length s1) (length s2))
4576               (progn
4577                 (while (and s1 (member (car s1) s2))
4578                   (setq s1 (cdr s1)))
4579                 (null s1))))))
4580
4581 (defun gnus-server-equal (m1 m2)
4582   "Say whether two methods are equal."
4583   (let ((m1 (cond ((null m1) gnus-select-method)
4584                   ((stringp m1) (gnus-server-to-method m1))
4585                   (t m1)))
4586         (m2 (cond ((null m2) gnus-select-method)
4587                   ((stringp m2) (gnus-server-to-method m2))
4588                   (t m2))))
4589     (gnus-method-equal m1 m2)))
4590
4591 (defun gnus-group-prefixed-name (group method)
4592   "Return the whole name from GROUP and METHOD."
4593   (and (stringp method) (setq method (gnus-server-to-method method)))
4594   (concat (format "%s" (car method))
4595           (if (and
4596                (or (assoc (format "%s" (car method)) 
4597                           (gnus-methods-using 'address))
4598                    (gnus-server-equal method gnus-message-archive-method))
4599                (nth 1 method)
4600                (not (string= (nth 1 method) "")))
4601               (concat "+" (nth 1 method)))
4602           ":" group))
4603
4604 (defun gnus-group-real-prefix (group)
4605   "Return the prefix of the current group name."
4606   (if (string-match "^[^:]+:" group)
4607       (substring group 0 (match-end 0))
4608     ""))
4609
4610 (defun gnus-group-method (group)
4611   "Return the server or method used for selecting GROUP."
4612   (let ((prefix (gnus-group-real-prefix group)))
4613     (if (equal prefix "")
4614         gnus-select-method
4615       (let ((servers gnus-opened-servers)
4616             (server "")
4617             backend possible found)
4618         (if (string-match "^[^\\+]+\\+" prefix)
4619             (setq backend (intern (substring prefix 0 (1- (match-end 0))))
4620                   server (substring prefix (match-end 0) (1- (length prefix))))
4621           (setq backend (intern (substring prefix 0 (1- (length prefix))))))
4622         (while servers
4623           (when (eq (caaar servers) backend)
4624             (setq possible (caar servers))
4625             (when (equal (cadaar servers) server)
4626               (setq found (caar servers))))
4627           (pop servers))
4628         (or (car (rassoc found gnus-server-alist))
4629             found
4630             (car (rassoc possible gnus-server-alist))
4631             possible
4632             (list backend server))))))
4633
4634 (defsubst gnus-secondary-method-p (method)
4635   "Return whether METHOD is a secondary select method."
4636   (let ((methods gnus-secondary-select-methods)
4637         (gmethod (gnus-server-get-method nil method)))
4638     (while (and methods
4639                 (not (equal (gnus-server-get-method nil (car methods))
4640                             gmethod)))
4641       (setq methods (cdr methods)))
4642     methods))
4643
4644 (defun gnus-group-foreign-p (group)
4645   "Say whether a group is foreign or not."
4646   (and (not (gnus-group-native-p group))
4647        (not (gnus-group-secondary-p group))))
4648
4649 (defun gnus-group-native-p (group)
4650   "Say whether the group is native or not."
4651   (not (string-match ":" group)))
4652
4653 (defun gnus-group-secondary-p (group)
4654   "Say whether the group is secondary or not."
4655   (gnus-secondary-method-p (gnus-find-method-for-group group)))
4656
4657 (defun gnus-group-get-parameter (group &optional symbol)
4658   "Returns the group parameters for GROUP.
4659 If SYMBOL, return the value of that symbol in the group parameters."
4660   (let ((params (gnus-info-params (gnus-get-info group))))
4661     (if symbol
4662         (gnus-group-parameter-value params symbol)
4663       params)))
4664
4665 (defun gnus-group-parameter-value (params symbol)
4666   "Return the value of SYMBOL in group PARAMS."
4667   (or (car (memq symbol params))        ; It's either a simple symbol
4668       (cdr (assq symbol params))))      ; or a cons.
4669
4670 (defun gnus-group-add-parameter (group param)
4671   "Add parameter PARAM to GROUP."
4672   (let ((info (gnus-get-info group)))
4673     (if (not info)
4674         () ; This is a dead group.  We just ignore it.
4675       ;; Cons the new param to the old one and update.
4676       (gnus-group-set-info (cons param (gnus-info-params info))
4677                            group 'params))))
4678
4679 (defun gnus-group-set-parameter (group name value)
4680   "Set parameter NAME to VALUE in GROUP."
4681   (let ((info (gnus-get-info group)))
4682     (if (not info)
4683         () ; This is a dead group.  We just ignore it.
4684       (let ((old-params (gnus-info-params info))
4685             (new-params (list (cons name value))))
4686         (while old-params
4687           (if (or (not (listp (car old-params)))
4688                   (not (eq (caar old-params) name)))
4689               (setq new-params (append new-params (list (car old-params)))))
4690           (setq old-params (cdr old-params)))
4691         (gnus-group-set-info new-params group 'params)))))
4692
4693 (defun gnus-group-add-score (group &optional score)
4694   "Add SCORE to the GROUP score.
4695 If SCORE is nil, add 1 to the score of GROUP."
4696   (let ((info (gnus-get-info group)))
4697     (when info
4698       (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
4699
4700 (defun gnus-summary-bubble-group ()
4701   "Increase the score of the current group.
4702 This is a handy function to add to `gnus-summary-exit-hook' to
4703 increase the score of each group you read."
4704   (gnus-group-add-score gnus-newsgroup-name))
4705
4706 (defun gnus-group-set-info (info &optional method-only-group part)
4707   (let* ((entry (gnus-gethash
4708                  (or method-only-group (gnus-info-group info))
4709                  gnus-newsrc-hashtb))
4710          (part-info info)
4711          (info (if method-only-group (nth 2 entry) info))
4712          method)
4713     (when method-only-group
4714       (unless entry
4715         (error "Trying to change non-existent group %s" method-only-group))
4716       ;; We have received parts of the actual group info - either the
4717       ;; select method or the group parameters.  We first check
4718       ;; whether we have to extend the info, and if so, do that.
4719       (let ((len (length info))
4720             (total (if (eq part 'method) 5 6)))
4721         (when (< len total)
4722           (setcdr (nthcdr (1- len) info)
4723                   (make-list (- total len) nil)))
4724         ;; Then we enter the new info.
4725         (setcar (nthcdr (1- total) info) part-info)))
4726     (unless entry
4727       ;; This is a new group, so we just create it.
4728       (save-excursion
4729         (set-buffer gnus-group-buffer)
4730         (setq method (gnus-info-method info))
4731         (when (gnus-server-equal method "native")
4732           (setq method nil))
4733         (if method
4734             ;; It's a foreign group...
4735             (gnus-group-make-group
4736              (gnus-group-real-name (gnus-info-group info))
4737              (if (stringp method) method
4738                (prin1-to-string (car method)))
4739              (and (consp method)
4740                   (nth 1 (gnus-info-method info))))
4741           ;; It's a native group.
4742           (gnus-group-make-group (gnus-info-group info)))
4743         (gnus-message 6 "Note: New group created")
4744         (setq entry
4745               (gnus-gethash (gnus-group-prefixed-name
4746                              (gnus-group-real-name (gnus-info-group info))
4747                              (or (gnus-info-method info) gnus-select-method))
4748                             gnus-newsrc-hashtb))))
4749     ;; Whether it was a new group or not, we now have the entry, so we
4750     ;; can do the update.
4751     (if entry
4752         (progn
4753           (setcar (nthcdr 2 entry) info)
4754           (when (and (not (eq (car entry) t))
4755                      (gnus-active (gnus-info-group info)))
4756             (setcar entry (length (gnus-list-of-unread-articles (car info))))))
4757       (error "No such group: %s" (gnus-info-group info)))))
4758
4759 (defun gnus-group-set-method-info (group select-method)
4760   (gnus-group-set-info select-method group 'method))
4761
4762 (defun gnus-group-set-params-info (group params)
4763   (gnus-group-set-info params group 'params))
4764
4765 (defun gnus-group-update-group-line ()
4766   "Update the current line in the group buffer."
4767   (let* ((buffer-read-only nil)
4768          (group (gnus-group-group-name))
4769          (gnus-group-indentation (gnus-group-group-indentation))
4770          (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
4771     (and entry
4772          (not (gnus-ephemeral-group-p group))
4773          (gnus-dribble-enter
4774           (concat "(gnus-group-set-info '"
4775                   (prin1-to-string (nth 2 entry)) ")")))
4776     (gnus-delete-line)
4777     (gnus-group-insert-group-line-info group)
4778     (forward-line -1)
4779     (gnus-group-position-point)))
4780
4781 (defun gnus-group-insert-group-line-info (group)
4782   "Insert GROUP on the current line."
4783   (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
4784         active info)
4785     (if entry
4786         (progn
4787           ;; (Un)subscribed group.
4788           (setq info (nth 2 entry))
4789           (gnus-group-insert-group-line
4790            group (gnus-info-level info) (gnus-info-marks info)
4791            (or (car entry) t) (gnus-info-method info)))
4792       ;; This group is dead.
4793       (gnus-group-insert-group-line
4794        group
4795        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
4796        nil
4797        (if (setq active (gnus-active group))
4798            (- (1+ (cdr active)) (car active)) 0)
4799        nil))))
4800
4801 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level 
4802                                                     gnus-tmp-marked number
4803                                                     gnus-tmp-method)
4804   "Insert a group line in the group buffer."
4805   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
4806          (gnus-tmp-number-total
4807           (if gnus-tmp-active
4808               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
4809             0))
4810          (gnus-tmp-number-of-unread
4811           (if (numberp number) (int-to-string (max 0 number))
4812             "*"))
4813          (gnus-tmp-number-of-read
4814           (if (numberp number)
4815               (int-to-string (max 0 (- gnus-tmp-number-total number)))
4816             "*"))
4817          (gnus-tmp-subscribed
4818           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
4819                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
4820                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
4821                 (t ?K)))
4822          (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
4823          (gnus-tmp-newsgroup-description
4824           (if gnus-description-hashtb
4825               (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
4826             ""))
4827          (gnus-tmp-moderated
4828           (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
4829          (gnus-tmp-moderated-string
4830           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
4831          (gnus-tmp-method
4832           (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
4833          (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
4834          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
4835          (gnus-tmp-news-method-string
4836           (if gnus-tmp-method
4837               (format "(%s:%s)" (car gnus-tmp-method)
4838                       (cadr gnus-tmp-method)) ""))
4839          (gnus-tmp-marked-mark
4840           (if (and (numberp number)
4841                    (zerop number)
4842                    (cdr (assq 'tick gnus-tmp-marked)))
4843               ?* ? ))
4844          (gnus-tmp-process-marked
4845           (if (member gnus-tmp-group gnus-group-marked)
4846               gnus-process-mark ? ))
4847          (gnus-tmp-grouplens
4848           (or (and gnus-use-grouplens
4849                    (bbb-grouplens-group-p gnus-tmp-group))
4850               ""))
4851          (buffer-read-only nil)
4852          header gnus-tmp-header)        ; passed as parameter to user-funcs.
4853     (beginning-of-line)
4854     (add-text-properties
4855      (point)
4856      (prog1 (1+ (point))
4857        ;; Insert the text.
4858        (eval gnus-group-line-format-spec))
4859      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
4860        gnus-unread ,(if (numberp number)
4861                         (string-to-int gnus-tmp-number-of-unread)
4862                       t)
4863        gnus-marked ,gnus-tmp-marked-mark
4864        gnus-indentation ,gnus-group-indentation
4865        gnus-level ,gnus-tmp-level))
4866     (when (inline (gnus-visual-p 'group-highlight 'highlight))
4867       (forward-line -1)
4868       (run-hooks 'gnus-group-update-hook)
4869       (forward-line))
4870     ;; Allow XEmacs to remove front-sticky text properties.
4871     (gnus-group-remove-excess-properties)))
4872
4873 (defun gnus-group-update-group (group &optional visible-only)
4874   "Update all lines where GROUP appear.
4875 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
4876 already."
4877   (save-excursion
4878     (set-buffer gnus-group-buffer)
4879     ;; The buffer may be narrowed.
4880     (save-restriction
4881       (widen)
4882       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
4883             (loc (point-min))
4884             found buffer-read-only)
4885         ;; Enter the current status into the dribble buffer.
4886         (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
4887           (if (and entry (not (gnus-ephemeral-group-p group)))
4888               (gnus-dribble-enter
4889                (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
4890                        ")"))))
4891         ;; Find all group instances.  If topics are in use, each group
4892         ;; may be listed in more than once.
4893         (while (setq loc (text-property-any
4894                           loc (point-max) 'gnus-group ident))
4895           (setq found t)
4896           (goto-char loc)
4897           (let ((gnus-group-indentation (gnus-group-group-indentation)))
4898             (gnus-delete-line)
4899             (gnus-group-insert-group-line-info group))
4900           (setq loc (1+ loc)))
4901         (unless (or found visible-only)
4902           ;; No such line in the buffer, find out where it's supposed to
4903           ;; go, and insert it there (or at the end of the buffer).
4904           (if gnus-goto-missing-group-function
4905               (funcall gnus-goto-missing-group-function group)
4906             (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb))))
4907               (while (and entry (car entry)
4908                           (not
4909                            (gnus-goto-char
4910                             (text-property-any
4911                              (point-min) (point-max)
4912                              'gnus-group (gnus-intern-safe
4913                                           (caar entry) gnus-active-hashtb)))))
4914                 (setq entry (cdr entry)))
4915               (or entry (goto-char (point-max)))))
4916           ;; Finally insert the line.
4917           (let ((gnus-group-indentation (gnus-group-group-indentation)))
4918             (gnus-group-insert-group-line-info group)))
4919         (gnus-group-set-mode-line)))))
4920
4921 (defun gnus-group-set-mode-line ()
4922   (when (memq 'group gnus-updated-mode-lines)
4923     (let* ((gformat (or gnus-group-mode-line-format-spec
4924                         (setq gnus-group-mode-line-format-spec
4925                               (gnus-parse-format
4926                                gnus-group-mode-line-format
4927                                gnus-group-mode-line-format-alist))))
4928            (gnus-tmp-news-server (cadr gnus-select-method))
4929            (gnus-tmp-news-method (car gnus-select-method))
4930            (max-len 60)
4931            gnus-tmp-header                      ;Dummy binding for user-defined formats
4932            ;; Get the resulting string.
4933            (mode-string (eval gformat)))
4934       ;; If the line is too long, we chop it off.
4935       (when (> (length mode-string) max-len)
4936         (setq mode-string (substring mode-string 0 (- max-len 4))))
4937       (prog1
4938           (setq mode-line-buffer-identification (list mode-string))
4939         (set-buffer-modified-p t)))))
4940
4941 (defun gnus-group-group-name ()
4942   "Get the name of the newsgroup on the current line."
4943   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
4944     (and group (symbol-name group))))
4945
4946 (defun gnus-group-group-level ()
4947   "Get the level of the newsgroup on the current line."
4948   (get-text-property (gnus-point-at-bol) 'gnus-level))
4949
4950 (defun gnus-group-group-indentation ()
4951   "Get the indentation of the newsgroup on the current line."
4952   (or (get-text-property (gnus-point-at-bol) 'gnus-indentation)
4953       (and gnus-group-indentation-function
4954            (funcall gnus-group-indentation-function))
4955       ""))
4956
4957 (defun gnus-group-group-unread ()
4958   "Get the number of unread articles of the newsgroup on the current line."
4959   (get-text-property (gnus-point-at-bol) 'gnus-unread))
4960
4961 (defun gnus-group-search-forward (&optional backward all level first-too)
4962   "Find the next newsgroup with unread articles.
4963 If BACKWARD is non-nil, find the previous newsgroup instead.
4964 If ALL is non-nil, just find any newsgroup.
4965 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
4966 group exists.
4967 If FIRST-TOO, the current line is also eligible as a target."
4968   (let ((way (if backward -1 1))
4969         (low gnus-level-killed)
4970         (beg (point))
4971         pos found lev)
4972     (if (and backward (progn (beginning-of-line)) (bobp))
4973         nil
4974       (or first-too (forward-line way))
4975       (while (and
4976               (not (eobp))
4977               (not (setq
4978                     found
4979                     (and (or all
4980                              (and
4981                               (let ((unread
4982                                      (get-text-property (point) 'gnus-unread)))
4983                                 (and (numberp unread) (> unread 0)))
4984                               (setq lev (get-text-property (point)
4985                                                            'gnus-level))
4986                               (<= lev gnus-level-subscribed)))
4987                          (or (not level)
4988                              (and (setq lev (get-text-property (point)
4989                                                                'gnus-level))
4990                                   (or (= lev level)
4991                                       (and (< lev low)
4992                                            (< level lev)
4993                                            (progn
4994                                              (setq low lev)
4995                                              (setq pos (point))
4996                                              nil))))))))
4997               (zerop (forward-line way)))))
4998     (if found
4999         (progn (gnus-group-position-point) t)
5000       (goto-char (or pos beg))
5001       (and pos t))))
5002
5003 ;;; Gnus group mode commands
5004
5005 ;; Group marking.
5006
5007 (defun gnus-group-mark-group (n &optional unmark no-advance)
5008   "Mark the current group."
5009   (interactive "p")
5010   (let ((buffer-read-only nil)
5011         group)
5012     (while
5013         (and (> n 0)
5014              (setq group (gnus-group-group-name))
5015              (progn
5016                (beginning-of-line)
5017                (forward-char
5018                 (or (cdr (assq 'process gnus-group-mark-positions)) 2))
5019                (delete-char 1)
5020                (if unmark
5021                    (progn
5022                      (insert " ")
5023                      (setq gnus-group-marked (delete group gnus-group-marked)))
5024                  (insert "#")
5025                  (setq gnus-group-marked
5026                        (cons group (delete group gnus-group-marked))))
5027                t)
5028              (or no-advance (zerop (gnus-group-next-group 1))))
5029       (setq n (1- n)))
5030     (gnus-summary-position-point)
5031     n))
5032
5033 (defun gnus-group-unmark-group (n)
5034   "Remove the mark from the current group."
5035   (interactive "p")
5036   (gnus-group-mark-group n 'unmark)
5037   (gnus-group-position-point))
5038
5039 (defun gnus-group-unmark-all-groups ()
5040   "Unmark all groups."
5041   (interactive)
5042   (let ((groups gnus-group-marked))
5043     (save-excursion
5044       (while groups
5045         (gnus-group-remove-mark (pop groups)))))
5046   (gnus-group-position-point))
5047
5048 (defun gnus-group-mark-region (unmark beg end)
5049   "Mark all groups between point and mark.
5050 If UNMARK, remove the mark instead."
5051   (interactive "P\nr")
5052   (let ((num (count-lines beg end)))
5053     (save-excursion
5054       (goto-char beg)
5055       (- num (gnus-group-mark-group num unmark)))))
5056
5057 (defun gnus-group-mark-buffer (&optional unmark)
5058   "Mark all groups in the buffer.
5059 If UNMARK, remove the mark instead."
5060   (interactive "P")
5061   (gnus-group-mark-region unmark (point-min) (point-max)))
5062
5063 (defun gnus-group-mark-regexp (regexp)
5064   "Mark all groups that match some regexp."
5065   (interactive "sMark (regexp): ")
5066   (let ((alist (cdr gnus-newsrc-alist))
5067         group)
5068     (while alist
5069       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
5070         (gnus-group-set-mark group))))
5071   (gnus-group-position-point))
5072
5073 (defun gnus-group-remove-mark (group)
5074   "Remove the process mark from GROUP and move point there.
5075 Return nil if the group isn't displayed."
5076   (if (gnus-group-goto-group group)
5077       (save-excursion
5078         (gnus-group-mark-group 1 'unmark t)
5079         t)
5080     (setq gnus-group-marked
5081           (delete group gnus-group-marked))
5082     nil))
5083
5084 (defun gnus-group-set-mark (group)
5085   "Set the process mark on GROUP."
5086   (if (gnus-group-goto-group group) 
5087       (save-excursion
5088         (gnus-group-mark-group 1 nil t))
5089     (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
5090
5091 (defun gnus-group-universal-argument (arg &optional groups func)
5092   "Perform any command on all groups accoring to the process/prefix convention."
5093   (interactive "P")
5094   (let ((groups (or groups (gnus-group-process-prefix arg)))
5095         group func)
5096     (if (eq (setq func (or func
5097                            (key-binding
5098                             (read-key-sequence
5099                              (substitute-command-keys
5100                               "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
5101             'undefined)
5102         (progn
5103           (message "Undefined key")
5104           (ding))
5105       (while groups
5106         (gnus-group-remove-mark (setq group (pop groups)))
5107         (command-execute func))))
5108   (gnus-group-position-point))
5109
5110 (defun gnus-group-process-prefix (n)
5111   "Return a list of groups to work on.
5112 Take into consideration N (the prefix) and the list of marked groups."
5113   (cond
5114    (n
5115     (setq n (prefix-numeric-value n))
5116     ;; There is a prefix, so we return a list of the N next
5117     ;; groups.
5118     (let ((way (if (< n 0) -1 1))
5119           (n (abs n))
5120           group groups)
5121       (save-excursion
5122         (while (and (> n 0)
5123                     (setq group (gnus-group-group-name)))
5124           (setq groups (cons group groups))
5125           (setq n (1- n))
5126           (gnus-group-next-group way)))
5127       (nreverse groups)))
5128    ((and (boundp 'transient-mark-mode)
5129          transient-mark-mode
5130          mark-active)
5131     ;; Work on the region between point and mark.
5132     (let ((max (max (point) (mark)))
5133           groups)
5134       (save-excursion
5135         (goto-char (min (point) (mark)))
5136         (while
5137             (and
5138              (push (gnus-group-group-name) groups)
5139              (zerop (gnus-group-next-group 1))
5140              (< (point) max)))
5141         (nreverse groups))))
5142    (gnus-group-marked
5143     ;; No prefix, but a list of marked articles.
5144     (reverse gnus-group-marked))
5145    (t
5146     ;; Neither marked articles or a prefix, so we return the
5147     ;; current group.
5148     (let ((group (gnus-group-group-name)))
5149       (and group (list group))))))
5150
5151 ;; Selecting groups.
5152
5153 (defun gnus-group-read-group (&optional all no-article group)
5154   "Read news in this newsgroup.
5155 If the prefix argument ALL is non-nil, already read articles become
5156 readable.  IF ALL is a number, fetch this number of articles.  If the
5157 optional argument NO-ARTICLE is non-nil, no article will be
5158 auto-selected upon group entry.  If GROUP is non-nil, fetch that
5159 group."
5160   (interactive "P")
5161   (let ((group (or group (gnus-group-group-name)))
5162         number active marked entry)
5163     (or group (error "No group on current line"))
5164     (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
5165                                             group gnus-newsrc-hashtb)))))
5166     ;; This group might be a dead group.  In that case we have to get
5167     ;; the number of unread articles from `gnus-active-hashtb'.
5168     (setq number
5169           (cond ((numberp all) all)
5170                 (entry (car entry))
5171                 ((setq active (gnus-active group))
5172                  (- (1+ (cdr active)) (car active)))))
5173     (gnus-summary-read-group
5174      group (or all (and (numberp number)
5175                         (zerop (+ number (length (cdr (assq 'tick marked)))
5176                                   (length (cdr (assq 'dormant marked)))))))
5177      no-article)))
5178
5179 (defun gnus-group-select-group (&optional all)
5180   "Select this newsgroup.
5181 No article is selected automatically.
5182 If ALL is non-nil, already read articles become readable.
5183 If ALL is a number, fetch this number of articles."
5184   (interactive "P")
5185   (gnus-group-read-group all t))
5186
5187 (defun gnus-group-quick-select-group (&optional all)
5188   "Select the current group \"quickly\".
5189 This means that no highlighting or scoring will be performed."
5190   (interactive "P")
5191   (let (gnus-visual
5192         gnus-score-find-score-files-function
5193         gnus-apply-kill-hook
5194         gnus-summary-expunge-below)
5195     (gnus-group-read-group all t)))
5196
5197 (defun gnus-group-visible-select-group (&optional all)
5198   "Select the current group without hiding any articles."
5199   (interactive "P")
5200   (let ((gnus-inhibit-limiting t))
5201     (gnus-group-read-group all t)))
5202
5203 ;;;###autoload
5204 (defun gnus-fetch-group (group)
5205   "Start Gnus if necessary and enter GROUP.
5206 Returns whether the fetching was successful or not."
5207   (interactive "sGroup name: ")
5208   (or (get-buffer gnus-group-buffer)
5209       (gnus))
5210   (gnus-group-read-group nil nil group))
5211
5212 ;; Enter a group that is not in the group buffer.  Non-nil is returned
5213 ;; if selection was successful.
5214 (defun gnus-group-read-ephemeral-group
5215   (group method &optional activate quit-config)
5216   (let ((group (if (gnus-group-foreign-p group) group
5217                  (gnus-group-prefixed-name group method))))
5218     (gnus-sethash
5219      group
5220      `(t nil (,group ,gnus-level-default-subscribed nil nil ,method
5221                      ((quit-config . ,(if quit-config quit-config
5222                                         (cons (current-buffer) 'summary))))))
5223      gnus-newsrc-hashtb)
5224     (set-buffer gnus-group-buffer)
5225     (or (gnus-check-server method)
5226         (error "Unable to contact server: %s" (gnus-status-message method)))
5227     (if activate (or (gnus-request-group group)
5228                      (error "Couldn't request group")))
5229     (condition-case ()
5230         (gnus-group-read-group t t group)
5231       (error nil)
5232       (quit nil))))
5233
5234 (defun gnus-group-jump-to-group (group)
5235   "Jump to newsgroup GROUP."
5236   (interactive
5237    (list (completing-read
5238           "Group: " gnus-active-hashtb nil
5239           (memq gnus-select-method gnus-have-read-active-file))))
5240
5241   (if (equal group "")
5242       (error "Empty group name"))
5243
5244   (let ((b (text-property-any
5245             (point-min) (point-max)
5246             'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
5247     (unless (gnus-ephemeral-group-p group)
5248       (if b
5249           ;; Either go to the line in the group buffer...
5250           (goto-char b)
5251         ;; ... or insert the line.
5252         (or
5253          (gnus-active group)
5254          (gnus-activate-group group)
5255          (error "%s error: %s" group (gnus-status-message group)))
5256
5257         (gnus-group-update-group group)
5258         (goto-char (text-property-any
5259                     (point-min) (point-max)
5260                     'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
5261     ;; Adjust cursor point.
5262     (gnus-group-position-point)))
5263
5264 (defun gnus-group-goto-group (group)
5265   "Goto to newsgroup GROUP."
5266   (when group
5267     (let ((b (text-property-any (point-min) (point-max)
5268                                 'gnus-group (gnus-intern-safe
5269                                              group gnus-active-hashtb))))
5270       (and b (goto-char b)))))
5271
5272 (defun gnus-group-next-group (n)
5273   "Go to next N'th newsgroup.
5274 If N is negative, search backward instead.
5275 Returns the difference between N and the number of skips actually
5276 done."
5277   (interactive "p")
5278   (gnus-group-next-unread-group n t))
5279
5280 (defun gnus-group-next-unread-group (n &optional all level)
5281   "Go to next N'th unread newsgroup.
5282 If N is negative, search backward instead.
5283 If ALL is non-nil, choose any newsgroup, unread or not.
5284 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
5285 such group can be found, the next group with a level higher than
5286 LEVEL.
5287 Returns the difference between N and the number of skips actually
5288 made."
5289   (interactive "p")
5290   (let ((backward (< n 0))
5291         (n (abs n)))
5292     (while (and (> n 0)
5293                 (gnus-group-search-forward
5294                  backward (or (not gnus-group-goto-unread) all) level))
5295       (setq n (1- n)))
5296     (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
5297                                (if level " on this level or higher" "")))
5298     n))
5299
5300 (defun gnus-group-prev-group (n)
5301   "Go to previous N'th newsgroup.
5302 Returns the difference between N and the number of skips actually
5303 done."
5304   (interactive "p")
5305   (gnus-group-next-unread-group (- n) t))
5306
5307 (defun gnus-group-prev-unread-group (n)
5308   "Go to previous N'th unread newsgroup.
5309 Returns the difference between N and the number of skips actually
5310 done."
5311   (interactive "p")
5312   (gnus-group-next-unread-group (- n)))
5313
5314 (defun gnus-group-next-unread-group-same-level (n)
5315   "Go to next N'th unread newsgroup on the same level.
5316 If N is negative, search backward instead.
5317 Returns the difference between N and the number of skips actually
5318 done."
5319   (interactive "p")
5320   (gnus-group-next-unread-group n t (gnus-group-group-level))
5321   (gnus-group-position-point))
5322
5323 (defun gnus-group-prev-unread-group-same-level (n)
5324   "Go to next N'th unread newsgroup on the same level.
5325 Returns the difference between N and the number of skips actually
5326 done."
5327   (interactive "p")
5328   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
5329   (gnus-group-position-point))
5330
5331 (defun gnus-group-best-unread-group (&optional exclude-group)
5332   "Go to the group with the highest level.
5333 If EXCLUDE-GROUP, do not go to that group."
5334   (interactive)
5335   (goto-char (point-min))
5336   (let ((best 100000)
5337         unread best-point)
5338     (while (not (eobp))
5339       (setq unread (get-text-property (point) 'gnus-unread))
5340       (if (and (numberp unread) (> unread 0))
5341           (progn
5342             (if (and (get-text-property (point) 'gnus-level)
5343                      (< (get-text-property (point) 'gnus-level) best)
5344                      (or (not exclude-group)
5345                          (not (equal exclude-group (gnus-group-group-name)))))
5346                 (progn
5347                   (setq best (get-text-property (point) 'gnus-level))
5348                   (setq best-point (point))))))
5349       (forward-line 1))
5350     (if best-point (goto-char best-point))
5351     (gnus-summary-position-point)
5352     (and best-point (gnus-group-group-name))))
5353
5354 (defun gnus-group-first-unread-group ()
5355   "Go to the first group with unread articles."
5356   (interactive)
5357   (prog1
5358       (let ((opoint (point))
5359             unread)
5360         (goto-char (point-min))
5361         (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
5362                 (and (numberp unread)   ; Not a topic.
5363                      (not (zerop unread))) ; Has unread articles.
5364                 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
5365             (point)                     ; Success.
5366           (goto-char opoint)
5367           nil))                         ; Not success.
5368     (gnus-group-position-point)))
5369
5370 (defun gnus-group-enter-server-mode ()
5371   "Jump to the server buffer."
5372   (interactive)
5373   (gnus-enter-server-buffer))
5374
5375 (defun gnus-group-make-group (name &optional method address)
5376   "Add a new newsgroup.
5377 The user will be prompted for a NAME, for a select METHOD, and an
5378 ADDRESS."
5379   (interactive
5380    (cons
5381     (read-string "Group name: ")
5382     (let ((method
5383            (completing-read
5384             "Method: " (append gnus-valid-select-methods gnus-server-alist)
5385             nil t)))
5386       (cond ((assoc method gnus-valid-select-methods)
5387              (list method
5388                    (if (memq 'prompt-address
5389                              (assoc method gnus-valid-select-methods))
5390                        (read-string "Address: ")
5391                      "")))
5392             ((assoc method gnus-server-alist)
5393              (list method))
5394             (t
5395              (list method ""))))))
5396
5397   (save-excursion
5398     (set-buffer gnus-group-buffer)
5399     (let* ((meth (and method (if address (list (intern method) address)
5400                                method)))
5401            (nname (if method (gnus-group-prefixed-name name meth) name))
5402            backend info)
5403       (and (gnus-gethash nname gnus-newsrc-hashtb)
5404            (error "Group %s already exists" nname))
5405       (gnus-group-change-level
5406        (setq info (list t nname gnus-level-default-subscribed nil nil meth))
5407        gnus-level-default-subscribed gnus-level-killed
5408        (and (gnus-group-group-name)
5409             (gnus-gethash (gnus-group-group-name)
5410                           gnus-newsrc-hashtb))
5411        t)
5412       (gnus-set-active nname (cons 1 0))
5413       (or (gnus-ephemeral-group-p name)
5414           (gnus-dribble-enter
5415            (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
5416       (gnus-group-insert-group-line-info nname)
5417
5418       (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
5419                                                     nil meth))))
5420                    gnus-valid-select-methods)
5421         (require backend))
5422       (gnus-check-server meth)
5423       (and (gnus-check-backend-function 'request-create-group nname)
5424            (gnus-request-create-group nname))
5425       t)))
5426
5427 (defun gnus-group-delete-group (group &optional force)
5428   "Delete the current group.
5429 If FORCE (the prefix) is non-nil, all the articles in the group will
5430 be deleted.  This is \"deleted\" as in \"removed forever from the face
5431 of the Earth\".  There is no undo."
5432   (interactive
5433    (list (gnus-group-group-name)
5434          current-prefix-arg))
5435   (or group (error "No group to rename"))
5436   (or (gnus-check-backend-function 'request-delete-group group)
5437       (error "This backend does not support group deletion"))
5438   (prog1
5439       (if (not (gnus-yes-or-no-p
5440                 (format
5441                  "Do you really want to delete %s%s? "
5442                  group (if force " and all its contents" ""))))
5443           () ; Whew!
5444         (gnus-message 6 "Deleting group %s..." group)
5445         (if (not (gnus-request-delete-group group force))
5446             (progn
5447               (gnus-message 3 "Couldn't delete group %s" group)
5448               (ding))
5449           (gnus-message 6 "Deleting group %s...done" group)
5450           (gnus-group-goto-group group)
5451           (gnus-group-kill-group 1 t)
5452           (gnus-sethash group nil gnus-active-hashtb)
5453           t))
5454     (gnus-group-position-point)))
5455
5456 (defun gnus-group-rename-group (group new-name)
5457   (interactive
5458    (list
5459     (gnus-group-group-name)
5460     (progn
5461       (or (gnus-check-backend-function
5462            'request-rename-group (gnus-group-group-name))
5463           (error "This backend does not support renaming groups"))
5464       (read-string "New group name: "))))
5465
5466   (or (gnus-check-backend-function 'request-rename-group group)
5467       (error "This backend does not support renaming groups"))
5468
5469   (or group (error "No group to rename"))
5470   (and (string-match "^[ \t]*$" new-name)
5471        (error "Not a valid group name"))
5472
5473   ;; We find the proper prefixed name.
5474   (setq new-name
5475         (gnus-group-prefixed-name
5476          (gnus-group-real-name new-name)
5477          (gnus-info-method (gnus-get-info group))))
5478
5479   (gnus-message 6 "Renaming group %s to %s..." group new-name)
5480   (prog1
5481       (if (not (gnus-request-rename-group group new-name))
5482           (progn
5483             (gnus-message 3 "Couldn't rename group %s to %s" group new-name)
5484             (ding))
5485         ;; We rename the group internally by killing it...
5486         (gnus-group-goto-group group)
5487         (gnus-group-kill-group)
5488         ;; ... changing its name ...
5489         (setcar (cdar gnus-list-of-killed-groups) new-name)
5490         ;; ... and then yanking it.  Magic!
5491         (gnus-group-yank-group)
5492         (gnus-set-active new-name (gnus-active group))
5493         (gnus-message 6 "Renaming group %s to %s...done" group new-name)
5494         new-name)
5495     (gnus-group-position-point)))
5496
5497 (defun gnus-group-edit-group (group &optional part)
5498   "Edit the group on the current line."
5499   (interactive (list (gnus-group-group-name)))
5500   (let* ((part (or part 'info))
5501          (done-func `(lambda ()
5502                        "Exit editing mode and update the information."
5503                        (interactive)
5504                        (gnus-group-edit-group-done ',part ,group)))
5505          (winconf (current-window-configuration))
5506          info)
5507     (or group (error "No group on current line"))
5508     (or (setq info (gnus-get-info group))
5509         (error "Killed group; can't be edited"))
5510     (set-buffer (get-buffer-create gnus-group-edit-buffer))
5511     (gnus-configure-windows 'edit-group)
5512     (gnus-add-current-to-buffer-list)
5513     (emacs-lisp-mode)
5514     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
5515     (use-local-map (copy-keymap emacs-lisp-mode-map))
5516     (local-set-key "\C-c\C-c" done-func)
5517     (make-local-variable 'gnus-prev-winconf)
5518     (setq gnus-prev-winconf winconf)
5519     (erase-buffer)
5520     (insert
5521      (cond
5522       ((eq part 'method)
5523        ";; Type `C-c C-c' after editing the select method.\n\n")
5524       ((eq part 'params)
5525        ";; Type `C-c C-c' after editing the group parameters.\n\n")
5526       ((eq part 'info)
5527        ";; Type `C-c C-c' after editing the group info.\n\n")))
5528     (insert
5529      (pp-to-string
5530       (cond ((eq part 'method)
5531              (or (gnus-info-method info) "native"))
5532             ((eq part 'params)
5533              (gnus-info-params info))
5534             (t info)))
5535      "\n")))
5536
5537 (defun gnus-group-edit-group-method (group)
5538   "Edit the select method of GROUP."
5539   (interactive (list (gnus-group-group-name)))
5540   (gnus-group-edit-group group 'method))
5541
5542 (defun gnus-group-edit-group-parameters (group)
5543   "Edit the group parameters of GROUP."
5544   (interactive (list (gnus-group-group-name)))
5545   (gnus-group-edit-group group 'params))
5546
5547 (defun gnus-group-edit-group-done (part group)
5548   "Get info from buffer, update variables and jump to the group buffer."
5549   (set-buffer (get-buffer-create gnus-group-edit-buffer))
5550   (goto-char (point-min))
5551   (let* ((form (read (current-buffer)))
5552          (winconf gnus-prev-winconf)
5553          (method (cond ((eq part 'info) (nth 4 form))
5554                        ((eq part 'method) form)
5555                        (t nil)))
5556          (info (cond ((eq part 'info) form)
5557                      ((eq part 'method) (gnus-get-info group))
5558                      (t nil)))
5559          (new-group (if info
5560                       (if (or (not method)
5561                               (gnus-server-equal
5562                                gnus-select-method method))
5563                           (gnus-group-real-name (car info))
5564                         (gnus-group-prefixed-name
5565                          (gnus-group-real-name (car info)) method))
5566                       nil)))
5567     (when (and new-group
5568                (not (equal new-group group)))
5569       (when (gnus-group-goto-group group)
5570         (gnus-group-kill-group 1))
5571       (gnus-activate-group new-group))
5572     ;; Set the info.
5573     (if (and info new-group)
5574         (progn
5575           (setq info (gnus-copy-sequence info))
5576           (setcar info new-group)
5577           (unless (gnus-server-equal method "native")
5578             (unless (nthcdr 3 info)
5579               (nconc info (list nil nil)))
5580             (unless (nthcdr 4 info)
5581               (nconc info (list nil)))
5582             (gnus-info-set-method info method))
5583           (gnus-group-set-info info))
5584       (gnus-group-set-info form (or new-group group) part))
5585     (kill-buffer (current-buffer))
5586     (and winconf (set-window-configuration winconf))
5587     (set-buffer gnus-group-buffer)
5588     (gnus-group-update-group (or new-group group))
5589     (gnus-group-position-point)))
5590
5591 (defun gnus-group-make-help-group ()
5592   "Create the Gnus documentation group."
5593   (interactive)
5594   (let ((path load-path)
5595         (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
5596         file dir)
5597     (and (gnus-gethash name gnus-newsrc-hashtb)
5598          (error "Documentation group already exists"))
5599     (while path
5600       (setq dir (file-name-as-directory (expand-file-name (pop path)))
5601             file nil)
5602       (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt")))
5603                 (file-exists-p
5604                  (setq file (concat (file-name-directory
5605                                      (directory-file-name dir))
5606                                     "etc/gnus-tut.txt"))))
5607         (setq path nil)))
5608     (if (not file)
5609         (message "Couldn't find doc group")
5610       (gnus-group-make-group
5611        (gnus-group-real-name name)
5612        (list 'nndoc "gnus-help"
5613              (list 'nndoc-address file)
5614              (list 'nndoc-article-type 'mbox)))))
5615   (gnus-group-position-point))
5616
5617 (defun gnus-group-make-doc-group (file type)
5618   "Create a group that uses a single file as the source."
5619   (interactive
5620    (list (read-file-name "File name: ")
5621          (and current-prefix-arg 'ask)))
5622   (when (eq type 'ask)
5623     (let ((err "")
5624           char found)
5625       (while (not found)
5626         (message
5627          "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
5628          err)
5629         (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
5630                           ((= char ?b) 'babyl)
5631                           ((= char ?d) 'digest)
5632                           ((= char ?f) 'forward)
5633                           ((= char ?a) 'mmfd)
5634                           (t (setq err (format "%c unknown. " char))
5635                              nil))))
5636       (setq type found)))
5637   (let* ((file (expand-file-name file))
5638          (name (gnus-generate-new-group-name
5639                 (gnus-group-prefixed-name
5640                  (file-name-nondirectory file) '(nndoc "")))))
5641     (gnus-group-make-group
5642      (gnus-group-real-name name)
5643      (list 'nndoc (file-name-nondirectory file)
5644            (list 'nndoc-address file)
5645            (list 'nndoc-article-type (or type 'guess))))
5646     (forward-line -1)
5647     (gnus-group-position-point)))
5648
5649 (defun gnus-group-make-archive-group (&optional all)
5650   "Create the (ding) Gnus archive group of the most recent articles.
5651 Given a prefix, create a full group."
5652   (interactive "P")
5653   (let ((group (gnus-group-prefixed-name
5654                 (if all "ding.archives" "ding.recent") '(nndir ""))))
5655     (and (gnus-gethash group gnus-newsrc-hashtb)
5656          (error "Archive group already exists"))
5657     (gnus-group-make-group
5658      (gnus-group-real-name group)
5659      (list 'nndir (if all "hpc" "edu")
5660            (list 'nndir-directory
5661                  (if all gnus-group-archive-directory
5662                    gnus-group-recent-archive-directory)))))
5663   (forward-line -1)
5664   (gnus-group-position-point))
5665
5666 (defun gnus-group-make-directory-group (dir)
5667   "Create an nndir group.
5668 The user will be prompted for a directory.  The contents of this
5669 directory will be used as a newsgroup.  The directory should contain
5670 mail messages or news articles in files that have numeric names."
5671   (interactive
5672    (list (read-file-name "Create group from directory: ")))
5673   (or (file-exists-p dir) (error "No such directory"))
5674   (or (file-directory-p dir) (error "Not a directory"))
5675   (let ((ext "")
5676         (i 0)
5677         group)
5678     (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
5679       (setq group
5680             (gnus-group-prefixed-name
5681              (concat (file-name-as-directory (directory-file-name dir))
5682                      ext)
5683              '(nndir "")))
5684       (setq ext (format "<%d>" (setq i (1+ i)))))
5685     (gnus-group-make-group
5686      (gnus-group-real-name group)
5687      (list 'nndir group (list 'nndir-directory dir))))
5688   (forward-line -1)
5689   (gnus-group-position-point))
5690
5691 (defun gnus-group-make-kiboze-group (group address scores)
5692   "Create an nnkiboze group.
5693 The user will be prompted for a name, a regexp to match groups, and
5694 score file entries for articles to include in the group."
5695   (interactive
5696    (list
5697     (read-string "nnkiboze group name: ")
5698     (read-string "Source groups (regexp): ")
5699     (let ((headers (mapcar (lambda (group) (list group))
5700                            '("subject" "from" "number" "date" "message-id"
5701                              "references" "chars" "lines" "xref"
5702                              "followup" "all" "body" "head")))
5703           scores header regexp regexps)
5704       (while (not (equal "" (setq header (completing-read
5705                                           "Match on header: " headers nil t))))
5706         (setq regexps nil)
5707         (while (not (equal "" (setq regexp (read-string
5708                                             (format "Match on %s (string): "
5709                                                     header)))))
5710           (setq regexps (cons (list regexp nil nil 'r) regexps)))
5711         (setq scores (cons (cons header regexps) scores)))
5712       scores)))
5713   (gnus-group-make-group group "nnkiboze" address)
5714   (save-excursion
5715     (gnus-set-work-buffer)
5716     (let (emacs-lisp-mode-hook)
5717       (pp scores (current-buffer)))
5718     (write-region (point-min) (point-max)
5719                   (gnus-score-file-name (concat "nnkiboze:" group))))
5720   (forward-line -1)
5721   (gnus-group-position-point))
5722
5723 (defun gnus-group-add-to-virtual (n vgroup)
5724   "Add the current group to a virtual group."
5725   (interactive
5726    (list current-prefix-arg
5727          (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
5728                           "nnvirtual:")))
5729   (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
5730       (error "%s is not an nnvirtual group" vgroup))
5731   (let* ((groups (gnus-group-process-prefix n))
5732          (method (gnus-info-method (gnus-get-info vgroup))))
5733     (setcar (cdr method)
5734             (concat
5735              (nth 1 method) "\\|"
5736              (mapconcat
5737               (lambda (s)
5738                 (gnus-group-remove-mark s)
5739                 (concat "\\(^" (regexp-quote s) "$\\)"))
5740               groups "\\|"))))
5741   (gnus-group-position-point))
5742
5743 (defun gnus-group-make-empty-virtual (group)
5744   "Create a new, fresh, empty virtual group."
5745   (interactive "sCreate new, empty virtual group: ")
5746   (let* ((method (list 'nnvirtual "^$"))
5747          (pgroup (gnus-group-prefixed-name group method)))
5748     ;; Check whether it exists already.
5749     (and (gnus-gethash pgroup gnus-newsrc-hashtb)
5750          (error "Group %s already exists." pgroup))
5751     ;; Subscribe the new group after the group on the current line.
5752     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
5753     (gnus-group-update-group pgroup)
5754     (forward-line -1)
5755     (gnus-group-position-point)))
5756
5757 (defun gnus-group-enter-directory (dir)
5758   "Enter an ephemeral nneething group."
5759   (interactive "DDirectory to read: ")
5760   (let* ((method (list 'nneething dir))
5761          (leaf (gnus-group-prefixed-name
5762                 (file-name-nondirectory (directory-file-name dir))
5763                 method))
5764          (name (gnus-generate-new-group-name leaf)))
5765     (let ((nneething-read-only t))
5766       (or (gnus-group-read-ephemeral-group
5767            name method t
5768            (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
5769                                       'summary 'group)))
5770           (error "Couldn't enter %s" dir)))))
5771
5772 ;; Group sorting commands
5773 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
5774
5775 (defun gnus-group-sort-groups (func &optional reverse)
5776   "Sort the group buffer according to FUNC.
5777 If REVERSE, reverse the sorting order."
5778   (interactive (list gnus-group-sort-function
5779                      current-prefix-arg))
5780   (let ((func (cond 
5781                ((not (listp func)) func)
5782                ((null func) func)
5783                ((= 1 (length func)) (car func))
5784                (t `(lambda (t1 t2)
5785                      ,(gnus-make-sort-function 
5786                        (reverse func)))))))
5787     ;; We peel off the dummy group from the alist.
5788     (when func
5789       (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
5790         (pop gnus-newsrc-alist))
5791       ;; Do the sorting.
5792       (setq gnus-newsrc-alist
5793             (sort gnus-newsrc-alist func))
5794       (when reverse
5795         (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
5796       ;; Regenerate the hash table.
5797       (gnus-make-hashtable-from-newsrc-alist)
5798       (gnus-group-list-groups))))
5799
5800 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
5801   "Sort the group buffer alphabetically by group name.
5802 If REVERSE, sort in reverse order."
5803   (interactive "P")
5804   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
5805
5806 (defun gnus-group-sort-groups-by-unread (&optional reverse)
5807   "Sort the group buffer by number of unread articles.
5808 If REVERSE, sort in reverse order."
5809   (interactive "P")
5810   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
5811
5812 (defun gnus-group-sort-groups-by-level (&optional reverse)
5813   "Sort the group buffer by group level.
5814 If REVERSE, sort in reverse order."
5815   (interactive "P")
5816   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
5817
5818 (defun gnus-group-sort-groups-by-score (&optional reverse)
5819   "Sort the group buffer by group score.
5820 If REVERSE, sort in reverse order."
5821   (interactive "P")
5822   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
5823
5824 (defun gnus-group-sort-groups-by-rank (&optional reverse)
5825   "Sort the group buffer by group rank.
5826 If REVERSE, sort in reverse order."
5827   (interactive "P")
5828   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
5829
5830 (defun gnus-group-sort-groups-by-method (&optional reverse)
5831   "Sort the group buffer alphabetically by backend name.
5832 If REVERSE, sort in reverse order."
5833   (interactive "P")
5834   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
5835
5836 (defun gnus-group-sort-by-alphabet (info1 info2)
5837   "Sort alphabetically."
5838   (string< (gnus-info-group info1) (gnus-info-group info2)))
5839
5840 (defun gnus-group-sort-by-unread (info1 info2)
5841   "Sort by number of unread articles."
5842   (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
5843         (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
5844     (< (or (and (numberp n1) n1) 0)
5845        (or (and (numberp n2) n2) 0))))
5846
5847 (defun gnus-group-sort-by-level (info1 info2)
5848   "Sort by level."
5849   (< (gnus-info-level info1) (gnus-info-level info2)))
5850
5851 (defun gnus-group-sort-by-method (info1 info2)
5852   "Sort alphabetically by backend name."
5853   (string< (symbol-name (car (gnus-find-method-for-group
5854                               (gnus-info-group info1) info1)))
5855            (symbol-name (car (gnus-find-method-for-group
5856                               (gnus-info-group info2) info2)))))
5857
5858 (defun gnus-group-sort-by-score (info1 info2)
5859   "Sort by group score."
5860   (< (gnus-info-score info1) (gnus-info-score info2)))
5861
5862 (defun gnus-group-sort-by-rank (info1 info2)
5863   "Sort by level and score."
5864   (let ((level1 (gnus-info-level info1))
5865         (level2 (gnus-info-level info2)))
5866     (or (< level1 level2)
5867         (and (= level1 level2)
5868              (< (gnus-info-score info1) (gnus-info-score info2))))))
5869
5870 ;; Group catching up.
5871
5872 (defun gnus-group-clear-data (n)
5873   "Clear all marks and read ranges from the current group."
5874   (interactive "P")
5875   (let ((groups (gnus-group-process-prefix n))
5876         group info)
5877     (while (setq group (pop groups))
5878       (setq info (gnus-get-info group))
5879       (gnus-info-set-read info nil)
5880       (when (gnus-info-marks info)
5881         (gnus-info-set-marks info nil))
5882       (gnus-get-unread-articles-in-group info (gnus-active group) t)
5883       (when (gnus-group-goto-group group)
5884         (gnus-group-remove-mark group)
5885         (gnus-group-update-group-line)))))
5886
5887 (defun gnus-group-catchup-current (&optional n all)
5888   "Mark all articles not marked as unread in current newsgroup as read.
5889 If prefix argument N is numeric, the ARG next newsgroups will be
5890 caught up.  If ALL is non-nil, marked articles will also be marked as
5891 read.  Cross references (Xref: header) of articles are ignored.
5892 The difference between N and actual number of newsgroups that were
5893 caught up is returned."
5894   (interactive "P")
5895   (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
5896                gnus-expert-user
5897                (gnus-y-or-n-p
5898                 (if all
5899                     "Do you really want to mark all articles as read? "
5900                   "Mark all unread articles as read? "))))
5901       n
5902     (let ((groups (gnus-group-process-prefix n))
5903           (ret 0))
5904       (while groups
5905         ;; Virtual groups have to be given special treatment.
5906         (let ((method (gnus-find-method-for-group (car groups))))
5907           (if (eq 'nnvirtual (car method))
5908               (nnvirtual-catchup-group
5909                (gnus-group-real-name (car groups)) (nth 1 method) all)))
5910         (gnus-group-remove-mark (car groups))
5911         (if (prog1
5912                 (gnus-group-goto-group (car groups))
5913               (gnus-group-catchup (car groups) all))
5914             (gnus-group-update-group-line)
5915           (setq ret (1+ ret)))
5916         (setq groups (cdr groups)))
5917       (gnus-group-next-unread-group 1)
5918       ret)))
5919
5920 (defun gnus-group-catchup-current-all (&optional n)
5921   "Mark all articles in current newsgroup as read.
5922 Cross references (Xref: header) of articles are ignored."
5923   (interactive "P")
5924   (gnus-group-catchup-current n 'all))
5925
5926 (defun gnus-group-catchup (group &optional all)
5927   "Mark all articles in GROUP as read.
5928 If ALL is non-nil, all articles are marked as read.
5929 The return value is the number of articles that were marked as read,
5930 or nil if no action could be taken."
5931   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
5932          (num (car entry)))
5933     ;; Do the updating only if the newsgroup isn't killed.
5934     (if (not (numberp (car entry)))
5935         (gnus-message 1 "Can't catch up; non-active group")
5936       ;; Do auto-expirable marks if that's required.
5937       (when (gnus-group-auto-expirable-p group)
5938         (gnus-add-marked-articles
5939          group 'expire (gnus-list-of-unread-articles group))
5940         (when all
5941           (let ((marks (nth 3 (nth 2 entry))))
5942             (gnus-add-marked-articles
5943              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
5944             (gnus-add-marked-articles
5945              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
5946       (when entry
5947         (gnus-update-read-articles group nil)
5948         ;; Also nix out the lists of marks and dormants.
5949         (when all
5950           (gnus-add-marked-articles group 'tick nil nil 'force)
5951           (gnus-add-marked-articles group 'dormant nil nil 'force))
5952         (run-hooks 'gnus-group-catchup-group-hook)
5953         num))))
5954
5955 (defun gnus-group-expire-articles (&optional n)
5956   "Expire all expirable articles in the current newsgroup."
5957   (interactive "P")
5958   (let ((groups (gnus-group-process-prefix n))
5959         group)
5960     (unless groups
5961       (error "No groups to expire"))
5962     (while (setq group (pop groups))
5963       (gnus-group-remove-mark group)
5964       (when (gnus-check-backend-function 'request-expire-articles group)
5965         (gnus-message 6 "Expiring articles in %s..." group)
5966         (let* ((info (gnus-get-info group))
5967                (expirable (if (gnus-group-total-expirable-p group)
5968                               (cons nil (gnus-list-of-read-articles group))
5969                             (assq 'expire (gnus-info-marks info))))
5970                (expiry-wait (gnus-group-get-parameter group 'expiry-wait)))
5971           (when expirable
5972             (setcdr
5973              expirable
5974              (gnus-compress-sequence
5975               (if expiry-wait
5976                   ;; We set the expiry variables to the groupp
5977                   ;; parameter. 
5978                   (let ((nnmail-expiry-wait-function nil)
5979                         (nnmail-expiry-wait expiry-wait))
5980                     (gnus-request-expire-articles
5981                      (gnus-uncompress-sequence (cdr expirable)) group))
5982                 ;; Just expire using the normal expiry values.
5983                 (gnus-request-expire-articles
5984                  (gnus-uncompress-sequence (cdr expirable)) group)))))
5985           (gnus-message 6 "Expiring articles in %s...done" group)))
5986       (gnus-group-position-point))))
5987
5988 (defun gnus-group-expire-all-groups ()
5989   "Expire all expirable articles in all newsgroups."
5990   (interactive)
5991   (save-excursion
5992     (gnus-message 5 "Expiring...")
5993     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
5994                                      (cdr gnus-newsrc-alist))))
5995       (gnus-group-expire-articles nil)))
5996   (gnus-group-position-point)
5997   (gnus-message 5 "Expiring...done"))
5998
5999 (defun gnus-group-set-current-level (n level)
6000   "Set the level of the next N groups to LEVEL."
6001   (interactive
6002    (list
6003     current-prefix-arg
6004     (string-to-int
6005      (let ((s (read-string
6006                (format "Level (default %s): "
6007                        (or (gnus-group-group-level) 
6008                            gnus-level-default-subscribed)))))
6009        (if (string-match "^\\s-*$" s)
6010            (int-to-string (or (gnus-group-group-level) 
6011                               gnus-level-default-subscribed))
6012          s)))))
6013   (or (and (>= level 1) (<= level gnus-level-killed))
6014       (error "Illegal level: %d" level))
6015   (let ((groups (gnus-group-process-prefix n))
6016         group)
6017     (while (setq group (pop groups))
6018       (gnus-group-remove-mark group)
6019       (gnus-message 6 "Changed level of %s from %d to %d"
6020                     group (or (gnus-group-group-level) gnus-level-killed)
6021                     level)
6022       (gnus-group-change-level
6023        group level (or (gnus-group-group-level) gnus-level-killed))
6024       (gnus-group-update-group-line)))
6025   (gnus-group-position-point))
6026
6027 (defun gnus-group-unsubscribe-current-group (&optional n)
6028   "Toggle subscription of the current group.
6029 If given numerical prefix, toggle the N next groups."
6030   (interactive "P")
6031   (let ((groups (gnus-group-process-prefix n))
6032         group)
6033     (while groups
6034       (setq group (car groups)
6035             groups (cdr groups))
6036       (gnus-group-remove-mark group)
6037       (gnus-group-unsubscribe-group
6038        group (if (<= (gnus-group-group-level) gnus-level-subscribed)
6039                  gnus-level-default-unsubscribed
6040                gnus-level-default-subscribed) t)
6041       (gnus-group-update-group-line))
6042     (gnus-group-next-group 1)))
6043
6044 (defun gnus-group-unsubscribe-group (group &optional level silent)
6045   "Toggle subscription to GROUP.
6046 Killed newsgroups are subscribed.  If SILENT, don't try to update the
6047 group line."
6048   (interactive
6049    (list (completing-read
6050           "Group: " gnus-active-hashtb nil
6051           (memq gnus-select-method gnus-have-read-active-file))))
6052   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
6053     (cond
6054      ((string-match "^[ \t]$" group)
6055       (error "Empty group name"))
6056      (newsrc
6057       ;; Toggle subscription flag.
6058       (gnus-group-change-level
6059        newsrc (if level level (if (<= (nth 1 (nth 2 newsrc))
6060                                       gnus-level-subscribed)
6061                                   (1+ gnus-level-subscribed)
6062                                 gnus-level-default-subscribed)))
6063       (unless silent
6064         (gnus-group-update-group group)))
6065      ((and (stringp group)
6066            (or (not (memq gnus-select-method gnus-have-read-active-file))
6067                (gnus-active group)))
6068       ;; Add new newsgroup.
6069       (gnus-group-change-level
6070        group
6071        (if level level gnus-level-default-subscribed)
6072        (or (and (member group gnus-zombie-list)
6073                 gnus-level-zombie)
6074            gnus-level-killed)
6075        (and (gnus-group-group-name)
6076             (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
6077       (unless silent
6078         (gnus-group-update-group group)))
6079      (t (error "No such newsgroup: %s" group)))
6080     (gnus-group-position-point)))
6081
6082 (defun gnus-group-transpose-groups (n)
6083   "Move the current newsgroup up N places.
6084 If given a negative prefix, move down instead.  The difference between
6085 N and the number of steps taken is returned."
6086   (interactive "p")
6087   (or (gnus-group-group-name)
6088       (error "No group on current line"))
6089   (gnus-group-kill-group 1)
6090   (prog1
6091       (forward-line (- n))
6092     (gnus-group-yank-group)
6093     (gnus-group-position-point)))
6094
6095 (defun gnus-group-kill-all-zombies ()
6096   "Kill all zombie newsgroups."
6097   (interactive)
6098   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
6099   (setq gnus-zombie-list nil)
6100   (gnus-group-list-groups))
6101
6102 (defun gnus-group-kill-region (begin end)
6103   "Kill newsgroups in current region (excluding current point).
6104 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
6105   (interactive "r")
6106   (let ((lines
6107          ;; Count lines.
6108          (save-excursion
6109            (count-lines
6110             (progn
6111               (goto-char begin)
6112               (beginning-of-line)
6113               (point))
6114             (progn
6115               (goto-char end)
6116               (beginning-of-line)
6117               (point))))))
6118     (goto-char begin)
6119     (beginning-of-line)                 ;Important when LINES < 1
6120     (gnus-group-kill-group lines)))
6121
6122 (defun gnus-group-kill-group (&optional n discard)
6123   "Kill the next N groups.
6124 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
6125 However, only groups that were alive can be yanked; already killed
6126 groups or zombie groups can't be yanked.
6127 The return value is the name of the group that was killed, or a list
6128 of groups killed."
6129   (interactive "P")
6130   (let ((buffer-read-only nil)
6131         (groups (gnus-group-process-prefix n))
6132         group entry level out)
6133     (if (< (length groups) 10)
6134         ;; This is faster when there are few groups.
6135         (while groups
6136           (push (setq group (pop groups)) out)
6137           (gnus-group-remove-mark group)
6138           (setq level (gnus-group-group-level))
6139           (gnus-delete-line)
6140           (when (and (not discard)
6141                      (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
6142             (push (cons (car entry) (nth 2 entry))
6143                   gnus-list-of-killed-groups))
6144           (gnus-group-change-level
6145            (if entry entry group) gnus-level-killed (if entry nil level)))
6146       ;; If there are lots and lots of groups to be killed, we use
6147       ;; this thing instead.
6148       (let (entry)
6149         (setq groups (nreverse groups))
6150         (while groups
6151           (gnus-group-remove-mark (setq group (pop groups)))
6152           (gnus-delete-line)
6153           (cond
6154            ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
6155             (push (cons (car entry) (nth 2 entry))
6156                   gnus-list-of-killed-groups)
6157             (setcdr (cdr entry) (cdddr entry)))
6158            ((member group gnus-zombie-list)
6159             (setq gnus-zombie-list (delete group gnus-zombie-list)))))
6160         (gnus-make-hashtable-from-newsrc-alist)))
6161
6162     (gnus-group-position-point)
6163     (if (< (length out) 2) (car out) (nreverse out))))
6164
6165 (defun gnus-group-yank-group (&optional arg)
6166   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
6167 inserting it before the current newsgroup.  The numeric ARG specifies
6168 how many newsgroups are to be yanked.  The name of the newsgroup yanked
6169 is returned, or (if several groups are yanked) a list of yanked groups
6170 is returned."
6171   (interactive "p")
6172   (setq arg (or arg 1))
6173   (let (info group prev out)
6174     (while (>= (decf arg) 0)
6175       (if (not (setq info (pop gnus-list-of-killed-groups)))
6176           (error "No more newsgroups to yank"))
6177       (push (setq group (nth 1 info)) out)
6178       ;; Find which newsgroup to insert this one before - search
6179       ;; backward until something suitable is found.  If there are no
6180       ;; other newsgroups in this buffer, just make this newsgroup the
6181       ;; first newsgroup.
6182       (setq prev (gnus-group-group-name))
6183       (gnus-group-change-level
6184        info (gnus-info-level (cdr info)) gnus-level-killed
6185        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
6186        t)
6187       (gnus-group-insert-group-line-info group))
6188     (forward-line -1)
6189     (gnus-group-position-point)
6190     (if (< (length out) 2) (car out) (nreverse out))))
6191
6192 (defun gnus-group-kill-level (level)
6193   "Kill all groups that is on a certain LEVEL."
6194   (interactive "nKill all groups on level: ")
6195   (cond
6196    ((= level gnus-level-zombie)
6197     (setq gnus-killed-list
6198           (nconc gnus-zombie-list gnus-killed-list))
6199     (setq gnus-zombie-list nil))
6200    ((and (< level gnus-level-zombie)
6201          (> level 0)
6202          (or gnus-expert-user
6203              (gnus-yes-or-no-p
6204               (format
6205                "Do you really want to kill all groups on level %d? "
6206                level))))
6207     (let* ((prev gnus-newsrc-alist)
6208            (alist (cdr prev)))
6209       (while alist
6210         (if (= (gnus-info-level level) level)
6211             (setcdr prev (cdr alist))
6212           (setq prev alist))
6213         (setq alist (cdr alist)))
6214       (gnus-make-hashtable-from-newsrc-alist)
6215       (gnus-group-list-groups)))
6216    (t
6217     (error "Can't kill; illegal level: %d" level))))
6218
6219 (defun gnus-group-list-all-groups (&optional arg)
6220   "List all newsgroups with level ARG or lower.
6221 Default is gnus-level-unsubscribed, which lists all subscribed and most
6222 unsubscribed groups."
6223   (interactive "P")
6224   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
6225
6226 ;; Redefine this to list ALL killed groups if prefix arg used.
6227 ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
6228 (defun gnus-group-list-killed (&optional arg)
6229   "List all killed newsgroups in the group buffer.
6230 If ARG is non-nil, list ALL killed groups known to Gnus.  This may
6231 entail asking the server for the groups."
6232   (interactive "P")
6233   ;; Find all possible killed newsgroups if arg.
6234   (when arg
6235     ;; First make sure active file has been read.
6236     (unless gnus-have-read-active-file
6237       (let ((gnus-read-active-file t))
6238         (gnus-read-active-file)))
6239     (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
6240     ;; Go through all newsgroups that are known to Gnus - enlarge kill list
6241     (mapatoms
6242      (lambda (sym)
6243        (let ((groups 0)
6244              (group (symbol-name sym)))
6245          (if (or (null group)
6246                  (gnus-gethash group gnus-killed-hashtb)
6247                  (gnus-gethash group gnus-newsrc-hashtb))
6248              ()
6249            (let ((do-sub (gnus-matches-options-n group)))
6250              (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
6251                  ()
6252                (setq groups (1+ groups))
6253                (setq gnus-killed-list
6254                      (cons group gnus-killed-list))
6255                (gnus-sethash group group gnus-killed-hashtb))))))
6256      gnus-active-hashtb))
6257   (if (not gnus-killed-list)
6258       (gnus-message 6 "No killed groups")
6259     (let (gnus-group-list-mode)
6260       (funcall gnus-group-prepare-function
6261                gnus-level-killed t gnus-level-killed))
6262     (goto-char (point-min)))
6263   (gnus-group-position-point))
6264
6265 (defun gnus-group-list-zombies ()
6266   "List all zombie newsgroups in the group buffer."
6267   (interactive)
6268   (if (not gnus-zombie-list)
6269       (gnus-message 6 "No zombie groups")
6270     (let (gnus-group-list-mode)
6271       (funcall gnus-group-prepare-function
6272                gnus-level-zombie t gnus-level-zombie))
6273     (goto-char (point-min)))
6274   (gnus-group-position-point))
6275
6276 (defun gnus-group-list-active ()
6277   "List all groups that are available from the server(s)."
6278   (interactive)
6279   ;; First we make sure that we have really read the active file.
6280   (unless gnus-have-read-active-file
6281     (let ((gnus-read-active-file t))
6282       (gnus-read-active-file)))
6283   ;; Find all groups and sort them.
6284   (let ((groups
6285          (sort
6286           (let (list)
6287             (mapatoms
6288              (lambda (sym)
6289                (and (symbol-value sym)
6290                     (setq list (cons (symbol-name sym) list))))
6291              gnus-active-hashtb)
6292             list)
6293           'string<))
6294         (buffer-read-only nil))
6295     (erase-buffer)
6296     (while groups
6297       (gnus-group-insert-group-line-info (pop groups)))
6298     (goto-char (point-min))))
6299
6300 (defun gnus-activate-all-groups (level)
6301   "Activate absolutely all groups."
6302   (interactive (list 7))
6303   (let ((gnus-activate-level level)
6304         (gnus-activate-foreign-newsgroups level))
6305     (gnus-group-get-new-news)))
6306
6307 (defun gnus-group-get-new-news (&optional arg)
6308   "Get newly arrived articles.
6309 If ARG is a number, it specifies which levels you are interested in
6310 re-scanning.  If ARG is non-nil and not a number, this will force
6311 \"hard\" re-reading of the active files from all servers."
6312   (interactive "P")
6313   (run-hooks 'gnus-get-new-news-hook)
6314   ;; We might read in new NoCeM messages here.
6315   (when (and gnus-use-nocem 
6316              (null arg))
6317     (gnus-nocem-scan-groups))
6318   ;; If ARG is not a number, then we read the active file.
6319   (when (and arg (not (numberp arg)))
6320     (let ((gnus-read-active-file t))
6321       (gnus-read-active-file))
6322     (setq arg nil))
6323
6324   (setq arg (gnus-group-default-level arg t))
6325   (if (and gnus-read-active-file (not arg))
6326       (progn
6327         (gnus-read-active-file)
6328         (gnus-get-unread-articles arg))
6329     (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
6330       (gnus-get-unread-articles arg)))
6331   (run-hooks 'gnus-after-getting-new-news-hook)
6332   (gnus-group-list-groups))
6333
6334 (defun gnus-group-get-new-news-this-group (&optional n)
6335   "Check for newly arrived news in the current group (and the N-1 next groups).
6336 The difference between N and the number of newsgroup checked is returned.
6337 If N is negative, this group and the N-1 previous groups will be checked."
6338   (interactive "P")
6339   (let* ((groups (gnus-group-process-prefix n))
6340          (ret (if (numberp n) (- n (length groups)) 0))
6341          group)
6342     (while groups
6343       (setq group (car groups)
6344             groups (cdr groups))
6345       (gnus-group-remove-mark group)
6346       (if (and group (gnus-activate-group group 'scan))
6347           (progn
6348             (gnus-get-unread-articles-in-group
6349              (gnus-get-info group) (gnus-active group) t)
6350             (gnus-close-group group)
6351             (gnus-group-update-group group))
6352         (ding)
6353         (gnus-message 3 "%s error: %s" group (gnus-status-message group))))
6354     (when gnus-goto-next-group-when-activating
6355       (gnus-group-next-unread-group 1 t))
6356     (gnus-summary-position-point)
6357     ret))
6358
6359 (defun gnus-group-fetch-faq (group &optional faq-dir)
6360   "Fetch the FAQ for the current group."
6361   (interactive
6362    (list
6363     (gnus-group-real-name (gnus-group-group-name))
6364     (cond (current-prefix-arg
6365            (completing-read
6366             "Faq dir: " (and (listp gnus-group-faq-directory)
6367                              gnus-group-faq-directory))))))
6368   (or faq-dir
6369       (setq faq-dir (if (listp gnus-group-faq-directory)
6370                         (car gnus-group-faq-directory)
6371                       gnus-group-faq-directory)))
6372   (or group (error "No group name given"))
6373   (let ((file (concat (file-name-as-directory faq-dir)
6374                       (gnus-group-real-name group))))
6375     (if (not (file-exists-p file))
6376         (error "No such file: %s" file)
6377       (find-file file))))
6378
6379 (defun gnus-group-describe-group (force &optional group)
6380   "Display a description of the current newsgroup."
6381   (interactive (list current-prefix-arg (gnus-group-group-name)))
6382   (and force (setq gnus-description-hashtb nil))
6383   (let ((method (gnus-find-method-for-group group))
6384         desc)
6385     (or group (error "No group name given"))
6386     (and (or (and gnus-description-hashtb
6387                   ;; We check whether this group's method has been
6388                   ;; queried for a description file.
6389                   (gnus-gethash
6390                    (gnus-group-prefixed-name "" method)
6391                    gnus-description-hashtb))
6392              (setq desc (gnus-group-get-description group))
6393              (gnus-read-descriptions-file method))
6394          (message
6395           (or desc (gnus-gethash group gnus-description-hashtb)
6396               "No description available")))))
6397
6398 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6399 (defun gnus-group-describe-all-groups (&optional force)
6400   "Pop up a buffer with descriptions of all newsgroups."
6401   (interactive "P")
6402   (and force (setq gnus-description-hashtb nil))
6403   (if (not (or gnus-description-hashtb
6404                (gnus-read-all-descriptions-files)))
6405       (error "Couldn't request descriptions file"))
6406   (let ((buffer-read-only nil)
6407         b)
6408     (erase-buffer)
6409     (mapatoms
6410      (lambda (group)
6411        (setq b (point))
6412        (insert (format "      *: %-20s %s\n" (symbol-name group)
6413                        (symbol-value group)))
6414        (add-text-properties
6415         b (1+ b) (list 'gnus-group group
6416                        'gnus-unread t 'gnus-marked nil
6417                        'gnus-level (1+ gnus-level-subscribed))))
6418      gnus-description-hashtb)
6419     (goto-char (point-min))
6420     (gnus-group-position-point)))
6421
6422 ;; Suggested by by Daniel Quinlan <quinlan@best.com>.
6423 (defun gnus-group-apropos (regexp &optional search-description)
6424   "List all newsgroups that have names that match a regexp."
6425   (interactive "sGnus apropos (regexp): ")
6426   (let ((prev "")
6427         (obuf (current-buffer))
6428         groups des)
6429     ;; Go through all newsgroups that are known to Gnus.
6430     (mapatoms
6431      (lambda (group)
6432        (and (symbol-name group)
6433             (string-match regexp (symbol-name group))
6434             (setq groups (cons (symbol-name group) groups))))
6435      gnus-active-hashtb)
6436     ;; Also go through all descriptions that are known to Gnus.
6437     (when search-description
6438       (mapatoms
6439        (lambda (group)
6440          (and (string-match regexp (symbol-value group))
6441               (gnus-active (symbol-name group))
6442               (setq groups (cons (symbol-name group) groups))))
6443        gnus-description-hashtb))
6444     (if (not groups)
6445         (gnus-message 3 "No groups matched \"%s\"." regexp)
6446       ;; Print out all the groups.
6447       (save-excursion
6448         (pop-to-buffer "*Gnus Help*")
6449         (buffer-disable-undo (current-buffer))
6450         (erase-buffer)
6451         (setq groups (sort groups 'string<))
6452         (while groups
6453           ;; Groups may be entered twice into the list of groups.
6454           (if (not (string= (car groups) prev))
6455               (progn
6456                 (insert (setq prev (car groups)) "\n")
6457                 (if (and gnus-description-hashtb
6458                          (setq des (gnus-gethash (car groups)
6459                                                  gnus-description-hashtb)))
6460                     (insert "  " des "\n"))))
6461           (setq groups (cdr groups)))
6462         (goto-char (point-min))))
6463     (pop-to-buffer obuf)))
6464
6465 (defun gnus-group-description-apropos (regexp)
6466   "List all newsgroups that have names or descriptions that match a regexp."
6467   (interactive "sGnus description apropos (regexp): ")
6468   (if (not (or gnus-description-hashtb
6469                (gnus-read-all-descriptions-files)))
6470       (error "Couldn't request descriptions file"))
6471   (gnus-group-apropos regexp t))
6472
6473 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6474 (defun gnus-group-list-matching (level regexp &optional all lowest)
6475   "List all groups with unread articles that match REGEXP.
6476 If the prefix LEVEL is non-nil, it should be a number that says which
6477 level to cut off listing groups.
6478 If ALL, also list groups with no unread articles.
6479 If LOWEST, don't list groups with level lower than LOWEST."
6480   (interactive "P\nsList newsgroups matching: ")
6481   (gnus-group-prepare-flat (or level gnus-level-subscribed)
6482                            all (or lowest 1) regexp)
6483   (goto-char (point-min))
6484   (gnus-group-position-point))
6485
6486 (defun gnus-group-list-all-matching (level regexp &optional lowest)
6487   "List all groups that match REGEXP.
6488 If the prefix LEVEL is non-nil, it should be a number that says which
6489 level to cut off listing groups.
6490 If LOWEST, don't list groups with level lower than LOWEST."
6491   (interactive "P\nsList newsgroups matching: ")
6492   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
6493
6494 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
6495 (defun gnus-group-save-newsrc (&optional force)
6496   "Save the Gnus startup files.
6497 If FORCE, force saving whether it is necessary or not."
6498   (interactive "P")
6499   (gnus-save-newsrc-file force))
6500
6501 (defun gnus-group-restart (&optional arg)
6502   "Force Gnus to read the .newsrc file."
6503   (interactive "P")
6504   (when (gnus-yes-or-no-p
6505          (format "Are you sure you want to read %s? "
6506                  gnus-current-startup-file))
6507     (gnus-save-newsrc-file)
6508     (gnus-setup-news 'force)
6509     (gnus-group-list-groups arg)))
6510
6511 (defun gnus-group-read-init-file ()
6512   "Read the Gnus elisp init file."
6513   (interactive)
6514   (gnus-read-init-file))
6515
6516 (defun gnus-group-check-bogus-groups (&optional silent)
6517   "Check bogus newsgroups.
6518 If given a prefix, don't ask for confirmation before removing a bogus
6519 group."
6520   (interactive "P")
6521   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
6522   (gnus-group-list-groups))
6523
6524 (defun gnus-group-edit-global-kill (&optional article group)
6525   "Edit the global kill file.
6526 If GROUP, edit that local kill file instead."
6527   (interactive "P")
6528   (setq gnus-current-kill-article article)
6529   (gnus-kill-file-edit-file group)
6530   (gnus-message
6531    6
6532    (substitute-command-keys
6533     (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
6534             (if group "local" "global")))))
6535
6536 (defun gnus-group-edit-local-kill (article group)
6537   "Edit a local kill file."
6538   (interactive (list nil (gnus-group-group-name)))
6539   (gnus-group-edit-global-kill article group))
6540
6541 (defun gnus-group-force-update ()
6542   "Update `.newsrc' file."
6543   (interactive)
6544   (gnus-save-newsrc-file))
6545
6546 (defun gnus-group-suspend ()
6547   "Suspend the current Gnus session.
6548 In fact, cleanup buffers except for group mode buffer.
6549 The hook gnus-suspend-gnus-hook is called before actually suspending."
6550   (interactive)
6551   (run-hooks 'gnus-suspend-gnus-hook)
6552   ;; Kill Gnus buffers except for group mode buffer.
6553   (let ((group-buf (get-buffer gnus-group-buffer)))
6554     ;; Do this on a separate list in case the user does a ^G before we finish
6555     (let ((gnus-buffer-list
6556            (delq group-buf (delq gnus-dribble-buffer
6557                                  (append gnus-buffer-list nil)))))
6558       (while gnus-buffer-list
6559         (gnus-kill-buffer (car gnus-buffer-list))
6560         (setq gnus-buffer-list (cdr gnus-buffer-list))))
6561     (if group-buf
6562         (progn
6563           (setq gnus-buffer-list (list group-buf))
6564           (bury-buffer group-buf)
6565           (delete-windows-on group-buf t)))))
6566
6567 (defun gnus-group-clear-dribble ()
6568   "Clear all information from the dribble buffer."
6569   (interactive)
6570   (gnus-dribble-clear)
6571   (gnus-message 7 "Cleared dribble buffer"))
6572
6573 (defun gnus-group-exit ()
6574   "Quit reading news after updating .newsrc.eld and .newsrc.
6575 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6576   (interactive)
6577   (when 
6578       (or noninteractive                ;For gnus-batch-kill
6579           (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
6580           (not gnus-interactive-exit)   ;Without confirmation
6581           gnus-expert-user
6582           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
6583     (run-hooks 'gnus-exit-gnus-hook)
6584     ;; Offer to save data from non-quitted summary buffers.
6585     (gnus-offer-save-summaries)
6586     ;; Save the newsrc file(s).
6587     (gnus-save-newsrc-file)
6588     ;; Kill-em-all.
6589     (gnus-close-backends)
6590     ;; Reset everything.
6591     (gnus-clear-system)
6592     ;; Allow the user to do things after cleaning up.
6593     (run-hooks 'gnus-after-exiting-gnus-hook)))
6594
6595 (defun gnus-close-backends ()
6596   ;; Send a close request to all backends that support such a request.
6597   (let ((methods gnus-valid-select-methods)
6598         func)
6599     (while methods
6600       (if (fboundp (setq func (intern (concat (caar methods)
6601                                               "-request-close"))))
6602           (funcall func))
6603       (setq methods (cdr methods)))))
6604
6605 (defun gnus-group-quit ()
6606   "Quit reading news without updating .newsrc.eld or .newsrc.
6607 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6608   (interactive)
6609   (when (or noninteractive              ;For gnus-batch-kill
6610             (zerop (buffer-size))
6611             (not (gnus-server-opened gnus-select-method))
6612             gnus-expert-user
6613             (not gnus-current-startup-file)
6614             (gnus-yes-or-no-p
6615              (format "Quit reading news without saving %s? "
6616                      (file-name-nondirectory gnus-current-startup-file))))
6617     (run-hooks 'gnus-exit-gnus-hook)
6618     (if gnus-use-full-window
6619         (delete-other-windows)
6620       (gnus-remove-some-windows))
6621     (gnus-dribble-save)
6622     (gnus-close-backends)
6623     (gnus-clear-system)
6624     ;; Allow the user to do things after cleaning up.
6625     (run-hooks 'gnus-after-exiting-gnus-hook)))
6626
6627 (defun gnus-offer-save-summaries ()
6628   "Offer to save all active summary buffers."
6629   (save-excursion
6630     (let ((buflist (buffer-list))
6631           buffers bufname)
6632       ;; Go through all buffers and find all summaries.
6633       (while buflist
6634         (and (setq bufname (buffer-name (car buflist)))
6635              (string-match "Summary" bufname)
6636              (save-excursion
6637                (set-buffer bufname)
6638                ;; We check that this is, indeed, a summary buffer.
6639                (and (eq major-mode 'gnus-summary-mode)
6640                     ;; Also make sure this isn't bogus.
6641                     gnus-newsgroup-prepared))
6642              (push bufname buffers))
6643         (setq buflist (cdr buflist)))
6644       ;; Go through all these summary buffers and offer to save them.
6645       (when buffers
6646         (map-y-or-n-p
6647          "Update summary buffer %s? "
6648          (lambda (buf) (set-buffer buf) (gnus-summary-exit))
6649          buffers)))))
6650
6651 (defun gnus-group-describe-briefly ()
6652   "Give a one line description of the group mode commands."
6653   (interactive)
6654   (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")))
6655
6656 (defun gnus-group-browse-foreign-server (method)
6657   "Browse a foreign news server.
6658 If called interactively, this function will ask for a select method
6659  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
6660 If not, METHOD should be a list where the first element is the method
6661 and the second element is the address."
6662   (interactive
6663    (list (let ((how (completing-read
6664                      "Which backend: "
6665                      (append gnus-valid-select-methods gnus-server-alist)
6666                      nil t (cons "nntp" 0))))
6667            ;; We either got a backend name or a virtual server name.
6668            ;; If the first, we also need an address.
6669            (if (assoc how gnus-valid-select-methods)
6670                (list (intern how)
6671                      ;; Suggested by mapjph@bath.ac.uk.
6672                      (completing-read
6673                       "Address: "
6674                       (mapcar (lambda (server) (list server))
6675                               gnus-secondary-servers)))
6676              ;; We got a server name, so we find the method.
6677              (gnus-server-to-method how)))))
6678   (gnus-browse-foreign-server method))
6679
6680 \f
6681 ;;;
6682 ;;; Gnus summary mode
6683 ;;;
6684
6685 (defvar gnus-summary-mode-map nil)
6686
6687 (put 'gnus-summary-mode 'mode-class 'special)
6688
6689 (unless gnus-summary-mode-map
6690   (setq gnus-summary-mode-map (make-keymap))
6691   (suppress-keymap gnus-summary-mode-map)
6692
6693   ;; Non-orthogonal keys
6694
6695   (gnus-define-keys gnus-summary-mode-map
6696     " " gnus-summary-next-page
6697     "\177" gnus-summary-prev-page
6698     [delete] gnus-summary-prev-page
6699     "\r" gnus-summary-scroll-up
6700     "n" gnus-summary-next-unread-article
6701     "p" gnus-summary-prev-unread-article
6702     "N" gnus-summary-next-article
6703     "P" gnus-summary-prev-article
6704     "\M-\C-n" gnus-summary-next-same-subject
6705     "\M-\C-p" gnus-summary-prev-same-subject
6706     "\M-n" gnus-summary-next-unread-subject
6707     "\M-p" gnus-summary-prev-unread-subject
6708     "." gnus-summary-first-unread-article
6709     "," gnus-summary-best-unread-article
6710     "\M-s" gnus-summary-search-article-forward
6711     "\M-r" gnus-summary-search-article-backward
6712     "<" gnus-summary-beginning-of-article
6713     ">" gnus-summary-end-of-article
6714     "j" gnus-summary-goto-article
6715     "^" gnus-summary-refer-parent-article
6716     "\M-^" gnus-summary-refer-article
6717     "u" gnus-summary-tick-article-forward
6718     "!" gnus-summary-tick-article-forward
6719     "U" gnus-summary-tick-article-backward
6720     "d" gnus-summary-mark-as-read-forward
6721     "D" gnus-summary-mark-as-read-backward
6722     "E" gnus-summary-mark-as-expirable
6723     "\M-u" gnus-summary-clear-mark-forward
6724     "\M-U" gnus-summary-clear-mark-backward
6725     "k" gnus-summary-kill-same-subject-and-select
6726     "\C-k" gnus-summary-kill-same-subject
6727     "\M-\C-k" gnus-summary-kill-thread
6728     "\M-\C-l" gnus-summary-lower-thread
6729     "e" gnus-summary-edit-article
6730     "#" gnus-summary-mark-as-processable
6731     "\M-#" gnus-summary-unmark-as-processable
6732     "\M-\C-t" gnus-summary-toggle-threads
6733     "\M-\C-s" gnus-summary-show-thread
6734     "\M-\C-h" gnus-summary-hide-thread
6735     "\M-\C-f" gnus-summary-next-thread
6736     "\M-\C-b" gnus-summary-prev-thread
6737     "\M-\C-u" gnus-summary-up-thread
6738     "\M-\C-d" gnus-summary-down-thread
6739     "&" gnus-summary-execute-command
6740     "c" gnus-summary-catchup-and-exit
6741     "\C-w" gnus-summary-mark-region-as-read
6742     "\C-t" gnus-summary-toggle-truncation
6743     "?" gnus-summary-mark-as-dormant
6744     "\C-c\M-\C-s" gnus-summary-limit-include-expunged
6745     "\C-c\C-s\C-n" gnus-summary-sort-by-number
6746     "\C-c\C-s\C-a" gnus-summary-sort-by-author
6747     "\C-c\C-s\C-s" gnus-summary-sort-by-subject
6748     "\C-c\C-s\C-d" gnus-summary-sort-by-date
6749     "\C-c\C-s\C-i" gnus-summary-sort-by-score
6750     "=" gnus-summary-expand-window
6751     "\C-x\C-s" gnus-summary-reselect-current-group
6752     "\M-g" gnus-summary-rescan-group
6753     "w" gnus-summary-stop-page-breaking
6754     "\C-c\C-r" gnus-summary-caesar-message
6755     "\M-t" gnus-summary-toggle-mime
6756     "f" gnus-summary-followup
6757     "F" gnus-summary-followup-with-original
6758     "C" gnus-summary-cancel-article
6759     "r" gnus-summary-reply
6760     "R" gnus-summary-reply-with-original
6761     "\C-c\C-f" gnus-summary-mail-forward
6762     "o" gnus-summary-save-article
6763     "\C-o" gnus-summary-save-article-mail
6764     "|" gnus-summary-pipe-output
6765     "\M-k" gnus-summary-edit-local-kill
6766     "\M-K" gnus-summary-edit-global-kill
6767     "V" gnus-version
6768     "\C-c\C-d" gnus-summary-describe-group
6769     "q" gnus-summary-exit
6770     "Q" gnus-summary-exit-no-update
6771     "\C-c\C-i" gnus-info-find-node
6772     gnus-mouse-2 gnus-mouse-pick-article
6773     "m" gnus-summary-mail-other-window
6774     "a" gnus-summary-post-news
6775     "x" gnus-summary-limit-to-unread
6776     "s" gnus-summary-isearch-article
6777     "t" gnus-article-hide-headers
6778     "g" gnus-summary-show-article
6779     "l" gnus-summary-goto-last-article
6780     "\C-c\C-v\C-v" gnus-uu-decode-uu-view
6781     "\C-d" gnus-summary-enter-digest-group
6782     "\C-c\C-b" gnus-bug
6783     "*" gnus-cache-enter-article
6784     "\M-*" gnus-cache-remove-article
6785     "\M-&" gnus-summary-universal-argument
6786     "\C-l" gnus-recenter
6787     "I" gnus-summary-increase-score
6788     "L" gnus-summary-lower-score
6789
6790     "V" gnus-summary-score-map
6791     "X" gnus-uu-extract-map
6792     "S" gnus-summary-send-map)
6793
6794   ;; Sort of orthogonal keymap
6795   (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
6796     "t" gnus-summary-tick-article-forward
6797     "!" gnus-summary-tick-article-forward
6798     "d" gnus-summary-mark-as-read-forward
6799     "r" gnus-summary-mark-as-read-forward
6800     "c" gnus-summary-clear-mark-forward
6801     " " gnus-summary-clear-mark-forward
6802     "e" gnus-summary-mark-as-expirable
6803     "x" gnus-summary-mark-as-expirable
6804     "?" gnus-summary-mark-as-dormant
6805     "b" gnus-summary-set-bookmark
6806     "B" gnus-summary-remove-bookmark
6807     "#" gnus-summary-mark-as-processable
6808     "\M-#" gnus-summary-unmark-as-processable
6809     "S" gnus-summary-limit-include-expunged
6810     "C" gnus-summary-catchup
6811     "H" gnus-summary-catchup-to-here
6812     "\C-c" gnus-summary-catchup-all
6813     "k" gnus-summary-kill-same-subject-and-select
6814     "K" gnus-summary-kill-same-subject
6815     "P" gnus-uu-mark-map)
6816
6817   (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mode-map)
6818     "c" gnus-summary-clear-above
6819     "u" gnus-summary-tick-above
6820     "m" gnus-summary-mark-above
6821     "k" gnus-summary-kill-below)
6822
6823   (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
6824     "/" gnus-summary-limit-to-subject
6825     "n" gnus-summary-limit-to-articles
6826     "w" gnus-summary-pop-limit
6827     "s" gnus-summary-limit-to-subject
6828     "a" gnus-summary-limit-to-author
6829     "u" gnus-summary-limit-to-unread
6830     "m" gnus-summary-limit-to-marks
6831     "v" gnus-summary-limit-to-score
6832     "D" gnus-summary-limit-include-dormant
6833     "d" gnus-summary-limit-exclude-dormant
6834     ;;  "t" gnus-summary-limit-exclude-thread
6835     "E" gnus-summary-limit-include-expunged
6836     "c" gnus-summary-limit-exclude-childless-dormant
6837     "C" gnus-summary-limit-mark-excluded-as-read)
6838
6839   (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
6840     "n" gnus-summary-next-unread-article
6841     "p" gnus-summary-prev-unread-article
6842     "N" gnus-summary-next-article
6843     "P" gnus-summary-prev-article
6844     "\C-n" gnus-summary-next-same-subject
6845     "\C-p" gnus-summary-prev-same-subject
6846     "\M-n" gnus-summary-next-unread-subject
6847     "\M-p" gnus-summary-prev-unread-subject
6848     "f" gnus-summary-first-unread-article
6849     "b" gnus-summary-best-unread-article
6850     "j" gnus-summary-goto-article
6851     "g" gnus-summary-goto-subject
6852     "l" gnus-summary-goto-last-article
6853     "p" gnus-summary-pop-article)
6854
6855   (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
6856     "k" gnus-summary-kill-thread
6857     "l" gnus-summary-lower-thread
6858     "i" gnus-summary-raise-thread
6859     "T" gnus-summary-toggle-threads
6860     "t" gnus-summary-rethread-current
6861     "^" gnus-summary-reparent-thread
6862     "s" gnus-summary-show-thread
6863     "S" gnus-summary-show-all-threads
6864     "h" gnus-summary-hide-thread
6865     "H" gnus-summary-hide-all-threads
6866     "n" gnus-summary-next-thread
6867     "p" gnus-summary-prev-thread
6868     "u" gnus-summary-up-thread
6869     "o" gnus-summary-top-thread
6870     "d" gnus-summary-down-thread
6871     "#" gnus-uu-mark-thread
6872     "\M-#" gnus-uu-unmark-thread)
6873
6874   (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
6875     "c" gnus-summary-catchup-and-exit
6876     "C" gnus-summary-catchup-all-and-exit
6877     "E" gnus-summary-exit-no-update
6878     "Q" gnus-summary-exit
6879     "Z" gnus-summary-exit
6880     "n" gnus-summary-catchup-and-goto-next-group
6881     "R" gnus-summary-reselect-current-group
6882     "G" gnus-summary-rescan-group
6883     "N" gnus-summary-next-group
6884     "P" gnus-summary-prev-group)
6885
6886   (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
6887     " " gnus-summary-next-page
6888     "n" gnus-summary-next-page
6889     "\177" gnus-summary-prev-page
6890     [delete] gnus-summary-prev-page
6891     "p" gnus-summary-prev-page
6892     "\r" gnus-summary-scroll-up
6893     "<" gnus-summary-beginning-of-article
6894     ">" gnus-summary-end-of-article
6895     "b" gnus-summary-beginning-of-article
6896     "e" gnus-summary-end-of-article
6897     "^" gnus-summary-refer-parent-article
6898     "r" gnus-summary-refer-parent-article
6899     "R" gnus-summary-refer-references
6900     "g" gnus-summary-show-article
6901     "s" gnus-summary-isearch-article)
6902
6903   (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
6904     "b" gnus-article-add-buttons
6905     "B" gnus-article-add-buttons-to-head
6906     "o" gnus-article-treat-overstrike
6907     ;;  "w" gnus-article-word-wrap
6908     "w" gnus-article-fill-cited-article
6909     "c" gnus-article-remove-cr
6910     "L" gnus-article-remove-trailing-blank-lines
6911     "q" gnus-article-de-quoted-unreadable
6912     "f" gnus-article-display-x-face
6913     "l" gnus-summary-stop-page-breaking
6914     "r" gnus-summary-caesar-message
6915     "t" gnus-article-hide-headers
6916     "v" gnus-summary-verbose-headers
6917     "m" gnus-summary-toggle-mime)
6918
6919   (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
6920     "a" gnus-article-hide
6921     "h" gnus-article-hide-headers
6922     "b" gnus-article-hide-boring-headers
6923     "s" gnus-article-hide-signature
6924     "c" gnus-article-hide-citation
6925     "p" gnus-article-hide-pgp
6926     "\C-c" gnus-article-hide-citation-maybe)
6927
6928   (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
6929     "a" gnus-article-highlight
6930     "h" gnus-article-highlight-headers
6931     "c" gnus-article-highlight-citation
6932     "s" gnus-article-highlight-signature)
6933
6934   (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
6935     "z" gnus-article-date-ut
6936     "u" gnus-article-date-ut
6937     "l" gnus-article-date-local
6938     "e" gnus-article-date-lapsed
6939     "o" gnus-article-date-original)
6940
6941   (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
6942     "v" gnus-version
6943     "f" gnus-summary-fetch-faq
6944     "d" gnus-summary-describe-group
6945     "h" gnus-summary-describe-briefly
6946     "i" gnus-info-find-node)
6947
6948   (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
6949     "e" gnus-summary-expire-articles
6950     "\M-\C-e" gnus-summary-expire-articles-now
6951     "\177" gnus-summary-delete-article
6952     [delete] gnus-summary-delete-article
6953     "m" gnus-summary-move-article
6954     "r" gnus-summary-respool-article
6955     "w" gnus-summary-edit-article
6956     "c" gnus-summary-copy-article
6957     "B" gnus-summary-crosspost-article
6958     "q" gnus-summary-respool-query
6959     "i" gnus-summary-import-article)
6960
6961   (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
6962     "o" gnus-summary-save-article
6963     "m" gnus-summary-save-article-mail
6964     "r" gnus-summary-save-article-rmail
6965     "f" gnus-summary-save-article-file
6966     "b" gnus-summary-save-article-body-file
6967     "h" gnus-summary-save-article-folder
6968     "v" gnus-summary-save-article-vm
6969     "p" gnus-summary-pipe-output
6970     "s" gnus-soup-add-article)
6971   )
6972
6973 \f
6974
6975 (defun gnus-summary-mode (&optional group)
6976   "Major mode for reading articles.
6977
6978 All normal editing commands are switched off.
6979 \\<gnus-summary-mode-map>
6980 Each line in this buffer represents one article.  To read an
6981 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
6982 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
6983 respectively.
6984
6985 You can also post articles and send mail from this buffer.  To
6986 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author
6987 of an article, type `\\[gnus-summary-reply]'.
6988
6989 There are approx. one gazillion commands you can execute in this
6990 buffer; read the info pages for more information (`\\[gnus-info-find-node]').
6991
6992 The following commands are available:
6993
6994 \\{gnus-summary-mode-map}"
6995   (interactive)
6996   (when (and menu-bar-mode
6997              (gnus-visual-p 'summary-menu 'menu))
6998     (gnus-summary-make-menu-bar))
6999   (kill-all-local-variables)
7000   (let ((locals gnus-summary-local-variables))
7001     (while locals
7002       (if (consp (car locals))
7003           (progn
7004             (make-local-variable (caar locals))
7005             (set (caar locals) (eval (cdar locals))))
7006         (make-local-variable (car locals))
7007         (set (car locals) nil))
7008       (setq locals (cdr locals))))
7009   (gnus-make-thread-indent-array)
7010   (gnus-simplify-mode-line)
7011   (setq major-mode 'gnus-summary-mode)
7012   (setq mode-name "Summary")
7013   (make-local-variable 'minor-mode-alist)
7014   (use-local-map gnus-summary-mode-map)
7015   (buffer-disable-undo (current-buffer))
7016   (setq buffer-read-only t)             ;Disable modification
7017   (setq truncate-lines t)
7018   (setq selective-display t)
7019   (setq selective-display-ellipses t)   ;Display `...'
7020   (setq buffer-display-table gnus-summary-display-table)
7021   (setq gnus-newsgroup-name group)
7022   (run-hooks 'gnus-summary-mode-hook))
7023
7024 (defun gnus-summary-make-display-table ()
7025   ;; Change the display table.  Odd characters have a tendency to mess
7026   ;; up nicely formatted displays - we make all possible glyphs
7027   ;; display only a single character.
7028
7029   ;; We start from the standard display table, if any.
7030   (setq gnus-summary-display-table
7031         (or (copy-sequence standard-display-table)
7032             (make-display-table)))
7033   ;; Nix out all the control chars...
7034   (let ((i 32))
7035     (while (>= (setq i (1- i)) 0)
7036       (aset gnus-summary-display-table i [??])))
7037   ;; ... but not newline and cr, of course. (cr is necessary for the
7038   ;; selective display).
7039   (aset gnus-summary-display-table ?\n nil)
7040   (aset gnus-summary-display-table ?\r nil)
7041   ;; We nix out any glyphs over 126 that are not set already.
7042   (let ((i 256))
7043     (while (>= (setq i (1- i)) 127)
7044       ;; Only modify if the entry is nil.
7045       (or (aref gnus-summary-display-table i)
7046           (aset gnus-summary-display-table i [??])))))
7047
7048 (defun gnus-summary-clear-local-variables ()
7049   (let ((locals gnus-summary-local-variables))
7050     (while locals
7051       (if (consp (car locals))
7052           (and (vectorp (caar locals))
7053                (set (caar locals) nil))
7054         (and (vectorp (car locals))
7055              (set (car locals) nil)))
7056       (setq locals (cdr locals)))))
7057
7058 ;; Summary data functions.
7059
7060 (defmacro gnus-data-number (data)
7061   `(car ,data))
7062
7063 (defmacro gnus-data-set-number (data number)
7064   `(setcar ,data ,number))
7065
7066 (defmacro gnus-data-mark (data)
7067   `(nth 1 ,data))
7068
7069 (defmacro gnus-data-set-mark (data mark)
7070   `(setcar (nthcdr 1 ,data) ,mark))
7071
7072 (defmacro gnus-data-pos (data)
7073   `(nth 2 ,data))
7074
7075 (defmacro gnus-data-set-pos (data pos)
7076   `(setcar (nthcdr 2 ,data) ,pos))
7077
7078 (defmacro gnus-data-header (data)
7079   `(nth 3 ,data))
7080
7081 (defmacro gnus-data-level (data)
7082   `(nth 4 ,data))
7083
7084 (defmacro gnus-data-unread-p (data)
7085   `(= (nth 1 ,data) gnus-unread-mark))
7086
7087 (defmacro gnus-data-pseudo-p (data)
7088   `(consp (nth 3 ,data)))
7089
7090 (defmacro gnus-data-find (number)
7091   `(assq ,number gnus-newsgroup-data))
7092
7093 (defmacro gnus-data-find-list (number &optional data)
7094   `(let ((bdata ,(or data 'gnus-newsgroup-data)))
7095      (memq (assq ,number bdata)
7096            bdata)))
7097
7098 (defmacro gnus-data-make (number mark pos header level)
7099   `(list ,number ,mark ,pos ,header ,level))
7100
7101 (defun gnus-data-enter (after-article number mark pos header level offset)
7102   (let ((data (gnus-data-find-list after-article)))
7103     (or data (error "No such article: %d" after-article))
7104     (setcdr data (cons (gnus-data-make number mark pos header level)
7105                        (cdr data)))
7106     (setq gnus-newsgroup-data-reverse nil)
7107     (gnus-data-update-list (cddr data) offset)))
7108
7109 (defun gnus-data-enter-list (after-article list &optional offset)
7110   (when list
7111     (let ((data (and after-article (gnus-data-find-list after-article)))
7112           (ilist list))
7113       (or data (not after-article) (error "No such article: %d" after-article))
7114       ;; Find the last element in the list to be spliced into the main
7115       ;; list.
7116       (while (cdr list)
7117         (setq list (cdr list)))
7118       (if (not data)
7119           (progn
7120             (setcdr list gnus-newsgroup-data)
7121             (setq gnus-newsgroup-data ilist)
7122             (and offset (gnus-data-update-list (cdr list) offset)))
7123         (setcdr list (cdr data))
7124         (setcdr data ilist)
7125         (and offset (gnus-data-update-list (cdr data) offset)))
7126       (setq gnus-newsgroup-data-reverse nil))))
7127
7128 (defun gnus-data-remove (article &optional offset)
7129   (let ((data gnus-newsgroup-data))
7130     (if (= (gnus-data-number (car data)) article)
7131         (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
7132               gnus-newsgroup-data-reverse nil)
7133       (while (cdr data)
7134         (and (= (gnus-data-number (cadr data)) article)
7135              (progn
7136                (setcdr data (cddr data))
7137                (and offset (gnus-data-update-list (cdr data) offset))
7138                (setq data nil
7139                      gnus-newsgroup-data-reverse nil)))
7140         (setq data (cdr data))))))
7141
7142 (defmacro gnus-data-list (backward)
7143   `(if ,backward
7144        (or gnus-newsgroup-data-reverse
7145            (setq gnus-newsgroup-data-reverse
7146                  (reverse gnus-newsgroup-data)))
7147      gnus-newsgroup-data))
7148
7149 (defun gnus-data-update-list (data offset)
7150   "Add OFFSET to the POS of all data entries in DATA."
7151   (while data
7152     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
7153     (setq data (cdr data))))
7154
7155 (defun gnus-data-compute-positions ()
7156   "Compute the positions of all articles."
7157   (let ((data gnus-newsgroup-data)
7158         pos)
7159     (while data
7160       (when (setq pos (text-property-any
7161                        (point-min) (point-max)
7162                        'gnus-number (gnus-data-number (car data))))
7163         (gnus-data-set-pos (car data) (+ pos 3)))
7164       (setq data (cdr data)))))
7165
7166 (defun gnus-summary-article-pseudo-p (article)
7167   "Say whether this article is a pseudo article or not."
7168   (not (vectorp (gnus-data-header (gnus-data-find article)))))
7169
7170 (defun gnus-article-parent-p (number)
7171   "Say whether this article is a parent or not."
7172   (let ((data (gnus-data-find-list number)))
7173     (and (cdr data)                     ; There has to be an article after...
7174          (< (gnus-data-level (car data)) ; And it has to have a higher level.
7175             (gnus-data-level (nth 1 data))))))
7176
7177 (defun gnus-article-children (number)
7178   "Return a list of all children to NUMBER."
7179   (let* ((data (gnus-data-find-list number))
7180          (level (gnus-data-level (car data)))
7181          children)
7182     (setq data (cdr data))
7183     (while (and data            
7184                 (= (gnus-data-level (car data)) (1+ level)))
7185       (push (gnus-data-number (car data)) children)
7186       (setq data (cdr data)))
7187     children))
7188
7189 (defmacro gnus-summary-skip-intangible ()
7190   "If the current article is intangible, then jump to a different article."
7191   '(let ((to (get-text-property (point) 'gnus-intangible)))
7192     (and to (gnus-summary-goto-subject to))))
7193
7194 (defmacro gnus-summary-article-intangible-p ()
7195   "Say whether this article is intangible or not."
7196   '(get-text-property (point) 'gnus-intangible))
7197
7198 ;; Some summary mode macros.
7199
7200 (defmacro gnus-summary-article-number ()
7201   "The article number of the article on the current line.
7202 If there isn's an article number here, then we return the current
7203 article number."
7204   '(progn
7205      (gnus-summary-skip-intangible)
7206      (or (get-text-property (point) 'gnus-number)
7207          (gnus-summary-last-subject))))
7208
7209 (defmacro gnus-summary-article-header (&optional number)
7210   `(gnus-data-header (gnus-data-find
7211                       ,(or number '(gnus-summary-article-number)))))
7212
7213 (defmacro gnus-summary-thread-level (&optional number)
7214   `(if (and (eq gnus-summary-make-false-root 'dummy)
7215             (get-text-property (point) 'gnus-intangible))
7216        0
7217      (gnus-data-level (gnus-data-find
7218                        ,(or number '(gnus-summary-article-number))))))
7219
7220 (defmacro gnus-summary-article-mark (&optional number)
7221   `(gnus-data-mark (gnus-data-find
7222                     ,(or number '(gnus-summary-article-number)))))
7223
7224 (defmacro gnus-summary-article-pos (&optional number)
7225   `(gnus-data-pos (gnus-data-find
7226                    ,(or number '(gnus-summary-article-number)))))
7227
7228 (defalias 'gnus-summary-subject-string 'gnus-summary-article-subject)
7229 (defmacro gnus-summary-article-subject (&optional number)
7230   "Return current subject string or nil if nothing."
7231   `(let ((headers
7232           ,(if number
7233                `(gnus-data-header (assq ,number gnus-newsgroup-data))
7234              '(gnus-data-header (assq (gnus-summary-article-number)
7235                                       gnus-newsgroup-data)))))
7236      (and headers
7237           (vectorp headers)
7238           (mail-header-subject headers))))
7239
7240 (defmacro gnus-summary-article-score (&optional number)
7241   "Return current article score."
7242   `(or (cdr (assq ,(or number '(gnus-summary-article-number))
7243                   gnus-newsgroup-scored))
7244        gnus-summary-default-score 0))
7245
7246 (defun gnus-summary-article-children (&optional number)
7247   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
7248          (level (gnus-data-level (car data)))
7249          l children)
7250     (while (and (setq data (cdr data))
7251                 (> (setq l (gnus-data-level (car data))) level))
7252       (and (= (1+ level) l)
7253            (setq children (cons (gnus-data-number (car data))
7254                                 children))))
7255     (nreverse children)))
7256
7257 (defun gnus-summary-article-parent (&optional number)
7258   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
7259                                     (gnus-data-list t)))
7260          (level (gnus-data-level (car data))))
7261     (if (zerop level)
7262         () ; This is a root.
7263       ;; We search until we find an article with a level less than
7264       ;; this one.  That function has to be the parent.
7265       (while (and (setq data (cdr data))
7266                   (not (< (gnus-data-level (car data)) level))))
7267       (and data (gnus-data-number (car data))))))
7268
7269 (defun gnus-unread-mark-p (mark)
7270   "Say whether MARK is the unread mark."
7271   (= mark gnus-unread-mark))
7272
7273 (defun gnus-read-mark-p (mark)
7274   "Say whether MARK is one of the marks that mark as read.
7275 This is all marks except unread, ticked, dormant, and expirable."
7276   (not (or (= mark gnus-unread-mark)
7277            (= mark gnus-ticked-mark)
7278            (= mark gnus-dormant-mark)
7279            (= mark gnus-expirable-mark))))
7280
7281 ;; Various summary mode internalish functions.
7282
7283 (defun gnus-mouse-pick-article (e)
7284   (interactive "e")
7285   (mouse-set-point e)
7286   (gnus-summary-next-page nil t))
7287
7288 (defun gnus-summary-setup-buffer (group)
7289   "Initialize summary buffer."
7290   (let ((buffer (concat "*Summary " group "*")))
7291     (if (get-buffer buffer)
7292         (progn
7293           (set-buffer buffer)
7294           (setq gnus-summary-buffer (current-buffer))
7295           (not gnus-newsgroup-prepared))
7296       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
7297       (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
7298       (gnus-add-current-to-buffer-list)
7299       (gnus-summary-mode group)
7300       (when gnus-carpal
7301         (gnus-carpal-setup-buffer 'summary))
7302       (unless gnus-single-article-buffer
7303         (make-local-variable 'gnus-article-buffer)
7304         (make-local-variable 'gnus-article-current)
7305         (make-local-variable 'gnus-original-article-buffer))
7306       (setq gnus-newsgroup-name group)
7307       t)))
7308
7309 (defun gnus-set-global-variables ()
7310   ;; Set the global equivalents of the summary buffer-local variables
7311   ;; to the latest values they had.  These reflect the summary buffer
7312   ;; that was in action when the last article was fetched.
7313   (when (eq major-mode 'gnus-summary-mode)
7314     (setq gnus-summary-buffer (current-buffer))
7315     (let ((name gnus-newsgroup-name)
7316           (marked gnus-newsgroup-marked)
7317           (unread gnus-newsgroup-unreads)
7318           (headers gnus-current-headers)
7319           (data gnus-newsgroup-data)
7320           (summary gnus-summary-buffer)
7321           (article-buffer gnus-article-buffer)
7322           (original gnus-original-article-buffer)
7323           (gac gnus-article-current)
7324           (score-file gnus-current-score-file))
7325       (save-excursion
7326         (set-buffer gnus-group-buffer)
7327         (setq gnus-newsgroup-name name)
7328         (setq gnus-newsgroup-marked marked)
7329         (setq gnus-newsgroup-unreads unread)
7330         (setq gnus-current-headers headers)
7331         (setq gnus-newsgroup-data data)
7332         (setq gnus-article-current gac)
7333         (setq gnus-summary-buffer summary)
7334         (setq gnus-article-buffer article-buffer)
7335         (setq gnus-original-article-buffer original)
7336         (setq gnus-current-score-file score-file)))))
7337
7338 (defun gnus-summary-last-article-p (&optional article)
7339   "Return whether ARTICLE is the last article in the buffer."
7340   (if (not (setq article (or article (gnus-summary-article-number))))
7341       t ; All non-existant numbers are the last article. :-)
7342     (cdr (gnus-data-find-list article))))
7343
7344 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
7345   "Insert a dummy root in the summary buffer."
7346   (beginning-of-line)
7347   (add-text-properties
7348    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
7349    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
7350
7351 (defvar gnus-thread-indent-array nil)
7352 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
7353 (defun gnus-make-thread-indent-array ()
7354   (let ((n 200))
7355     (unless (and gnus-thread-indent-array
7356                  (= gnus-thread-indent-level gnus-thread-indent-array-level))
7357       (setq gnus-thread-indent-array (make-vector 201 "")
7358             gnus-thread-indent-array-level gnus-thread-indent-level)
7359       (while (>= n 0)
7360         (aset gnus-thread-indent-array n
7361               (make-string (* n gnus-thread-indent-level) ? ))
7362         (setq n (1- n))))))
7363
7364 (defun gnus-summary-insert-line
7365   (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread
7366                    gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
7367                    &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
7368   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
7369          (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
7370          (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
7371          (gnus-tmp-score-char
7372           (if (or (null gnus-summary-default-score)
7373                   (<= (abs (- gnus-tmp-score gnus-summary-default-score))
7374                       gnus-summary-zcore-fuzz)) ? 
7375             (if (< gnus-tmp-score gnus-summary-default-score)
7376                 gnus-score-below-mark gnus-score-over-mark)))
7377          (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark)
7378                                  ((memq gnus-tmp-current gnus-newsgroup-cached)
7379                                   gnus-cached-mark)
7380                                  (gnus-tmp-replied gnus-replied-mark)
7381                                  ((memq gnus-tmp-current gnus-newsgroup-saved)
7382                                   gnus-saved-mark)
7383                                  (t gnus-unread-mark)))
7384          (gnus-tmp-from (mail-header-from gnus-tmp-header))
7385          (gnus-tmp-name
7386           (cond
7387            ((string-match "(.+)" gnus-tmp-from)
7388             (substring gnus-tmp-from
7389                        (1+ (match-beginning 0)) (1- (match-end 0))))
7390            ((string-match "<[^>]+> *$" gnus-tmp-from)
7391             (let ((beg (match-beginning 0)))
7392               (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
7393                        (substring gnus-tmp-from (1+ (match-beginning 0))
7394                                   (1- (match-end 0))))
7395                   (substring gnus-tmp-from 0 beg))))
7396            (t gnus-tmp-from)))
7397          (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
7398          (gnus-tmp-number (mail-header-number gnus-tmp-header))
7399          (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
7400          (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
7401          (buffer-read-only nil))
7402     (when (string= gnus-tmp-name "")
7403       (setq gnus-tmp-name gnus-tmp-from))
7404     (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
7405     (put-text-property
7406      (point)
7407      (progn (eval gnus-summary-line-format-spec) (point))
7408      'gnus-number gnus-tmp-number)
7409     (when (gnus-visual-p 'summary-highlight 'highlight)
7410       (forward-line -1)
7411       (run-hooks 'gnus-summary-update-hook)
7412       (forward-line 1))))
7413
7414 (defun gnus-summary-update-line (&optional dont-update)
7415   ;; Update summary line after change.
7416   (when (and gnus-summary-default-score
7417              (not gnus-summary-inhibit-highlight))
7418     (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
7419            (article (gnus-summary-article-number))
7420            (score (gnus-summary-article-score article)))
7421       (unless dont-update
7422         (if (and gnus-summary-mark-below
7423                  (< (gnus-summary-article-score)
7424                     gnus-summary-mark-below))
7425             ;; This article has a low score, so we mark it as read.
7426             (when (memq article gnus-newsgroup-unreads)
7427               (gnus-summary-mark-article-as-read gnus-low-score-mark))
7428           (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
7429             ;; This article was previously marked as read on account
7430             ;; of a low score, but now it has risen, so we mark it as
7431             ;; unread.
7432             (gnus-summary-mark-article-as-unread gnus-unread-mark)))
7433         (gnus-summary-update-mark
7434          (if (or (null gnus-summary-default-score)
7435                  (<= (abs (- score gnus-summary-default-score))
7436                      gnus-summary-zcore-fuzz)) ? 
7437            (if (< score gnus-summary-default-score)
7438                gnus-score-below-mark gnus-score-over-mark)) 'score))
7439       ;; Do visual highlighting.
7440       (when (gnus-visual-p 'summary-highlight 'highlight)
7441         (run-hooks 'gnus-summary-update-hook)))))
7442
7443 (defvar gnus-tmp-new-adopts nil)
7444
7445 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
7446   ;; Sum up all elements (and sub-elements) in a list.
7447   (let* ((number
7448           ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
7449           (cond
7450            ((and (consp thread) (cdr thread))
7451             (apply
7452              '+ 1 (mapcar
7453                    'gnus-summary-number-of-articles-in-thread (cdr thread))))
7454            ((null thread)
7455             1)
7456            ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
7457             1)
7458            (t 1))))
7459     (when (and level (zerop level) gnus-tmp-new-adopts)
7460       (incf number
7461             (apply '+ (mapcar
7462                        'gnus-summary-number-of-articles-in-thread
7463                        gnus-tmp-new-adopts))))
7464     (if char
7465         (if (> number 1) gnus-not-empty-thread-mark
7466           gnus-empty-thread-mark)
7467       number)))
7468
7469 (defun gnus-summary-set-local-parameters (group)
7470  "Go through the local params of GROUP and set all variable specs in that list."
7471   (let ((params (gnus-info-params (gnus-get-info group)))
7472         elem)
7473     (while params
7474       (setq elem (car params)
7475             params (cdr params))
7476       (and (consp elem)                 ; Has to be a cons.
7477            (consp (cdr elem))           ; The cdr has to be a list.
7478            (symbolp (car elem))         ; Has to be a symbol in there.
7479            (not (memq (car elem) 
7480                       '(quit-config to-address to-list to-group)))
7481            (progn                       ; So we set it.
7482              (make-local-variable (car elem))
7483              (set (car elem) (eval (nth 1 elem))))))))
7484
7485 (defun gnus-summary-read-group (group &optional show-all no-article
7486                                       kill-buffer no-display)
7487   "Start reading news in newsgroup GROUP.
7488 If SHOW-ALL is non-nil, already read articles are also listed.
7489 If NO-ARTICLE is non-nil, no article is selected initially.
7490 If NO-DISPLAY, don't generate a summary buffer."
7491   (gnus-message 5 "Retrieving newsgroup: %s..." group)
7492   (let* ((new-group (gnus-summary-setup-buffer group))
7493          (quit-config (gnus-group-quit-config group))
7494          (did-select (and new-group (gnus-select-newsgroup group show-all))))
7495     (cond
7496      ;; This summary buffer exists already, so we just select it.
7497      ((not new-group)
7498       (gnus-set-global-variables)
7499       (when kill-buffer
7500         (gnus-kill-or-deaden-summary kill-buffer))
7501       (gnus-configure-windows 'summary 'force)
7502       (gnus-set-mode-line 'summary)
7503       (gnus-summary-position-point)
7504       (message "")
7505       t)
7506      ;; We couldn't select this group.
7507      ((null did-select)
7508       (when (and (eq major-mode 'gnus-summary-mode)
7509                  (not (equal (current-buffer) kill-buffer)))
7510         (kill-buffer (current-buffer))
7511         (if (not quit-config)
7512             (progn
7513               (set-buffer gnus-group-buffer)
7514               (gnus-group-jump-to-group group)
7515               (gnus-group-next-unread-group 1))
7516           (if (not (buffer-name (car quit-config)))
7517               (gnus-configure-windows 'group 'force)
7518             (set-buffer (car quit-config))
7519             (and (eq major-mode 'gnus-summary-mode)
7520                  (gnus-set-global-variables))
7521             (gnus-configure-windows (cdr quit-config)))))
7522       (gnus-message 3 "Can't select group")
7523       nil)
7524      ;; The user did a `C-g' while prompting for number of articles,
7525      ;; so we exit this group.
7526      ((eq did-select 'quit)
7527       (and (eq major-mode 'gnus-summary-mode)
7528            (not (equal (current-buffer) kill-buffer))
7529            (kill-buffer (current-buffer)))
7530       (when kill-buffer
7531         (gnus-kill-or-deaden-summary kill-buffer))
7532       (if (not quit-config)
7533           (progn
7534             (set-buffer gnus-group-buffer)
7535             (gnus-group-jump-to-group group)
7536             (gnus-group-next-unread-group 1)
7537             (gnus-configure-windows 'group 'force))
7538         (if (not (buffer-name (car quit-config)))
7539             (gnus-configure-windows 'group 'force)
7540           (set-buffer (car quit-config))
7541           (and (eq major-mode 'gnus-summary-mode)
7542                (gnus-set-global-variables))
7543           (gnus-configure-windows (cdr quit-config))))
7544       ;; Finally signal the quit.
7545       (signal 'quit nil))
7546      ;; The group was successfully selected.
7547      (t
7548       (gnus-set-global-variables)
7549       ;; Save the active value in effect when the group was entered.
7550       (setq gnus-newsgroup-active
7551             (gnus-copy-sequence
7552              (gnus-active gnus-newsgroup-name)))
7553       ;; You can change the summary buffer in some way with this hook.
7554       (run-hooks 'gnus-select-group-hook)
7555       ;; Set any local variables in the group parameters.
7556       (gnus-summary-set-local-parameters gnus-newsgroup-name)
7557       (gnus-update-format-specifications)
7558       ;; Do score processing.
7559       (when gnus-use-scoring
7560         (gnus-possibly-score-headers))
7561       ;; Check whether to fill in the gaps in the threads.
7562       (when gnus-build-sparse-threads
7563         (gnus-build-sparse-threads))
7564       ;; Find the initial limit.
7565       (if show-all
7566           (let ((gnus-newsgroup-dormant nil))
7567             (gnus-summary-initial-limit show-all))
7568         (gnus-summary-initial-limit show-all))
7569       ;; Generate the summary buffer.
7570       (unless no-display
7571         (gnus-summary-prepare))
7572       (when gnus-use-trees
7573         (gnus-tree-open group)
7574         (setq gnus-summary-highlight-line-function
7575               'gnus-tree-highlight-article))
7576       ;; If the summary buffer is empty, but there are some low-scored
7577       ;; articles or some excluded dormants, we include these in the
7578       ;; buffer.
7579       (when (and (zerop (buffer-size))
7580                  (not no-display))
7581         (cond (gnus-newsgroup-dormant
7582                (gnus-summary-limit-include-dormant))
7583               ((and gnus-newsgroup-scored show-all)
7584                (gnus-summary-limit-include-expunged))))
7585       ;; Function `gnus-apply-kill-file' must be called in this hook.
7586       (run-hooks 'gnus-apply-kill-hook)
7587       (if (and (zerop (buffer-size))
7588                (not no-display))
7589           (progn
7590             ;; This newsgroup is empty.
7591             (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
7592             (gnus-message 6 "No unread news")
7593             (when kill-buffer
7594               (gnus-kill-or-deaden-summary kill-buffer))
7595             ;; Return nil from this function.
7596             nil)
7597         ;; Hide conversation thread subtrees.  We cannot do this in
7598         ;; gnus-summary-prepare-hook since kill processing may not
7599         ;; work with hidden articles.
7600         (and gnus-show-threads
7601              gnus-thread-hide-subtree
7602              (gnus-summary-hide-all-threads))
7603         ;; Show first unread article if requested.
7604         (if (and (not no-article)
7605                  (not no-display)
7606                  gnus-newsgroup-unreads
7607                  gnus-auto-select-first)
7608             (if (eq gnus-auto-select-first 'best)
7609                 (gnus-summary-best-unread-article)
7610               (gnus-summary-first-unread-article))
7611           ;; Don't select any articles, just move point to the first
7612           ;; article in the group.
7613           (goto-char (point-min))
7614           (gnus-summary-position-point)
7615           (gnus-set-mode-line 'summary)
7616           (gnus-configure-windows 'summary 'force))
7617         ;; If we are in async mode, we send some info to the backend.
7618         (when gnus-newsgroup-async
7619           (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data))
7620         (when kill-buffer
7621           (gnus-kill-or-deaden-summary kill-buffer))
7622         (when (get-buffer-window gnus-group-buffer t)
7623           ;; Gotta use windows, because recenter does wierd stuff if
7624           ;; the current buffer ain't the displayed window.
7625           (let ((owin (selected-window)))
7626             (select-window (get-buffer-window gnus-group-buffer t))
7627             (when (gnus-group-goto-group group)
7628               (recenter))
7629             (select-window owin))))
7630       ;; Mark this buffer as "prepared".
7631       (setq gnus-newsgroup-prepared t)
7632       t))))
7633
7634 (defun gnus-summary-prepare ()
7635   "Generate the summary buffer."
7636   (let ((buffer-read-only nil))
7637     (erase-buffer)
7638     (setq gnus-newsgroup-data nil
7639           gnus-newsgroup-data-reverse nil)
7640     (run-hooks 'gnus-summary-generate-hook)
7641     ;; Generate the buffer, either with threads or without.
7642     (when gnus-newsgroup-headers
7643       (gnus-summary-prepare-threads
7644        (if gnus-show-threads
7645            (gnus-sort-gathered-threads
7646             (funcall gnus-summary-thread-gathering-function
7647                      (gnus-sort-threads
7648                       (gnus-cut-threads (gnus-make-threads)))))
7649          ;; Unthreaded display.
7650          (gnus-sort-articles gnus-newsgroup-headers))))
7651     (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
7652     ;; Call hooks for modifying summary buffer.
7653     (goto-char (point-min))
7654     (run-hooks 'gnus-summary-prepare-hook)))
7655
7656 (defun gnus-gather-threads-by-subject (threads)
7657   "Gather threads by looking at Subject headers."
7658   (if (not gnus-summary-make-false-root)
7659       threads
7660     (let ((hashtb (gnus-make-hashtable 1023))
7661           (prev threads)
7662           (result threads)
7663           subject hthread whole-subject)
7664       (while threads
7665         (setq whole-subject (mail-header-subject (caar threads)))
7666         (setq subject
7667               (cond
7668                ;; Truncate the subject.
7669                ((numberp gnus-summary-gather-subject-limit)
7670                 (setq subject (gnus-simplify-subject-re whole-subject))
7671                 (if (> (length subject) gnus-summary-gather-subject-limit)
7672                     (substring subject 0 gnus-summary-gather-subject-limit)
7673                   subject))
7674                ;; Fuzzily simplify it.
7675                ((eq 'fuzzy gnus-summary-gather-subject-limit)
7676                 (gnus-simplify-subject-fuzzy whole-subject))
7677                ;; Just remove the leading "Re:".
7678                (t
7679                 (gnus-simplify-subject-re whole-subject))))
7680
7681         (if (and gnus-summary-gather-exclude-subject
7682                  (string-match gnus-summary-gather-exclude-subject
7683                                subject))
7684             ()          ; We don't want to do anything with this article.
7685           ;; We simplify the subject before looking it up in the
7686           ;; hash table.
7687
7688           (if (setq hthread (gnus-gethash subject hashtb))
7689               (progn
7690                 ;; We enter a dummy root into the thread, if we
7691                 ;; haven't done that already.
7692                 (unless (stringp (caar hthread))
7693                   (setcar hthread (list whole-subject (car hthread))))
7694                 ;; We add this new gathered thread to this gathered
7695                 ;; thread.
7696                 (setcdr (car hthread)
7697                         (nconc (cdar hthread) (list (car threads))))
7698                 ;; Remove it from the list of threads.
7699                 (setcdr prev (cdr threads))
7700                 (setq threads prev))
7701             ;; Enter this thread into the hash table.
7702             (gnus-sethash subject threads hashtb)))
7703         (setq prev threads)
7704         (setq threads (cdr threads)))
7705       result)))
7706
7707 (defun gnus-gather-threads-by-references (threads)
7708   "Gather threads by looking at References headers."
7709   (let ((idhashtb (gnus-make-hashtable 1023))
7710         (thhashtb (gnus-make-hashtable 1023))
7711         (prev threads)
7712         (result threads)
7713         ids references id gthread gid entered)
7714     (while threads
7715       (when (setq references (mail-header-references (caar threads)))
7716         (setq id (mail-header-id (caar threads)))
7717         (setq ids (gnus-split-references references))
7718         (setq entered nil)
7719         (while ids
7720           (if (not (setq gid (gnus-gethash (car ids) idhashtb)))
7721               (progn
7722                 (gnus-sethash (car ids) id idhashtb)
7723                 (gnus-sethash id threads thhashtb))
7724             (setq gthread (gnus-gethash gid thhashtb))
7725             (unless entered
7726               ;; We enter a dummy root into the thread, if we
7727               ;; haven't done that already.
7728               (unless (stringp (caar gthread))
7729                 (setcar gthread (list (mail-header-subject (caar gthread))
7730                                       (car gthread))))
7731               ;; We add this new gathered thread to this gathered
7732               ;; thread.
7733               (setcdr (car gthread)
7734                       (nconc (cdar gthread) (list (car threads)))))
7735             ;; Add it into the thread hash table.
7736             (gnus-sethash id gthread thhashtb)
7737             (setq entered t)
7738             ;; Remove it from the list of threads.
7739             (setcdr prev (cdr threads))
7740             (setq threads prev))
7741           (setq ids (cdr ids))))
7742       (setq prev threads)
7743       (setq threads (cdr threads)))
7744     result))
7745
7746 (defun gnus-sort-gathered-threads (threads)
7747   "Sort subtreads inside each gathered thread by article number."
7748   (let ((result threads))
7749     (while threads
7750       (when (stringp (caar threads))
7751         (setcdr (car threads)
7752                 (sort (cdar threads) 'gnus-thread-sort-by-number)))
7753       (setq threads (cdr threads)))
7754     result))
7755
7756 (defun gnus-make-threads ()
7757   "Go through the dependency hashtb and find the roots.  Return all threads."
7758   (let (threads)
7759     (mapatoms
7760      (lambda (refs)
7761        (unless (car (symbol-value refs))
7762          ;; These threads do not refer back to any other articles,
7763          ;; so they're roots.
7764          (setq threads (append (cdr (symbol-value refs)) threads))))
7765      gnus-newsgroup-dependencies)
7766     threads))
7767
7768 (defun gnus-build-sparse-threads ()
7769   (let ((headers gnus-newsgroup-headers)
7770         (deps gnus-newsgroup-dependencies)
7771         header references generation relations 
7772         cthread subject child end pthread relation)
7773     ;; First we create an alist of generations/relations, where 
7774     ;; generations is how much we trust the ralation, and the relation
7775     ;; is parent/child.
7776     (gnus-message 7 "Making sparse threads...")
7777     (save-excursion
7778       (nnheader-set-temp-buffer " *gnus sparse threads*")
7779       (while (setq header (pop headers))
7780         (when (and (setq references (mail-header-references header))
7781                    (not (string= references "")))
7782           (insert references)
7783           (setq child (mail-header-id header)
7784                 subject (mail-header-subject header))
7785           (setq generation 0)
7786           (while (search-backward ">" nil t)
7787             (setq end (1+ (point)))
7788             (when (search-backward "<" nil t)
7789               (push (list (incf generation) 
7790                           child (setq child (buffer-substring (point) end))
7791                           subject)
7792                     relations)))
7793           (push (list (1+ generation) child nil subject) relations)
7794           (erase-buffer)))
7795       (kill-buffer (current-buffer)))
7796     ;; Sort over trustworthiness.
7797     (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2)))))
7798     (while (setq relation (pop relations))
7799       (when (if (boundp (setq cthread (intern (cadr relation) deps)))
7800                 (unless (car (symbol-value cthread))
7801                   ;; Make this article the parent of these threads.
7802                   (setcar (symbol-value cthread)
7803                           (vector gnus-reffed-article-number 
7804                                   (cadddr relation) 
7805                                   "" ""
7806                                   (cadr relation) 
7807                                   (or (caddr relation) "") 0 0 "")))
7808               (set cthread (list (vector gnus-reffed-article-number
7809                                          (cadddr relation) 
7810                                          "" "" (cadr relation) 
7811                                          (or (caddr relation) "") 0 0 ""))))
7812         (push gnus-reffed-article-number gnus-newsgroup-limit)
7813         (push gnus-reffed-article-number gnus-newsgroup-sparse)
7814         (push (cons gnus-reffed-article-number gnus-sparse-mark)
7815               gnus-newsgroup-reads)
7816         (decf gnus-reffed-article-number)
7817         ;; Make this new thread the child of its parent.
7818         (if (boundp (setq pthread (intern (or (caddr relation) "none") deps)))
7819             (setcdr (symbol-value pthread)
7820                     (nconc (cdr (symbol-value pthread))
7821                            (list (symbol-value cthread))))
7822           (set pthread (list nil (symbol-value cthread))))))
7823     (gnus-message 7 "Making sparse threads...done")))
7824
7825 (defun gnus-build-old-threads ()
7826   ;; Look at all the articles that refer back to old articles, and
7827   ;; fetch the headers for the articles that aren't there.  This will
7828   ;; build complete threads - if the roots haven't been expired by the
7829   ;; server, that is.
7830   (let (id heads)
7831     (mapatoms
7832      (lambda (refs)
7833        (when (not (car (symbol-value refs)))
7834          (setq heads (cdr (symbol-value refs)))
7835          (while heads
7836            (if (memq (mail-header-number (caar heads))
7837                      gnus-newsgroup-dormant)
7838                (setq heads (cdr heads))
7839              (setq id (symbol-name refs))
7840              (while (and (setq id (gnus-build-get-header id))
7841                          (not (car (gnus-gethash
7842                                     id gnus-newsgroup-dependencies)))))
7843              (setq heads nil)))))
7844      gnus-newsgroup-dependencies)))
7845
7846 (defun gnus-build-get-header (id)
7847   ;; Look through the buffer of NOV lines and find the header to
7848   ;; ID.  Enter this line into the dependencies hash table, and return
7849   ;; the id of the parent article (if any).
7850   (let ((deps gnus-newsgroup-dependencies)
7851         found header)
7852     (prog1
7853         (save-excursion
7854           (set-buffer nntp-server-buffer)
7855           (goto-char (point-min))
7856           (while (and (not found) (search-forward id nil t))
7857             (beginning-of-line)
7858             (setq found (looking-at
7859                          (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
7860                                  (regexp-quote id))))
7861             (or found (beginning-of-line 2)))
7862           (when found
7863             (beginning-of-line)
7864             (and
7865              (setq header (gnus-nov-parse-line
7866                            (read (current-buffer)) deps))
7867              (gnus-parent-id (mail-header-references header)))))
7868       (when header
7869         (let ((number (mail-header-number header)))
7870           (push number gnus-newsgroup-limit)
7871           (push header gnus-newsgroup-headers)
7872           (if (memq number gnus-newsgroup-unselected)
7873               (progn
7874                 (push number gnus-newsgroup-unreads)
7875                 (setq gnus-newsgroup-unselected
7876                       (delq number gnus-newsgroup-unselected)))
7877             (push number gnus-newsgroup-ancient)))))))
7878
7879 (defun gnus-summary-update-article (article &optional header)
7880   "Update ARTICLE in the summary buffer."
7881   (set-buffer gnus-summary-buffer)
7882   (let* ((header (or header (gnus-summary-article-header article)))
7883          (id (mail-header-id header))
7884          (data (gnus-data-find article))
7885          (thread (gnus-id-to-thread id))
7886          (parent
7887           (gnus-id-to-thread (or (gnus-parent-id 
7888                                   (mail-header-references header))
7889                                  "tull")))
7890          (buffer-read-only nil)
7891          (old (car thread))
7892          (number (mail-header-number header))
7893          pos)
7894     (when thread
7895       (setcar thread nil)
7896       (when parent
7897         (delq thread parent))
7898       (if (gnus-summary-insert-subject id header)
7899           ;; Set the (possibly) new article number in the data structure.
7900           (gnus-data-set-number data (gnus-id-to-article id))
7901         (setcar thread old)
7902         nil))))
7903
7904 (defun gnus-rebuild-thread (id)
7905   "Rebuild the thread containing ID."
7906   (let ((buffer-read-only nil)
7907         current thread data)
7908     (if (not gnus-show-threads)
7909         (setq thread (list (car (gnus-id-to-thread id))))
7910       ;; Get the thread this article is part of.
7911       (setq thread (gnus-remove-thread id)))
7912     (setq current (save-excursion
7913                     (and (zerop (forward-line -1))
7914                          (gnus-summary-article-number))))
7915     ;; If this is a gathered thread, we have to go some re-gathering.
7916     (when (stringp (car thread))
7917       (let ((subject (car thread))
7918             roots thr)
7919         (setq thread (cdr thread))
7920         (while thread
7921           (unless (memq (setq thr (gnus-id-to-thread
7922                                       (gnus-root-id
7923                                        (mail-header-id (caar thread)))))
7924                         roots)
7925             (push thr roots))
7926           (setq thread (cdr thread)))
7927         ;; We now have all (unique) roots.
7928         (if (= (length roots) 1)
7929             ;; All the loose roots are now one solid root.
7930             (setq thread (car roots))
7931           (setq thread (cons subject (gnus-sort-threads roots))))))
7932     (let (threads)
7933       ;; We then insert this thread into the summary buffer.
7934       (let (gnus-newsgroup-data gnus-newsgroup-threads)
7935         (gnus-summary-prepare-threads (list thread))
7936         (setq data (nreverse gnus-newsgroup-data))
7937         (setq threads gnus-newsgroup-threads))
7938       ;; We splice the new data into the data structure.
7939       (gnus-data-enter-list current data)
7940       (gnus-data-compute-positions)
7941       (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
7942
7943 (defun gnus-id-to-thread (id)
7944   "Return the (sub-)thread where ID appears."
7945   (gnus-gethash id gnus-newsgroup-dependencies))
7946
7947 (defun gnus-id-to-article (id)
7948   "Return the article number of ID."
7949   (let ((thread (gnus-id-to-thread id)))
7950     (when thread
7951       (mail-header-number (car thread)))))
7952
7953 (defun gnus-id-to-header (id)
7954   "Return the article headers of ID."
7955   (car (gnus-id-to-thread id)))
7956
7957 (defun gnus-article-displayed-root-p (article)
7958   "Say whether ARTICLE is a root(ish) article."
7959   (let ((level (gnus-summary-thread-level article))
7960         particle)
7961     (cond 
7962      ((null level) nil)
7963      ((zerop level) t)
7964      ((and (= 1 level)
7965            (null (setq particle (gnus-id-to-article
7966                                  (gnus-parent-id 
7967                                   (mail-header-references 
7968                                    (gnus-summary-article-header article))))))
7969            (null (gnus-summary-thread-level particle)))))))
7970
7971 (defun gnus-root-id (id)
7972   "Return the id of the root of the thread where ID appears."
7973   (let (last-id prev)
7974     (while (and id (setq prev (car (gnus-gethash 
7975                                     id gnus-newsgroup-dependencies))))
7976       (setq last-id id
7977             id (gnus-parent-id (mail-header-references prev))))
7978     last-id))
7979
7980 (defun gnus-remove-thread (id &optional dont-remove)
7981   "Remove the thread that has ID in it."
7982   (let ((dep gnus-newsgroup-dependencies)
7983         headers thread last-id)
7984     ;; First go up in this thread until we find the root.
7985     (setq last-id (gnus-root-id id))
7986     (setq headers (list (car (gnus-id-to-thread last-id))
7987                         (caadr (gnus-id-to-thread last-id))))
7988     ;; We have now found the real root of this thread.  It might have
7989     ;; been gathered into some loose thread, so we have to search
7990     ;; through the threads to find the thread we wanted.
7991     (let ((threads gnus-newsgroup-threads)
7992           sub)
7993       (while threads
7994         (setq sub (car threads))
7995         (if (stringp (car sub))
7996             ;; This is a gathered threads, so we look at the roots
7997             ;; below it to find whether this article in in this
7998             ;; gathered root.
7999             (progn
8000               (setq sub (cdr sub))
8001               (while sub
8002                 (when (member (caar sub) headers)
8003                   (setq thread (car threads)
8004                         threads nil
8005                         sub nil))
8006                 (setq sub (cdr sub))))
8007           ;; It's an ordinary thread, so we check it.
8008           (when (eq (car sub) (car headers))
8009             (setq thread sub
8010                   threads nil)))
8011         (setq threads (cdr threads)))
8012       ;; If this article is in no thread, then it's a root.
8013       (if thread
8014           (unless dont-remove
8015             (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
8016         (setq thread (gnus-gethash last-id dep)))
8017       (when thread
8018         (prog1
8019             thread ; We return this thread.
8020           (unless dont-remove
8021             (if (stringp (car thread))
8022                 (progn
8023                   ;; If we use dummy roots, then we have to remove the
8024                   ;; dummy root as well.
8025                   (when (eq gnus-summary-make-false-root 'dummy)
8026                     ;; Uhm.
8027                     )
8028                   (setq thread (cdr thread))
8029                   (while thread
8030                     (gnus-remove-thread-1 (car thread))
8031                     (setq thread (cdr thread))))
8032               (gnus-remove-thread-1 thread))))))))
8033
8034 (defun gnus-remove-thread-1 (thread)
8035   "Remove the thread THREAD recursively."
8036   (let ((number (mail-header-number (car thread)))
8037         pos)
8038     (when (setq pos (text-property-any
8039                      (point-min) (point-max) 'gnus-number number))
8040       (goto-char pos)
8041       (gnus-delete-line)
8042       (gnus-data-remove number))
8043     (setq thread (cdr thread))
8044     (while thread
8045       (gnus-remove-thread-1 (pop thread)))))
8046
8047 (defun gnus-sort-threads (threads)
8048   "Sort THREADS."
8049   (if (not gnus-thread-sort-functions)
8050       threads
8051     (let ((func (if (= 1 (length gnus-thread-sort-functions))
8052                     (car gnus-thread-sort-functions)
8053                   `(lambda (t1 t2)
8054                      ,(gnus-make-sort-function 
8055                        (reverse gnus-thread-sort-functions))))))
8056       (gnus-message 7 "Sorting threads...")
8057       (prog1
8058           (sort threads func)
8059         (gnus-message 7 "Sorting threads...done")))))
8060
8061 (defun gnus-sort-articles (articles)
8062   "Sort ARTICLES."
8063   (when gnus-article-sort-functions
8064     (let ((func (if (= 1 (length gnus-article-sort-functions))
8065                     (car gnus-article-sort-functions)
8066                   `(lambda (t1 t2)
8067                      ,(gnus-make-sort-function 
8068                        (reverse gnus-article-sort-functions))))))
8069       (gnus-message 7 "Sorting articles...")
8070       (prog1
8071           (setq gnus-newsgroup-headers (sort articles func))
8072         (gnus-message 7 "Sorting articles...done")))))
8073
8074 (defun gnus-make-sort-function (funs)
8075   "Return a composite sort condition based on the functions in FUNC."
8076   (if (cdr funs)
8077       `(or (,(car funs) t1 t2)
8078            (and (not (,(car funs) t2 t1))
8079                 ,(gnus-make-sort-function (cdr funs))))
8080     `(,(car funs) t1 t2)))
8081                  
8082 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
8083 (defmacro gnus-thread-header (thread)
8084   ;; Return header of first article in THREAD.
8085   ;; Note that THREAD must never, ever be anything else than a variable -
8086   ;; using some other form will lead to serious barfage.
8087   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
8088   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
8089   (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
8090         (vector thread) 2))
8091
8092 (defsubst gnus-article-sort-by-number (h1 h2)
8093   "Sort articles by article number."
8094   (< (mail-header-number h1)
8095      (mail-header-number h2)))
8096
8097 (defun gnus-thread-sort-by-number (h1 h2)
8098   "Sort threads by root article number."
8099   (gnus-article-sort-by-number
8100    (gnus-thread-header h1) (gnus-thread-header h2)))
8101
8102 (defsubst gnus-article-sort-by-author (h1 h2)
8103   "Sort articles by root author."
8104   (string-lessp
8105    (let ((extract (funcall
8106                    gnus-extract-address-components
8107                    (mail-header-from h1))))
8108      (or (car extract) (cdr extract)))
8109    (let ((extract (funcall
8110                    gnus-extract-address-components
8111                    (mail-header-from h2))))
8112      (or (car extract) (cdr extract)))))
8113
8114 (defun gnus-thread-sort-by-author (h1 h2)
8115   "Sort threads by root author."
8116   (gnus-article-sort-by-author
8117    (gnus-thread-header h1)  (gnus-thread-header h2)))
8118
8119 (defsubst gnus-article-sort-by-subject (h1 h2)
8120   "Sort articles by root subject."
8121   (string-lessp
8122    (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
8123    (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
8124
8125 (defun gnus-thread-sort-by-subject (h1 h2)
8126   "Sort threads by root subject."
8127   (gnus-article-sort-by-subject
8128    (gnus-thread-header h1) (gnus-thread-header h2)))
8129
8130 (defsubst gnus-article-sort-by-date (h1 h2)
8131   "Sort articles by root article date."
8132   (string-lessp
8133    (gnus-sortable-date (mail-header-date h1))
8134    (gnus-sortable-date (mail-header-date h2))))
8135
8136 (defun gnus-thread-sort-by-date (h1 h2)
8137   "Sort threads by root article date."
8138   (gnus-article-sort-by-date
8139    (gnus-thread-header h1) (gnus-thread-header h2)))
8140
8141 (defsubst gnus-article-sort-by-score (h1 h2)
8142   "Sort articles by root article score.
8143 Unscored articles will be counted as having a score of zero."
8144   (> (or (cdr (assq (mail-header-number h1)
8145                     gnus-newsgroup-scored))
8146          gnus-summary-default-score 0)
8147      (or (cdr (assq (mail-header-number h2)
8148                     gnus-newsgroup-scored))
8149          gnus-summary-default-score 0)))
8150
8151 (defun gnus-thread-sort-by-score (h1 h2)
8152   "Sort threads by root article score."
8153   (gnus-article-sort-by-score
8154    (gnus-thread-header h1) (gnus-thread-header h2)))
8155
8156 (defun gnus-thread-sort-by-total-score (h1 h2)
8157   "Sort threads by the sum of all scores in the thread.
8158 Unscored articles will be counted as having a score of zero."
8159   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
8160
8161 (defun gnus-thread-total-score (thread)
8162   ;;  This function find the total score of THREAD.
8163   (if (consp thread)
8164       (if (stringp (car thread))
8165           (apply gnus-thread-score-function 0
8166                  (mapcar 'gnus-thread-total-score-1 (cdr thread)))
8167         (gnus-thread-total-score-1 thread))
8168     (gnus-thread-total-score-1 (list thread))))
8169
8170 (defun gnus-thread-total-score-1 (root)
8171   ;; This function find the total score of the thread below ROOT.
8172   (setq root (car root))
8173   (apply gnus-thread-score-function
8174          (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
8175              gnus-summary-default-score 0)
8176          (mapcar 'gnus-thread-total-score
8177                  (cdr (gnus-gethash (mail-header-id root)
8178                                     gnus-newsgroup-dependencies)))))
8179
8180 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
8181 (defvar gnus-tmp-prev-subject nil)
8182 (defvar gnus-tmp-false-parent nil)
8183 (defvar gnus-tmp-root-expunged nil)
8184 (defvar gnus-tmp-dummy-line nil)
8185
8186 (defun gnus-summary-prepare-threads (threads)
8187   "Prepare summary buffer from THREADS and indentation LEVEL.
8188 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
8189 or a straight list of headers."
8190   (gnus-message 7 "Generating summary...")
8191
8192   (setq gnus-newsgroup-threads threads)
8193   (beginning-of-line)
8194
8195   (let ((gnus-tmp-level 0)
8196         (default-score (or gnus-summary-default-score 0))
8197         (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
8198         thread number subject stack state gnus-tmp-gathered beg-match
8199         new-roots gnus-tmp-new-adopts thread-end
8200         gnus-tmp-header gnus-tmp-unread
8201         gnus-tmp-replied gnus-tmp-subject-or-nil
8202         gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
8203         gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
8204         gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
8205
8206     (setq gnus-tmp-prev-subject nil)
8207
8208     (if (vectorp (car threads))
8209         ;; If this is a straight (sic) list of headers, then a
8210         ;; threaded summary display isn't required, so we just create
8211         ;; an unthreaded one.
8212         (gnus-summary-prepare-unthreaded threads)
8213
8214       ;; Do the threaded display.
8215
8216       (while (or threads stack gnus-tmp-new-adopts new-roots)
8217
8218         (if (and (= gnus-tmp-level 0)
8219                  (not (setq gnus-tmp-dummy-line nil))
8220                  (or (not stack)
8221                      (= (caar stack) 0))
8222                  (not gnus-tmp-false-parent)
8223                  (or gnus-tmp-new-adopts new-roots))
8224             (if gnus-tmp-new-adopts
8225                 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
8226                       thread (list (car gnus-tmp-new-adopts))
8227                       gnus-tmp-header (caar thread)
8228                       gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
8229               (if new-roots
8230                   (setq thread (list (car new-roots))
8231                         gnus-tmp-header (caar thread)
8232                         new-roots (cdr new-roots))))
8233
8234           (if threads
8235               ;; If there are some threads, we do them before the
8236               ;; threads on the stack.
8237               (setq thread threads
8238                     gnus-tmp-header (caar thread))
8239             ;; There were no current threads, so we pop something off
8240             ;; the stack.
8241             (setq state (car stack)
8242                   gnus-tmp-level (car state)
8243                   thread (cdr state)
8244                   stack (cdr stack)
8245                   gnus-tmp-header (caar thread))))
8246
8247         (setq gnus-tmp-false-parent nil)
8248         (setq gnus-tmp-root-expunged nil)
8249         (setq thread-end nil)
8250
8251         (if (stringp gnus-tmp-header)
8252             ;; The header is a dummy root.
8253             (cond
8254              ((eq gnus-summary-make-false-root 'adopt)
8255               ;; We let the first article adopt the rest.
8256               (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
8257                                                (cddar thread)))
8258               (setq gnus-tmp-gathered
8259                     (nconc (mapcar
8260                             (lambda (h) (mail-header-number (car h)))
8261                             (cddar thread))
8262                            gnus-tmp-gathered))
8263               (setq thread (cons (list (caar thread)
8264                                        (cadar thread))
8265                                  (cdr thread)))
8266               (setq gnus-tmp-level -1
8267                     gnus-tmp-false-parent t))
8268              ((eq gnus-summary-make-false-root 'empty)
8269               ;; We print adopted articles with empty subject fields.
8270               (setq gnus-tmp-gathered
8271                     (nconc (mapcar
8272                             (lambda (h) (mail-header-number (car h)))
8273                             (cddar thread))
8274                            gnus-tmp-gathered))
8275               (setq gnus-tmp-level -1))
8276              ((eq gnus-summary-make-false-root 'dummy)
8277               ;; We remember that we probably want to output a dummy
8278               ;; root.
8279               (setq gnus-tmp-dummy-line gnus-tmp-header)
8280               (setq gnus-tmp-prev-subject gnus-tmp-header))
8281              (t
8282               ;; We do not make a root for the gathered
8283               ;; sub-threads at all.
8284               (setq gnus-tmp-level -1)))
8285
8286           (setq number (mail-header-number gnus-tmp-header)
8287                 subject (mail-header-subject gnus-tmp-header))
8288
8289           (cond
8290            ;; If the thread has changed subject, we might want to make
8291            ;; this subthread into a root.
8292            ((and (null gnus-thread-ignore-subject)
8293                  (not (zerop gnus-tmp-level))
8294                  gnus-tmp-prev-subject
8295                  (not (inline
8296                         (gnus-subject-equal gnus-tmp-prev-subject subject))))
8297             (setq new-roots (nconc new-roots (list (car thread)))
8298                   thread-end t
8299                   gnus-tmp-header nil))
8300            ;; If the article lies outside the current limit,
8301            ;; then we do not display it.
8302            ((and (not (memq number gnus-newsgroup-limit))
8303                  (not gnus-tmp-dummy-line))
8304             (setq gnus-tmp-gathered
8305                   (nconc (mapcar
8306                           (lambda (h) (mail-header-number (car h)))
8307                           (cdar thread))
8308                          gnus-tmp-gathered))
8309             (setq gnus-tmp-new-adopts (if (cdar thread)
8310                                           (append gnus-tmp-new-adopts
8311                                                   (cdar thread))
8312                                         gnus-tmp-new-adopts)
8313                   thread-end t
8314                   gnus-tmp-header nil)
8315             (when (zerop gnus-tmp-level)
8316               (setq gnus-tmp-root-expunged t)))
8317            ;; Perhaps this article is to be marked as read?
8318            ((and gnus-summary-mark-below
8319                  (< (or (cdr (assq number gnus-newsgroup-scored))
8320                         default-score)
8321                     gnus-summary-mark-below)
8322                  ;; Don't touch sparse articles.
8323                  (not (memq number gnus-newsgroup-sparse)))
8324             (setq gnus-newsgroup-unreads
8325                   (delq number gnus-newsgroup-unreads))
8326             (if gnus-newsgroup-auto-expire
8327                 (push number gnus-newsgroup-expirable)
8328               (push (cons number gnus-low-score-mark)
8329                     gnus-newsgroup-reads))))
8330
8331           (when gnus-tmp-header
8332             ;; We may have an old dummy line to output before this
8333             ;; article.
8334             (when gnus-tmp-dummy-line
8335               (gnus-summary-insert-dummy-line
8336                gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
8337               (setq gnus-tmp-dummy-line nil))
8338
8339             ;; Compute the mark.
8340             (setq
8341              gnus-tmp-unread
8342              (cond
8343               ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8344               ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8345               ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8346               ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8347               (t (or (cdr (assq number gnus-newsgroup-reads))
8348                      gnus-ancient-mark))))
8349
8350             (push (gnus-data-make number gnus-tmp-unread (1+ (point))
8351                                   gnus-tmp-header gnus-tmp-level)
8352                   gnus-newsgroup-data)
8353
8354             ;; Actually insert the line.
8355             (setq
8356              gnus-tmp-subject-or-nil
8357              (cond
8358               ((and gnus-thread-ignore-subject
8359                     gnus-tmp-prev-subject
8360                     (not (inline (gnus-subject-equal
8361                                   gnus-tmp-prev-subject subject))))
8362                subject)
8363               ((zerop gnus-tmp-level)
8364                (if (and (eq gnus-summary-make-false-root 'empty)
8365                         (memq number gnus-tmp-gathered)
8366                         gnus-tmp-prev-subject
8367                         (inline (gnus-subject-equal
8368                                  gnus-tmp-prev-subject subject)))
8369                    gnus-summary-same-subject
8370                  subject))
8371               (t gnus-summary-same-subject)))
8372             (if (and (eq gnus-summary-make-false-root 'adopt)
8373                      (= gnus-tmp-level 1)
8374                      (memq number gnus-tmp-gathered))
8375                 (setq gnus-tmp-opening-bracket ?\<
8376                       gnus-tmp-closing-bracket ?\>)
8377               (setq gnus-tmp-opening-bracket ?\[
8378                     gnus-tmp-closing-bracket ?\]))
8379             (setq
8380              gnus-tmp-indentation
8381              (aref gnus-thread-indent-array gnus-tmp-level)
8382              gnus-tmp-lines (mail-header-lines gnus-tmp-header)
8383              gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
8384                                 gnus-summary-default-score 0)
8385              gnus-tmp-score-char
8386              (if (or (null gnus-summary-default-score)
8387                      (<= (abs (- gnus-tmp-score gnus-summary-default-score))
8388                          gnus-summary-zcore-fuzz)) ? 
8389                (if (< gnus-tmp-score gnus-summary-default-score)
8390                    gnus-score-below-mark gnus-score-over-mark))
8391              gnus-tmp-replied
8392              (cond ((memq number gnus-newsgroup-processable)
8393                     gnus-process-mark)
8394                    ((memq number gnus-newsgroup-cached)
8395                     gnus-cached-mark)
8396                    ((memq number gnus-newsgroup-replied)
8397                     gnus-replied-mark)
8398                    (t gnus-unread-mark))
8399              gnus-tmp-from (mail-header-from gnus-tmp-header)
8400              gnus-tmp-name
8401              (cond
8402               ((string-match "(.+)" gnus-tmp-from)
8403                (substring gnus-tmp-from
8404                           (1+ (match-beginning 0)) (1- (match-end 0))))
8405               ((string-match "<[^>]+> *$" gnus-tmp-from)
8406                (setq beg-match (match-beginning 0))
8407                (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
8408                         (substring gnus-tmp-from (1+ (match-beginning 0))
8409                                    (1- (match-end 0))))
8410                    (substring gnus-tmp-from 0 beg-match)))
8411               (t gnus-tmp-from)))
8412             (when (string= gnus-tmp-name "")
8413               (setq gnus-tmp-name gnus-tmp-from))
8414             (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
8415             (put-text-property
8416              (point)
8417              (progn (eval gnus-summary-line-format-spec) (point))
8418              'gnus-number number)
8419             (when gnus-visual-p
8420               (forward-line -1)
8421               (run-hooks 'gnus-summary-update-hook)
8422               (forward-line 1))
8423
8424             (setq gnus-tmp-prev-subject subject)))
8425
8426         (when (nth 1 thread)
8427           (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
8428         (incf gnus-tmp-level)
8429         (setq threads (if thread-end nil (cdar thread)))
8430         (unless threads
8431           (setq gnus-tmp-level 0)))))
8432   (gnus-message 7 "Generating summary...done"))
8433
8434 (defun gnus-summary-prepare-unthreaded (headers)
8435   "Generate an unthreaded summary buffer based on HEADERS."
8436   (let (header number mark)
8437
8438     (while headers
8439       (setq header (car headers)
8440             headers (cdr headers)
8441             number (mail-header-number header))
8442
8443       ;; We may have to root out some bad articles...
8444       (when (memq number gnus-newsgroup-limit)
8445         (when (and gnus-summary-mark-below
8446                    (< (or (cdr (assq number gnus-newsgroup-scored))
8447                           gnus-summary-default-score 0)
8448                       gnus-summary-mark-below))
8449           (setq gnus-newsgroup-unreads
8450                 (delq number gnus-newsgroup-unreads))
8451           (if gnus-newsgroup-auto-expire
8452               (push number gnus-newsgroup-expirable)
8453             (push (cons number gnus-low-score-mark)
8454                   gnus-newsgroup-reads)))
8455
8456         (setq mark
8457               (cond
8458                ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8459                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8460                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8461                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8462                (t (or (cdr (assq number gnus-newsgroup-reads))
8463                       gnus-ancient-mark))))
8464         (setq gnus-newsgroup-data
8465               (cons (gnus-data-make number mark (1+ (point)) header 0)
8466                     gnus-newsgroup-data))
8467         (gnus-summary-insert-line
8468          header 0 nil mark (memq number gnus-newsgroup-replied)
8469          (memq number gnus-newsgroup-expirable)
8470          (mail-header-subject header) nil
8471          (cdr (assq number gnus-newsgroup-scored))
8472          (memq number gnus-newsgroup-processable))))))
8473
8474 (defun gnus-select-newsgroup (group &optional read-all)
8475   "Select newsgroup GROUP.
8476 If READ-ALL is non-nil, all articles in the group are selected."
8477   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
8478          (info (nth 2 entry))
8479          articles fetched-articles cached)
8480
8481     (or (gnus-check-server
8482          (setq gnus-current-select-method (gnus-find-method-for-group group)))
8483         (error "Couldn't open server"))
8484
8485     (or (and entry (not (eq (car entry) t))) ; Either it's active...
8486         (gnus-activate-group group) ; Or we can activate it...
8487         (progn ; Or we bug out.
8488           (when (equal major-mode 'gnus-summary-mode)
8489             (kill-buffer (current-buffer)))
8490           (error "Couldn't request group %s: %s"
8491                  group (gnus-status-message group))))
8492
8493     (setq gnus-newsgroup-name group)
8494     (setq gnus-newsgroup-unselected nil)
8495     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
8496
8497     (and gnus-asynchronous
8498          (gnus-check-backend-function
8499           'request-asynchronous gnus-newsgroup-name)
8500          (setq gnus-newsgroup-async
8501                (gnus-request-asynchronous gnus-newsgroup-name)))
8502
8503     ;; Adjust and set lists of article marks.
8504     (when info
8505       (gnus-adjust-marked-articles info))
8506
8507     ;; Kludge to avoid having cached articles nixed out in virtual groups.
8508     (when (gnus-virtual-group-p group)
8509       (setq cached gnus-newsgroup-cached))
8510
8511     (setq gnus-newsgroup-unreads
8512           (gnus-set-difference
8513            (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
8514            gnus-newsgroup-dormant))
8515
8516     (setq gnus-newsgroup-processable nil)
8517
8518     (setq articles (gnus-articles-to-read group read-all))
8519
8520     (cond
8521      ((null articles)
8522       ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
8523       'quit)
8524      ((eq articles 0) nil)
8525      (t
8526       ;; Init the dependencies hash table.
8527       (setq gnus-newsgroup-dependencies
8528             (gnus-make-hashtable (length articles)))
8529       ;; Retrieve the headers and read them in.
8530       (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
8531       (setq gnus-newsgroup-headers
8532             (if (eq 'nov
8533                     (setq gnus-headers-retrieved-by
8534                           (gnus-retrieve-headers
8535                            articles gnus-newsgroup-name
8536                            ;; We might want to fetch old headers, but
8537                            ;; not if there is only 1 article.
8538                            (and gnus-fetch-old-headers
8539                                 (or (and
8540                                      (not (eq gnus-fetch-old-headers 'some))
8541                                      (not (numberp gnus-fetch-old-headers)))
8542                                     (> (length articles) 1))))))
8543                 (gnus-get-newsgroup-headers-xover articles)
8544               (gnus-get-newsgroup-headers)))
8545       (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
8546
8547       ;; Kludge to avoid having cached articles nixed out in virtual groups.
8548       (when cached
8549         (setq gnus-newsgroup-cached cached))
8550
8551       ;; Set the initial limit.
8552       (setq gnus-newsgroup-limit (copy-sequence articles))
8553       ;; Remove canceled articles from the list of unread articles.
8554       (setq gnus-newsgroup-unreads
8555             (gnus-set-sorted-intersection
8556              gnus-newsgroup-unreads
8557              (setq fetched-articles
8558                    (mapcar (lambda (headers) (mail-header-number headers))
8559                            gnus-newsgroup-headers))))
8560       ;; Removed marked articles that do not exist.
8561       (gnus-update-missing-marks
8562        (gnus-sorted-complement fetched-articles articles))
8563       ;; We might want to build some more threads first.
8564       (and gnus-fetch-old-headers
8565            (eq gnus-headers-retrieved-by 'nov)
8566            (gnus-build-old-threads))
8567       ;; Check whether auto-expire is to be done in this group.
8568       (setq gnus-newsgroup-auto-expire
8569             (gnus-group-auto-expirable-p group))
8570       ;; Set up the article buffer now, if necessary.
8571       (unless gnus-single-article-buffer
8572         (gnus-article-setup-buffer))
8573       ;; First and last article in this newsgroup.
8574       (and gnus-newsgroup-headers
8575            (setq gnus-newsgroup-begin
8576                  (mail-header-number (car gnus-newsgroup-headers)))
8577            (setq gnus-newsgroup-end
8578                  (mail-header-number
8579                   (gnus-last-element gnus-newsgroup-headers))))
8580       (setq gnus-reffed-article-number -1)
8581       ;; GROUP is successfully selected.
8582       (or gnus-newsgroup-headers t)))))
8583
8584 (defun gnus-articles-to-read (group read-all)
8585   ;; Find out what articles the user wants to read.
8586   (let* ((articles
8587           ;; Select all articles if `read-all' is non-nil, or if there
8588           ;; are no unread articles.
8589           (if (or read-all
8590                   (and (zerop (length gnus-newsgroup-marked))
8591                        (zerop (length gnus-newsgroup-unreads))))
8592               (gnus-uncompress-range (gnus-active group))
8593             (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
8594                           (copy-sequence gnus-newsgroup-unreads))
8595                   '<)))
8596          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
8597          (scored (length scored-list))
8598          (number (length articles))
8599          (marked (+ (length gnus-newsgroup-marked)
8600                     (length gnus-newsgroup-dormant)))
8601          (select
8602           (cond
8603            ((numberp read-all)
8604             read-all)
8605            (t
8606             (condition-case ()
8607                 (cond
8608                  ((and (or (<= scored marked) (= scored number))
8609                        (numberp gnus-large-newsgroup)
8610                        (> number gnus-large-newsgroup))
8611                   (let ((input
8612                          (read-string
8613                           (format
8614                            "How many articles from %s (default %d): "
8615                            gnus-newsgroup-name number))))
8616                     (if (string-match "^[ \t]*$" input) number input)))
8617                  ((and (> scored marked) (< scored number))
8618                   (let ((input
8619                          (read-string
8620                           (format "%s %s (%d scored, %d total): "
8621                                   "How many articles from"
8622                                   group scored number))))
8623                     (if (string-match "^[ \t]*$" input)
8624                         number input)))
8625                  (t number))
8626               (quit nil))))))
8627     (setq select (if (stringp select) (string-to-number select) select))
8628     (if (or (null select) (zerop select))
8629         select
8630       (if (and (not (zerop scored)) (<= (abs select) scored))
8631           (progn
8632             (setq articles (sort scored-list '<))
8633             (setq number (length articles)))
8634         (setq articles (copy-sequence articles)))
8635
8636       (if (< (abs select) number)
8637           (if (< select 0)
8638               ;; Select the N oldest articles.
8639               (setcdr (nthcdr (1- (abs select)) articles) nil)
8640             ;; Select the N most recent articles.
8641             (setq articles (nthcdr (- number select) articles))))
8642       (setq gnus-newsgroup-unselected
8643             (gnus-sorted-intersection
8644              gnus-newsgroup-unreads
8645              (gnus-sorted-complement gnus-newsgroup-unreads articles)))
8646       articles)))
8647
8648 (defun gnus-killed-articles (killed articles)
8649   (let (out)
8650     (while articles
8651       (if (inline (gnus-member-of-range (car articles) killed))
8652           (setq out (cons (car articles) out)))
8653       (setq articles (cdr articles)))
8654     out))
8655
8656 (defun gnus-uncompress-marks (marks)
8657   "Uncompress the mark ranges in MARKS."
8658   (let ((uncompressed '(score bookmark))
8659         out)
8660     (while marks
8661       (if (memq (caar marks) uncompressed)
8662           (push (car marks) out)
8663         (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
8664       (setq marks (cdr marks)))
8665     out))
8666
8667 (defun gnus-adjust-marked-articles (info)
8668   "Set all article lists and remove all marks that are no longer legal."
8669   (let* ((marked-lists (gnus-info-marks info))
8670          (active (gnus-active (gnus-info-group info)))
8671          (min (car active))
8672          (max (cdr active))
8673          (types gnus-article-mark-lists)
8674          (uncompressed '(score bookmark))
8675          marks var articles article mark)
8676
8677     (while marked-lists
8678       (setq marks (pop marked-lists))
8679       (set (setq var (intern (format "gnus-newsgroup-%s"
8680                                      (car (rassq (setq mark (car marks))
8681                                                  types)))))
8682            (if (memq (car marks) uncompressed) (cdr marks)
8683              (gnus-uncompress-range (cdr marks))))
8684
8685       (setq articles (symbol-value var))
8686
8687       ;; All articles have to be subsets of the active articles.
8688       (cond
8689        ;; Adjust "simple" lists.
8690        ((memq mark '(tick dormant expirable reply killed save))
8691         (while articles
8692           (when (or (< (setq article (pop articles)) min) (> article max))
8693             (set var (delq article (symbol-value var))))))
8694        ;; Adjust assocs.
8695        ((memq mark '(score bookmark))
8696         (while articles
8697           (when (or (< (car (setq article (pop articles))) min)
8698                     (> (car article) max))
8699             (set var (delq article (symbol-value var))))))))))
8700
8701 (defun gnus-update-missing-marks (missing)
8702   "Go through the list of MISSING articles and remove them mark lists."
8703   (when missing
8704     (let ((types gnus-article-mark-lists)
8705           var m)
8706       ;; Go through all types.
8707       (while types
8708         (setq var (intern (format "gnus-newsgroup-%s" (car (pop types)))))
8709         (when (symbol-value var)
8710           ;; This list has articles.  So we delete all missing articles
8711           ;; from it.
8712           (setq m missing)
8713           (while m
8714             (set var (delq (pop m) (symbol-value var)))))))))
8715
8716 (defun gnus-update-marks ()
8717   "Enter the various lists of marked articles into the newsgroup info list."
8718   (let ((types gnus-article-mark-lists)
8719         (info (gnus-get-info gnus-newsgroup-name))
8720         (uncompressed '(score bookmark killed))
8721         type list newmarked symbol)
8722     (when info
8723       ;; Add all marks lists that are non-nil to the list of marks lists.
8724       (while types
8725         (setq type (pop types))
8726         (when (setq list (symbol-value
8727                           (setq symbol
8728                                 (intern (format "gnus-newsgroup-%s"
8729                                                 (car type))))))
8730           (push (cons (cdr type)
8731                       (if (memq (cdr type) uncompressed) list
8732                         (gnus-compress-sequence (set symbol (sort list '<)) t)))
8733                 newmarked)))
8734
8735       ;; Enter these new marks into the info of the group.
8736       (if (nthcdr 3 info)
8737           (setcar (nthcdr 3 info) newmarked)
8738         ;; Add the marks lists to the end of the info.
8739         (when newmarked
8740           (setcdr (nthcdr 2 info) (list newmarked))))
8741
8742       ;; Cut off the end of the info if there's nothing else there.
8743       (let ((i 5))
8744         (while (and (> i 2)
8745                     (not (nth i info)))
8746           (when (nthcdr (decf i) info)
8747             (setcdr (nthcdr i info) nil)))))))
8748
8749 (defun gnus-add-marked-articles (group type articles &optional info force)
8750   ;; Add ARTICLES of TYPE to the info of GROUP.
8751   ;; If INFO is non-nil, use that info.  If FORCE is non-nil, don't
8752   ;; add, but replace marked articles of TYPE with ARTICLES.
8753   (let ((info (or info (gnus-get-info group)))
8754         (uncompressed '(score bookmark killed))
8755         marked m)
8756     (or (not info)
8757         (and (not (setq marked (nthcdr 3 info)))
8758              (or (null articles)
8759                  (setcdr (nthcdr 2 info)
8760                          (list (list (cons type (gnus-compress-sequence
8761                                                  articles t)))))))
8762         (and (not (setq m (assq type (car marked))))
8763              (or (null articles)
8764                  (setcar marked
8765                          (cons (cons type (gnus-compress-sequence articles t) )
8766                                (car marked)))))
8767         (if force
8768             (if (null articles)
8769                 (setcar (nthcdr 3 info)
8770                         (delq (assq type (car marked)) (car marked)))
8771               (setcdr m (gnus-compress-sequence articles t)))
8772           (setcdr m (gnus-compress-sequence
8773                      (sort (nconc (gnus-uncompress-range (cdr m))
8774                                   (copy-sequence articles)) '<) t))))))
8775
8776 (defun gnus-set-mode-line (where)
8777   "This function sets the mode line of the article or summary buffers.
8778 If WHERE is `summary', the summary mode line format will be used."
8779   ;; Is this mode line one we keep updated?
8780   (when (memq where gnus-updated-mode-lines)
8781     (let (mode-string)
8782       (save-excursion
8783         ;; We evaluate this in the summary buffer since these
8784         ;; variables are buffer-local to that buffer.
8785         (set-buffer gnus-summary-buffer)
8786         ;; We bind all these variables that are used in the `eval' form
8787         ;; below.
8788         (let* ((mformat (symbol-value
8789                          (intern
8790                           (format "gnus-%s-mode-line-format-spec" where))))
8791                (gnus-tmp-group-name gnus-newsgroup-name)
8792                (gnus-tmp-article-number (or gnus-current-article 0))
8793                (gnus-tmp-unread gnus-newsgroup-unreads)
8794                (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
8795                (gnus-tmp-unselected (length gnus-newsgroup-unselected))
8796                (gnus-tmp-unread-and-unselected
8797                 (cond ((and (zerop gnus-tmp-unread-and-unticked)
8798                             (zerop gnus-tmp-unselected)) "")
8799                       ((zerop gnus-tmp-unselected)
8800                        (format "{%d more}" gnus-tmp-unread-and-unticked))
8801                       (t (format "{%d(+%d) more}"
8802                                  gnus-tmp-unread-and-unticked
8803                                  gnus-tmp-unselected))))
8804                (gnus-tmp-subject
8805                 (if (and gnus-current-headers
8806                          (vectorp gnus-current-headers))
8807                     (mail-header-subject gnus-current-headers) ""))
8808                max-len
8809                gnus-tmp-header);; passed as argument to any user-format-funcs
8810           (setq mode-string (eval mformat))
8811           (setq max-len (max 4 (if gnus-mode-non-string-length
8812                                    (- (frame-width)
8813                                       gnus-mode-non-string-length)
8814                                  (length mode-string))))
8815           ;; We might have to chop a bit of the string off...
8816           (when (> (length mode-string) max-len)
8817             (setq mode-string
8818                   (concat (gnus-truncate-string mode-string (- max-len 3))
8819                           "...")))
8820           ;; Pad the mode string a bit.
8821           (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
8822       ;; Update the mode line.
8823       (setq mode-line-buffer-identification (list mode-string))
8824       (set-buffer-modified-p t))))
8825
8826 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
8827   "Go through the HEADERS list and add all Xrefs to a hash table.
8828 The resulting hash table is returned, or nil if no Xrefs were found."
8829   (let* ((virtual (gnus-virtual-group-p from-newsgroup))
8830          (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
8831          (xref-hashtb (make-vector 63 0))
8832          start group entry number xrefs header)
8833     (while headers
8834       (setq header (pop headers))
8835       (when (and (setq xrefs (mail-header-xref header))
8836                  (not (memq (setq number (mail-header-number header))
8837                             unreads)))
8838         (setq start 0)
8839         (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
8840           (setq start (match-end 0))
8841           (setq group (if prefix
8842                           (concat prefix (substring xrefs (match-beginning 1)
8843                                                     (match-end 1)))
8844                         (substring xrefs (match-beginning 1) (match-end 1))))
8845           (setq number
8846                 (string-to-int (substring xrefs (match-beginning 2)
8847                                           (match-end 2))))
8848           (if (setq entry (gnus-gethash group xref-hashtb))
8849               (setcdr entry (cons number (cdr entry)))
8850             (gnus-sethash group (cons number nil) xref-hashtb)))))
8851     (and start xref-hashtb)))
8852
8853 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
8854   "Look through all the headers and mark the Xrefs as read."
8855   (let ((virtual (gnus-virtual-group-p from-newsgroup))
8856         name entry info xref-hashtb idlist method nth4)
8857     (save-excursion
8858       (set-buffer gnus-group-buffer)
8859       (when (setq xref-hashtb
8860                   (gnus-create-xref-hashtb from-newsgroup headers unreads))
8861         (mapatoms
8862          (lambda (group)
8863            (unless (string= from-newsgroup (setq name (symbol-name group)))
8864              (setq idlist (symbol-value group))
8865              ;; Dead groups are not updated.
8866              (and (prog1
8867                       (setq entry (gnus-gethash name gnus-newsrc-hashtb)
8868                             info (nth 2 entry))
8869                     (if (stringp (setq nth4 (gnus-info-method info)))
8870                         (setq nth4 (gnus-server-to-method nth4))))
8871                   ;; Only do the xrefs if the group has the same
8872                   ;; select method as the group we have just read.
8873                   (or (gnus-methods-equal-p
8874                        nth4 (gnus-find-method-for-group from-newsgroup))
8875                       virtual
8876                       (equal nth4 (setq method (gnus-find-method-for-group
8877                                                 from-newsgroup)))
8878                       (and (equal (car nth4) (car method))
8879                            (equal (nth 1 nth4) (nth 1 method))))
8880                   gnus-use-cross-reference
8881                   (or (not (eq gnus-use-cross-reference t))
8882                       virtual
8883                       ;; Only do cross-references on subscribed
8884                       ;; groups, if that is what is wanted.
8885                       (<= (gnus-info-level info) gnus-level-subscribed))
8886                   (gnus-group-make-articles-read name idlist))))
8887          xref-hashtb)))))
8888
8889 (defun gnus-group-make-articles-read (group articles)
8890   (let* ((num 0)
8891          (entry (gnus-gethash group gnus-newsrc-hashtb))
8892          (info (nth 2 entry))
8893          (active (gnus-active group))
8894          range)
8895     ;; First peel off all illegal article numbers.
8896     (if active
8897         (let ((ids articles)
8898               id first)
8899           (while ids
8900             (setq id (car ids))
8901             (if (and first (> id (cdr active)))
8902                 (progn
8903                   ;; We'll end up in this situation in one particular
8904                   ;; obscure situation.  If you re-scan a group and get
8905                   ;; a new article that is cross-posted to a different
8906                   ;; group that has not been re-scanned, you might get
8907                   ;; crossposted article that has a higher number than
8908                   ;; Gnus believes possible.  So we re-activate this
8909                   ;; group as well.  This might mean doing the
8910                   ;; crossposting thingy will *increase* the number
8911                   ;; of articles in some groups.  Tsk, tsk.
8912                   (setq active (or (gnus-activate-group group) active))))
8913             (if (or (> id (cdr active))
8914                     (< id (car active)))
8915                 (setq articles (delq id articles)))
8916             (setq ids (cdr ids)))))
8917     ;; If the read list is nil, we init it.
8918     (and active
8919          (null (gnus-info-read info))
8920          (> (car active) 1)
8921          (gnus-info-set-read info (cons 1 (1- (car active)))))
8922     ;; Then we add the read articles to the range.
8923     (gnus-info-set-read
8924      info
8925      (setq range
8926            (gnus-add-to-range
8927             (gnus-info-read info) (setq articles (sort articles '<)))))
8928     ;; Then we have to re-compute how many unread
8929     ;; articles there are in this group.
8930     (if active
8931         (progn
8932           (cond
8933            ((not range)
8934             (setq num (- (1+ (cdr active)) (car active))))
8935            ((not (listp (cdr range)))
8936             (setq num (- (cdr active) (- (1+ (cdr range))
8937                                          (car range)))))
8938            (t
8939             (while range
8940               (if (numberp (car range))
8941                   (setq num (1+ num))
8942                 (setq num (+ num (- (1+ (cdar range)) (caar range)))))
8943               (setq range (cdr range)))
8944             (setq num (- (cdr active) num))))
8945           ;; Update the number of unread articles.
8946           (setcar entry num)
8947           ;; Update the group buffer.
8948           (gnus-group-update-group group t)))))
8949
8950 (defun gnus-methods-equal-p (m1 m2)
8951   (let ((m1 (or m1 gnus-select-method))
8952         (m2 (or m2 gnus-select-method)))
8953     (or (equal m1 m2)
8954         (and (eq (car m1) (car m2))
8955              (or (not (memq 'address (assoc (symbol-name (car m1))
8956                                             gnus-valid-select-methods)))
8957                  (equal (nth 1 m1) (nth 1 m2)))))))
8958
8959 (defsubst gnus-header-value ()
8960   (buffer-substring (match-end 0) (gnus-point-at-eol)))
8961
8962 (defvar gnus-newsgroup-none-id 0)
8963
8964 (defun gnus-get-newsgroup-headers (&optional dependencies force-new)
8965   (let ((cur nntp-server-buffer)
8966         (dependencies
8967          (or dependencies
8968              (save-excursion (set-buffer gnus-summary-buffer)
8969                              gnus-newsgroup-dependencies)))
8970         headers id id-dep ref-dep end ref)
8971     (save-excursion
8972       (set-buffer nntp-server-buffer)
8973       (let ((case-fold-search t)
8974             in-reply-to header p lines)
8975         (goto-char (point-min))
8976         ;; Search to the beginning of the next header.  Error messages
8977         ;; do not begin with 2 or 3.
8978         (while (re-search-forward "^[23][0-9]+ " nil t)
8979           (setq id nil
8980                 ref nil)
8981           ;; This implementation of this function, with nine
8982           ;; search-forwards instead of the one re-search-forward and
8983           ;; a case (which basically was the old function) is actually
8984           ;; about twice as fast, even though it looks messier.  You
8985           ;; can't have everything, I guess.  Speed and elegance
8986           ;; doesn't always go hand in hand.
8987           (setq
8988            header
8989            (vector
8990             ;; Number.
8991             (prog1
8992                 (read cur)
8993               (end-of-line)
8994               (setq p (point))
8995               (narrow-to-region (point)
8996                                 (or (and (search-forward "\n.\n" nil t)
8997                                          (- (point) 2))
8998                                     (point))))
8999             ;; Subject.
9000             (progn
9001               (goto-char p)
9002               (if (search-forward "\nsubject: " nil t)
9003                   (gnus-header-value) "(none)"))
9004             ;; From.
9005             (progn
9006               (goto-char p)
9007               (if (search-forward "\nfrom: " nil t)
9008                   (gnus-header-value) "(nobody)"))
9009             ;; Date.
9010             (progn
9011               (goto-char p)
9012               (if (search-forward "\ndate: " nil t)
9013                   (gnus-header-value) ""))
9014             ;; Message-ID.
9015             (progn
9016               (goto-char p)
9017               (if (search-forward "\nmessage-id: " nil t)
9018                   (setq id (gnus-header-value))
9019                 ;; If there was no message-id, we just fake one to make
9020                 ;; subsequent routines simpler.
9021                 (setq id (concat "none+"
9022                                  (int-to-string
9023                                   (setq gnus-newsgroup-none-id
9024                                         (1+ gnus-newsgroup-none-id)))))))
9025             ;; References.
9026             (progn
9027               (goto-char p)
9028               (if (search-forward "\nreferences: " nil t)
9029                   (prog1
9030                       (gnus-header-value)
9031                     (setq end (match-end 0))
9032                     (save-excursion
9033                       (setq ref
9034                             (buffer-substring
9035                              (progn
9036                                (end-of-line)
9037                                (search-backward ">" end t)
9038                                (1+ (point)))
9039                              (progn
9040                                (search-backward "<" end t)
9041                                (point))))))
9042                 ;; Get the references from the in-reply-to header if there
9043                 ;; were no references and the in-reply-to header looks
9044                 ;; promising.
9045                 (if (and (search-forward "\nin-reply-to: " nil t)
9046                          (setq in-reply-to (gnus-header-value))
9047                          (string-match "<[^>]+>" in-reply-to))
9048                     (setq ref (substring in-reply-to (match-beginning 0)
9049                                          (match-end 0)))
9050                   (setq ref ""))))
9051             ;; Chars.
9052             0
9053             ;; Lines.
9054             (progn
9055               (goto-char p)
9056               (if (search-forward "\nlines: " nil t)
9057                   (if (numberp (setq lines (read cur)))
9058                       lines 0)
9059                 0))
9060             ;; Xref.
9061             (progn
9062               (goto-char p)
9063               (and (search-forward "\nxref: " nil t)
9064                    (gnus-header-value)))))
9065           ;; We do the threading while we read the headers.  The
9066           ;; message-id and the last reference are both entered into
9067           ;; the same hash table.  Some tippy-toeing around has to be
9068           ;; done in case an article has arrived before the article
9069           ;; which it refers to.
9070           (if (boundp (setq id-dep (intern id dependencies)))
9071               (if (and (car (symbol-value id-dep))
9072                        (not force-new))
9073                   ;; An article with this Message-ID has already
9074                   ;; been seen, so we ignore this one, except we add
9075                   ;; any additional Xrefs (in case the two articles
9076                   ;; came from different servers).
9077                   (progn
9078                     (mail-header-set-xref
9079                      (car (symbol-value id-dep))
9080                      (concat (or (mail-header-xref
9081                                   (car (symbol-value id-dep))) "")
9082                              (or (mail-header-xref header) "")))
9083                     (setq header nil))
9084                 (setcar (symbol-value id-dep) header))
9085             (set id-dep (list header)))
9086           (when header
9087             (if (boundp (setq ref-dep (intern ref dependencies)))
9088                 (setcdr (symbol-value ref-dep)
9089                         (nconc (cdr (symbol-value ref-dep))
9090                                (list (symbol-value id-dep))))
9091               (set ref-dep (list nil (symbol-value id-dep))))
9092             (setq headers (cons header headers)))
9093           (goto-char (point-max))
9094           (widen))
9095         (nreverse headers)))))
9096
9097 ;; The following macros and functions were written by Felix Lee
9098 ;; <flee@cse.psu.edu>.
9099
9100 (defmacro gnus-nov-read-integer ()
9101   '(prog1
9102        (if (= (following-char) ?\t)
9103            0
9104          (let ((num (condition-case nil (read buffer) (error nil))))
9105            (if (numberp num) num 0)))
9106      (or (eobp) (forward-char 1))))
9107
9108 (defmacro gnus-nov-skip-field ()
9109   '(search-forward "\t" eol 'move))
9110
9111 (defmacro gnus-nov-field ()
9112   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
9113
9114 ;; Goes through the xover lines and returns a list of vectors
9115 (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new)
9116   "Parse the news overview data in the server buffer, and return a
9117 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
9118   ;; Get the Xref when the users reads the articles since most/some
9119   ;; NNTP servers do not include Xrefs when using XOVER.
9120   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
9121   (let ((cur nntp-server-buffer)
9122         (dependencies gnus-newsgroup-dependencies)
9123         number headers header)
9124     (save-excursion
9125       (set-buffer nntp-server-buffer)
9126       ;; Allow the user to mangle the headers before parsing them.
9127       (run-hooks 'gnus-parse-headers-hook)
9128       ;; Allow the user to mangle the headers before parsing them.
9129       (run-hooks 'gnus-parse-headers-hook)
9130       (goto-char (point-min))
9131       (while (and sequence (not (eobp)))
9132         (setq number (read cur))
9133         (while (and sequence (< (car sequence) number))
9134           (setq sequence (cdr sequence)))
9135         (and sequence
9136              (eq number (car sequence))
9137              (progn
9138                (setq sequence (cdr sequence))
9139                (if (setq header
9140                          (inline (gnus-nov-parse-line
9141                                   number dependencies force-new)))
9142                    (setq headers (cons header headers)))))
9143         (forward-line 1))
9144       (setq headers (nreverse headers)))
9145     headers))
9146
9147 ;; This function has to be called with point after the article number
9148 ;; on the beginning of the line.
9149 (defun gnus-nov-parse-line (number dependencies &optional force-new)
9150   (let ((none 0)
9151         (eol (gnus-point-at-eol))
9152         (buffer (current-buffer))
9153         header ref id id-dep ref-dep)
9154
9155     ;; overview: [num subject from date id refs chars lines misc]
9156     (narrow-to-region (point) eol)
9157     (or (eobp) (forward-char))
9158
9159     (condition-case nil
9160         (setq header
9161               (vector
9162                number                   ; number
9163                (gnus-nov-field)         ; subject
9164                (gnus-nov-field)         ; from
9165                (gnus-nov-field)         ; date
9166                (setq id (or (gnus-nov-field)
9167                             (concat "none+"
9168                                     (int-to-string
9169                                      (setq none (1+ none)))))) ; id
9170                (progn
9171                  (save-excursion
9172                    (let ((beg (point)))
9173                      (search-forward "\t" eol)
9174                      (if (search-backward ">" beg t)
9175                          (setq ref
9176                                (buffer-substring
9177                                 (1+ (point))
9178                                 (search-backward "<" beg t)))
9179                        (setq ref nil))))
9180                  (gnus-nov-field))      ; refs
9181                (gnus-nov-read-integer)  ; chars
9182                (gnus-nov-read-integer)  ; lines
9183                (if (= (following-char) ?\n)
9184                    nil
9185                  (gnus-nov-field))      ; misc
9186                ))
9187       (error (progn
9188                (ding)
9189                (gnus-message 4 "Strange nov line")
9190                (setq header nil)
9191                (goto-char eol))))
9192
9193     (widen)
9194
9195     ;; We build the thread tree.
9196     (when header
9197       (if (boundp (setq id-dep (intern id dependencies)))
9198           (if (and (car (symbol-value id-dep))
9199                    (not force-new))
9200               ;; An article with this Message-ID has already been seen,
9201               ;; so we ignore this one, except we add any additional
9202               ;; Xrefs (in case the two articles came from different
9203               ;; servers.
9204               (progn
9205                 (mail-header-set-xref
9206                  (car (symbol-value id-dep))
9207                  (concat (or (mail-header-xref
9208                               (car (symbol-value id-dep))) "")
9209                          (or (mail-header-xref header) "")))
9210                 (setq header nil))
9211             (setcar (symbol-value id-dep) header))
9212         (set id-dep (list header))))
9213     (if header
9214         (progn
9215           (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
9216               (setcdr (symbol-value ref-dep)
9217                       (nconc (cdr (symbol-value ref-dep))
9218                              (list (symbol-value id-dep))))
9219             (set ref-dep (list nil (symbol-value id-dep))))))
9220     header))
9221
9222 (defun gnus-article-get-xrefs ()
9223   "Fill in the Xref value in `gnus-current-headers', if necessary.
9224 This is meant to be called in `gnus-article-internal-prepare-hook'."
9225   (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
9226                                  gnus-current-headers)))
9227     (or (not gnus-use-cross-reference)
9228         (not headers)
9229         (and (mail-header-xref headers)
9230              (not (string= (mail-header-xref headers) "")))
9231         (let ((case-fold-search t)
9232               xref)
9233           (save-restriction
9234             (nnheader-narrow-to-headers)
9235             (goto-char (point-min))
9236             (if (or (and (eq (downcase (following-char)) ?x)
9237                          (looking-at "Xref:"))
9238                     (search-forward "\nXref:" nil t))
9239                 (progn
9240                   (goto-char (1+ (match-end 0)))
9241                   (setq xref (buffer-substring (point)
9242                                                (progn (end-of-line) (point))))
9243                   (mail-header-set-xref headers xref))))))))
9244
9245 (defun gnus-summary-insert-subject (id &optional old-header)
9246   "Find article ID and insert the summary line for that article."
9247   (let ((header (gnus-read-header id))
9248         (number (and (numberp id) id))
9249         pos)
9250     (when header
9251       ;; Rebuild the thread that this article is part of and go to the
9252       ;; article we have fetched.
9253       (when old-header
9254         (when (setq pos (text-property-any
9255                          (point-min) (point-max) 'gnus-number 
9256                          (mail-header-number old-header)))
9257           (goto-char pos)
9258           (gnus-delete-line)
9259           (gnus-data-remove (mail-header-number old-header))))
9260       (gnus-rebuild-thread (mail-header-id header))
9261       (gnus-summary-goto-subject (setq number (mail-header-number header))))
9262     (when (and (numberp number)
9263                (> number 0))
9264       ;; We have to update the boundaries even if we can't fetch the
9265       ;; article if ID is a number -- so that the next `P' or `N'
9266       ;; command will fetch the previous (or next) article even
9267       ;; if the one we tried to fetch this time has been canceled.
9268       (and (> number gnus-newsgroup-end)
9269            (setq gnus-newsgroup-end number))
9270       (and (< number gnus-newsgroup-begin)
9271            (setq gnus-newsgroup-begin number))
9272       (setq gnus-newsgroup-unselected
9273             (delq number gnus-newsgroup-unselected)))
9274     ;; Report back a success?
9275     (and header (mail-header-number header))))
9276
9277 (defun gnus-summary-work-articles (n)
9278   "Return a list of articles to be worked upon.  The prefix argument,
9279 the list of process marked articles, and the current article will be
9280 taken into consideration."
9281   (cond
9282    ((and n (numberp n))
9283     ;; A numerical prefix has been given.
9284     (let ((backward (< n 0))
9285           (n (abs n))
9286           articles article)
9287       (save-excursion
9288         (while
9289             (and (> n 0)
9290                  (push (setq article (gnus-summary-article-number))
9291                        articles)
9292                  (if backward
9293                      (gnus-summary-find-prev nil article)
9294                    (gnus-summary-find-next nil article)))
9295           (decf n)))
9296       (nreverse articles)))
9297    ((and (boundp 'transient-mark-mode)
9298          transient-mark-mode
9299          mark-active)
9300     ;; Work on the region between point and mark.
9301     (let ((max (max (point) (mark)))
9302           articles article)
9303       (save-excursion
9304         (goto-char (min (point) (mark)))
9305         (while
9306             (and
9307              (push (setq article (gnus-summary-article-number)) articles)
9308              (gnus-summary-find-next nil article)
9309              (< (point) max)))
9310         (nreverse articles))))
9311    (gnus-newsgroup-processable
9312     ;; There are process-marked articles present.
9313     (reverse gnus-newsgroup-processable))
9314    (t
9315     ;; Just return the current article.
9316     (list (gnus-summary-article-number)))))
9317
9318 (defun gnus-summary-search-group (&optional backward use-level)
9319   "Search for next unread newsgroup.
9320 If optional argument BACKWARD is non-nil, search backward instead."
9321   (save-excursion
9322     (set-buffer gnus-group-buffer)
9323     (if (gnus-group-search-forward
9324          backward nil (if use-level (gnus-group-group-level) nil))
9325         (gnus-group-group-name))))
9326
9327 (defun gnus-summary-best-group (&optional exclude-group)
9328   "Find the name of the best unread group.
9329 If EXCLUDE-GROUP, do not go to this group."
9330   (save-excursion
9331     (set-buffer gnus-group-buffer)
9332     (save-excursion
9333       (gnus-group-best-unread-group exclude-group))))
9334
9335 (defun gnus-summary-find-next (&optional unread article backward)
9336   (if backward (gnus-summary-find-prev)
9337     (let* ((article (or article (gnus-summary-article-number)))
9338            (arts (gnus-data-find-list article))
9339            result)
9340       (when (or (not gnus-summary-check-current)
9341                 (not unread)
9342                 (not (gnus-data-unread-p (car arts))))
9343         (setq arts (cdr arts)))
9344       (when (setq result
9345                   (if unread
9346                       (progn
9347                         (while arts
9348                           (when (gnus-data-unread-p (car arts))
9349                             (setq result (car arts)
9350                                   arts nil))
9351                           (setq arts (cdr arts)))
9352                         result)
9353                     (car arts)))
9354         (goto-char (gnus-data-pos result))
9355         (gnus-data-number result)))))
9356
9357 (defun gnus-summary-find-prev (&optional unread article)
9358   (let* ((article (or article (gnus-summary-article-number)))
9359          (arts (gnus-data-find-list article (gnus-data-list 'rev)))
9360          result)
9361     (when (or (not gnus-summary-check-current)
9362               (not unread)
9363               (not (gnus-data-unread-p (car arts))))
9364       (setq arts (cdr arts)))
9365     (if (setq result
9366               (if unread
9367                   (progn
9368                     (while arts
9369                       (and (gnus-data-unread-p (car arts))
9370                            (setq result (car arts)
9371                                  arts nil))
9372                       (setq arts (cdr arts)))
9373                     result)
9374                 (car arts)))
9375         (progn
9376           (goto-char (gnus-data-pos result))
9377           (gnus-data-number result)))))
9378
9379 (defun gnus-summary-find-subject (subject &optional unread backward article)
9380   (let* ((simp-subject (gnus-simplify-subject-fully subject))
9381          (article (or article (gnus-summary-article-number)))
9382          (articles (gnus-data-list backward))
9383          (arts (gnus-data-find-list article articles))
9384          result)
9385     (when (or (not gnus-summary-check-current)
9386               (not unread)
9387               (not (gnus-data-unread-p (car arts))))
9388       (setq arts (cdr arts)))
9389     (while arts
9390       (and (or (not unread)
9391                (gnus-data-unread-p (car arts)))
9392            (vectorp (gnus-data-header (car arts)))
9393            (gnus-subject-equal
9394             simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
9395            (setq result (car arts)
9396                  arts nil))
9397       (setq arts (cdr arts)))
9398     (and result
9399          (goto-char (gnus-data-pos result))
9400          (gnus-data-number result))))
9401
9402 (defun gnus-summary-search-forward (&optional unread subject backward)
9403   "Search forward for an article.
9404 If UNREAD, look for unread articles.  If SUBJECT, look for
9405 articles with that subject.  If BACKWARD, search backward instead."
9406   (cond (subject (gnus-summary-find-subject subject unread backward))
9407         (backward (gnus-summary-find-prev unread))
9408         (t (gnus-summary-find-next unread))))
9409
9410 (defun gnus-recenter (&optional n)
9411   "Center point in window and redisplay frame.
9412 Also do horizontal recentering."
9413   (interactive "P")
9414   (when (and gnus-auto-center-summary
9415              (not (eq gnus-auto-center-summary 'vertical)))
9416     (gnus-horizontal-recenter))
9417   (recenter n))
9418
9419 (defun gnus-summary-recenter ()
9420   "Center point in the summary window.
9421 If `gnus-auto-center-summary' is nil, or the article buffer isn't
9422 displayed, no centering will be performed."
9423   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
9424   ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
9425   (let* ((top (cond ((< (window-height) 4) 0)
9426                     ((< (window-height) 7) 1)
9427                     (t 2)))
9428          (height (1- (window-height)))
9429          (bottom (save-excursion (goto-char (point-max))
9430                                  (forward-line (- height))
9431                                  (point)))
9432          (window (get-buffer-window (current-buffer))))
9433     ;; The user has to want it.
9434     (when gnus-auto-center-summary
9435       (when (get-buffer-window gnus-article-buffer)
9436        ;; Only do recentering when the article buffer is displayed,
9437        ;; Set the window start to either `bottom', which is the biggest
9438        ;; possible valid number, or the second line from the top,
9439        ;; whichever is the least.
9440        (set-window-start
9441         window (min bottom (save-excursion 
9442                              (forward-line (- top)) (point)))))
9443       ;; Do horizontal recentering while we're at it.
9444       (when (and (get-buffer-window (current-buffer) t)
9445                  (not (eq gnus-auto-center-summary 'vertical)))
9446         (let ((selected (selected-window)))
9447           (select-window (get-buffer-window (current-buffer) t))
9448           (gnus-summary-position-point)
9449           (gnus-horizontal-recenter)
9450           (select-window selected))))))
9451
9452 (defun gnus-horizontal-recenter ()
9453   "Recenter the current buffer horizontally."
9454   (if (< (current-column) (/ (window-width) 2))
9455       (set-window-hscroll (get-buffer-window (current-buffer) t) 0)
9456     (let* ((orig (point))
9457            (end (window-end (get-buffer-window (current-buffer) t)))
9458            (max 0))
9459       ;; Find the longest line currently displayed in the window.
9460       (goto-char (window-start))
9461       (while (and (not (eobp)) 
9462                   (< (point) end))
9463         (end-of-line)
9464         (setq max (max max (current-column)))
9465         (forward-line 1))
9466       (goto-char orig)
9467       ;; Scroll horizontally to center (sort of) the point.
9468       (if (> max (window-width))
9469           (set-window-hscroll 
9470            (get-buffer-window (current-buffer) t)
9471            (min (- (current-column) (/ (window-width) 3))
9472                 (+ 2 (- max (window-width)))))
9473         (set-window-hscroll (get-buffer-window (current-buffer) t) 0))
9474       max)))
9475
9476 ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
9477 (defun gnus-short-group-name (group &optional levels)
9478   "Collapse GROUP name LEVELS."
9479   (let* ((name "") 
9480          (foreign "")
9481          (depth 0) 
9482          (skip 1)
9483          (levels (or levels
9484                      (progn
9485                        (while (string-match "\\." group skip)
9486                          (setq skip (match-end 0)
9487                                depth (+ depth 1)))
9488                        depth))))
9489     (if (string-match ":" group)
9490         (setq foreign (substring group 0 (match-end 0))
9491               group (substring group (match-end 0))))
9492     (while group
9493       (if (and (string-match "\\." group)
9494                (> levels (- gnus-group-uncollapsed-levels 1)))
9495           (setq name (concat name (substring group 0 1))
9496                 group (substring group (match-end 0))
9497                 levels (- levels 1)
9498                 name (concat name "."))
9499         (setq name (concat foreign name group)
9500               group nil)))
9501     name))
9502
9503 (defun gnus-summary-jump-to-group (newsgroup)
9504   "Move point to NEWSGROUP in group mode buffer."
9505   ;; Keep update point of group mode buffer if visible.
9506   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
9507       (save-window-excursion
9508         ;; Take care of tree window mode.
9509         (if (get-buffer-window gnus-group-buffer)
9510             (pop-to-buffer gnus-group-buffer))
9511         (gnus-group-jump-to-group newsgroup))
9512     (save-excursion
9513       ;; Take care of tree window mode.
9514       (if (get-buffer-window gnus-group-buffer)
9515           (pop-to-buffer gnus-group-buffer)
9516         (set-buffer gnus-group-buffer))
9517       (gnus-group-jump-to-group newsgroup))))
9518
9519 ;; This function returns a list of article numbers based on the
9520 ;; difference between the ranges of read articles in this group and
9521 ;; the range of active articles.
9522 (defun gnus-list-of-unread-articles (group)
9523   (let* ((read (gnus-info-read (gnus-get-info group)))
9524          (active (gnus-active group))
9525          (last (cdr active))
9526          first nlast unread)
9527     ;; If none are read, then all are unread.
9528     (if (not read)
9529         (setq first (car active))
9530       ;; If the range of read articles is a single range, then the
9531       ;; first unread article is the article after the last read
9532       ;; article.  Sounds logical, doesn't it?
9533       (if (not (listp (cdr read)))
9534           (setq first (1+ (cdr read)))
9535         ;; `read' is a list of ranges.
9536         (if (/= (setq nlast (or (and (numberp (car read)) (car read))
9537                                 (caar read))) 1)
9538             (setq first 1))
9539         (while read
9540           (if first
9541               (while (< first nlast)
9542                 (setq unread (cons first unread))
9543                 (setq first (1+ first))))
9544           (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
9545           (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
9546           (setq read (cdr read)))))
9547     ;; And add the last unread articles.
9548     (while (<= first last)
9549       (setq unread (cons first unread))
9550       (setq first (1+ first)))
9551     ;; Return the list of unread articles.
9552     (nreverse unread)))
9553
9554 (defun gnus-list-of-read-articles (group)
9555   "Return a list of unread, unticked and non-dormant articles."
9556   (let* ((info (gnus-get-info group))
9557          (marked (gnus-info-marks info))
9558          (active (gnus-active group)))
9559     (and info active
9560          (gnus-set-difference
9561           (gnus-sorted-complement
9562            (gnus-uncompress-range active)
9563            (gnus-list-of-unread-articles group))
9564           (append
9565            (gnus-uncompress-range (cdr (assq 'dormant marked)))
9566            (gnus-uncompress-range (cdr (assq 'tick marked))))))))
9567
9568 ;; Various summary commands
9569
9570 (defun gnus-summary-universal-argument (arg)
9571   "Perform any operation on all articles that are process/prefixed."
9572   (interactive "P")
9573   (gnus-set-global-variables)
9574   (let ((articles (gnus-summary-work-articles arg))
9575         func article)
9576     (if (eq
9577          (setq
9578           func
9579           (key-binding
9580            (read-key-sequence
9581             (substitute-command-keys
9582              "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
9583              ))))
9584          'undefined)
9585         (progn
9586           (message "Undefined key")
9587           (ding))
9588       (save-excursion
9589         (while articles
9590           (gnus-summary-goto-subject (setq article (pop articles)))
9591           (command-execute func)
9592           (gnus-summary-remove-process-mark article)))))
9593   (gnus-summary-position-point))
9594
9595 (defun gnus-summary-toggle-truncation (&optional arg)
9596   "Toggle truncation of summary lines.
9597 With arg, turn line truncation on iff arg is positive."
9598   (interactive "P")
9599   (setq truncate-lines
9600         (if (null arg) (not truncate-lines)
9601           (> (prefix-numeric-value arg) 0)))
9602   (redraw-display))
9603
9604 (defun gnus-summary-reselect-current-group (&optional all rescan)
9605   "Exit and then reselect the current newsgroup.
9606 The prefix argument ALL means to select all articles."
9607   (interactive "P")
9608   (gnus-set-global-variables)
9609   (let ((current-subject (gnus-summary-article-number))
9610         (group gnus-newsgroup-name))
9611     (setq gnus-newsgroup-begin nil)
9612     (gnus-summary-exit)
9613     ;; We have to adjust the point of group mode buffer because the
9614     ;; current point was moved to the next unread newsgroup by
9615     ;; exiting.
9616     (gnus-summary-jump-to-group group)
9617     (when rescan
9618       (save-excursion
9619         (gnus-group-get-new-news-this-group 1)))
9620     (gnus-group-read-group all t)
9621     (gnus-summary-goto-subject current-subject)))
9622
9623 (defun gnus-summary-rescan-group (&optional all)
9624   "Exit the newsgroup, ask for new articles, and select the newsgroup."
9625   (interactive "P")
9626   (gnus-summary-reselect-current-group all t))
9627
9628 (defun gnus-summary-update-info ()
9629   (let* ((group gnus-newsgroup-name))
9630     (when gnus-newsgroup-kill-headers
9631       (setq gnus-newsgroup-killed
9632             (gnus-compress-sequence
9633              (nconc
9634               (gnus-set-sorted-intersection
9635                (gnus-uncompress-range gnus-newsgroup-killed)
9636                (setq gnus-newsgroup-unselected
9637                      (sort gnus-newsgroup-unselected '<)))
9638               (setq gnus-newsgroup-unreads
9639                     (sort gnus-newsgroup-unreads '<))) t)))
9640     (unless (listp (cdr gnus-newsgroup-killed))
9641       (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
9642     (let ((headers gnus-newsgroup-headers))
9643       (run-hooks 'gnus-exit-group-hook)
9644       (unless gnus-save-score
9645         (setq gnus-newsgroup-scored nil))
9646       ;; Set the new ranges of read articles.
9647       (gnus-update-read-articles
9648        group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
9649       ;; Set the current article marks.
9650       (gnus-update-marks)
9651       ;; Do the cross-ref thing.
9652       (when gnus-use-cross-reference
9653         (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
9654       ;; Do adaptive scoring, and possibly save score files.
9655       (when gnus-newsgroup-adaptive
9656         (gnus-score-adaptive))
9657       (when gnus-use-scoring
9658         (gnus-score-save))
9659       ;; Do not switch windows but change the buffer to work.
9660       (set-buffer gnus-group-buffer)
9661       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
9662           (gnus-group-update-group group)))))
9663
9664 (defun gnus-summary-exit (&optional temporary)
9665   "Exit reading current newsgroup, and then return to group selection mode.
9666 gnus-exit-group-hook is called with no arguments if that value is non-nil."
9667   (interactive)
9668   (gnus-set-global-variables)
9669   (gnus-kill-save-kill-buffer)
9670   (let* ((group gnus-newsgroup-name)
9671          (quit-config (gnus-group-quit-config gnus-newsgroup-name))
9672          (mode major-mode)
9673          (buf (current-buffer)))
9674     (unless temporary
9675       (run-hooks 'gnus-summary-prepare-exit-hook))
9676     ;; If we have several article buffers, we kill them at exit.
9677     (unless gnus-single-article-buffer
9678       (gnus-kill-buffer gnus-article-buffer)
9679       (gnus-kill-buffer gnus-original-article-buffer)
9680       (setq gnus-article-current nil))
9681     (when gnus-use-cache
9682       (gnus-cache-possibly-remove-articles)
9683       (gnus-cache-save-buffers))
9684     (when gnus-use-trees
9685       (gnus-tree-close group))
9686     ;; Make all changes in this group permanent.
9687     (unless quit-config
9688       (gnus-summary-update-info))
9689     (gnus-close-group group)
9690     ;; Make sure where I was, and go to next newsgroup.
9691     (set-buffer gnus-group-buffer)
9692     (unless quit-config
9693       (gnus-group-jump-to-group group)
9694       (gnus-group-next-unread-group 1))
9695     (run-hooks 'gnus-summary-exit-hook)
9696     (unless gnus-single-article-buffer
9697       (setq gnus-article-current nil))
9698     (if temporary
9699         nil                             ;Nothing to do.
9700       ;; If we have several article buffers, we kill them at exit.
9701       (unless gnus-single-article-buffer
9702         (gnus-kill-buffer gnus-article-buffer)
9703         (gnus-kill-buffer gnus-original-article-buffer)
9704         (setq gnus-article-current nil))
9705       (set-buffer buf)
9706       (if (not gnus-kill-summary-on-exit)
9707           (gnus-deaden-summary)
9708         ;; We set all buffer-local variables to nil.  It is unclear why
9709         ;; this is needed, but if we don't, buffer-local variables are
9710         ;; not garbage-collected, it seems.  This would the lead to en
9711         ;; ever-growing Emacs.
9712         (gnus-summary-clear-local-variables)
9713         (when (get-buffer gnus-article-buffer)
9714           (bury-buffer gnus-article-buffer))
9715         ;; We clear the global counterparts of the buffer-local
9716         ;; variables as well, just to be on the safe side.
9717         (gnus-configure-windows 'group 'force)
9718         (gnus-summary-clear-local-variables)
9719         ;; Return to group mode buffer.
9720         (if (eq mode 'gnus-summary-mode)
9721             (gnus-kill-buffer buf)))
9722       (setq gnus-current-select-method gnus-select-method)
9723       (pop-to-buffer gnus-group-buffer)
9724       ;; Clear the current group name.
9725       (if (not quit-config)
9726           (progn
9727             (gnus-group-jump-to-group group)
9728             (gnus-group-next-unread-group 1)
9729             (gnus-configure-windows 'group 'force))
9730         (if (not (buffer-name (car quit-config)))
9731             (gnus-configure-windows 'group 'force)
9732           (set-buffer (car quit-config))
9733           (and (eq major-mode 'gnus-summary-mode)
9734                (gnus-set-global-variables))
9735           (gnus-configure-windows (cdr quit-config))))
9736       (unless quit-config
9737         (setq gnus-newsgroup-name nil)))))
9738
9739 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
9740 (defun gnus-summary-exit-no-update (&optional no-questions)
9741   "Quit reading current newsgroup without updating read article info."
9742   (interactive)
9743   (gnus-set-global-variables)
9744   (let* ((group gnus-newsgroup-name)
9745          (quit-config (gnus-group-quit-config group)))
9746     (when (or no-questions
9747               gnus-expert-user
9748               (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
9749       ;; If we have several article buffers, we kill them at exit.
9750       (unless gnus-single-article-buffer
9751         (gnus-kill-buffer gnus-article-buffer)
9752         (gnus-kill-buffer gnus-original-article-buffer)
9753         (setq gnus-article-current nil))
9754       (if (not gnus-kill-summary-on-exit)
9755           (gnus-deaden-summary)
9756         (gnus-close-group group)
9757         (gnus-summary-clear-local-variables)
9758         (set-buffer gnus-group-buffer)
9759         (gnus-summary-clear-local-variables)
9760         (when (get-buffer gnus-summary-buffer)
9761           (kill-buffer gnus-summary-buffer)))
9762       (unless gnus-single-article-buffer
9763         (setq gnus-article-current nil))
9764       (when gnus-use-trees
9765         (gnus-tree-close group))
9766       (when (get-buffer gnus-article-buffer)
9767         (bury-buffer gnus-article-buffer))
9768       ;; Return to the group buffer.
9769       (gnus-configure-windows 'group 'force)
9770       ;; Clear the current group name.
9771       (setq gnus-newsgroup-name nil)
9772       (when (equal (gnus-group-group-name) group)
9773         (gnus-group-next-unread-group 1))
9774       (when quit-config
9775         (if (not (buffer-name (car quit-config)))
9776             (gnus-configure-windows 'group 'force)
9777           (set-buffer (car quit-config))
9778           (when (eq major-mode 'gnus-summary-mode)
9779             (gnus-set-global-variables))
9780           (gnus-configure-windows (cdr quit-config)))))))
9781
9782 ;;; Dead summaries.
9783
9784 (defvar gnus-dead-summary-mode-map nil)
9785
9786 (if gnus-dead-summary-mode-map
9787     nil
9788   (setq gnus-dead-summary-mode-map (make-keymap))
9789   (suppress-keymap gnus-dead-summary-mode-map)
9790   (substitute-key-definition
9791    'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
9792   (let ((keys '("\C-d" "\r" "\177")))
9793     (while keys
9794       (define-key gnus-dead-summary-mode-map
9795         (pop keys) 'gnus-summary-wake-up-the-dead))))
9796
9797 (defvar gnus-dead-summary-mode nil
9798   "Minor mode for Gnus summary buffers.")
9799
9800 (defun gnus-dead-summary-mode (&optional arg)
9801   "Minor mode for Gnus summary buffers."
9802   (interactive "P")
9803   (when (eq major-mode 'gnus-summary-mode)
9804     (make-local-variable 'gnus-dead-summary-mode)
9805     (setq gnus-dead-summary-mode
9806           (if (null arg) (not gnus-dead-summary-mode)
9807             (> (prefix-numeric-value arg) 0)))
9808     (when gnus-dead-summary-mode
9809       (unless (assq 'gnus-dead-summary-mode minor-mode-alist)
9810         (push '(gnus-dead-summary-mode " Dead") minor-mode-alist))
9811       (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist)
9812         (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map)
9813               minor-mode-map-alist)))))
9814
9815 (defun gnus-deaden-summary ()
9816   "Make the current summary buffer into a dead summary buffer."
9817   ;; Kill any previous dead summary buffer.
9818   (when (and gnus-dead-summary
9819              (buffer-name gnus-dead-summary))
9820     (save-excursion
9821       (set-buffer gnus-dead-summary)
9822       (when gnus-dead-summary-mode
9823         (kill-buffer (current-buffer)))))
9824   ;; Make this the current dead summary.
9825   (setq gnus-dead-summary (current-buffer))
9826   (gnus-dead-summary-mode 1)
9827   (let ((name (buffer-name)))
9828     (when (string-match "Summary" name)
9829       (rename-buffer
9830        (concat (substring name 0 (match-beginning 0)) "Dead "
9831                (substring name (match-beginning 0))) t))))
9832
9833 (defun gnus-kill-or-deaden-summary (buffer)
9834   "Kill or deaden the summary BUFFER."
9835   (cond (gnus-kill-summary-on-exit
9836          (when (and gnus-use-trees
9837                     (and (get-buffer buffer)
9838                          (buffer-name (get-buffer buffer))))
9839            (save-excursion
9840              (set-buffer (get-buffer buffer))
9841              (gnus-tree-close gnus-newsgroup-name)))
9842          (gnus-kill-buffer buffer))
9843         ((and (get-buffer buffer)
9844               (buffer-name (get-buffer buffer)))
9845          (save-excursion
9846            (set-buffer buffer)
9847            (gnus-deaden-summary)))))
9848
9849 (defun gnus-summary-wake-up-the-dead (&rest args)
9850   "Wake up the dead summary buffer."
9851   (interactive)
9852   (gnus-dead-summary-mode -1)
9853   (let ((name (buffer-name)))
9854     (when (string-match "Dead " name)
9855       (rename-buffer
9856        (concat (substring name 0 (match-beginning 0))
9857                (substring name (match-end 0))) t)))
9858   (gnus-message 3 "This dead summary is now alive again"))
9859
9860 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
9861 (defun gnus-summary-fetch-faq (&optional faq-dir)
9862   "Fetch the FAQ for the current group.
9863 If FAQ-DIR (the prefix), prompt for a directory to search for the faq
9864 in."
9865   (interactive
9866    (list
9867     (if current-prefix-arg
9868         (completing-read
9869          "Faq dir: " (and (listp gnus-group-faq-directory)
9870                           gnus-group-faq-directory)))))
9871   (let (gnus-faq-buffer)
9872     (and (setq gnus-faq-buffer
9873                (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
9874          (gnus-configure-windows 'summary-faq))))
9875
9876 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
9877 (defun gnus-summary-describe-group (&optional force)
9878   "Describe the current newsgroup."
9879   (interactive "P")
9880   (gnus-group-describe-group force gnus-newsgroup-name))
9881
9882 (defun gnus-summary-describe-briefly ()
9883   "Describe summary mode commands briefly."
9884   (interactive)
9885   (gnus-message 6
9886                 (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")))
9887
9888 ;; Walking around group mode buffer from summary mode.
9889
9890 (defun gnus-summary-next-group (&optional no-article target-group backward)
9891   "Exit current newsgroup and then select next unread newsgroup.
9892 If prefix argument NO-ARTICLE is non-nil, no article is selected
9893 initially.  If NEXT-GROUP, go to this group.  If BACKWARD, go to
9894 previous group instead."
9895   (interactive "P")
9896   (gnus-set-global-variables)
9897   (let ((current-group gnus-newsgroup-name)
9898         (current-buffer (current-buffer))
9899         entered)
9900     ;; First we semi-exit this group to update Xrefs and all variables.
9901     ;; We can't do a real exit, because the window conf must remain
9902     ;; the same in case the user is prompted for info, and we don't
9903     ;; want the window conf to change before that...
9904     (gnus-summary-exit t)
9905     (while (not entered)
9906       ;; Then we find what group we are supposed to enter.
9907       (set-buffer gnus-group-buffer)
9908       (gnus-group-jump-to-group current-group)
9909       (setq target-group
9910             (or target-group
9911                 (if (eq gnus-keep-same-level 'best)
9912                     (gnus-summary-best-group gnus-newsgroup-name)
9913                   (gnus-summary-search-group backward gnus-keep-same-level))))
9914       (if (not target-group)
9915           ;; There are no further groups, so we return to the group
9916           ;; buffer.
9917           (progn
9918             (gnus-message 5 "Returning to the group buffer")
9919             (setq entered t)
9920             (set-buffer current-buffer)
9921             (gnus-summary-exit))
9922         ;; We try to enter the target group.
9923         (gnus-group-jump-to-group target-group)
9924         (let ((unreads (gnus-group-group-unread)))
9925           (if (and (or (eq t unreads)
9926                        (and unreads (not (zerop unreads))))
9927                    (gnus-summary-read-group
9928                     target-group nil no-article current-buffer))
9929               (setq entered t)
9930             (setq current-group target-group
9931                   target-group nil)))))))
9932
9933 (defun gnus-summary-prev-group (&optional no-article)
9934   "Exit current newsgroup and then select previous unread newsgroup.
9935 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
9936   (interactive "P")
9937   (gnus-summary-next-group no-article nil t))
9938
9939 ;; Walking around summary lines.
9940
9941 (defun gnus-summary-first-subject (&optional unread)
9942   "Go to the first unread subject.
9943 If UNREAD is non-nil, go to the first unread article.
9944 Returns the article selected or nil if there are no unread articles."
9945   (interactive "P")
9946   (prog1
9947       (cond
9948        ;; Empty summary.
9949        ((null gnus-newsgroup-data)
9950         (gnus-message 3 "No articles in the group")
9951         nil)
9952        ;; Pick the first article.
9953        ((not unread)
9954         (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
9955         (gnus-data-number (car gnus-newsgroup-data)))
9956        ;; No unread articles.
9957        ((null gnus-newsgroup-unreads)
9958         (gnus-message 3 "No more unread articles")
9959         nil)
9960        ;; Find the first unread article.
9961        (t
9962         (let ((data gnus-newsgroup-data))
9963           (while (and data
9964                       (not (gnus-data-unread-p (car data))))
9965             (setq data (cdr data)))
9966           (if data
9967               (progn
9968                 (goto-char (gnus-data-pos (car data)))
9969                 (gnus-data-number (car data)))))))
9970     (gnus-summary-position-point)))
9971
9972 (defun gnus-summary-next-subject (n &optional unread dont-display)
9973   "Go to next N'th summary line.
9974 If N is negative, go to the previous N'th subject line.
9975 If UNREAD is non-nil, only unread articles are selected.
9976 The difference between N and the actual number of steps taken is
9977 returned."
9978   (interactive "p")
9979   (let ((backward (< n 0))
9980         (n (abs n)))
9981     (while (and (> n 0)
9982                 (if backward
9983                     (gnus-summary-find-prev unread)
9984                   (gnus-summary-find-next unread)))
9985       (setq n (1- n)))
9986     (if (/= 0 n) (gnus-message 7 "No more%s articles"
9987                                (if unread " unread" "")))
9988     (unless dont-display
9989       (gnus-summary-recenter)
9990       (gnus-summary-position-point))
9991     n))
9992
9993 (defun gnus-summary-next-unread-subject (n)
9994   "Go to next N'th unread summary line."
9995   (interactive "p")
9996   (gnus-summary-next-subject n t))
9997
9998 (defun gnus-summary-prev-subject (n &optional unread)
9999   "Go to previous N'th summary line.
10000 If optional argument UNREAD is non-nil, only unread article is selected."
10001   (interactive "p")
10002   (gnus-summary-next-subject (- n) unread))
10003
10004 (defun gnus-summary-prev-unread-subject (n)
10005   "Go to previous N'th unread summary line."
10006   (interactive "p")
10007   (gnus-summary-next-subject (- n) t))
10008
10009 (defun gnus-summary-goto-subject (article &optional force silent)
10010   "Go the subject line of ARTICLE.
10011 If FORCE, also allow jumping to articles not currently shown."
10012   (let ((b (point))
10013         (data (gnus-data-find article)))
10014     ;; We read in the article if we have to.
10015     (and (not data)
10016          force
10017          (gnus-summary-insert-subject article)
10018          (setq data (gnus-data-find article)))
10019     (goto-char b)
10020     (if (not data)
10021         (progn
10022           (unless silent
10023             (gnus-message 3 "Can't find article %d" article))
10024           nil)
10025       (goto-char (gnus-data-pos data))
10026       article)))
10027
10028 ;; Walking around summary lines with displaying articles.
10029
10030 (defun gnus-summary-expand-window (&optional arg)
10031   "Make the summary buffer take up the entire Emacs frame.
10032 Given a prefix, will force an `article' buffer configuration."
10033   (interactive "P")
10034   (gnus-set-global-variables)
10035   (if arg
10036       (gnus-configure-windows 'article 'force)
10037     (gnus-configure-windows 'summary 'force)))
10038
10039 (defun gnus-summary-display-article (article &optional all-header)
10040   "Display ARTICLE in article buffer."
10041   (gnus-set-global-variables)
10042   (if (null article)
10043       nil
10044     (prog1
10045         (if gnus-summary-display-article-function
10046             (funcall gnus-summary-display-article-function article all-header)
10047           (gnus-article-prepare article all-header))
10048       (run-hooks 'gnus-select-article-hook)
10049       (gnus-summary-recenter)
10050       (gnus-summary-goto-subject article)
10051       (when gnus-use-trees
10052         (gnus-possibly-generate-tree article)
10053         (gnus-highlight-selected-tree article))
10054       ;; Successfully display article.
10055       (gnus-article-set-window-start
10056        (cdr (assq article gnus-newsgroup-bookmarks)))
10057       t)))
10058
10059 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
10060   "Select the current article.
10061 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
10062 non-nil, the article will be re-fetched even if it already present in
10063 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
10064 be displayed."
10065   (let ((article (or article (gnus-summary-article-number)))
10066         (all-headers (not (not all-headers))) ;Must be T or NIL.
10067         gnus-summary-display-article-function
10068         did)
10069     (and (not pseudo)
10070          (gnus-summary-article-pseudo-p article)
10071          (error "This is a pseudo-article."))
10072     (prog1
10073         (save-excursion
10074           (set-buffer gnus-summary-buffer)
10075           (if (or (and gnus-single-article-buffer
10076                        (or (null gnus-current-article)
10077                            (null gnus-article-current)
10078                            (null (get-buffer gnus-article-buffer))
10079                            (not (eq article (cdr gnus-article-current)))
10080                            (not (equal (car gnus-article-current)
10081                                        gnus-newsgroup-name))))
10082                   (and (not gnus-single-article-buffer)
10083                        (or (null gnus-current-article)
10084                            (not (eq gnus-current-article article))))
10085                   force)
10086               ;; The requested article is different from the current article.
10087               (prog1
10088                   (gnus-summary-display-article article all-headers)
10089                 (setq did article))
10090             (if (or all-headers gnus-show-all-headers)
10091                 (gnus-article-show-all-headers))
10092             'old))
10093       (if did
10094           (gnus-article-set-window-start
10095            (cdr (assq article gnus-newsgroup-bookmarks)))))))
10096
10097 (defun gnus-summary-set-current-mark (&optional current-mark)
10098   "Obsolete function."
10099   nil)
10100
10101 (defun gnus-summary-next-article (&optional unread subject backward push)
10102   "Select the next article.
10103 If UNREAD, only unread articles are selected.
10104 If SUBJECT, only articles with SUBJECT are selected.
10105 If BACKWARD, the previous article is selected instead of the next."
10106   (interactive "P")
10107   (gnus-set-global-variables)
10108   (cond
10109    ;; Is there such an article?
10110    ((and (gnus-summary-search-forward unread subject backward)
10111          (or (gnus-summary-display-article (gnus-summary-article-number))
10112              (eq (gnus-summary-article-mark) gnus-canceled-mark)))
10113     (gnus-summary-position-point))
10114    ;; If not, we try the first unread, if that is wanted.
10115    ((and subject
10116          gnus-auto-select-same
10117          (or (gnus-summary-first-unread-article)
10118              (eq (gnus-summary-article-mark) gnus-canceled-mark)))
10119     (gnus-summary-position-point)
10120     (gnus-message 6 "Wrapped"))
10121    ;; Try to get next/previous article not displayed in this group.
10122    ((and gnus-auto-extend-newsgroup
10123          (not unread) (not subject))
10124     (gnus-summary-goto-article
10125      (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
10126      nil t))
10127    ;; Go to next/previous group.
10128    (t
10129     (or (gnus-ephemeral-group-p gnus-newsgroup-name)
10130         (gnus-summary-jump-to-group gnus-newsgroup-name))
10131     (let ((cmd last-command-char)
10132           (group
10133            (if (eq gnus-keep-same-level 'best)
10134                (gnus-summary-best-group gnus-newsgroup-name)
10135              (gnus-summary-search-group backward gnus-keep-same-level))))
10136       ;; For some reason, the group window gets selected.  We change
10137       ;; it back.
10138       (select-window (get-buffer-window (current-buffer)))
10139       ;; Select next unread newsgroup automagically.
10140       (cond
10141        ((not gnus-auto-select-next)
10142         (gnus-message 7 "No more%s articles" (if unread " unread" "")))
10143        ((or (eq gnus-auto-select-next 'quietly)
10144             (and (eq gnus-auto-select-next 'slightly-quietly)
10145                  push)
10146             (and (eq gnus-auto-select-next 'almost-quietly)
10147                  (gnus-summary-last-article-p)))
10148         ;; Select quietly.
10149         (if (gnus-ephemeral-group-p gnus-newsgroup-name)
10150             (gnus-summary-exit)
10151           (gnus-message 7 "No more%s articles (%s)..."
10152                         (if unread " unread" "")
10153                         (if group (concat "selecting " group)
10154                           "exiting"))
10155           (gnus-summary-next-group nil group backward)))
10156        (t
10157         (gnus-summary-walk-group-buffer
10158          gnus-newsgroup-name cmd unread backward)))))))
10159
10160 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
10161   (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
10162                       (?\C-p (gnus-group-prev-unread-group 1))))
10163         keve key group ended)
10164     (save-excursion
10165       (set-buffer gnus-group-buffer)
10166       (gnus-summary-jump-to-group from-group)
10167       (setq group
10168             (if (eq gnus-keep-same-level 'best)
10169                 (gnus-summary-best-group gnus-newsgroup-name)
10170               (gnus-summary-search-group backward gnus-keep-same-level))))
10171     (while (not ended)
10172       (gnus-message
10173        5 "No more%s articles%s" (if unread " unread" "")
10174        (if (and group
10175                 (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
10176            (format " (Type %s for %s [%s])"
10177                    (single-key-description cmd) group
10178                    (car (gnus-gethash group gnus-newsrc-hashtb)))
10179          (format " (Type %s to exit %s)"
10180                  (single-key-description cmd)
10181                  gnus-newsgroup-name)))
10182       ;; Confirm auto selection.
10183       (setq key (car (setq keve (gnus-read-event-char))))
10184       (setq ended t)
10185       (cond
10186        ((assq key keystrokes)
10187         (let ((obuf (current-buffer)))
10188           (switch-to-buffer gnus-group-buffer)
10189           (and group
10190                (gnus-group-jump-to-group group))
10191           (eval (cadr (assq key keystrokes)))
10192           (setq group (gnus-group-group-name))
10193           (switch-to-buffer obuf))
10194         (setq ended nil))
10195        ((equal key cmd)
10196         (if (or (not group)
10197                 (gnus-ephemeral-group-p gnus-newsgroup-name))
10198             (gnus-summary-exit)
10199           (gnus-summary-next-group nil group backward)))
10200        (t
10201         (push (cdr keve) unread-command-events))))))
10202
10203 (defun gnus-read-event-char ()
10204   "Get the next event."
10205   (let ((event (read-event)))
10206     (cons (and (numberp event) event) event)))
10207
10208 (defun gnus-summary-next-unread-article ()
10209   "Select unread article after current one."
10210   (interactive)
10211   (gnus-summary-next-article t (and gnus-auto-select-same
10212                                     (gnus-summary-article-subject))))
10213
10214 (defun gnus-summary-prev-article (&optional unread subject)
10215   "Select the article after the current one.
10216 If UNREAD is non-nil, only unread articles are selected."
10217   (interactive "P")
10218   (gnus-summary-next-article unread subject t))
10219
10220 (defun gnus-summary-prev-unread-article ()
10221   "Select unred article before current one."
10222   (interactive)
10223   (gnus-summary-prev-article t (and gnus-auto-select-same
10224                                     (gnus-summary-article-subject))))
10225
10226 (defun gnus-summary-next-page (&optional lines circular)
10227   "Show next page of the selected article.
10228 If at the end of the current article, select the next article.
10229 LINES says how many lines should be scrolled up.
10230
10231 If CIRCULAR is non-nil, go to the start of the article instead of
10232 selecting the next article when reaching the end of the current
10233 article."
10234   (interactive "P")
10235   (setq gnus-summary-buffer (current-buffer))
10236   (gnus-set-global-variables)
10237   (let ((article (gnus-summary-article-number))
10238         (endp nil))
10239     (gnus-configure-windows 'article)
10240     (if (or (null gnus-current-article)
10241             (null gnus-article-current)
10242             (/= article (cdr gnus-article-current))
10243             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
10244         ;; Selected subject is different from current article's.
10245         (gnus-summary-display-article article)
10246       (gnus-eval-in-buffer-window
10247        gnus-article-buffer
10248        (setq endp (gnus-article-next-page lines)))
10249       (if endp
10250           (cond (circular
10251                  (gnus-summary-beginning-of-article))
10252                 (lines
10253                  (gnus-message 3 "End of message"))
10254                 ((null lines)
10255                  (if (and (eq gnus-summary-goto-unread 'never)
10256                           (not (gnus-summary-last-article-p article)))
10257                      (gnus-summary-next-article)
10258                    (gnus-summary-next-unread-article))))))
10259     (gnus-summary-recenter)
10260     (gnus-summary-position-point)))
10261
10262 (defun gnus-summary-prev-page (&optional lines)
10263   "Show previous page of selected article.
10264 Argument LINES specifies lines to be scrolled down."
10265   (interactive "P")
10266   (gnus-set-global-variables)
10267   (let ((article (gnus-summary-article-number)))
10268     (gnus-configure-windows 'article)
10269     (if (or (null gnus-current-article)
10270             (null gnus-article-current)
10271             (/= article (cdr gnus-article-current))
10272             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
10273         ;; Selected subject is different from current article's.
10274         (gnus-summary-display-article article)
10275       (gnus-summary-recenter)
10276       (gnus-eval-in-buffer-window gnus-article-buffer
10277                                   (gnus-article-prev-page lines))))
10278   (gnus-summary-position-point))
10279
10280 (defun gnus-summary-scroll-up (lines)
10281   "Scroll up (or down) one line current article.
10282 Argument LINES specifies lines to be scrolled up (or down if negative)."
10283   (interactive "p")
10284   (gnus-set-global-variables)
10285   (gnus-configure-windows 'article)
10286   (gnus-summary-show-thread)
10287   (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
10288     (gnus-eval-in-buffer-window
10289      gnus-article-buffer
10290      (cond ((> lines 0)
10291             (if (gnus-article-next-page lines)
10292                 (gnus-message 3 "End of message")))
10293            ((< lines 0)
10294             (gnus-article-prev-page (- lines))))))
10295   (gnus-summary-recenter)
10296   (gnus-summary-position-point))
10297
10298 (defun gnus-summary-next-same-subject ()
10299   "Select next article which has the same subject as current one."
10300   (interactive)
10301   (gnus-set-global-variables)
10302   (gnus-summary-next-article nil (gnus-summary-article-subject)))
10303
10304 (defun gnus-summary-prev-same-subject ()
10305   "Select previous article which has the same subject as current one."
10306   (interactive)
10307   (gnus-set-global-variables)
10308   (gnus-summary-prev-article nil (gnus-summary-article-subject)))
10309
10310 (defun gnus-summary-next-unread-same-subject ()
10311   "Select next unread article which has the same subject as current one."
10312   (interactive)
10313   (gnus-set-global-variables)
10314   (gnus-summary-next-article t (gnus-summary-article-subject)))
10315
10316 (defun gnus-summary-prev-unread-same-subject ()
10317   "Select previous unread article which has the same subject as current one."
10318   (interactive)
10319   (gnus-set-global-variables)
10320   (gnus-summary-prev-article t (gnus-summary-article-subject)))
10321
10322 (defun gnus-summary-first-unread-article ()
10323   "Select the first unread article.
10324 Return nil if there are no unread articles."
10325   (interactive)
10326   (gnus-set-global-variables)
10327   (prog1
10328       (if (gnus-summary-first-subject t)
10329           (progn
10330             (gnus-summary-show-thread)
10331             (gnus-summary-first-subject t)
10332             (gnus-summary-display-article (gnus-summary-article-number))))
10333     (gnus-summary-position-point)))
10334
10335 (defun gnus-summary-best-unread-article ()
10336   "Select the unread article with the highest score."
10337   (interactive)
10338   (gnus-set-global-variables)
10339   (let ((best -1000000)
10340         (data gnus-newsgroup-data)
10341         article score)
10342     (while data
10343       (and (gnus-data-unread-p (car data))
10344            (> (setq score
10345                     (gnus-summary-article-score (gnus-data-number (car data))))
10346               best)
10347            (setq best score
10348                  article (gnus-data-number (car data))))
10349       (setq data (cdr data)))
10350     (if article
10351         (gnus-summary-goto-article article)
10352       (error "No unread articles"))
10353     (gnus-summary-position-point)))
10354
10355 (defun gnus-summary-last-subject ()
10356   "Go to the last displayed subject line in the group."
10357   (let ((article (gnus-data-number (car (gnus-data-list t)))))
10358     (when article
10359       (gnus-summary-goto-subject article))))
10360
10361 (defun gnus-summary-goto-article (article &optional all-headers force)
10362   "Fetch ARTICLE and display it if it exists.
10363 If ALL-HEADERS is non-nil, no header lines are hidden."
10364   (interactive
10365    (list
10366     (string-to-int
10367      (completing-read
10368       "Article number: "
10369       (mapcar (lambda (number) (list (int-to-string number)))
10370               gnus-newsgroup-limit)))
10371     current-prefix-arg
10372     t))
10373   (prog1
10374       (if (gnus-summary-goto-subject article force)
10375           (gnus-summary-display-article article all-headers)
10376         (gnus-message 4 "Couldn't go to article %s" article) nil)
10377     (gnus-summary-position-point)))
10378
10379 (defun gnus-summary-goto-last-article ()
10380   "Go to the previously read article."
10381   (interactive)
10382   (prog1
10383       (and gnus-last-article
10384            (gnus-summary-goto-article gnus-last-article))
10385     (gnus-summary-position-point)))
10386
10387 (defun gnus-summary-pop-article (number)
10388   "Pop one article off the history and go to the previous.
10389 NUMBER articles will be popped off."
10390   (interactive "p")
10391   (let (to)
10392     (setq gnus-newsgroup-history
10393           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
10394     (if to
10395         (gnus-summary-goto-article (car to))
10396       (error "Article history empty")))
10397   (gnus-summary-position-point))
10398
10399 ;; Summary commands and functions for limiting the summary buffer.
10400
10401 (defun gnus-summary-limit-to-articles (n)
10402   "Limit the summary buffer to the next N articles.
10403 If not given a prefix, use the process marked articles instead."
10404   (interactive "P")
10405   (gnus-set-global-variables)
10406   (prog1
10407       (let ((articles (gnus-summary-work-articles n)))
10408         (setq gnus-newsgroup-processable nil)
10409         (gnus-summary-limit articles))
10410     (gnus-summary-position-point)))
10411
10412 (defun gnus-summary-pop-limit (&optional total)
10413   "Restore the previous limit.
10414 If given a prefix, remove all limits."
10415   (interactive "P")
10416   (gnus-set-global-variables)
10417   (when total 
10418     (setq gnus-newsgroup-limits
10419           (list (mapcar (lambda (h) (mail-header-number h))
10420                         gnus-newsgroup-headers))))
10421   (unless gnus-newsgroup-limits
10422     (error "No limit to pop"))
10423   (prog1
10424       (gnus-summary-limit nil 'pop)
10425     (gnus-summary-position-point)))
10426
10427 (defun gnus-summary-limit-to-subject (subject &optional header)
10428   "Limit the summary buffer to articles that have subjects that match a regexp."
10429   (interactive "sRegexp: ")
10430   (unless header
10431     (setq header "subject"))
10432   (when (not (equal "" subject))
10433     (prog1
10434         (let ((articles (gnus-summary-find-matching
10435                          (or header "subject") subject 'all)))
10436           (or articles (error "Found no matches for \"%s\"" subject))
10437           (gnus-summary-limit articles))
10438       (gnus-summary-position-point))))
10439
10440 (defun gnus-summary-limit-to-author (from)
10441   "Limit the summary buffer to articles that have authors that match a regexp."
10442   (interactive "sRegexp: ")
10443   (gnus-summary-limit-to-subject from "from"))
10444
10445 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10446 (make-obsolete
10447  'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10448
10449 (defun gnus-summary-limit-to-unread (&optional all)
10450   "Limit the summary buffer to articles that are not marked as read.
10451 If ALL is non-nil, limit strictly to unread articles."
10452   (interactive "P")
10453   (if all
10454       (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
10455     (gnus-summary-limit-to-marks
10456      ;; Concat all the marks that say that an article is read and have
10457      ;; those removed.
10458      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
10459            gnus-killed-mark gnus-kill-file-mark
10460            gnus-low-score-mark gnus-expirable-mark
10461            gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark)
10462      'reverse)))
10463
10464 (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10465 (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10466
10467 (defun gnus-summary-limit-to-marks (marks &optional reverse)
10468   "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
10469 If REVERSE, limit the summary buffer to articles that are not marked
10470 with MARKS.  MARKS can either be a string of marks or a list of marks.
10471 Returns how many articles were removed."
10472   (interactive "sMarks: ")
10473   (gnus-set-global-variables)
10474   (prog1
10475       (let ((data gnus-newsgroup-data)
10476             (marks (if (listp marks) marks
10477                      (append marks nil))) ; Transform to list.
10478             articles)
10479         (while data
10480           (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
10481                  (memq (gnus-data-mark (car data)) marks))
10482                (setq articles (cons (gnus-data-number (car data)) articles)))
10483           (setq data (cdr data)))
10484         (gnus-summary-limit articles))
10485     (gnus-summary-position-point)))
10486
10487 (defun gnus-summary-limit-to-score (&optional score)
10488   "Limit to articles with score at or above SCORE."
10489   (interactive "P")
10490   (gnus-set-global-variables)
10491   (setq score (if score
10492                   (prefix-numeric-value score)
10493                 (or gnus-summary-default-score 0)))
10494   (let ((data gnus-newsgroup-data)
10495         articles)
10496     (while data
10497       (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
10498                 score)
10499         (push (gnus-data-number (car data)) articles))
10500       (setq data (cdr data)))
10501     (prog1
10502         (gnus-summary-limit articles)
10503       (gnus-summary-position-point))))
10504
10505 (defun gnus-summary-limit-include-dormant ()
10506   "Display all the hidden articles that are marked as dormant."
10507   (interactive)
10508   (gnus-set-global-variables)
10509   (or gnus-newsgroup-dormant
10510       (error "There are no dormant articles in this group"))
10511   (prog1
10512       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
10513     (gnus-summary-position-point)))
10514
10515 (defun gnus-summary-limit-exclude-dormant ()
10516   "Hide all dormant articles."
10517   (interactive)
10518   (gnus-set-global-variables)
10519   (prog1
10520       (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
10521     (gnus-summary-position-point)))
10522
10523 (defun gnus-summary-limit-exclude-childless-dormant ()
10524   "Hide all dormant articles that have no children."
10525   (interactive)
10526   (gnus-set-global-variables)
10527   (let ((data (gnus-data-list t))
10528         articles d children)
10529     ;; Find all articles that are either not dormant or have
10530     ;; children.
10531     (while (setq d (pop data))
10532       (when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
10533                 (and (setq children 
10534                            (gnus-article-children (gnus-data-number d)))
10535                      (let (found)
10536                        (while children
10537                          (when (memq (car children) articles)
10538                            (setq children nil
10539                                  found t))
10540                          (pop children))
10541                        found)))
10542         (push (gnus-data-number d) articles)))
10543     ;; Do the limiting.
10544     (prog1
10545         (gnus-summary-limit articles)
10546       (gnus-summary-position-point))))
10547
10548 (defun gnus-summary-limit-mark-excluded-as-read (&optional all)
10549   "Mark all unread excluded articles as read.
10550 If ALL, mark even excluded ticked and dormants as read."
10551   (interactive "P")
10552   (let ((articles (gnus-sorted-complement
10553                    (sort
10554                     (mapcar (lambda (h) (mail-header-number h))
10555                             gnus-newsgroup-headers)
10556                     '<)
10557                    (sort gnus-newsgroup-limit '<)))
10558         article)
10559     (setq gnus-newsgroup-unreads nil)
10560     (if all
10561         (setq gnus-newsgroup-dormant nil
10562               gnus-newsgroup-marked nil
10563               gnus-newsgroup-reads
10564               (nconc
10565                (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
10566                gnus-newsgroup-reads))
10567       (while (setq article (pop articles))
10568         (unless (or (memq article gnus-newsgroup-dormant)
10569                     (memq article gnus-newsgroup-marked))
10570           (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
10571
10572 (defun gnus-summary-limit (articles &optional pop)
10573   (if pop
10574       ;; We pop the previous limit off the stack and use that.
10575       (setq articles (car gnus-newsgroup-limits)
10576             gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
10577     ;; We use the new limit, so we push the old limit on the stack.
10578     (setq gnus-newsgroup-limits
10579           (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
10580   ;; Set the limit.
10581   (setq gnus-newsgroup-limit articles)
10582   (let ((total (length gnus-newsgroup-data))
10583         (data (gnus-data-find-list (gnus-summary-article-number)))
10584         found)
10585     ;; This will do all the work of generating the new summary buffer
10586     ;; according to the new limit.
10587     (gnus-summary-prepare)
10588     ;; Hide any threads, possibly.
10589     (and gnus-show-threads
10590          gnus-thread-hide-subtree
10591          (gnus-summary-hide-all-threads))
10592     ;; Try to return to the article you were at, or one in the
10593     ;; neighborhood.
10594     (if data
10595         ;; We try to find some article after the current one.
10596         (while data
10597           (and (gnus-summary-goto-subject
10598                 (gnus-data-number (car data)) nil t)
10599                (setq data nil
10600                      found t))
10601           (setq data (cdr data))))
10602     (or found
10603         ;; If there is no data, that means that we were after the last
10604         ;; article.  The same goes when we can't find any articles
10605         ;; after the current one.
10606         (progn
10607           (goto-char (point-max))
10608           (gnus-summary-find-prev)))
10609     ;; We return how many articles were removed from the summary
10610     ;; buffer as a result of the new limit.
10611     (- total (length gnus-newsgroup-data))))
10612
10613 (defsubst gnus-cut-thread (thread)
10614   "Go forwards in the thread until we find an article that we want to display."
10615   (when (eq gnus-fetch-old-headers 'some)
10616     ;; Deal with old-fetched headers.
10617     (while (and thread
10618                 (memq (mail-header-number (car thread)) 
10619                       gnus-newsgroup-ancient)
10620                 (<= (length (cdr thread)) 1))
10621       (setq thread (cadr thread))))
10622   ;; Deal with sparse threads.
10623   (when (or (eq gnus-build-sparse-threads 'some)
10624             (eq gnus-build-sparse-threads 'more))
10625     (while (and thread
10626                 (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
10627                 (= (length (cdr thread)) 1))
10628       (setq thread (cadr thread))))
10629   thread)
10630
10631 (defun gnus-cut-threads (threads)
10632   "Cut off all uninteresting articles from the beginning of threads."
10633   (when (or (eq gnus-fetch-old-headers 'some)
10634             (eq gnus-build-sparse-threads 'some)
10635             (eq gnus-build-sparse-threads 'more))
10636     (let ((th threads))
10637       (while th
10638         (setcar th (gnus-cut-thread (car th)))
10639         (setq th (cdr th)))))
10640   ;; Remove nixed out threads.
10641   (delq nil threads))
10642
10643 (defun gnus-summary-initial-limit (&optional show-if-empty)
10644   "Figure out what the initial limit is supposed to be on group entry.
10645 This entails weeding out unwanted dormants, low-scored articles,
10646 fetch-old-headers verbiage, and so on."
10647   ;; Most groups have nothing to remove.
10648   (if (or gnus-inhibit-limiting
10649           (and (null gnus-newsgroup-dormant)
10650                (not (eq gnus-fetch-old-headers 'some))
10651                (null gnus-summary-expunge-below)
10652                (not (eq gnus-build-sparse-threads 'some))
10653                (not (eq gnus-build-sparse-threads 'more))
10654                (null gnus-thread-expunge-below)
10655                (not gnus-use-nocem)))
10656       () ; Do nothing.
10657     (push gnus-newsgroup-limit gnus-newsgroup-limits)
10658     (setq gnus-newsgroup-limit nil)
10659     (mapatoms
10660      (lambda (node)
10661        (unless (car (symbol-value node))
10662          ;; These threads have no parents -- they are roots.
10663          (let ((nodes (cdr (symbol-value node)))
10664                thread)
10665            (while nodes
10666              (if (and gnus-thread-expunge-below
10667                       (< (gnus-thread-total-score (car nodes))
10668                          gnus-thread-expunge-below))
10669                  (gnus-expunge-thread (pop nodes))
10670                (setq thread (pop nodes))
10671                (gnus-summary-limit-children thread))))))
10672      gnus-newsgroup-dependencies)
10673     ;; If this limitation resulted in an empty group, we might
10674     ;; pop the previous limit and use it instead.
10675     (when (and (not gnus-newsgroup-limit)
10676                show-if-empty)
10677       (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
10678     gnus-newsgroup-limit))
10679
10680 (defun gnus-summary-limit-children (thread)
10681   "Return 1 if this subthread is visible and 0 if it is not."
10682   ;; First we get the number of visible children to this thread.  This
10683   ;; is done by recursing down the thread using this function, so this
10684   ;; will really go down to a leaf article first, before slowly
10685   ;; working its way up towards the root.
10686   (when thread
10687     (let ((children
10688            (if (cdr thread)
10689                (apply '+ (mapcar 'gnus-summary-limit-children
10690                                  (cdr thread)))
10691              0))
10692           (number (mail-header-number (car thread)))
10693           score)
10694       (if (or
10695            ;; If this article is dormant and has absolutely no visible
10696            ;; children, then this article isn't visible.
10697            (and (memq number gnus-newsgroup-dormant)
10698                 (= children 0))
10699            ;; If this is a "fetch-old-headered" and there is only one
10700            ;; visible child (or less), then we don't want this article.
10701            (and (eq gnus-fetch-old-headers 'some)
10702                 (memq number gnus-newsgroup-ancient)
10703                 (zerop children))
10704            ;; If this is a sparsely inserted article with no children,
10705            ;; we don't want it.
10706            (and (eq gnus-build-sparse-threads 'some)
10707                 (memq number gnus-newsgroup-sparse)
10708                 (zerop children))
10709            ;; If we use expunging, and this article is really
10710            ;; low-scored, then we don't want this article.
10711            (when (and gnus-summary-expunge-below
10712                       (< (setq score
10713                                (or (cdr (assq number gnus-newsgroup-scored))
10714                                    gnus-summary-default-score))
10715                          gnus-summary-expunge-below))
10716              ;; We increase the expunge-tally here, but that has
10717              ;; nothing to do with the limits, really.
10718              (incf gnus-newsgroup-expunged-tally)
10719              ;; We also mark as read here, if that's wanted.
10720              (when (and gnus-summary-mark-below
10721                         (< score gnus-summary-mark-below))
10722                (setq gnus-newsgroup-unreads
10723                      (delq number gnus-newsgroup-unreads))
10724                (if gnus-newsgroup-auto-expire
10725                    (push number gnus-newsgroup-expirable)
10726                  (push (cons number gnus-low-score-mark)
10727                        gnus-newsgroup-reads)))
10728              t)
10729            (and gnus-use-nocem
10730                 (gnus-nocem-unwanted-article-p (mail-header-id (car thread)))))
10731           ;; Nope, invisible article.
10732           0
10733         ;; Ok, this article is to be visible, so we add it to the limit
10734         ;; and return 1.
10735         (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
10736         1))))
10737
10738 (defun gnus-expunge-thread (thread)
10739   "Mark all articles in THREAD as read."
10740   (let* ((number (mail-header-number (car thread))))
10741     (incf gnus-newsgroup-expunged-tally)
10742     ;; We also mark as read here, if that's wanted.
10743     (setq gnus-newsgroup-unreads
10744           (delq number gnus-newsgroup-unreads))
10745     (if gnus-newsgroup-auto-expire
10746         (push number gnus-newsgroup-expirable)
10747       (push (cons number gnus-low-score-mark)
10748             gnus-newsgroup-reads)))
10749   ;; Go recursively through all subthreads.
10750   (mapcar 'gnus-expunge-thread (cdr thread)))
10751
10752 ;; Summary article oriented commands
10753
10754 (defun gnus-summary-refer-parent-article (n)
10755   "Refer parent article N times.
10756 The difference between N and the number of articles fetched is returned."
10757   (interactive "p")
10758   (gnus-set-global-variables)
10759   (while
10760       (and
10761        (> n 0)
10762        (let* ((header (gnus-summary-article-header))
10763               (ref
10764                ;; If we try to find the parent of the currently
10765                ;; displayed article, then we take a look at the actual
10766                ;; References header, since this is slightly more
10767                ;; reliable than the References field we got from the
10768                ;; server.
10769                (if (and (eq (mail-header-number header)
10770                             (cdr gnus-article-current))
10771                         (equal gnus-newsgroup-name
10772                                (car gnus-article-current)))
10773                    (save-excursion
10774                      (set-buffer gnus-original-article-buffer)
10775                      (nnheader-narrow-to-headers)
10776                      (prog1
10777                          (mail-fetch-field "references")
10778                        (widen)))
10779                  ;; It's not the current article, so we take a bet on
10780                  ;; the value we got from the server.
10781                  (mail-header-references header))))
10782          (if (setq ref (or ref (mail-header-references header)))
10783              (or (gnus-summary-refer-article (gnus-parent-id ref))
10784                  (gnus-message 1 "Couldn't find parent"))
10785            (gnus-message 1 "No references in article %d"
10786                          (gnus-summary-article-number))
10787            nil)))
10788     (setq n (1- n)))
10789   (gnus-summary-position-point)
10790   n)
10791
10792 (defun gnus-summary-refer-references ()
10793   "Fetch all articles mentioned in the References header.
10794 Return how many articles were fetched."
10795   (interactive)
10796   (gnus-set-global-variables)
10797   (let ((ref (mail-header-references (gnus-summary-article-header)))
10798         (current (gnus-summary-article-number))
10799         (n 0))
10800     ;; For each Message-ID in the References header...
10801     (while (string-match "<[^>]*>" ref)
10802       (incf n)
10803       ;; ... fetch that article.
10804       (gnus-summary-refer-article
10805        (prog1 (match-string 0 ref)
10806          (setq ref (substring ref (match-end 0))))))
10807     (gnus-summary-goto-subject current)
10808     (gnus-summary-position-point)
10809     n))
10810
10811 (defun gnus-summary-refer-article (message-id)
10812   "Fetch an article specified by MESSAGE-ID."
10813   (interactive "sMessage-ID: ")
10814   (when (and (stringp message-id)
10815              (not (zerop (length message-id))))
10816     ;; Construct the correct Message-ID if necessary.
10817     ;; Suggested by tale@pawl.rpi.edu.
10818     (unless (string-match "^<" message-id)
10819       (setq message-id (concat "<" message-id)))
10820     (unless (string-match ">$" message-id)
10821       (setq message-id (concat message-id ">")))
10822     (let ((header (car (gnus-gethash message-id
10823                                      gnus-newsgroup-dependencies))))
10824       (if header
10825           ;; The article is present in the buffer, to we just go to it.
10826           (gnus-summary-goto-article (mail-header-number header) nil t)
10827         ;; We fetch the article
10828         (let ((gnus-override-method 
10829                (and (gnus-news-group-p gnus-newsgroup-name)
10830                     gnus-refer-article-method))
10831               number)
10832           ;; Start the special refer-article method, if necessary.
10833           (when gnus-refer-article-method
10834             (gnus-check-server gnus-refer-article-method))
10835           ;; Fetch the header, and display the article.
10836           (if (setq number (gnus-summary-insert-subject message-id))
10837               (gnus-summary-select-article nil nil nil number)
10838             (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
10839
10840 (defun gnus-summary-enter-digest-group (&optional force)
10841   "Enter a digest group based on the current article."
10842   (interactive "P")
10843   (gnus-set-global-variables)
10844   (gnus-summary-select-article)
10845   (let ((name (format "%s-%d"
10846                       (gnus-group-prefixed-name
10847                        gnus-newsgroup-name (list 'nndoc ""))
10848                       gnus-current-article))
10849         (ogroup gnus-newsgroup-name)
10850         (case-fold-search t)
10851         (buf (current-buffer))
10852         dig)
10853     (save-excursion
10854       (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
10855       (insert-buffer-substring gnus-original-article-buffer)
10856       (narrow-to-region
10857        (goto-char (point-min))
10858        (or (search-forward "\n\n" nil t) (point)))
10859       (goto-char (point-min))
10860       (delete-matching-lines "^\\(Path\\):\\|^From ")
10861       (widen))
10862     (unwind-protect
10863         (if (gnus-group-read-ephemeral-group
10864              name `(nndoc ,name (nndoc-address
10865                                  ,(get-buffer dig))
10866                           (nndoc-article-type ,(if force 'digest 'guess))) t)
10867             ;; Make all postings to this group go to the parent group.
10868             (nconc (gnus-info-params (gnus-get-info name))
10869                    (list (cons 'to-group ogroup)))
10870           ;; Couldn't select this doc group.
10871           (switch-to-buffer buf)
10872           (gnus-set-global-variables)
10873           (gnus-configure-windows 'summary)
10874           (gnus-message 3 "Article couldn't be entered?"))
10875       (kill-buffer dig))))
10876
10877 (defun gnus-summary-isearch-article (&optional regexp-p)
10878   "Do incremental search forward on the current article.
10879 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
10880   (interactive "P")
10881   (gnus-set-global-variables)
10882   (gnus-summary-select-article)
10883   (gnus-configure-windows 'article)
10884   (gnus-eval-in-buffer-window
10885    gnus-article-buffer
10886    (goto-char (point-min))
10887    (isearch-forward regexp-p)))
10888
10889 (defun gnus-summary-search-article-forward (regexp &optional backward)
10890   "Search for an article containing REGEXP forward.
10891 If BACKWARD, search backward instead."
10892   (interactive
10893    (list (read-string
10894           (format "Search article %s (regexp%s): "
10895                   (if current-prefix-arg "backward" "forward")
10896                   (if gnus-last-search-regexp
10897                       (concat ", default " gnus-last-search-regexp)
10898                     "")))
10899          current-prefix-arg))
10900   (gnus-set-global-variables)
10901   (if (string-equal regexp "")
10902       (setq regexp (or gnus-last-search-regexp ""))
10903     (setq gnus-last-search-regexp regexp))
10904   (if (gnus-summary-search-article regexp backward)
10905       (gnus-article-set-window-start
10906        (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks)))
10907     (error "Search failed: \"%s\"" regexp)))
10908
10909 (defun gnus-summary-search-article-backward (regexp)
10910   "Search for an article containing REGEXP backward."
10911   (interactive
10912    (list (read-string
10913           (format "Search article backward (regexp%s): "
10914                   (if gnus-last-search-regexp
10915                       (concat ", default " gnus-last-search-regexp)
10916                     "")))))
10917   (gnus-summary-search-article-forward regexp 'backward))
10918
10919 (defun gnus-summary-search-article (regexp &optional backward)
10920   "Search for an article containing REGEXP.
10921 Optional argument BACKWARD means do search for backward.
10922 gnus-select-article-hook is not called during the search."
10923   (let ((gnus-select-article-hook nil)  ;Disable hook.
10924         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
10925         (re-search
10926          (if backward
10927              (function re-search-backward) (function re-search-forward)))
10928         (found nil)
10929         (last nil))
10930     ;; Hidden thread subtrees must be searched for ,too.
10931     (gnus-summary-show-all-threads)
10932     ;; First of all, search current article.
10933     ;; We don't want to read article again from NNTP server nor reset
10934     ;; current point.
10935     (gnus-summary-select-article)
10936     (gnus-message 9 "Searching article: %d..." gnus-current-article)
10937     (setq last gnus-current-article)
10938     (gnus-eval-in-buffer-window
10939      gnus-article-buffer
10940      (save-restriction
10941        (widen)
10942        ;; Begin search from current point.
10943        (setq found (funcall re-search regexp nil t))))
10944     ;; Then search next articles.
10945     (while (and (not found)
10946                 (gnus-summary-display-article
10947                  (if backward (gnus-summary-find-prev)
10948                    (gnus-summary-find-next))))
10949       (gnus-message 9 "Searching article: %d..." gnus-current-article)
10950       (gnus-eval-in-buffer-window
10951        gnus-article-buffer
10952        (save-restriction
10953          (widen)
10954          (goto-char (if backward (point-max) (point-min)))
10955          (setq found (funcall re-search regexp nil t)))))
10956     (message "")
10957     ;; Adjust article pointer.
10958     (or (eq last gnus-current-article)
10959         (setq gnus-last-article last))
10960     ;; Return T if found such article.
10961     found))
10962
10963 (defun gnus-summary-find-matching (header regexp &optional backward unread
10964                                           not-case-fold)
10965   "Return a list of all articles that match REGEXP on HEADER.
10966 The search stars on the current article and goes forwards unless
10967 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
10968 If UNREAD is non-nil, only unread articles will
10969 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
10970 in the comparisons."
10971   (let ((data (if (eq backward 'all) gnus-newsgroup-data
10972                 (gnus-data-find-list
10973                  (gnus-summary-article-number) (gnus-data-list backward))))
10974         (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
10975         (case-fold-search (not not-case-fold))
10976         articles d)
10977     (or (fboundp (intern (concat "mail-header-" header)))
10978         (error "%s is not a valid header" header))
10979     (while data
10980       (setq d (car data))
10981       (and (or (not unread)             ; We want all articles...
10982                (gnus-data-unread-p d))  ; Or just unreads.
10983            (vectorp (gnus-data-header d)) ; It's not a pseudo.
10984            (string-match regexp (funcall func (gnus-data-header d))) ; Match.
10985            (setq articles (cons (gnus-data-number d) articles))) ; Success!
10986       (setq data (cdr data)))
10987     (nreverse articles)))
10988
10989 (defun gnus-summary-execute-command (header regexp command &optional backward)
10990   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
10991 If HEADER is an empty string (or nil), the match is done on the entire
10992 article.  If BACKWARD (the prefix) is non-nil, search backward instead."
10993   (interactive
10994    (list (let ((completion-ignore-case t))
10995            (completing-read
10996             "Header name: "
10997             (mapcar (lambda (string) (list string))
10998                     '("Number" "Subject" "From" "Lines" "Date"
10999                       "Message-ID" "Xref" "References" "Body"))
11000             nil 'require-match))
11001          (read-string "Regexp: ")
11002          (read-key-sequence "Command: ")
11003          current-prefix-arg))
11004   (when (equal header "Body")
11005     (setq header ""))
11006   (gnus-set-global-variables)
11007   ;; Hidden thread subtrees must be searched as well.
11008   (gnus-summary-show-all-threads)
11009   ;; We don't want to change current point nor window configuration.
11010   (save-excursion
11011     (save-window-excursion
11012       (gnus-message 6 "Executing %s..." (key-description command))
11013       ;; We'd like to execute COMMAND interactively so as to give arguments.
11014       (gnus-execute header regexp
11015                     `(lambda () (call-interactively ',(key-binding command)))
11016                     backward)
11017       (gnus-message 6 "Executing %s...done" (key-description command)))))
11018
11019 (defun gnus-summary-beginning-of-article ()
11020   "Scroll the article back to the beginning."
11021   (interactive)
11022   (gnus-set-global-variables)
11023   (gnus-summary-select-article)
11024   (gnus-configure-windows 'article)
11025   (gnus-eval-in-buffer-window
11026    gnus-article-buffer
11027    (widen)
11028    (goto-char (point-min))
11029    (and gnus-break-pages (gnus-narrow-to-page))))
11030
11031 (defun gnus-summary-end-of-article ()
11032   "Scroll to the end of the article."
11033   (interactive)
11034   (gnus-set-global-variables)
11035   (gnus-summary-select-article)
11036   (gnus-configure-windows 'article)
11037   (gnus-eval-in-buffer-window
11038    gnus-article-buffer
11039    (widen)
11040    (goto-char (point-max))
11041    (recenter -3)
11042    (and gnus-break-pages (gnus-narrow-to-page))))
11043
11044 (defun gnus-summary-show-article (&optional arg)
11045   "Force re-fetching of the current article.
11046 If ARG (the prefix) is non-nil, show the raw article without any
11047 article massaging functions being run."
11048   (interactive "P")
11049   (gnus-set-global-variables)
11050   (if (not arg)
11051       ;; Select the article the normal way.
11052       (gnus-summary-select-article nil 'force)
11053     ;; Bind the article treatment functions to nil.
11054     (let ((gnus-have-all-headers t)
11055           gnus-article-display-hook
11056           gnus-article-prepare-hook
11057           gnus-visual)
11058       (gnus-summary-select-article nil 'force)))
11059 ;  (gnus-configure-windows 'article)
11060   (gnus-summary-position-point))
11061
11062 (defun gnus-summary-verbose-headers (&optional arg)
11063   "Toggle permanent full header display.
11064 If ARG is a positive number, turn header display on.
11065 If ARG is a negative number, turn header display off."
11066   (interactive "P")
11067   (gnus-set-global-variables)
11068   (gnus-summary-toggle-header arg)
11069   (setq gnus-show-all-headers
11070         (cond ((or (not (numberp arg))
11071                    (zerop arg))
11072                (not gnus-show-all-headers))
11073               ((natnump arg)
11074                t))))
11075
11076 (defun gnus-summary-toggle-header (&optional arg)
11077   "Show the headers if they are hidden, or hide them if they are shown.
11078 If ARG is a positive number, show the entire header.
11079 If ARG is a negative number, hide the unwanted header lines."
11080   (interactive "P")
11081   (gnus-set-global-variables)
11082   (save-excursion
11083     (set-buffer gnus-article-buffer)
11084     (let* ((buffer-read-only nil)
11085            (inhibit-point-motion-hooks t)
11086            (hidden (text-property-any
11087                     (goto-char (point-min)) (search-forward "\n\n")
11088                     'invisible t))
11089            e)
11090       (goto-char (point-min))
11091       (when (search-forward "\n\n" nil t)
11092         (delete-region (point-min) (1- (point))))
11093       (goto-char (point-min))
11094       (save-excursion
11095         (set-buffer gnus-original-article-buffer)
11096         (goto-char (point-min))
11097         (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
11098       (insert-buffer-substring gnus-original-article-buffer 1 e)
11099       (let ((gnus-inhibit-hiding t))
11100         (run-hooks 'gnus-article-display-hook))
11101       (if (or (not hidden) (and (numberp arg) (< arg 0)))
11102           (gnus-article-hide-headers)))))
11103
11104 (defun gnus-summary-show-all-headers ()
11105   "Make all header lines visible."
11106   (interactive)
11107   (gnus-set-global-variables)
11108   (gnus-article-show-all-headers))
11109
11110 (defun gnus-summary-toggle-mime (&optional arg)
11111   "Toggle MIME processing.
11112 If ARG is a positive number, turn MIME processing on."
11113   (interactive "P")
11114   (gnus-set-global-variables)
11115   (setq gnus-show-mime
11116         (if (null arg) (not gnus-show-mime)
11117           (> (prefix-numeric-value arg) 0)))
11118   (gnus-summary-select-article t 'force))
11119
11120 (defun gnus-summary-caesar-message (&optional arg)
11121   "Caesar rotate the current article by 13.
11122 The numerical prefix specifies how manu places to rotate each letter
11123 forward."
11124   (interactive "P")
11125   (gnus-set-global-variables)
11126   (gnus-summary-select-article)
11127   (let ((mail-header-separator ""))
11128     (gnus-eval-in-buffer-window
11129      gnus-article-buffer
11130      (save-restriction
11131        (widen)
11132        (let ((start (window-start)))
11133          (news-caesar-buffer-body arg)
11134          (set-window-start (get-buffer-window (current-buffer)) start))))))
11135
11136 (defun gnus-summary-stop-page-breaking ()
11137   "Stop page breaking in the current article."
11138   (interactive)
11139   (gnus-set-global-variables)
11140   (gnus-summary-select-article)
11141   (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
11142
11143 (defun gnus-summary-move-article (&optional n to-newsgroup select-method action)
11144   "Move the current article to a different newsgroup.
11145 If N is a positive number, move the N next articles.
11146 If N is a negative number, move the N previous articles.
11147 If N is nil and any articles have been marked with the process mark,
11148 move those articles instead.
11149 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
11150 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
11151 re-spool using this method.
11152
11153 For this function to work, both the current newsgroup and the
11154 newsgroup that you want to move to have to support the `request-move'
11155 and `request-accept' functions."
11156   (interactive "P")
11157   (unless action (setq action 'move))
11158   (gnus-set-global-variables)
11159   ;; Check whether the source group supports the required functions.
11160   (cond ((and (eq action 'move)
11161               (not (gnus-check-backend-function
11162                     'request-move-article gnus-newsgroup-name)))
11163          (error "The current group does not support article moving"))
11164         ((and (eq action 'crosspost)
11165               (not (gnus-check-backend-function
11166                     'request-replace-article gnus-newsgroup-name)))
11167          (error "The current group does not support article editing")))
11168   (let ((articles (gnus-summary-work-articles n))
11169         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
11170         (names '((move "move" "Moving")
11171                  (copy "copy" "Copying")
11172                  (crosspost "crosspost" "Crossposting")))
11173         (copy-buf (save-excursion
11174                     (nnheader-set-temp-buffer " *copy article*")))
11175         art-group to-method new-xref article to-groups)
11176     (unless (assq action names)
11177       (error "Unknown action %s" action))
11178     ;; Read the newsgroup name.
11179     (when (and (not to-newsgroup)
11180                (not select-method))
11181       (setq to-newsgroup
11182             (gnus-read-move-group-name
11183              (cadr (assq action names))
11184              gnus-current-move-group articles prefix))
11185       (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
11186     (setq to-method (if select-method (list select-method "")
11187                       (gnus-find-method-for-group to-newsgroup)))
11188     ;;(when (equal to-newsgroup gnus-newsgroup-name)
11189     ;;(error "Can't %s to the same group you're already in" action))
11190     ;; Check the method we are to move this article to...
11191     (or (gnus-check-backend-function 'request-accept-article (car to-method))
11192         (error "%s does not support article copying" (car to-method)))
11193     (or (gnus-check-server to-method)
11194         (error "Can't open server %s" (car to-method)))
11195     (gnus-message 6 "%s to %s: %s..."
11196                   (caddr (assq action names))
11197                   (or select-method to-newsgroup) articles)
11198     (while articles
11199       (setq article (pop articles))
11200       (setq
11201        art-group
11202        (cond
11203         ;; Move the article.
11204         ((eq action 'move)
11205          (gnus-request-move-article
11206           article                       ; Article to move
11207           gnus-newsgroup-name           ; From newsgrouo
11208           (nth 1 (gnus-find-method-for-group
11209                   gnus-newsgroup-name)) ; Server
11210           (list 'gnus-request-accept-article
11211                 (if select-method
11212                     (list 'quote select-method)
11213                   to-newsgroup)
11214                 (not articles))         ; Accept form
11215           (not articles)))              ; Only save nov last time
11216         ;; Copy the article.
11217         ((eq action 'copy)
11218          (save-excursion
11219            (set-buffer copy-buf)
11220            (gnus-request-article-this-buffer article gnus-newsgroup-name)
11221            (gnus-request-accept-article
11222             (if select-method select-method to-newsgroup)
11223             (not articles))))
11224         ;; Crosspost the article.
11225         ((eq action 'crosspost)
11226          (let ((xref (mail-header-xref (gnus-summary-article-header article))))
11227            (setq new-xref (concat gnus-newsgroup-name ":" article))
11228            (if (and xref (not (string= xref "")))
11229                (progn
11230                  (when (string-match "^Xref: " xref)
11231                    (setq xref (substring xref (match-end 0))))
11232                  (setq new-xref (concat xref " " new-xref)))
11233              (setq new-xref (concat (system-name) " " new-xref)))
11234            (save-excursion
11235              (set-buffer copy-buf)
11236              (gnus-request-article-this-buffer article gnus-newsgroup-name)
11237              (nnheader-replace-header "xref" new-xref)
11238              (gnus-request-accept-article
11239               (if select-method select-method to-newsgroup)
11240               (not articles)))))))
11241       (if (not art-group)
11242           (gnus-message 1 "Couldn't %s article %s"
11243                         (cadr (assq action names)) article)
11244         (let* ((entry
11245                 (or
11246                  (gnus-gethash (car art-group) gnus-newsrc-hashtb)
11247                  (gnus-gethash
11248                   (gnus-group-prefixed-name
11249                    (car art-group)
11250                    (if select-method (list select-method "")
11251                      (gnus-find-method-for-group to-newsgroup)))
11252                   gnus-newsrc-hashtb)))
11253                (info (nth 2 entry))
11254                (to-group (gnus-info-group info)))
11255           ;; Update the group that has been moved to.
11256           (when (and info
11257                      (memq action '(move copy)))
11258             (unless (member to-group to-groups)
11259               (push to-group to-groups))
11260
11261             (unless (memq article gnus-newsgroup-unreads)
11262               (gnus-info-set-read
11263                info (gnus-add-to-range (gnus-info-read info)
11264                                        (list (cdr art-group)))))
11265
11266             ;; Copy any marks over to the new group.
11267             (let ((marks gnus-article-mark-lists)
11268                   (to-article (cdr art-group)))
11269
11270               ;; See whether the article is to be put in the cache.
11271               (when gnus-use-cache
11272                 (gnus-cache-possibly-enter-article
11273                  to-group to-article
11274                  (let ((header (copy-sequence
11275                                 (gnus-summary-article-header article))))
11276                    (mail-header-set-number header to-article)
11277                    header)
11278                  (memq article gnus-newsgroup-marked)
11279                  (memq article gnus-newsgroup-dormant)
11280                  (memq article gnus-newsgroup-unreads)))
11281
11282               (while marks
11283                 (when (memq article (symbol-value
11284                                      (intern (format "gnus-newsgroup-%s"
11285                                                      (caar marks)))))
11286                   ;; If the other group is the same as this group,
11287                   ;; then we have to add the mark to the list.
11288                   (when (equal to-group gnus-newsgroup-name)
11289                     (set (intern (format "gnus-newsgroup-%s" (caar marks)))
11290                          (cons to-article
11291                                (symbol-value
11292                                 (intern (format "gnus-newsgroup-%s"
11293                                                 (caar marks)))))))
11294                   ;; Copy mark to other group.
11295                   (gnus-add-marked-articles
11296                    to-group (cdar marks) (list to-article) info))
11297                 (setq marks (cdr marks)))))
11298
11299           ;; Update the Xref header in this article to point to
11300           ;; the new crossposted article we have just created.
11301           (when (eq action 'crosspost)
11302             (save-excursion
11303               (set-buffer copy-buf)
11304               (gnus-request-article-this-buffer article gnus-newsgroup-name)
11305               (nnheader-replace-header
11306                "xref" (concat new-xref " " (gnus-group-prefixed-name
11307                                             (car art-group) to-method)
11308                               ":" (cdr art-group)))
11309               (gnus-request-replace-article
11310                article gnus-newsgroup-name (current-buffer)))))
11311
11312         (gnus-summary-goto-subject article)
11313         (when (eq action 'move)
11314           (gnus-summary-mark-article article gnus-canceled-mark)))
11315       (gnus-summary-remove-process-mark article))
11316     ;; Re-activate all groups that have been moved to.
11317     (while to-groups
11318       (gnus-activate-group (pop to-groups)))
11319     
11320     (gnus-kill-buffer copy-buf)
11321     (gnus-summary-position-point)
11322     (gnus-set-mode-line 'summary)))
11323
11324 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
11325   "Move the current article to a different newsgroup.
11326 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
11327 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
11328 re-spool using this method."
11329   (interactive "P")
11330   (gnus-summary-move-article n nil select-method 'copy))
11331
11332 (defun gnus-summary-crosspost-article (&optional n)
11333   "Crosspost the current article to some other group."
11334   (interactive "P")
11335   (gnus-summary-move-article n nil nil 'crosspost))
11336
11337 (defun gnus-summary-respool-article (&optional n respool-method)
11338   "Respool the current article.
11339 The article will be squeezed through the mail spooling process again,
11340 which means that it will be put in some mail newsgroup or other
11341 depending on `nnmail-split-methods'.
11342 If N is a positive number, respool the N next articles.
11343 If N is a negative number, respool the N previous articles.
11344 If N is nil and any articles have been marked with the process mark,
11345 respool those articles instead.
11346
11347 Respooling can be done both from mail groups and \"real\" newsgroups.
11348 In the former case, the articles in question will be moved from the
11349 current group into whatever groups they are destined to.  In the
11350 latter case, they will be copied into the relevant groups."
11351   (interactive "P")
11352   (gnus-set-global-variables)
11353   (let ((respool-methods (gnus-methods-using 'respool))
11354         (methname
11355          (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name)))))
11356     (unless respool-method
11357       (setq respool-method
11358             (completing-read
11359              "What method do you want to use when respooling? "
11360              respool-methods nil t (cons methname 0))))
11361     (unless (string= respool-method "")
11362       (if (assoc (symbol-name
11363                   (car (gnus-find-method-for-group gnus-newsgroup-name)))
11364                  respool-methods)
11365           (gnus-summary-move-article n nil (intern respool-method))
11366         (gnus-summary-copy-article n nil (intern respool-method))))))
11367
11368 (defun gnus-summary-import-article (file)
11369   "Import a random file into a mail newsgroup."
11370   (interactive "fImport file: ")
11371   (gnus-set-global-variables)
11372   (let ((group gnus-newsgroup-name)
11373         (now (current-time))
11374         atts lines)
11375     (or (gnus-check-backend-function 'request-accept-article group)
11376         (error "%s does not support article importing" group))
11377     (or (file-readable-p file)
11378         (not (file-regular-p file))
11379         (error "Can't read %s" file))
11380     (save-excursion
11381       (set-buffer (get-buffer-create " *import file*"))
11382       (buffer-disable-undo (current-buffer))
11383       (erase-buffer)
11384       (insert-file-contents file)
11385       (goto-char (point-min))
11386       (unless (nnheader-article-p)
11387         ;; This doesn't look like an article, so we fudge some headers.
11388         (setq atts (file-attributes file)
11389               lines (count-lines (point-min) (point-max)))
11390         (insert "From: " (read-string "From: ") "\n"
11391                 "Subject: " (read-string "Subject: ") "\n"
11392                 "Date: " (timezone-make-date-arpa-standard
11393                           (current-time-string (nth 5 atts))
11394                           (current-time-zone now)
11395                           (current-time-zone now)) "\n"
11396                 "Message-ID: " (gnus-inews-message-id) "\n"
11397                 "Lines: " (int-to-string lines) "\n"
11398                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
11399       (gnus-request-accept-article group t)
11400       (kill-buffer (current-buffer)))))
11401
11402 (defun gnus-summary-expire-articles ()
11403   "Expire all articles that are marked as expirable in the current group."
11404   (interactive)
11405   (gnus-set-global-variables)
11406   (when (gnus-check-backend-function
11407          'request-expire-articles gnus-newsgroup-name)
11408     ;; This backend supports expiry.
11409     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
11410            (expirable (if total
11411                           (gnus-list-of-read-articles gnus-newsgroup-name)
11412                         (setq gnus-newsgroup-expirable
11413                               (sort gnus-newsgroup-expirable '<))))
11414            (expiry-wait (gnus-group-get-parameter
11415                          gnus-newsgroup-name 'expiry-wait))
11416            es)
11417       (when expirable
11418         ;; There are expirable articles in this group, so we run them
11419         ;; through the expiry process.
11420         (gnus-message 6 "Expiring articles...")
11421         ;; The list of articles that weren't expired is returned.
11422         (if expiry-wait
11423             (let ((nnmail-expiry-wait-function nil)
11424                   (nnmail-expiry-wait expiry-wait))
11425               (setq es (gnus-request-expire-articles
11426                         expirable gnus-newsgroup-name)))
11427           (setq es (gnus-request-expire-articles
11428                     expirable gnus-newsgroup-name)))
11429         (or total (setq gnus-newsgroup-expirable es))
11430         ;; We go through the old list of expirable, and mark all
11431         ;; really expired articles as nonexistent.
11432         (unless (eq es expirable)       ;If nothing was expired, we don't mark.
11433           (let ((gnus-use-cache nil))
11434             (while expirable
11435               (unless (memq (car expirable) es)
11436                 (when (gnus-data-find (car expirable))
11437                   (gnus-summary-mark-article
11438                    (car expirable) gnus-canceled-mark)))
11439               (setq expirable (cdr expirable)))))
11440         (gnus-message 6 "Expiring articles...done")))))
11441
11442 (defun gnus-summary-expire-articles-now ()
11443   "Expunge all expirable articles in the current group.
11444 This means that *all* articles that are marked as expirable will be
11445 deleted forever, right now."
11446   (interactive)
11447   (gnus-set-global-variables)
11448   (or gnus-expert-user
11449       (gnus-y-or-n-p
11450        "Are you really, really, really sure you want to expunge? ")
11451       (error "Phew!"))
11452   (let ((nnmail-expiry-wait 'immediate)
11453         (nnmail-expiry-wait-function nil))
11454     (gnus-summary-expire-articles)))
11455
11456 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
11457 (defun gnus-summary-delete-article (&optional n)
11458   "Delete the N next (mail) articles.
11459 This command actually deletes articles.  This is not a marking
11460 command.  The article will disappear forever from your life, never to
11461 return.
11462 If N is negative, delete backwards.
11463 If N is nil and articles have been marked with the process mark,
11464 delete these instead."
11465   (interactive "P")
11466   (gnus-set-global-variables)
11467   (or (gnus-check-backend-function 'request-expire-articles
11468                                    gnus-newsgroup-name)
11469       (error "The current newsgroup does not support article deletion."))
11470   ;; Compute the list of articles to delete.
11471   (let ((articles (gnus-summary-work-articles n))
11472         not-deleted)
11473     (if (and gnus-novice-user
11474              (not (gnus-y-or-n-p
11475                    (format "Do you really want to delete %s forever? "
11476                            (if (> (length articles) 1) "these articles"
11477                              "this article")))))
11478         ()
11479       ;; Delete the articles.
11480       (setq not-deleted (gnus-request-expire-articles
11481                          articles gnus-newsgroup-name 'force))
11482       (while articles
11483         (gnus-summary-remove-process-mark (car articles))
11484         ;; The backend might not have been able to delete the article
11485         ;; after all.
11486         (or (memq (car articles) not-deleted)
11487             (gnus-summary-mark-article (car articles) gnus-canceled-mark))
11488         (setq articles (cdr articles))))
11489     (gnus-summary-position-point)
11490     (gnus-set-mode-line 'summary)
11491     not-deleted))
11492
11493 (defun gnus-summary-edit-article (&optional force)
11494   "Enter into a buffer and edit the current article.
11495 This will have permanent effect only in mail groups.
11496 If FORCE is non-nil, allow editing of articles even in read-only
11497 groups."
11498   (interactive "P")
11499   (save-excursion
11500     (set-buffer gnus-summary-buffer)
11501     (gnus-set-global-variables)
11502     (when (and (not force)
11503                (gnus-group-read-only-p))
11504       (error "The current newsgroup does not support article editing."))
11505     (gnus-summary-select-article t nil t)
11506     (gnus-configure-windows 'article)
11507     (select-window (get-buffer-window gnus-article-buffer))
11508     (gnus-message 6 "C-c C-c to end edits")
11509     (setq buffer-read-only nil)
11510     (text-mode)
11511     (use-local-map (copy-keymap (current-local-map)))
11512     (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
11513     (buffer-enable-undo)
11514     (widen)
11515     (goto-char (point-min))
11516     (search-forward "\n\n" nil t)))
11517
11518 (defun gnus-summary-edit-article-done ()
11519   "Make edits to the current article permanent."
11520   (interactive)
11521   (if (gnus-group-read-only-p)
11522       (progn
11523         (gnus-summary-edit-article-postpone)
11524         (gnus-message
11525          1 "The current newsgroup does not support article editing.")
11526         (ding))
11527     (let ((buf (format "%s" (buffer-string))))
11528       (erase-buffer)
11529       (insert buf)
11530       (if (not (gnus-request-replace-article
11531                 (cdr gnus-article-current) (car gnus-article-current)
11532                 (current-buffer)))
11533           (error "Couldn't replace article.")
11534         (gnus-article-mode)
11535         (use-local-map gnus-article-mode-map)
11536         (setq buffer-read-only t)
11537         (buffer-disable-undo (current-buffer))
11538         (gnus-configure-windows 'summary)
11539         (gnus-summary-update-article (cdr gnus-article-current))
11540         (when gnus-use-cache
11541           (gnus-cache-update-article 
11542            (cdr gnus-article-current) (car gnus-article-current))))
11543       (run-hooks 'gnus-article-display-hook)
11544       (and (gnus-visual-p 'summary-highlight 'highlight)
11545            (run-hooks 'gnus-visual-mark-article-hook)))))
11546
11547 (defun gnus-summary-edit-article-postpone ()
11548   "Postpone changes to the current article."
11549   (interactive)
11550   (gnus-article-mode)
11551   (use-local-map gnus-article-mode-map)
11552   (setq buffer-read-only t)
11553   (buffer-disable-undo (current-buffer))
11554   (gnus-configure-windows 'summary)
11555   (and (gnus-visual-p 'summary-highlight 'highlight)
11556        (run-hooks 'gnus-visual-mark-article-hook)))
11557
11558 (defun gnus-summary-respool-query ()
11559   "Query where the respool algorithm would put this article."
11560   (interactive)
11561   (gnus-set-global-variables)
11562   (gnus-summary-select-article)
11563   (save-excursion
11564     (set-buffer gnus-article-buffer)
11565     (save-restriction
11566       (goto-char (point-min))
11567       (search-forward "\n\n")
11568       (narrow-to-region (point-min) (point))
11569       (pp-eval-expression
11570        (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
11571
11572 ;; Summary score commands.
11573
11574 ;; Suggested by boubaker@cenatls.cena.dgac.fr.
11575
11576 (defun gnus-summary-raise-score (n)
11577   "Raise the score of the current article by N."
11578   (interactive "p")
11579   (gnus-set-global-variables)
11580   (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
11581
11582 (defun gnus-summary-set-score (n)
11583   "Set the score of the current article to N."
11584   (interactive "p")
11585   (gnus-set-global-variables)
11586   (save-excursion
11587     (gnus-summary-show-thread)
11588     (let ((buffer-read-only nil))
11589       ;; Set score.
11590       (gnus-summary-update-mark
11591        (if (= n (or gnus-summary-default-score 0)) ? 
11592          (if (< n (or gnus-summary-default-score 0))
11593              gnus-score-below-mark gnus-score-over-mark)) 'score))
11594     (let* ((article (gnus-summary-article-number))
11595            (score (assq article gnus-newsgroup-scored)))
11596       (if score (setcdr score n)
11597         (setq gnus-newsgroup-scored
11598               (cons (cons article n) gnus-newsgroup-scored))))
11599     (gnus-summary-update-line)))
11600
11601 (defun gnus-summary-current-score ()
11602   "Return the score of the current article."
11603   (interactive)
11604   (gnus-set-global-variables)
11605   (message "%s" (gnus-summary-article-score)))
11606
11607 ;; Summary marking commands.
11608
11609 (defun gnus-summary-kill-same-subject-and-select (&optional unmark)
11610   "Mark articles which has the same subject as read, and then select the next.
11611 If UNMARK is positive, remove any kind of mark.
11612 If UNMARK is negative, tick articles."
11613   (interactive "P")
11614   (gnus-set-global-variables)
11615   (if unmark
11616       (setq unmark (prefix-numeric-value unmark)))
11617   (let ((count
11618          (gnus-summary-mark-same-subject
11619           (gnus-summary-article-subject) unmark)))
11620     ;; Select next unread article.  If auto-select-same mode, should
11621     ;; select the first unread article.
11622     (gnus-summary-next-article t (and gnus-auto-select-same
11623                                       (gnus-summary-article-subject)))
11624     (gnus-message 7 "%d article%s marked as %s"
11625                   count (if (= count 1) " is" "s are")
11626                   (if unmark "unread" "read"))))
11627
11628 (defun gnus-summary-kill-same-subject (&optional unmark)
11629   "Mark articles which has the same subject as read.
11630 If UNMARK is positive, remove any kind of mark.
11631 If UNMARK is negative, tick articles."
11632   (interactive "P")
11633   (gnus-set-global-variables)
11634   (if unmark
11635       (setq unmark (prefix-numeric-value unmark)))
11636   (let ((count
11637          (gnus-summary-mark-same-subject
11638           (gnus-summary-article-subject) unmark)))
11639     ;; If marked as read, go to next unread subject.
11640     (if (null unmark)
11641         ;; Go to next unread subject.
11642         (gnus-summary-next-subject 1 t))
11643     (gnus-message 7 "%d articles are marked as %s"
11644                   count (if unmark "unread" "read"))))
11645
11646 (defun gnus-summary-mark-same-subject (subject &optional unmark)
11647   "Mark articles with same SUBJECT as read, and return marked number.
11648 If optional argument UNMARK is positive, remove any kinds of marks.
11649 If optional argument UNMARK is negative, mark articles as unread instead."
11650   (let ((count 1))
11651     (save-excursion
11652       (cond
11653        ((null unmark)                   ; Mark as read.
11654         (while (and
11655                 (progn
11656                   (gnus-summary-mark-article-as-read gnus-killed-mark)
11657                   (gnus-summary-show-thread) t)
11658                 (gnus-summary-find-subject subject))
11659           (setq count (1+ count))))
11660        ((> unmark 0)                    ; Tick.
11661         (while (and
11662                 (progn
11663                   (gnus-summary-mark-article-as-unread gnus-ticked-mark)
11664                   (gnus-summary-show-thread) t)
11665                 (gnus-summary-find-subject subject))
11666           (setq count (1+ count))))
11667        (t                               ; Mark as unread.
11668         (while (and
11669                 (progn
11670                   (gnus-summary-mark-article-as-unread gnus-unread-mark)
11671                   (gnus-summary-show-thread) t)
11672                 (gnus-summary-find-subject subject))
11673           (setq count (1+ count)))))
11674       (gnus-set-mode-line 'summary)
11675       ;; Return the number of marked articles.
11676       count)))
11677
11678 (defun gnus-summary-mark-as-processable (n &optional unmark)
11679   "Set the process mark on the next N articles.
11680 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
11681 the process mark instead.  The difference between N and the actual
11682 number of articles marked is returned."
11683   (interactive "p")
11684   (gnus-set-global-variables)
11685   (let ((backward (< n 0))
11686         (n (abs n)))
11687     (while (and
11688             (> n 0)
11689             (if unmark
11690                 (gnus-summary-remove-process-mark
11691                  (gnus-summary-article-number))
11692               (gnus-summary-set-process-mark (gnus-summary-article-number)))
11693             (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
11694       (setq n (1- n)))
11695     (if (/= 0 n) (gnus-message 7 "No more articles"))
11696     (gnus-summary-recenter)
11697     (gnus-summary-position-point)
11698     n))
11699
11700 (defun gnus-summary-unmark-as-processable (n)
11701   "Remove the process mark from the next N articles.
11702 If N is negative, mark backward instead.  The difference between N and
11703 the actual number of articles marked is returned."
11704   (interactive "p")
11705   (gnus-set-global-variables)
11706   (gnus-summary-mark-as-processable n t))
11707
11708 (defun gnus-summary-unmark-all-processable ()
11709   "Remove the process mark from all articles."
11710   (interactive)
11711   (gnus-set-global-variables)
11712   (save-excursion
11713     (while gnus-newsgroup-processable
11714       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
11715   (gnus-summary-position-point))
11716
11717 (defun gnus-summary-mark-as-expirable (n)
11718   "Mark N articles forward as expirable.
11719 If N is negative, mark backward instead.  The difference between N and
11720 the actual number of articles marked is returned."
11721   (interactive "p")
11722   (gnus-set-global-variables)
11723   (gnus-summary-mark-forward n gnus-expirable-mark))
11724
11725 (defun gnus-summary-mark-article-as-replied (article)
11726   "Mark ARTICLE replied and update the summary line."
11727   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
11728   (let ((buffer-read-only nil))
11729     (when (gnus-summary-goto-subject article)
11730       (gnus-summary-update-secondary-mark article))))
11731
11732 (defun gnus-summary-set-bookmark (article)
11733   "Set a bookmark in current article."
11734   (interactive (list (gnus-summary-article-number)))
11735   (gnus-set-global-variables)
11736   (if (or (not (get-buffer gnus-article-buffer))
11737           (not gnus-current-article)
11738           (not gnus-article-current)
11739           (not (equal gnus-newsgroup-name (car gnus-article-current))))
11740       (error "No current article selected"))
11741   ;; Remove old bookmark, if one exists.
11742   (let ((old (assq article gnus-newsgroup-bookmarks)))
11743     (if old (setq gnus-newsgroup-bookmarks
11744                   (delq old gnus-newsgroup-bookmarks))))
11745   ;; Set the new bookmark, which is on the form
11746   ;; (article-number . line-number-in-body).
11747   (setq gnus-newsgroup-bookmarks
11748         (cons
11749          (cons article
11750                (save-excursion
11751                  (set-buffer gnus-article-buffer)
11752                  (count-lines
11753                   (min (point)
11754                        (save-excursion
11755                          (goto-char (point-min))
11756                          (search-forward "\n\n" nil t)
11757                          (point)))
11758                   (point))))
11759          gnus-newsgroup-bookmarks))
11760   (gnus-message 6 "A bookmark has been added to the current article."))
11761
11762 (defun gnus-summary-remove-bookmark (article)
11763   "Remove the bookmark from the current article."
11764   (interactive (list (gnus-summary-article-number)))
11765   (gnus-set-global-variables)
11766   ;; Remove old bookmark, if one exists.
11767   (let ((old (assq article gnus-newsgroup-bookmarks)))
11768     (if old
11769         (progn
11770           (setq gnus-newsgroup-bookmarks
11771                 (delq old gnus-newsgroup-bookmarks))
11772           (gnus-message 6 "Removed bookmark."))
11773       (gnus-message 6 "No bookmark in current article."))))
11774
11775 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
11776 (defun gnus-summary-mark-as-dormant (n)
11777   "Mark N articles forward as dormant.
11778 If N is negative, mark backward instead.  The difference between N and
11779 the actual number of articles marked is returned."
11780   (interactive "p")
11781   (gnus-set-global-variables)
11782   (gnus-summary-mark-forward n gnus-dormant-mark))
11783
11784 (defun gnus-summary-set-process-mark (article)
11785   "Set the process mark on ARTICLE and update the summary line."
11786   (setq gnus-newsgroup-processable
11787         (cons article
11788               (delq article gnus-newsgroup-processable)))
11789   (when (gnus-summary-goto-subject article)
11790     (gnus-summary-show-thread)
11791     (gnus-summary-update-secondary-mark article)))
11792
11793 (defun gnus-summary-remove-process-mark (article)
11794   "Remove the process mark from ARTICLE and update the summary line."
11795   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
11796   (when (gnus-summary-goto-subject article)
11797     (gnus-summary-show-thread)
11798     (gnus-summary-update-secondary-mark article)))
11799
11800 (defun gnus-summary-set-saved-mark (article)
11801   "Set the process mark on ARTICLE and update the summary line."
11802   (push article gnus-newsgroup-saved)
11803   (when (gnus-summary-goto-subject article)
11804     (gnus-summary-update-secondary-mark article)))
11805
11806 (defun gnus-summary-mark-forward (n &optional mark no-expire)
11807   "Mark N articles as read forwards.
11808 If N is negative, mark backwards instead.
11809 Mark with MARK.  If MARK is ? , ?! or ??, articles will be
11810 marked as unread.
11811 The difference between N and the actual number of articles marked is
11812 returned."
11813   (interactive "p")
11814   (gnus-set-global-variables)
11815   (let ((backward (< n 0))
11816         (gnus-summary-goto-unread
11817          (and gnus-summary-goto-unread
11818               (not (eq gnus-summary-goto-unread 'never))
11819               (not (memq mark (list gnus-unread-mark
11820                                     gnus-ticked-mark gnus-dormant-mark)))))
11821         (n (abs n))
11822         (mark (or mark gnus-del-mark)))
11823     (while (and (> n 0)
11824                 (gnus-summary-mark-article nil mark no-expire)
11825                 (zerop (gnus-summary-next-subject
11826                         (if backward -1 1)
11827                         (and gnus-summary-goto-unread
11828                              (not (eq gnus-summary-goto-unread 'never)))
11829                         t)))
11830       (setq n (1- n)))
11831     (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
11832     (gnus-summary-recenter)
11833     (gnus-summary-position-point)
11834     (gnus-set-mode-line 'summary)
11835     n))
11836
11837 (defun gnus-summary-mark-article-as-read (mark)
11838   "Mark the current article quickly as read with MARK."
11839   (let ((article (gnus-summary-article-number)))
11840     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11841     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11842     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11843     (setq gnus-newsgroup-reads
11844           (cons (cons article mark) gnus-newsgroup-reads))
11845     ;; Possibly remove from cache, if that is used.
11846     (and gnus-use-cache (gnus-cache-enter-remove-article article))
11847     ;; Allow the backend to change the mark.
11848     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
11849     ;; Check for auto-expiry.
11850     (when (and gnus-newsgroup-auto-expire
11851                (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
11852                    (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
11853                    (= mark gnus-ancient-mark)
11854                    (= mark gnus-read-mark) (= mark gnus-souped-mark)))
11855       (setq mark gnus-expirable-mark)
11856       (push article gnus-newsgroup-expirable))
11857     ;; Set the mark in the buffer.
11858     (gnus-summary-update-mark mark 'unread)
11859     t))
11860
11861 (defun gnus-summary-mark-article-as-unread (mark)
11862   "Mark the current article quickly as unread with MARK."
11863   (let ((article (gnus-summary-article-number)))
11864     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11865     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11866     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
11867     (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
11868     (cond ((= mark gnus-ticked-mark)
11869            (push article gnus-newsgroup-marked))
11870           ((= mark gnus-dormant-mark)
11871            (push article gnus-newsgroup-dormant))
11872           (t
11873            (push article gnus-newsgroup-unreads)))
11874     (setq gnus-newsgroup-reads
11875           (delq (assq article gnus-newsgroup-reads)
11876                 gnus-newsgroup-reads))
11877
11878     ;; See whether the article is to be put in the cache.
11879     (and gnus-use-cache
11880          (vectorp (gnus-summary-article-header article))
11881          (save-excursion
11882            (gnus-cache-possibly-enter-article
11883             gnus-newsgroup-name article
11884             (gnus-summary-article-header article)
11885             (= mark gnus-ticked-mark)
11886             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
11887
11888     ;; Fix the mark.
11889     (gnus-summary-update-mark mark 'unread)
11890     t))
11891
11892 (defun gnus-summary-mark-article (&optional article mark no-expire)
11893   "Mark ARTICLE with MARK.  MARK can be any character.
11894 Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
11895 `??' (dormant) and `?E' (expirable).
11896 If MARK is nil, then the default character `?D' is used.
11897 If ARTICLE is nil, then the article on the current line will be
11898 marked."
11899   ;; The mark might be a string.
11900   (and (stringp mark)
11901        (setq mark (aref mark 0)))
11902   ;; If no mark is given, then we check auto-expiring.
11903   (and (not no-expire)
11904        gnus-newsgroup-auto-expire
11905        (or (not mark)
11906            (and (numberp mark)
11907                 (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
11908                     (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
11909                     (= mark gnus-read-mark) (= mark gnus-souped-mark))))
11910        (setq mark gnus-expirable-mark))
11911   (let* ((mark (or mark gnus-del-mark))
11912          (article (or article (gnus-summary-article-number))))
11913     (or article (error "No article on current line"))
11914     (if (or (= mark gnus-unread-mark)
11915             (= mark gnus-ticked-mark)
11916             (= mark gnus-dormant-mark))
11917         (gnus-mark-article-as-unread article mark)
11918       (gnus-mark-article-as-read article mark))
11919
11920     ;; See whether the article is to be put in the cache.
11921     (and gnus-use-cache
11922          (not (= mark gnus-canceled-mark))
11923          (vectorp (gnus-summary-article-header article))
11924          (save-excursion
11925            (gnus-cache-possibly-enter-article
11926             gnus-newsgroup-name article
11927             (gnus-summary-article-header article)
11928             (= mark gnus-ticked-mark)
11929             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
11930
11931     (if (gnus-summary-goto-subject article nil t)
11932         (let ((buffer-read-only nil))
11933           (gnus-summary-show-thread)
11934           ;; Fix the mark.
11935           (gnus-summary-update-mark mark 'unread)
11936           t))))
11937
11938 (defun gnus-summary-update-secondary-mark (article)
11939   "Update the secondary (read, process, cache) mark."
11940   (gnus-summary-update-mark
11941    (cond ((memq article gnus-newsgroup-processable)
11942           gnus-process-mark)
11943          ((memq article gnus-newsgroup-cached)
11944           gnus-cached-mark)
11945          ((memq article gnus-newsgroup-replied)
11946           gnus-replied-mark)
11947          ((memq article gnus-newsgroup-saved)
11948           gnus-saved-mark)
11949          (t gnus-unread-mark))
11950    'replied)
11951   (when (gnus-visual-p 'summary-highlight 'highlight)
11952     (run-hooks 'gnus-summary-update-hook))
11953   t)
11954
11955 (defun gnus-summary-update-mark (mark type)
11956   (beginning-of-line)
11957   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
11958         (buffer-read-only nil))
11959     (when forward
11960       ;; Go to the right position on the line.
11961       (forward-char forward)
11962       ;; Replace the old mark with the new mark.
11963       (subst-char-in-region (point) (1+ (point)) (following-char) mark)
11964       ;; Optionally update the marks by some user rule.
11965       (when (eq type 'unread)
11966         (gnus-data-set-mark
11967          (gnus-data-find (gnus-summary-article-number)) mark)
11968         (gnus-summary-update-line (eq mark gnus-unread-mark))))))
11969
11970 (defun gnus-mark-article-as-read (article &optional mark)
11971   "Enter ARTICLE in the pertinent lists and remove it from others."
11972   ;; Make the article expirable.
11973   (let ((mark (or mark gnus-del-mark)))
11974     (if (= mark gnus-expirable-mark)
11975         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
11976       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
11977     ;; Remove from unread and marked lists.
11978     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11979     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11980     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11981     (push (cons article mark) gnus-newsgroup-reads)
11982     ;; Possibly remove from cache, if that is used.
11983     (when gnus-use-cache
11984       (gnus-cache-enter-remove-article article))))
11985
11986 (defun gnus-mark-article-as-unread (article &optional mark)
11987   "Enter ARTICLE in the pertinent lists and remove it from others."
11988   (let ((mark (or mark gnus-ticked-mark)))
11989     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11990     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11991     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
11992     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11993     (cond ((= mark gnus-ticked-mark)
11994            (push article gnus-newsgroup-marked))
11995           ((= mark gnus-dormant-mark)
11996            (push article gnus-newsgroup-dormant))
11997           (t
11998            (push article gnus-newsgroup-unreads)))
11999     (setq gnus-newsgroup-reads
12000           (delq (assq article gnus-newsgroup-reads)
12001                 gnus-newsgroup-reads))))
12002
12003 (defalias 'gnus-summary-mark-as-unread-forward
12004   'gnus-summary-tick-article-forward)
12005 (make-obsolete 'gnus-summary-mark-as-unread-forward
12006                'gnus-summary-tick-article-forward)
12007 (defun gnus-summary-tick-article-forward (n)
12008   "Tick N articles forwards.
12009 If N is negative, tick backwards instead.
12010 The difference between N and the number of articles ticked is returned."
12011   (interactive "p")
12012   (gnus-summary-mark-forward n gnus-ticked-mark))
12013
12014 (defalias 'gnus-summary-mark-as-unread-backward
12015   'gnus-summary-tick-article-backward)
12016 (make-obsolete 'gnus-summary-mark-as-unread-backward
12017                'gnus-summary-tick-article-backward)
12018 (defun gnus-summary-tick-article-backward (n)
12019   "Tick N articles backwards.
12020 The difference between N and the number of articles ticked is returned."
12021   (interactive "p")
12022   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
12023
12024 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
12025 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
12026 (defun gnus-summary-tick-article (&optional article clear-mark)
12027   "Mark current article as unread.
12028 Optional 1st argument ARTICLE specifies article number to be marked as unread.
12029 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
12030   (interactive)
12031   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
12032                                        gnus-ticked-mark)))
12033
12034 (defun gnus-summary-mark-as-read-forward (n)
12035   "Mark N articles as read forwards.
12036 If N is negative, mark backwards instead.
12037 The difference between N and the actual number of articles marked is
12038 returned."
12039   (interactive "p")
12040   (gnus-summary-mark-forward n gnus-del-mark t))
12041
12042 (defun gnus-summary-mark-as-read-backward (n)
12043   "Mark the N articles as read backwards.
12044 The difference between N and the actual number of articles marked is
12045 returned."
12046   (interactive "p")
12047   (gnus-summary-mark-forward (- n) gnus-del-mark t))
12048
12049 (defun gnus-summary-mark-as-read (&optional article mark)
12050   "Mark current article as read.
12051 ARTICLE specifies the article to be marked as read.
12052 MARK specifies a string to be inserted at the beginning of the line."
12053   (gnus-summary-mark-article article mark))
12054
12055 (defun gnus-summary-clear-mark-forward (n)
12056   "Clear marks from N articles forward.
12057 If N is negative, clear backward instead.
12058 The difference between N and the number of marks cleared is returned."
12059   (interactive "p")
12060   (gnus-summary-mark-forward n gnus-unread-mark))
12061
12062 (defun gnus-summary-clear-mark-backward (n)
12063   "Clear marks from N articles backward.
12064 The difference between N and the number of marks cleared is returned."
12065   (interactive "p")
12066   (gnus-summary-mark-forward (- n) gnus-unread-mark))
12067
12068 (defun gnus-summary-mark-unread-as-read ()
12069   "Intended to be used by `gnus-summary-mark-article-hook'."
12070   (when (memq gnus-current-article gnus-newsgroup-unreads)
12071     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
12072
12073 (defun gnus-summary-mark-read-and-unread-as-read ()
12074   "Intended to be used by `gnus-summary-mark-article-hook'."
12075   (let ((mark (gnus-summary-article-mark)))
12076     (when (or (gnus-unread-mark-p mark)
12077               (gnus-read-mark-p mark))
12078       (gnus-summary-mark-article gnus-current-article gnus-read-mark))))
12079
12080 (defun gnus-summary-mark-region-as-read (point mark all)
12081   "Mark all unread articles between point and mark as read.
12082 If given a prefix, mark all articles between point and mark as read,
12083 even ticked and dormant ones."
12084   (interactive "r\nP")
12085   (save-excursion
12086     (let (article)
12087       (goto-char point)
12088       (beginning-of-line)
12089       (while (and
12090               (< (point) mark)
12091               (progn
12092                 (when (or all
12093                           (memq (setq article (gnus-summary-article-number))
12094                                 gnus-newsgroup-unreads))
12095                   (gnus-summary-mark-article article gnus-del-mark))
12096                 t)
12097               (gnus-summary-find-next))))))
12098
12099 (defun gnus-summary-mark-below (score mark)
12100   "Mark articles with score less than SCORE with MARK."
12101   (interactive "P\ncMark: ")
12102   (gnus-set-global-variables)
12103   (setq score (if score
12104                   (prefix-numeric-value score)
12105                 (or gnus-summary-default-score 0)))
12106   (save-excursion
12107     (set-buffer gnus-summary-buffer)
12108     (goto-char (point-min))
12109     (while 
12110         (progn
12111           (and (< (gnus-summary-article-score) score)
12112                (gnus-summary-mark-article nil mark))
12113           (gnus-summary-find-next)))))
12114
12115 (defun gnus-summary-kill-below (&optional score)
12116   "Mark articles with score below SCORE as read."
12117   (interactive "P")
12118   (gnus-set-global-variables)
12119   (gnus-summary-mark-below score gnus-killed-mark))
12120
12121 (defun gnus-summary-clear-above (&optional score)
12122   "Clear all marks from articles with score above SCORE."
12123   (interactive "P")
12124   (gnus-set-global-variables)
12125   (gnus-summary-mark-above score gnus-unread-mark))
12126
12127 (defun gnus-summary-tick-above (&optional score)
12128   "Tick all articles with score above SCORE."
12129   (interactive "P")
12130   (gnus-set-global-variables)
12131   (gnus-summary-mark-above score gnus-ticked-mark))
12132
12133 (defun gnus-summary-mark-above (score mark)
12134   "Mark articles with score over SCORE with MARK."
12135   (interactive "P\ncMark: ")
12136   (gnus-set-global-variables)
12137   (setq score (if score
12138                   (prefix-numeric-value score)
12139                 (or gnus-summary-default-score 0)))
12140   (save-excursion
12141     (set-buffer gnus-summary-buffer)
12142     (goto-char (point-min))
12143     (while (and (progn
12144                   (if (> (gnus-summary-article-score) score)
12145                       (gnus-summary-mark-article nil mark))
12146                   t)
12147                 (gnus-summary-find-next)))))
12148
12149 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
12150 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
12151 (defun gnus-summary-limit-include-expunged ()
12152   "Display all the hidden articles that were expunged for low scores."
12153   (interactive)
12154   (gnus-set-global-variables)
12155   (let ((buffer-read-only nil))
12156     (let ((scored gnus-newsgroup-scored)
12157           headers h)
12158       (while scored
12159         (or (gnus-summary-goto-subject (caar scored))
12160             (and (setq h (gnus-summary-article-header (caar scored)))
12161                  (< (cdar scored) gnus-summary-expunge-below)
12162                  (setq headers (cons h headers))))
12163         (setq scored (cdr scored)))
12164       (or headers (error "No expunged articles hidden."))
12165       (goto-char (point-min))
12166       (gnus-summary-prepare-unthreaded (nreverse headers)))
12167     (goto-char (point-min))
12168     (gnus-summary-position-point)))
12169
12170 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
12171   "Mark all articles not marked as unread in this newsgroup as read.
12172 If prefix argument ALL is non-nil, all articles are marked as read.
12173 If QUIETLY is non-nil, no questions will be asked.
12174 If TO-HERE is non-nil, it should be a point in the buffer.  All
12175 articles before this point will be marked as read.
12176 The number of articles marked as read is returned."
12177   (interactive "P")
12178   (gnus-set-global-variables)
12179   (prog1
12180       (if (or quietly
12181               (not gnus-interactive-catchup) ;Without confirmation?
12182               gnus-expert-user
12183               (gnus-y-or-n-p
12184                (if all
12185                    "Mark absolutely all articles as read? "
12186                  "Mark all unread articles as read? ")))
12187           (if (and not-mark
12188                    (not gnus-newsgroup-adaptive)
12189                    (not gnus-newsgroup-auto-expire))
12190               (progn
12191                 (when all
12192                   (setq gnus-newsgroup-marked nil
12193                         gnus-newsgroup-dormant nil))
12194                 (setq gnus-newsgroup-unreads nil))
12195             ;; We actually mark all articles as canceled, which we
12196             ;; have to do when using auto-expiry or adaptive scoring.
12197             (gnus-summary-show-all-threads)
12198             (if (gnus-summary-first-subject (not all))
12199                 (while (and
12200                         (if to-here (< (point) to-here) t)
12201                         (gnus-summary-mark-article-as-read gnus-catchup-mark)
12202                         (gnus-summary-find-next (not all)))))
12203             (unless to-here
12204               (setq gnus-newsgroup-unreads nil))
12205             (gnus-set-mode-line 'summary)))
12206     (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
12207       (if (and (not to-here) (eq 'nnvirtual (car method)))
12208           (nnvirtual-catchup-group
12209            (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
12210     (gnus-summary-position-point)))
12211
12212 (defun gnus-summary-catchup-to-here (&optional all)
12213   "Mark all unticked articles before the current one as read.
12214 If ALL is non-nil, also mark ticked and dormant articles as read."
12215   (interactive "P")
12216   (gnus-set-global-variables)
12217   (save-excursion
12218     (let ((beg (point)))
12219       ;; We check that there are unread articles.
12220       (when (or all (gnus-summary-find-prev))
12221         (gnus-summary-catchup all t beg))))
12222   (gnus-summary-position-point))
12223
12224 (defun gnus-summary-catchup-all (&optional quietly)
12225   "Mark all articles in this newsgroup as read."
12226   (interactive "P")
12227   (gnus-set-global-variables)
12228   (gnus-summary-catchup t quietly))
12229
12230 (defun gnus-summary-catchup-and-exit (&optional all quietly)
12231   "Mark all articles not marked as unread in this newsgroup as read, then exit.
12232 If prefix argument ALL is non-nil, all articles are marked as read."
12233   (interactive "P")
12234   (gnus-set-global-variables)
12235   (gnus-summary-catchup all quietly nil 'fast)
12236   ;; Select next newsgroup or exit.
12237   (if (eq gnus-auto-select-next 'quietly)
12238       (gnus-summary-next-group nil)
12239     (gnus-summary-exit)))
12240
12241 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
12242   "Mark all articles in this newsgroup as read, and then exit."
12243   (interactive "P")
12244   (gnus-set-global-variables)
12245   (gnus-summary-catchup-and-exit t quietly))
12246
12247 ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
12248 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
12249   "Mark all articles in this group as read and select the next group.
12250 If given a prefix, mark all articles, unread as well as ticked, as
12251 read."
12252   (interactive "P")
12253   (gnus-set-global-variables)
12254   (save-excursion
12255     (gnus-summary-catchup all))
12256   (gnus-summary-next-article t nil nil t))
12257
12258 ;; Thread-based commands.
12259
12260 (defun gnus-summary-articles-in-thread (&optional article)
12261   "Return a list of all articles in the current thread.
12262 If ARTICLE is non-nil, return all articles in the thread that starts
12263 with that article."
12264   (let* ((article (or article (gnus-summary-article-number)))
12265          (data (gnus-data-find-list article))
12266          (top-level (gnus-data-level (car data)))
12267          (top-subject
12268           (cond ((null gnus-thread-operation-ignore-subject)
12269                  (gnus-simplify-subject-re
12270                   (mail-header-subject (gnus-data-header (car data)))))
12271                 ((eq gnus-thread-operation-ignore-subject 'fuzzy)
12272                  (gnus-simplify-subject-fuzzy
12273                   (mail-header-subject (gnus-data-header (car data)))))
12274                 (t nil)))
12275          articles)
12276     (if (not data)
12277         ()                              ; This article doesn't exist.
12278       (while data
12279         (and (or (not top-subject)
12280                  (string= top-subject
12281                           (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
12282                               (gnus-simplify-subject-fuzzy
12283                                (mail-header-subject
12284                                 (gnus-data-header (car data))))
12285                             (gnus-simplify-subject-re
12286                              (mail-header-subject
12287                               (gnus-data-header (car data)))))))
12288              (setq articles (cons (gnus-data-number (car data)) articles)))
12289         (if (and (setq data (cdr data))
12290                  (> (gnus-data-level (car data)) top-level))
12291             ()
12292           (setq data nil)))
12293       ;; Return the list of articles.
12294       (nreverse articles))))
12295
12296 (defun gnus-summary-rethread-current ()
12297   "Rethread the thread the current article is part of."
12298   (interactive)
12299   (gnus-set-global-variables)
12300   (let* ((gnus-show-threads t)
12301          (article (gnus-summary-article-number))
12302          (id (mail-header-id (gnus-summary-article-header)))
12303          (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id)))))
12304     (unless id
12305       (error "No article on the current line"))
12306     (gnus-rebuild-thread id)
12307     (gnus-summary-goto-subject article)))
12308
12309 (defun gnus-summary-reparent-thread ()
12310   "Make current article child of the marked (or previous) article.
12311
12312 Note that the re-threading will only work if `gnus-thread-ignore-subject'
12313 is non-nil or the Subject: of both articles are the same."
12314   (interactive)
12315   (or (not (gnus-group-read-only-p))
12316       (error "The current newsgroup does not support article editing."))
12317   (or (<= (length gnus-newsgroup-processable) 1)
12318       (error "No more than one article may be marked."))
12319   (save-window-excursion
12320     (let ((gnus-article-buffer " *reparent*")
12321           (current-article (gnus-summary-article-number))
12322           ; first grab the marked article, otherwise one line up.
12323           (parent-article (if (not (null gnus-newsgroup-processable))
12324                               (car gnus-newsgroup-processable)
12325                             (save-excursion
12326                               (if (eq (forward-line -1) 0)
12327                                   (gnus-summary-article-number)
12328                                 (error "Beginning of summary buffer."))))))
12329       (or (not (eq current-article parent-article))
12330           (error "An article may not be self-referential."))
12331       (let ((message-id (mail-header-id 
12332                          (gnus-summary-article-header parent-article))))
12333         (or (and message-id (not (equal message-id "")))
12334             (error "No message-id in desired parent."))
12335         (gnus-summary-select-article t t nil current-article)
12336         (set-buffer gnus-article-buffer)
12337         (setq buffer-read-only nil)
12338         (let ((buf (format "%s" (buffer-string))))
12339           (erase-buffer)
12340           (insert buf))
12341         (goto-char (point-min))
12342         (if (search-forward-regexp "^References: " nil t)
12343             (insert message-id " " )
12344           (insert "References: " message-id "\n"))
12345         (or (gnus-request-replace-article current-article
12346                                           (car gnus-article-current)
12347                                           gnus-article-buffer)
12348             (error "Couldn't replace article."))
12349         (set-buffer gnus-summary-buffer)
12350         (gnus-summary-unmark-all-processable)
12351         (gnus-summary-rethread-current)
12352         (message "Article %d is now the child of article %d."
12353                  current-article parent-article)))))
12354
12355 (defun gnus-summary-toggle-threads (&optional arg)
12356   "Toggle showing conversation threads.
12357 If ARG is positive number, turn showing conversation threads on."
12358   (interactive "P")
12359   (gnus-set-global-variables)
12360   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
12361     (setq gnus-show-threads
12362           (if (null arg) (not gnus-show-threads)
12363             (> (prefix-numeric-value arg) 0)))
12364     (gnus-summary-prepare)
12365     (gnus-summary-goto-subject current)
12366     (gnus-summary-position-point)))
12367
12368 (defun gnus-summary-show-all-threads ()
12369   "Show all threads."
12370   (interactive)
12371   (gnus-set-global-variables)
12372   (save-excursion
12373     (let ((buffer-read-only nil))
12374       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
12375   (gnus-summary-position-point))
12376
12377 (defun gnus-summary-show-thread ()
12378   "Show thread subtrees.
12379 Returns nil if no thread was there to be shown."
12380   (interactive)
12381   (gnus-set-global-variables)
12382   (let ((buffer-read-only nil)
12383         (orig (point))
12384         ;; first goto end then to beg, to have point at beg after let
12385         (end (progn (end-of-line) (point)))
12386         (beg (progn (beginning-of-line) (point))))
12387     (prog1
12388         ;; Any hidden lines here?
12389         (search-forward "\r" end t)
12390       (subst-char-in-region beg end ?\^M ?\n t)
12391       (goto-char orig)
12392       (gnus-summary-position-point))))
12393
12394 (defun gnus-summary-hide-all-threads ()
12395   "Hide all thread subtrees."
12396   (interactive)
12397   (gnus-set-global-variables)
12398   (save-excursion
12399     (goto-char (point-min))
12400     (gnus-summary-hide-thread)
12401     (while (zerop (gnus-summary-next-thread 1 t))
12402       (gnus-summary-hide-thread)))
12403   (gnus-summary-position-point))
12404
12405 (defun gnus-summary-hide-thread ()
12406   "Hide thread subtrees.
12407 Returns nil if no threads were there to be hidden."
12408   (interactive)
12409   (gnus-set-global-variables)
12410   (let ((buffer-read-only nil)
12411         (start (point))
12412         (article (gnus-summary-article-number)))
12413     (goto-char start)
12414     ;; Go forward until either the buffer ends or the subthread
12415     ;; ends.
12416     (when (and (not (eobp))
12417                (or (zerop (gnus-summary-next-thread 1 t))
12418                    (goto-char (point-max))))
12419       (prog1
12420           (if (and (> (point) start)
12421                    (search-backward "\n" start t))
12422               (progn
12423                 (subst-char-in-region start (point) ?\n ?\^M)
12424                 (gnus-summary-goto-subject article))
12425             (goto-char start)
12426             nil)
12427         ;;(gnus-summary-position-point)
12428         ))))
12429
12430 (defun gnus-summary-go-to-next-thread (&optional previous)
12431   "Go to the same level (or less) next thread.
12432 If PREVIOUS is non-nil, go to previous thread instead.
12433 Return the article number moved to, or nil if moving was impossible."
12434   (let ((level (gnus-summary-thread-level))
12435         (way (if previous -1 1))
12436         (beg (point)))
12437     (forward-line way)
12438     (while (and (not (eobp))
12439                 (< level (gnus-summary-thread-level)))
12440       (forward-line way))
12441     (if (eobp)
12442         (progn
12443           (goto-char beg)
12444           nil)
12445       (setq beg (point))
12446       (prog1
12447           (gnus-summary-article-number)
12448         (goto-char beg)))))
12449
12450 (defun gnus-summary-go-to-next-thread-old (&optional previous)
12451   "Go to the same level (or less) next thread.
12452 If PREVIOUS is non-nil, go to previous thread instead.
12453 Return the article number moved to, or nil if moving was impossible."
12454   (if (and (eq gnus-summary-make-false-root 'dummy)
12455            (gnus-summary-article-intangible-p))
12456       (let ((beg (point)))
12457         (while (and (zerop (forward-line 1))
12458                     (not (gnus-summary-article-intangible-p))
12459                     (not (zerop (save-excursion 
12460                                   (gnus-summary-thread-level))))))
12461         (if (eobp)
12462             (progn
12463               (goto-char beg)
12464               nil)
12465           (point)))
12466     (let* ((level (gnus-summary-thread-level))
12467            (article (gnus-summary-article-number))
12468            (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
12469            oart)
12470       (while data
12471         (if (<= (gnus-data-level (car data)) level)
12472             (setq oart (gnus-data-number (car data))
12473                   data nil)
12474           (setq data (cdr data))))
12475       (and oart
12476            (gnus-summary-goto-subject oart)))))
12477
12478 (defun gnus-summary-next-thread (n &optional silent)
12479   "Go to the same level next N'th thread.
12480 If N is negative, search backward instead.
12481 Returns the difference between N and the number of skips actually
12482 done.
12483
12484 If SILENT, don't output messages."
12485   (interactive "p")
12486   (gnus-set-global-variables)
12487   (let ((backward (< n 0))
12488         (n (abs n))
12489         old dum int)
12490     (while (and (> n 0)
12491                 (gnus-summary-go-to-next-thread backward))
12492       (decf n))
12493     (unless silent 
12494       (gnus-summary-position-point))
12495     (when (and (not silent) (/= 0 n))
12496       (gnus-message 7 "No more threads"))
12497     n))
12498
12499 (defun gnus-summary-prev-thread (n)
12500   "Go to the same level previous N'th thread.
12501 Returns the difference between N and the number of skips actually
12502 done."
12503   (interactive "p")
12504   (gnus-set-global-variables)
12505   (gnus-summary-next-thread (- n)))
12506
12507 (defun gnus-summary-go-down-thread ()
12508   "Go down one level in the current thread."
12509   (let ((children (gnus-summary-article-children)))
12510     (and children
12511          (gnus-summary-goto-subject (car children)))))
12512
12513 (defun gnus-summary-go-up-thread ()
12514   "Go up one level in the current thread."
12515   (let ((parent (gnus-summary-article-parent)))
12516     (and parent
12517          (gnus-summary-goto-subject parent))))
12518
12519 (defun gnus-summary-down-thread (n)
12520   "Go down thread N steps.
12521 If N is negative, go up instead.
12522 Returns the difference between N and how many steps down that were
12523 taken."
12524   (interactive "p")
12525   (gnus-set-global-variables)
12526   (let ((up (< n 0))
12527         (n (abs n)))
12528     (while (and (> n 0)
12529                 (if up (gnus-summary-go-up-thread)
12530                   (gnus-summary-go-down-thread)))
12531       (setq n (1- n)))
12532     (gnus-summary-position-point)
12533     (if (/= 0 n) (gnus-message 7 "Can't go further"))
12534     n))
12535
12536 (defun gnus-summary-up-thread (n)
12537   "Go up thread N steps.
12538 If N is negative, go up instead.
12539 Returns the difference between N and how many steps down that were
12540 taken."
12541   (interactive "p")
12542   (gnus-set-global-variables)
12543   (gnus-summary-down-thread (- n)))
12544
12545 (defun gnus-summary-top-thread ()
12546   "Go to the top of the thread."
12547   (interactive)
12548   (gnus-set-global-variables)
12549   (while (gnus-summary-go-up-thread))
12550   (gnus-summary-article-number))
12551
12552 (defun gnus-summary-kill-thread (&optional unmark)
12553   "Mark articles under current thread as read.
12554 If the prefix argument is positive, remove any kinds of marks.
12555 If the prefix argument is negative, tick articles instead."
12556   (interactive "P")
12557   (gnus-set-global-variables)
12558   (if unmark
12559       (setq unmark (prefix-numeric-value unmark)))
12560   (let ((articles (gnus-summary-articles-in-thread)))
12561     (save-excursion
12562       ;; Expand the thread.
12563       (gnus-summary-show-thread)
12564       ;; Mark all the articles.
12565       (while articles
12566         (gnus-summary-goto-subject (car articles))
12567         (cond ((null unmark)
12568                (gnus-summary-mark-article-as-read gnus-killed-mark))
12569               ((> unmark 0)
12570                (gnus-summary-mark-article-as-unread gnus-unread-mark))
12571               (t
12572                (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
12573         (setq articles (cdr articles))))
12574     ;; Hide killed subtrees.
12575     (and (null unmark)
12576          gnus-thread-hide-killed
12577          (gnus-summary-hide-thread))
12578     ;; If marked as read, go to next unread subject.
12579     (if (null unmark)
12580         ;; Go to next unread subject.
12581         (gnus-summary-next-subject 1 t)))
12582   (gnus-set-mode-line 'summary))
12583
12584 ;; Summary sorting commands
12585
12586 (defun gnus-summary-sort-by-number (&optional reverse)
12587   "Sort summary buffer by article number.
12588 Argument REVERSE means reverse order."
12589   (interactive "P")
12590   (gnus-summary-sort 'number reverse))
12591
12592 (defun gnus-summary-sort-by-author (&optional reverse)
12593   "Sort summary buffer by author name alphabetically.
12594 If case-fold-search is non-nil, case of letters is ignored.
12595 Argument REVERSE means reverse order."
12596   (interactive "P")
12597   (gnus-summary-sort 'author reverse))
12598
12599 (defun gnus-summary-sort-by-subject (&optional reverse)
12600   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
12601 If case-fold-search is non-nil, case of letters is ignored.
12602 Argument REVERSE means reverse order."
12603   (interactive "P")
12604   (gnus-summary-sort 'subject reverse))
12605
12606 (defun gnus-summary-sort-by-date (&optional reverse)
12607   "Sort summary buffer by date.
12608 Argument REVERSE means reverse order."
12609   (interactive "P")
12610   (gnus-summary-sort 'date reverse))
12611
12612 (defun gnus-summary-sort-by-score (&optional reverse)
12613   "Sort summary buffer by score.
12614 Argument REVERSE means reverse order."
12615   (interactive "P")
12616   (gnus-summary-sort 'score reverse))
12617
12618 (defun gnus-summary-sort (predicate reverse)
12619   "Sort summary buffer by PREDICATE.  REVERSE means reverse order."
12620   (gnus-set-global-variables)
12621   (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
12622          (article (intern (format "gnus-article-sort-by-%s" predicate)))
12623          (gnus-thread-sort-functions
12624           (list
12625            (if (not reverse)
12626                thread
12627              `(lambda (t1 t2)
12628                 (,thread t2 t1)))))
12629          (gnus-article-sort-functions
12630           (list
12631            (if (not reverse)
12632                article
12633              `(lambda (t1 t2)
12634                 (,article t2 t1)))))
12635          (buffer-read-only)
12636          (gnus-summary-prepare-hook nil))
12637     ;; We do the sorting by regenerating the threads.
12638     (gnus-summary-prepare)
12639     ;; Hide subthreads if needed.
12640     (when (and gnus-show-threads gnus-thread-hide-subtree)
12641       (gnus-summary-hide-all-threads)))
12642   ;; If in async mode, we send some info to the backend.
12643   (when gnus-newsgroup-async
12644     (gnus-request-asynchronous
12645      gnus-newsgroup-name gnus-newsgroup-data)))
12646
12647 (defun gnus-sortable-date (date)
12648   "Make sortable string by string-lessp from DATE.
12649 Timezone package is used."
12650   (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S]
12651          (year (aref date 0))
12652          (month (aref date 1))
12653          (day (aref date 2)))
12654     (timezone-make-sortable-date
12655      year month day
12656      (timezone-make-time-string
12657       (aref date 3) (aref date 4) (aref date 5)))))
12658
12659 ;; Summary saving commands.
12660
12661 (defun gnus-summary-save-article (&optional n not-saved)
12662   "Save the current article using the default saver function.
12663 If N is a positive number, save the N next articles.
12664 If N is a negative number, save the N previous articles.
12665 If N is nil and any articles have been marked with the process mark,
12666 save those articles instead.
12667 The variable `gnus-default-article-saver' specifies the saver function."
12668   (interactive "P")
12669   (gnus-set-global-variables)
12670   (let ((articles (gnus-summary-work-articles n))
12671         file header article)
12672     (while articles
12673       (setq header (gnus-summary-article-header
12674                     (setq article (pop articles))))
12675       (if (not (vectorp header))
12676           ;; This is a pseudo-article.
12677           (if (assq 'name header)
12678               (gnus-copy-file (cdr (assq 'name header)))
12679             (gnus-message 1 "Article %d is unsaveable" article))
12680         ;; This is a real article.
12681         (save-window-excursion
12682           (gnus-summary-select-article t nil nil article))
12683         (unless gnus-save-all-headers
12684           ;; Remove headers accoring to `gnus-saved-headers'.
12685           (let ((gnus-visible-headers
12686                  (or gnus-saved-headers gnus-visible-headers)))
12687             (gnus-article-hide-headers nil t)))
12688         ;; Remove any X-Gnus lines.
12689         (save-excursion
12690           (set-buffer gnus-article-buffer)
12691           (save-restriction
12692             (let ((buffer-read-only nil))
12693               (nnheader-narrow-to-headers)
12694               (while (re-search-forward "^X-Gnus" nil t)
12695                 (gnus-delete-line)))))
12696         (save-window-excursion
12697           (if (not gnus-default-article-saver)
12698               (error "No default saver is defined.")
12699             (setq file (funcall
12700                         gnus-default-article-saver
12701                         (cond
12702                          ((not gnus-prompt-before-saving)
12703                           'default)
12704                          ((eq gnus-prompt-before-saving 'always)
12705                           nil)
12706                          (t file))))))
12707         (gnus-summary-remove-process-mark article)
12708         (unless not-saved
12709           (gnus-summary-set-saved-mark article))))
12710     (gnus-summary-position-point)
12711     n))
12712
12713 (defun gnus-summary-pipe-output (&optional arg)
12714   "Pipe the current article to a subprocess.
12715 If N is a positive number, pipe the N next articles.
12716 If N is a negative number, pipe the N previous articles.
12717 If N is nil and any articles have been marked with the process mark,
12718 pipe those articles instead."
12719   (interactive "P")
12720   (gnus-set-global-variables)
12721   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
12722     (gnus-summary-save-article arg t))
12723   (gnus-configure-windows 'pipe))
12724
12725 (defun gnus-summary-save-article-mail (&optional arg)
12726   "Append the current article to an mail file.
12727 If N is a positive number, save the N next articles.
12728 If N is a negative number, save the N previous articles.
12729 If N is nil and any articles have been marked with the process mark,
12730 save those articles instead."
12731   (interactive "P")
12732   (gnus-set-global-variables)
12733   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
12734     (gnus-summary-save-article arg)))
12735
12736 (defun gnus-summary-save-article-rmail (&optional arg)
12737   "Append the current article to an rmail file.
12738 If N is a positive number, save the N next articles.
12739 If N is a negative number, save the N previous articles.
12740 If N is nil and any articles have been marked with the process mark,
12741 save those articles instead."
12742   (interactive "P")
12743   (gnus-set-global-variables)
12744   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
12745     (gnus-summary-save-article arg)))
12746
12747 (defun gnus-summary-save-article-file (&optional arg)
12748   "Append the current article to a file.
12749 If N is a positive number, save the N next articles.
12750 If N is a negative number, save the N previous articles.
12751 If N is nil and any articles have been marked with the process mark,
12752 save those articles instead."
12753   (interactive "P")
12754   (gnus-set-global-variables)
12755   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
12756     (gnus-summary-save-article arg)))
12757
12758 (defun gnus-summary-save-article-body-file (&optional arg)
12759   "Append the current article body to a file.
12760 If N is a positive number, save the N next articles.
12761 If N is a negative number, save the N previous articles.
12762 If N is nil and any articles have been marked with the process mark,
12763 save those articles instead."
12764   (interactive "P")
12765   (gnus-set-global-variables)
12766   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
12767     (gnus-summary-save-article arg)))
12768
12769 (defun gnus-get-split-value (methods)
12770   "Return a value based on the split METHODS."
12771   (let (split-name method result match)
12772     (when methods
12773       (save-excursion
12774         (set-buffer gnus-original-article-buffer)
12775         (save-restriction
12776           (nnheader-narrow-to-headers)
12777           (while methods
12778             (goto-char (point-min))
12779             (setq method (pop methods))
12780             (setq match (car method))
12781             (when (cond
12782                    ((stringp match)
12783                     ;; Regular expression.
12784                     (condition-case ()
12785                         (re-search-forward match nil t)
12786                       (error nil)))
12787                    ((gnus-functionp match)
12788                     ;; Function.
12789                     (save-restriction
12790                       (widen)
12791                       (setq result (funcall match gnus-newsgroup-name))))
12792                    ((consp match)
12793                     ;; Form.
12794                     (save-restriction
12795                       (widen)
12796                       (setq result (eval match)))))
12797               (setq split-name (append (cdr method) split-name))
12798               (cond ((stringp result)
12799                      (push result split-name))
12800                     ((consp result)
12801                      (setq split-name (append result split-name)))))))))
12802     split-name))
12803
12804 (defun gnus-read-move-group-name (prompt default articles prefix)
12805   "Read a group name."
12806   (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
12807          (prom
12808           (format "Where do you want to %s %s? "
12809                   prompt
12810                   (if (> (length articles) 1)
12811                       (format "these %d articles" (length articles))
12812                     "this article")))
12813          (to-newsgroup
12814           (cond
12815            ((null split-name)
12816             (completing-read
12817              (concat prom
12818                      (if default
12819                          (format "(default %s) " default)
12820                        ""))
12821              gnus-active-hashtb nil nil prefix))
12822            ((= 1 (length split-name))
12823             (completing-read prom gnus-active-hashtb
12824                              nil nil (cons (car split-name) 0)))
12825            (t
12826             (completing-read
12827              prom (mapcar (lambda (el) (list el)) (nreverse split-name)))))))
12828
12829     (when to-newsgroup
12830       (if (or (string= to-newsgroup "")
12831               (string= to-newsgroup prefix))
12832           (setq to-newsgroup (or default "")))
12833       (or (gnus-active to-newsgroup)
12834           (gnus-activate-group to-newsgroup)
12835           (error "No such group: %s" to-newsgroup)))
12836     to-newsgroup))
12837
12838 (defun gnus-read-save-file-name (prompt default-name)
12839   (let* ((split-name (gnus-get-split-value gnus-split-methods))
12840          (file
12841           ;; Let the split methods have their say.
12842           (cond
12843            ;; No split name was found.
12844            ((null split-name)
12845             (read-file-name
12846              (concat prompt " (default "
12847                      (file-name-nondirectory default-name) ") ")
12848              (file-name-directory default-name)
12849              default-name))
12850            ;; A single split name was found
12851            ((= 1 (length split-name))
12852             (read-file-name
12853              (concat prompt " (default " (car split-name) ") ")
12854              gnus-article-save-directory
12855              (concat gnus-article-save-directory (car split-name))))
12856            ;; A list of splits was found.
12857            (t
12858             (setq split-name (mapcar (lambda (el) (list el))
12859                                      (nreverse split-name)))
12860             (let ((result (completing-read
12861                            (concat prompt " ") split-name nil nil)))
12862               (concat gnus-article-save-directory
12863                       (if (string= result "")
12864                           (caar split-name)
12865                         result)))))))
12866     ;; If we have read a directory, we append the default file name.
12867     (when (file-directory-p file)
12868       (setq file (concat (file-name-as-directory file)
12869                          (file-name-nondirectory default-name))))
12870     ;; Possibly translate some charaters.
12871     (nnheader-translate-file-chars file)))
12872
12873 (defun gnus-article-archive-name (group)
12874   "Return the first instance of an \"Archive-name\" in the current buffer."
12875   (let ((case-fold-search t))
12876     (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
12877       (match-string 1))))
12878
12879 (defun gnus-summary-save-in-rmail (&optional filename)
12880   "Append this article to Rmail file.
12881 Optional argument FILENAME specifies file name.
12882 Directory to save to is default to `gnus-article-save-directory' which
12883 is initialized from the SAVEDIR environment variable."
12884   (interactive)
12885   (gnus-set-global-variables)
12886   (let ((default-name
12887           (funcall gnus-rmail-save-name gnus-newsgroup-name
12888                    gnus-current-headers gnus-newsgroup-last-rmail)))
12889     (setq filename
12890           (cond ((eq filename 'default)
12891                  default-name)
12892                 (filename filename)
12893                 (t (gnus-read-save-file-name
12894                     "Save in rmail file:" default-name))))
12895     (gnus-make-directory (file-name-directory filename))
12896     (gnus-eval-in-buffer-window
12897      gnus-original-article-buffer
12898      (save-excursion
12899        (save-restriction
12900          (widen)
12901          (gnus-output-to-rmail filename))))
12902     ;; Remember the directory name to save articles
12903     (setq gnus-newsgroup-last-rmail filename)))
12904
12905 (defun gnus-summary-save-in-mail (&optional filename)
12906   "Append this article to Unix mail file.
12907 Optional argument FILENAME specifies file name.
12908 Directory to save to is default to `gnus-article-save-directory' which
12909 is initialized from the SAVEDIR environment variable."
12910   (interactive)
12911   (gnus-set-global-variables)
12912   (let ((default-name
12913           (funcall gnus-mail-save-name gnus-newsgroup-name
12914                    gnus-current-headers gnus-newsgroup-last-mail)))
12915     (setq filename
12916           (cond ((eq filename 'default)
12917                  default-name)
12918                 (filename filename)
12919                 (t (gnus-read-save-file-name
12920                     "Save in Unix mail file:" default-name))))
12921     (setq filename
12922           (expand-file-name filename
12923                             (and default-name
12924                                  (file-name-directory default-name))))
12925     (gnus-make-directory (file-name-directory filename))
12926     (gnus-eval-in-buffer-window
12927      gnus-original-article-buffer
12928      (save-excursion
12929        (save-restriction
12930          (widen)
12931          (if (and (file-readable-p filename) (mail-file-babyl-p filename))
12932              (gnus-output-to-rmail filename)
12933            (let ((mail-use-rfc822 t))
12934              (rmail-output filename 1 t t))))))
12935     ;; Remember the directory name to save articles.
12936     (setq gnus-newsgroup-last-mail filename)))
12937
12938 (defun gnus-summary-save-in-file (&optional filename)
12939   "Append this article to file.
12940 Optional argument FILENAME specifies file name.
12941 Directory to save to is default to `gnus-article-save-directory' which
12942 is initialized from the SAVEDIR environment variable."
12943   (interactive)
12944   (gnus-set-global-variables)
12945   (let ((default-name
12946           (funcall gnus-file-save-name gnus-newsgroup-name
12947                    gnus-current-headers gnus-newsgroup-last-file)))
12948     (setq filename
12949           (cond ((eq filename 'default)
12950                  default-name)
12951                 (filename filename)
12952                 (t (gnus-read-save-file-name
12953                     "Save in file:" default-name))))
12954     (gnus-make-directory (file-name-directory filename))
12955     (gnus-eval-in-buffer-window
12956      gnus-original-article-buffer
12957      (save-excursion
12958        (save-restriction
12959          (widen)
12960          (gnus-output-to-file filename))))
12961     ;; Remember the directory name to save articles.
12962     (setq gnus-newsgroup-last-file filename)))
12963
12964 (defun gnus-summary-save-body-in-file (&optional filename)
12965   "Append this article body to a file.
12966 Optional argument FILENAME specifies file name.
12967 The directory to save in defaults to `gnus-article-save-directory' which
12968 is initialized from the SAVEDIR environment variable."
12969   (interactive)
12970   (gnus-set-global-variables)
12971   (let ((default-name
12972           (funcall gnus-file-save-name gnus-newsgroup-name
12973                    gnus-current-headers gnus-newsgroup-last-file)))
12974     (setq filename
12975           (cond ((eq filename 'default)
12976                  default-name)
12977                 (filename filename)
12978                 (t (gnus-read-save-file-name
12979                     "Save body in file:" default-name))))
12980     (gnus-make-directory (file-name-directory filename))
12981     (gnus-eval-in-buffer-window
12982      gnus-article-buffer
12983      (save-excursion
12984        (save-restriction
12985          (widen)
12986          (goto-char (point-min))
12987          (and (search-forward "\n\n" nil t)
12988               (narrow-to-region (point) (point-max)))
12989          (gnus-output-to-file filename))))
12990     ;; Remember the directory name to save articles.
12991     (setq gnus-newsgroup-last-file filename)))
12992
12993 (defun gnus-summary-save-in-pipe (&optional command)
12994   "Pipe this article to subprocess."
12995   (interactive)
12996   (gnus-set-global-variables)
12997   (setq command
12998         (cond ((eq command 'default)
12999                gnus-last-shell-command)
13000               (command command)
13001               (t (read-string "Shell command on article: "
13002                               gnus-last-shell-command))))
13003   (if (string-equal command "")
13004       (setq command gnus-last-shell-command))
13005   (gnus-eval-in-buffer-window
13006    gnus-article-buffer
13007    (save-restriction
13008      (widen)
13009      (shell-command-on-region (point-min) (point-max) command nil)))
13010   (setq gnus-last-shell-command command))
13011
13012 ;; Summary extract commands
13013
13014 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
13015   (let ((buffer-read-only nil)
13016         (article (gnus-summary-article-number))
13017         after-article b e)
13018     (or (gnus-summary-goto-subject article)
13019         (error (format "No such article: %d" article)))
13020     (gnus-summary-position-point)
13021     ;; If all commands are to be bunched up on one line, we collect
13022     ;; them here.
13023     (if gnus-view-pseudos-separately
13024         ()
13025       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
13026             files action)
13027         (while ps
13028           (setq action (cdr (assq 'action (car ps))))
13029           (setq files (list (cdr (assq 'name (car ps)))))
13030           (while (and ps (cdr ps)
13031                       (string= (or action "1")
13032                                (or (cdr (assq 'action (cadr ps))) "2")))
13033             (setq files (cons (cdr (assq 'name (cadr ps))) files))
13034             (setcdr ps (cddr ps)))
13035           (if (not files)
13036               ()
13037             (if (not (string-match "%s" action))
13038                 (setq files (cons " " files)))
13039             (setq files (cons " " files))
13040             (and (assq 'execute (car ps))
13041                  (setcdr (assq 'execute (car ps))
13042                          (funcall (if (string-match "%s" action)
13043                                       'format 'concat)
13044                                   action
13045                                   (mapconcat (lambda (f) f) files " ")))))
13046           (setq ps (cdr ps)))))
13047     (if (and gnus-view-pseudos (not not-view))
13048         (while pslist
13049           (and (assq 'execute (car pslist))
13050                (gnus-execute-command (cdr (assq 'execute (car pslist)))
13051                                      (eq gnus-view-pseudos 'not-confirm)))
13052           (setq pslist (cdr pslist)))
13053       (save-excursion
13054         (while pslist
13055           (setq after-article (or (cdr (assq 'article (car pslist)))
13056                                   (gnus-summary-article-number)))
13057           (gnus-summary-goto-subject after-article)
13058           (forward-line 1)
13059           (setq b (point))
13060           (insert "    " (file-name-nondirectory
13061                                 (cdr (assq 'name (car pslist))))
13062                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
13063           (setq e (point))
13064           (forward-line -1)             ; back to `b'
13065           (add-text-properties
13066            b e (list 'gnus-number gnus-reffed-article-number
13067                      gnus-mouse-face-prop gnus-mouse-face))
13068           (gnus-data-enter
13069            after-article gnus-reffed-article-number
13070            gnus-unread-mark b (car pslist) 0 (- e b))
13071           (push gnus-reffed-article-number gnus-newsgroup-unreads)
13072           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
13073           (setq pslist (cdr pslist)))))))
13074
13075 (defun gnus-pseudos< (p1 p2)
13076   (let ((c1 (cdr (assq 'action p1)))
13077         (c2 (cdr (assq 'action p2))))
13078     (and c1 c2 (string< c1 c2))))
13079
13080 (defun gnus-request-pseudo-article (props)
13081   (cond ((assq 'execute props)
13082          (gnus-execute-command (cdr (assq 'execute props)))))
13083   (let ((gnus-current-article (gnus-summary-article-number)))
13084     (run-hooks 'gnus-mark-article-hook)))
13085
13086 (defun gnus-execute-command (command &optional automatic)
13087   (save-excursion
13088     (gnus-article-setup-buffer)
13089     (set-buffer gnus-article-buffer)
13090     (let ((command (if automatic command (read-string "Command: " command)))
13091           (buffer-read-only nil))
13092       (erase-buffer)
13093       (insert "$ " command "\n\n")
13094       (if gnus-view-pseudo-asynchronously
13095           (start-process "gnus-execute" nil "sh" "-c" command)
13096         (call-process "sh" nil t nil "-c" command)))))
13097
13098 (defun gnus-copy-file (file &optional to)
13099   "Copy FILE to TO."
13100   (interactive
13101    (list (read-file-name "Copy file: " default-directory)
13102          (read-file-name "Copy file to: " default-directory)))
13103   (gnus-set-global-variables)
13104   (or to (setq to (read-file-name "Copy file to: " default-directory)))
13105   (and (file-directory-p to)
13106        (setq to (concat (file-name-as-directory to)
13107                         (file-name-nondirectory file))))
13108   (copy-file file to))
13109
13110 ;; Summary kill commands.
13111
13112 (defun gnus-summary-edit-global-kill (article)
13113   "Edit the \"global\" kill file."
13114   (interactive (list (gnus-summary-article-number)))
13115   (gnus-set-global-variables)
13116   (gnus-group-edit-global-kill article))
13117
13118 (defun gnus-summary-edit-local-kill ()
13119   "Edit a local kill file applied to the current newsgroup."
13120   (interactive)
13121   (gnus-set-global-variables)
13122   (setq gnus-current-headers (gnus-summary-article-header))
13123   (gnus-set-global-variables)
13124   (gnus-group-edit-local-kill
13125    (gnus-summary-article-number) gnus-newsgroup-name))
13126
13127 \f
13128 ;;;
13129 ;;; Gnus article mode
13130 ;;;
13131
13132 (put 'gnus-article-mode 'mode-class 'special)
13133
13134 (if gnus-article-mode-map
13135     nil
13136   (setq gnus-article-mode-map (make-keymap))
13137   (suppress-keymap gnus-article-mode-map)
13138
13139   (gnus-define-keys gnus-article-mode-map
13140     " " gnus-article-goto-next-page
13141     "\177" gnus-article-goto-prev-page
13142     [delete] gnus-article-goto-prev-page
13143     "\C-c^" gnus-article-refer-article
13144     "h" gnus-article-show-summary
13145     "s" gnus-article-show-summary
13146     "\C-c\C-m" gnus-article-mail
13147     "?" gnus-article-describe-briefly
13148     gnus-mouse-2 gnus-article-push-button
13149     "\r" gnus-article-press-button
13150     "\t" gnus-article-next-button
13151     "\M-\t" gnus-article-prev-button
13152     "\C-c\C-b" gnus-bug)
13153
13154   (substitute-key-definition
13155    'undefined 'gnus-article-read-summary-keys gnus-article-mode-map))
13156
13157 (defun gnus-article-mode ()
13158   "Major mode for displaying an article.
13159
13160 All normal editing commands are switched off.
13161
13162 The following commands are available:
13163
13164 \\<gnus-article-mode-map>
13165 \\[gnus-article-next-page]\t Scroll the article one page forwards
13166 \\[gnus-article-prev-page]\t Scroll the article one page backwards
13167 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
13168 \\[gnus-article-show-summary]\t Display the summary buffer
13169 \\[gnus-article-mail]\t Send a reply to the address near point
13170 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
13171 \\[gnus-info-find-node]\t Go to the Gnus info node"
13172   (interactive)
13173   (when (and menu-bar-mode
13174              (gnus-visual-p 'article-menu 'menu))
13175     (gnus-article-make-menu-bar))
13176   (kill-all-local-variables)
13177   (gnus-simplify-mode-line)
13178   (setq mode-name "Article")
13179   (setq major-mode 'gnus-article-mode)
13180   (make-local-variable 'minor-mode-alist)
13181   (or (assq 'gnus-show-mime minor-mode-alist)
13182       (setq minor-mode-alist
13183             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
13184   (use-local-map gnus-article-mode-map)
13185   (make-local-variable 'page-delimiter)
13186   (setq page-delimiter gnus-page-delimiter)
13187   (buffer-disable-undo (current-buffer))
13188   (setq buffer-read-only t)             ;Disable modification
13189   (run-hooks 'gnus-article-mode-hook))
13190
13191 (defun gnus-article-setup-buffer ()
13192   "Initialize the article buffer."
13193   (let* ((name (if gnus-single-article-buffer "*Article*"
13194                  (concat "*Article " gnus-newsgroup-name "*")))
13195          (original
13196           (progn (string-match "\\*Article" name)
13197                  (concat " *Original Article"
13198                          (substring name (match-end 0))))))
13199     (setq gnus-article-buffer name)
13200     (setq gnus-original-article-buffer original)
13201     ;; This might be a variable local to the summary buffer.
13202     (unless gnus-single-article-buffer
13203       (save-excursion
13204         (set-buffer gnus-summary-buffer)
13205         (setq gnus-article-buffer name)
13206         (setq gnus-original-article-buffer original)
13207         (gnus-set-global-variables))
13208       (make-local-variable 'gnus-summary-buffer))
13209     ;; Init original article buffer.
13210     (save-excursion
13211       (set-buffer (get-buffer-create gnus-original-article-buffer))
13212       (buffer-disable-undo (current-buffer))
13213       (setq major-mode 'gnus-original-article-mode)
13214       (make-local-variable 'gnus-original-article))
13215     (if (get-buffer name)
13216         (save-excursion
13217           (set-buffer name)
13218           (buffer-disable-undo (current-buffer))
13219           (setq buffer-read-only t)
13220           (gnus-add-current-to-buffer-list)
13221           (or (eq major-mode 'gnus-article-mode)
13222               (gnus-article-mode))
13223           (current-buffer))
13224       (save-excursion
13225         (set-buffer (get-buffer-create name))
13226         (gnus-add-current-to-buffer-list)
13227         (gnus-article-mode)
13228         (current-buffer)))))
13229
13230 ;; Set article window start at LINE, where LINE is the number of lines
13231 ;; from the head of the article.
13232 (defun gnus-article-set-window-start (&optional line)
13233   (set-window-start
13234    (get-buffer-window gnus-article-buffer)
13235    (save-excursion
13236      (set-buffer gnus-article-buffer)
13237      (goto-char (point-min))
13238      (if (not line)
13239          (point-min)
13240        (gnus-message 6 "Moved to bookmark")
13241        (search-forward "\n\n" nil t)
13242        (forward-line line)
13243        (point)))))
13244
13245 (defun gnus-kill-all-overlays ()
13246   "Delete all overlays in the current buffer."
13247   (when (fboundp 'overlay-lists)
13248     (let* ((overlayss (overlay-lists))
13249            (buffer-read-only nil)
13250            (overlays (nconc (car overlayss) (cdr overlayss))))
13251       (while overlays
13252         (delete-overlay (pop overlays))))))
13253
13254 (defun gnus-request-article-this-buffer (article group)
13255   "Get an article and insert it into this buffer."
13256   (let (do-update-line)
13257     (prog1
13258         (save-excursion
13259           (erase-buffer)
13260           (gnus-kill-all-overlays)
13261           (setq group (or group gnus-newsgroup-name))
13262
13263           ;; Open server if it has closed.
13264           (gnus-check-server (gnus-find-method-for-group group))
13265
13266           ;; Using `gnus-request-article' directly will insert the article into
13267           ;; `nntp-server-buffer' - so we'll save some time by not having to
13268           ;; copy it from the server buffer into the article buffer.
13269
13270           ;; We only request an article by message-id when we do not have the
13271           ;; headers for it, so we'll have to get those.
13272           (when (stringp article)
13273             (let ((gnus-override-method gnus-refer-article-method))
13274               (gnus-read-header article)))
13275
13276           ;; If the article number is negative, that means that this article
13277           ;; doesn't belong in this newsgroup (possibly), so we find its
13278           ;; message-id and request it by id instead of number.
13279           (when (and (numberp article)
13280                      gnus-summary-buffer
13281                      (get-buffer gnus-summary-buffer)
13282                      (buffer-name (get-buffer gnus-summary-buffer)))
13283             (save-excursion
13284               (set-buffer gnus-summary-buffer)
13285               (let ((header (gnus-summary-article-header article)))
13286                 (if (< article 0)
13287                     (cond 
13288                      ((memq article gnus-newsgroup-sparse)
13289                       ;; This is a sparse gap article.
13290                       (setq do-update-line article)
13291                       (setq article (mail-header-id header))
13292                       (let ((gnus-override-method gnus-refer-article-method))
13293                         (gnus-read-header article)))
13294                      ((vectorp header)
13295                       ;; It's a real article.
13296                       (setq article (mail-header-id header)))
13297                      (t
13298                       ;; It is an extracted pseudo-article.
13299                       (setq article 'pseudo)
13300                       (gnus-request-pseudo-article header))))
13301                 
13302                 (let ((method (gnus-find-method-for-group 
13303                                gnus-newsgroup-name)))
13304                   (if (not (eq (car method) 'nneething))
13305                       ()
13306                     (let ((dir (concat (file-name-as-directory (nth 1 method))
13307                                        (mail-header-subject header))))
13308                       (if (file-directory-p dir)
13309                           (progn
13310                             (setq article 'nneething)
13311                             (gnus-group-enter-directory dir)))))))))
13312
13313           (cond
13314            ;; We first check `gnus-original-article-buffer'.
13315            ((and (get-buffer gnus-original-article-buffer)
13316                  (save-excursion
13317                    (set-buffer gnus-original-article-buffer)
13318                    (and (equal (car gnus-original-article) group)
13319                         (eq (cdr gnus-original-article) article))))
13320             (insert-buffer-substring gnus-original-article-buffer)
13321             'article)
13322            ;; Check the backlog.
13323            ((and gnus-keep-backlog
13324                  (gnus-backlog-request-article group article (current-buffer)))
13325             'article)
13326            ;; Check the cache.
13327            ((and gnus-use-cache
13328                  (numberp article)
13329                  (gnus-cache-request-article article group))
13330             'article)
13331            ;; Get the article and put into the article buffer.
13332            ((or (stringp article) (numberp article))
13333             (let ((gnus-override-method
13334                    (and (stringp article) gnus-refer-article-method))
13335                   (buffer-read-only nil))
13336               (erase-buffer)
13337               (gnus-kill-all-overlays)
13338               (if (gnus-request-article article group (current-buffer))
13339                   (progn
13340                     (and gnus-keep-backlog
13341                          (numberp article)
13342                          (gnus-backlog-enter-article
13343                           group article (current-buffer)))
13344                     'article))))
13345            ;; It was a pseudo.
13346            (t article)))
13347
13348       ;; Take the article from the original article buffer
13349       ;; and place it in the buffer it's supposed to be in.
13350       (when (and (get-buffer gnus-article-buffer)
13351                  (equal (buffer-name (current-buffer))
13352                         (buffer-name (get-buffer gnus-article-buffer))))
13353         (save-excursion
13354           (if (get-buffer gnus-original-article-buffer)
13355               (set-buffer (get-buffer gnus-original-article-buffer))
13356             (set-buffer (get-buffer-create gnus-original-article-buffer))
13357             (buffer-disable-undo (current-buffer))
13358             (setq major-mode 'gnus-original-article-mode)
13359             (setq buffer-read-only t)
13360             (gnus-add-current-to-buffer-list))
13361           (let (buffer-read-only)
13362             (erase-buffer)
13363             (insert-buffer-substring gnus-article-buffer))
13364           (setq gnus-original-article (cons group article))))
13365     
13366       ;; Update sparse articles.
13367       (when do-update-line
13368         (save-excursion
13369           (set-buffer gnus-summary-buffer)
13370           (gnus-summary-update-article do-update-line)
13371           (gnus-summary-goto-subject do-update-line)
13372           (set-window-point (get-buffer-window (current-buffer) t)
13373                             (point)))))))
13374
13375 (defun gnus-read-header (id &optional header)
13376   "Read the headers of article ID and enter them into the Gnus system."
13377   (let ((group gnus-newsgroup-name)
13378         where)
13379     ;; First we check to see whether the header in question is already
13380     ;; fetched.
13381     (if (stringp id)
13382         ;; This is a Message-ID.
13383         (setq header (or header (gnus-id-to-header id)))
13384       ;; This is an article number.
13385       (setq header (or header (gnus-summary-article-header id))))
13386     (if (and header
13387              (not (memq (mail-header-number header) gnus-newsgroup-sparse)))
13388         ;; We have found the header.
13389         header
13390       ;; We have to really fetch the header to this article.
13391       (when (setq where
13392                   (if (gnus-check-backend-function 'request-head group)
13393                       (gnus-request-head id group)
13394                     (gnus-request-article id group)))
13395         (save-excursion
13396           (set-buffer nntp-server-buffer)
13397           (and (search-forward "\n\n" nil t)
13398                (delete-region (1- (point)) (point-max)))
13399           (goto-char (point-max))
13400           (insert ".\n")
13401           (goto-char (point-min))
13402           (insert "211 ")
13403           (princ (cond
13404                   ((numberp id) id)
13405                   ((cdr where) (cdr where))
13406                   (header (mail-header-number header))
13407                   (t gnus-reffed-article-number))
13408                  (current-buffer))
13409           (insert " Article retrieved.\n"))
13410         ;(when (and header
13411         ;          (memq (mail-header-number header) gnus-newsgroup-sparse))
13412         ;  (setcar (gnus-id-to-thread id) nil))
13413         (if (not (setq header (car (gnus-get-newsgroup-headers))))
13414             ()                          ; Malformed head.
13415           (unless (memq (mail-header-number header) gnus-newsgroup-sparse)
13416             (if (and (stringp id)
13417                      (not (string= (gnus-group-real-name group)
13418                                    (car where))))
13419                 ;; If we fetched by Message-ID and the article came
13420                 ;; from a different group, we fudge some bogus article
13421                 ;; numbers for this article.
13422                 (mail-header-set-number header gnus-reffed-article-number))
13423             (decf gnus-reffed-article-number)
13424             (push header gnus-newsgroup-headers)
13425             (setq gnus-current-headers header)
13426             (push (mail-header-number header) gnus-newsgroup-limit))
13427           header)))))
13428
13429 (defun gnus-article-prepare (article &optional all-headers header)
13430   "Prepare ARTICLE in article mode buffer.
13431 ARTICLE should either be an article number or a Message-ID.
13432 If ARTICLE is an id, HEADER should be the article headers.
13433 If ALL-HEADERS is non-nil, no headers are hidden."
13434   (save-excursion
13435     ;; Make sure we start in a summary buffer.
13436     (unless (eq major-mode 'gnus-summary-mode)
13437       (set-buffer gnus-summary-buffer))
13438     (setq gnus-summary-buffer (current-buffer))
13439     ;; Make sure the connection to the server is alive.
13440     (unless (gnus-server-opened
13441              (gnus-find-method-for-group gnus-newsgroup-name))
13442       (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
13443       (gnus-request-group gnus-newsgroup-name t))
13444     (let* ((article (if header (mail-header-number header) article))
13445            (summary-buffer (current-buffer))
13446            (internal-hook gnus-article-internal-prepare-hook)
13447            (group gnus-newsgroup-name)
13448            result)
13449       (save-excursion
13450         (gnus-article-setup-buffer)
13451         (set-buffer gnus-article-buffer)
13452         ;; Deactivate active regions.
13453         (when (and (boundp 'transient-mark-mode)
13454                    transient-mark-mode)
13455           (setq mark-active nil))
13456         (if (not (setq result (let ((buffer-read-only nil))
13457                                 (gnus-request-article-this-buffer
13458                                  article group))))
13459             ;; There is no such article.
13460             (save-excursion
13461               (when (and (numberp article)
13462                          (not (memq article gnus-newsgroup-sparse)))
13463                 (setq gnus-article-current
13464                       (cons gnus-newsgroup-name article))
13465                 (set-buffer gnus-summary-buffer)
13466                 (setq gnus-current-article article)
13467                 (gnus-summary-mark-article article gnus-canceled-mark))
13468               (unless (memq article gnus-newsgroup-sparse)
13469                 (gnus-message
13470                  1 "No such article (may have expired or been canceled)")
13471                 (ding)
13472                 nil))
13473           (if (or (eq result 'pseudo) (eq result 'nneething))
13474               (progn
13475                 (save-excursion
13476                   (set-buffer summary-buffer)
13477                   (setq gnus-last-article gnus-current-article
13478                         gnus-newsgroup-history (cons gnus-current-article
13479                                                      gnus-newsgroup-history)
13480                         gnus-current-article 0
13481                         gnus-current-headers nil
13482                         gnus-article-current nil)
13483                   (if (eq result 'nneething)
13484                       (gnus-configure-windows 'summary)
13485                     (gnus-configure-windows 'article))
13486                   (gnus-set-global-variables))
13487                 (gnus-set-mode-line 'article))
13488             ;; The result from the `request' was an actual article -
13489             ;; or at least some text that is now displayed in the
13490             ;; article buffer.
13491             (if (and (numberp article)
13492                      (not (eq article gnus-current-article)))
13493                 ;; Seems like a new article has been selected.
13494                 ;; `gnus-current-article' must be an article number.
13495                 (save-excursion
13496                   (set-buffer summary-buffer)
13497                   (setq gnus-last-article gnus-current-article
13498                         gnus-newsgroup-history (cons gnus-current-article
13499                                                      gnus-newsgroup-history)
13500                         gnus-current-article article
13501                         gnus-current-headers
13502                         (gnus-summary-article-header gnus-current-article)
13503                         gnus-article-current
13504                         (cons gnus-newsgroup-name gnus-current-article))
13505                   (unless (vectorp gnus-current-headers)
13506                     (setq gnus-current-headers nil))
13507                   (gnus-summary-show-thread)
13508                   (run-hooks 'gnus-mark-article-hook)
13509                   (gnus-set-mode-line 'summary)
13510                   (and (gnus-visual-p 'article-highlight 'highlight)
13511                        (run-hooks 'gnus-visual-mark-article-hook))
13512                   ;; Set the global newsgroup variables here.
13513                   ;; Suggested by Jim Sisolak
13514                   ;; <sisolak@trans4.neep.wisc.edu>.
13515                   (gnus-set-global-variables)
13516                   (setq gnus-have-all-headers
13517                         (or all-headers gnus-show-all-headers))
13518                   (and gnus-use-cache
13519                        (vectorp (gnus-summary-article-header article))
13520                        (gnus-cache-possibly-enter-article
13521                         group article
13522                         (gnus-summary-article-header article)
13523                         (memq article gnus-newsgroup-marked)
13524                         (memq article gnus-newsgroup-dormant)
13525                         (memq article gnus-newsgroup-unreads)))))
13526             ;; Hooks for getting information from the article.
13527             ;; This hook must be called before being narrowed.
13528             (let (buffer-read-only)
13529               (run-hooks 'internal-hook)
13530               (run-hooks 'gnus-article-prepare-hook)
13531               ;; Decode MIME message.
13532               (if gnus-show-mime
13533                   (if (or (not gnus-strict-mime)
13534                           (gnus-fetch-field "Mime-Version"))
13535                       (funcall gnus-show-mime-method)
13536                     (funcall gnus-decode-encoded-word-method)))
13537               ;; Perform the article display hooks.
13538               (run-hooks 'gnus-article-display-hook))
13539             ;; Do page break.
13540             (goto-char (point-min))
13541             (and gnus-break-pages (gnus-narrow-to-page))
13542             (gnus-set-mode-line 'article)
13543             (gnus-configure-windows 'article)
13544             (goto-char (point-min))
13545             t))))))
13546
13547 (defun gnus-article-show-all-headers ()
13548   "Show all article headers in article mode buffer."
13549   (save-excursion
13550     (gnus-article-setup-buffer)
13551     (set-buffer gnus-article-buffer)
13552     (let ((buffer-read-only nil))
13553       (gnus-unhide-text (point-min) (point-max)))))
13554
13555 (defun gnus-article-hide-headers-if-wanted ()
13556   "Hide unwanted headers if `gnus-have-all-headers' is nil.
13557 Provided for backwards compatibility."
13558   (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
13559       gnus-inhibit-hiding
13560       (gnus-article-hide-headers)))
13561
13562 (defun gnus-article-hide-headers (&optional arg delete)
13563   "Toggle whether to hide unwanted headers and possibly sort them as well.
13564 If given a negative prefix, always show; if given a positive prefix,
13565 always hide."
13566   (interactive "P")
13567   (unless (gnus-article-check-hidden-text 'headers arg)
13568     ;; This function might be inhibited.
13569     (unless gnus-inhibit-hiding
13570       (save-excursion
13571         (set-buffer gnus-article-buffer)
13572         (save-restriction
13573           (let ((buffer-read-only nil)
13574                 (props (nconc (list 'gnus-type 'headers)
13575                               gnus-hidden-properties))
13576                 (ignored (when (not (stringp gnus-visible-headers))
13577                            (cond ((stringp gnus-ignored-headers)
13578                                   gnus-ignored-headers)
13579                                  ((listp gnus-ignored-headers)
13580                                   (mapconcat 'identity gnus-ignored-headers
13581                                              "\\|")))))
13582                 (visible
13583                  (cond ((stringp gnus-visible-headers)
13584                         gnus-visible-headers)
13585                        ((and gnus-visible-headers
13586                              (listp gnus-visible-headers))
13587                         (mapconcat 'identity gnus-visible-headers "\\|"))))
13588                 want-list beg)
13589             ;; First we narrow to just the headers.
13590             (widen)
13591             (goto-char (point-min))
13592             ;; Hide any "From " lines at the beginning of (mail) articles.
13593             (while (looking-at "From ")
13594               (forward-line 1))
13595             (unless (bobp)
13596               (gnus-hide-text (point-min) (point) props))
13597             ;; Then treat the rest of the header lines.
13598             (narrow-to-region
13599              (point)
13600              (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
13601             ;; Then we use the two regular expressions
13602             ;; `gnus-ignored-headers' and `gnus-visible-headers' to
13603             ;; select which header lines is to remain visible in the
13604             ;; article buffer.
13605             (goto-char (point-min))
13606             (while (re-search-forward "^[^ \t]*:" nil t)
13607               (beginning-of-line)
13608               ;; We add the headers we want to keep to a list and delete
13609               ;; them from the buffer.
13610               (if (or (and visible (looking-at visible))
13611                       (and ignored (not (looking-at ignored))))
13612                   (progn
13613                     (push (buffer-substring
13614                            (setq beg (point))
13615                            (progn
13616                              (forward-line 1)
13617                              ;; Be sure to get multi-line headers...
13618                              (re-search-forward "^[^ \t]*:" nil t)
13619                              (beginning-of-line)
13620                              (point)))
13621                           want-list)
13622                     (delete-region beg (point)))
13623                 (forward-line 1)))
13624             ;; Sort the headers that we want to display.
13625             (setq want-list (sort want-list 'gnus-article-header-less))
13626             (goto-char (point-min))
13627             (while want-list
13628               (insert (pop want-list)))
13629             ;; We make the unwanted headers invisible.
13630             (if delete
13631                 (delete-region (point-min) (point-max))
13632               ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
13633               (gnus-hide-text-type (point) (point-max) 'headers))))))))
13634
13635 (defsubst gnus-article-header-rank (header)
13636   "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
13637   (let ((list gnus-sorted-header-list)
13638         (i 0))
13639     (while list
13640       (when (string-match (car list) header)
13641         (setq list nil))
13642       (setq list (cdr list))
13643       (incf i))
13644     i))
13645
13646 (defun gnus-article-header-less (h1 h2)
13647   "Say whether string H1 is \"less\" than string H2."
13648   (< (gnus-article-header-rank h1)
13649      (gnus-article-header-rank h2)))
13650
13651 (defun gnus-article-hide-boring-headers (&optional arg)
13652   "Toggle hiding of headers that aren't very interesting.
13653 If given a negative prefix, always show; if given a positive prefix,
13654 always hide."
13655   (interactive "P")
13656   (unless (gnus-article-check-hidden-text 'boring-headers arg)
13657     (save-excursion
13658       (set-buffer gnus-article-buffer)
13659       (save-restriction
13660         (let ((buffer-read-only nil)
13661               (list gnus-boring-article-headers)
13662               (inhibit-point-motion-hooks t)
13663               elem)
13664           (nnheader-narrow-to-headers)
13665           (while list
13666             (setq elem (pop list))
13667             (goto-char (point-min))
13668             (cond
13669              ;; Hide empty headers.
13670              ((eq elem 'empty)
13671               (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t)
13672                 (forward-line -1)
13673                 (gnus-hide-text-type
13674                  (progn (beginning-of-line) (point))
13675                  (progn 
13676                    (end-of-line)
13677                    (if (re-search-forward "^[^ \t]" nil t)
13678                        (match-beginning 0)
13679                      (point-max)))
13680                  'boring-headers)))
13681              ;; Hide boring Newsgroups header.
13682              ((eq elem 'newsgroups)
13683               (when (equal (mail-fetch-field "newsgroups")
13684                            (gnus-group-real-name gnus-newsgroup-name))
13685                 (gnus-article-hide-header "newsgroups")))
13686              ((eq elem 'followup-to)
13687               (when (equal (mail-fetch-field "followup-to")
13688                            (mail-fetch-field "newsgroups"))
13689                 (gnus-article-hide-header "followup-to")))
13690              ((eq elem 'reply-to)
13691               (let ((from (mail-fetch-field "from"))
13692                     (reply-to (mail-fetch-field "reply-to")))
13693                 (when (and
13694                        from reply-to
13695                        (equal 
13696                         (nth 1 (funcall gnus-extract-address-components from))
13697                         (nth 1 (funcall gnus-extract-address-components
13698                                         reply-to))))
13699                   (gnus-article-hide-header "reply-to"))))
13700              ((eq elem 'date)
13701               (let ((date (mail-fetch-field "date")))
13702                 (when (and date
13703                            (< (gnus-days-between date (current-time-string))
13704                               4))
13705                   (gnus-article-hide-header "date")))))))))))
13706
13707 (defun gnus-article-hide-header (header)
13708   (save-excursion
13709     (goto-char (point-min))
13710     (when (re-search-forward (concat "^" header ":") nil t)
13711       (gnus-hide-text-type
13712        (progn (beginning-of-line) (point))
13713        (progn 
13714          (end-of-line)
13715          (if (re-search-forward "^[^ \t]" nil t)
13716              (match-beginning 0)
13717            (point-max)))
13718        'boring-headers))))
13719
13720 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
13721 (defun gnus-article-treat-overstrike ()
13722   "Translate overstrikes into bold text."
13723   (interactive)
13724   (save-excursion
13725     (set-buffer gnus-article-buffer)
13726     (let ((buffer-read-only nil))
13727       (while (search-forward "\b" nil t)
13728         (let ((next (following-char))
13729               (previous (char-after (- (point) 2))))
13730           (cond ((eq next previous)
13731                  (put-text-property (- (point) 2) (point) 'invisible t)
13732                  (put-text-property (point) (1+ (point)) 'face 'bold))
13733                 ((eq next ?_)
13734                  (put-text-property (1- (point)) (1+ (point)) 'invisible t)
13735                  (put-text-property
13736                   (- (point) 2) (1- (point)) 'face 'underline))
13737                 ((eq previous ?_)
13738                  (put-text-property (- (point) 2) (point) 'invisible t)
13739                  (put-text-property
13740                   (point) (1+ (point))  'face 'underline))))))))
13741
13742 (defun gnus-article-word-wrap ()
13743   "Format too long lines."
13744   (interactive)
13745   (save-excursion
13746     (set-buffer gnus-article-buffer)
13747     (let ((buffer-read-only nil))
13748       (widen)
13749       (goto-char (point-min))
13750       (search-forward "\n\n" nil t)
13751       (end-of-line 1)
13752       (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
13753             (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
13754             (adaptive-fill-mode t))
13755         (while (not (eobp))
13756           (and (>= (current-column) (min fill-column (window-width)))
13757                (/= (preceding-char) ?:)
13758                (fill-paragraph nil))
13759           (end-of-line 2))))))
13760
13761 (defun gnus-article-remove-cr ()
13762   "Remove carriage returns from an article."
13763   (interactive)
13764   (save-excursion
13765     (set-buffer gnus-article-buffer)
13766     (let ((buffer-read-only nil))
13767       (goto-char (point-min))
13768       (while (search-forward "\r" nil t)
13769         (replace-match "" t t)))))
13770
13771 (defun gnus-article-remove-trailing-blank-lines ()
13772   "Remove all trailing blank lines from the article."
13773   (interactive)
13774   (save-excursion
13775     (set-buffer gnus-article-buffer)
13776     (let ((buffer-read-only nil))
13777       (goto-char (point-max))
13778       (delete-region
13779        (point)
13780        (progn
13781          (while (looking-at "^[ \t]*$")
13782            (forward-line -1))
13783          (forward-line 1)
13784          (point))))))
13785
13786 (defun gnus-article-display-x-face (&optional force)
13787   "Look for an X-Face header and display it if present."
13788   (interactive (list 'force))
13789   (save-excursion
13790     (set-buffer gnus-article-buffer)
13791     ;; Delete the old process, if any.
13792     (when (process-status "gnus-x-face")
13793       (delete-process "gnus-x-face"))
13794     (let ((inhibit-point-motion-hooks t)
13795           (case-fold-search nil)
13796           from)
13797       (save-restriction
13798         (nnheader-narrow-to-headers)
13799         (setq from (mail-fetch-field "from"))
13800         (goto-char (point-min))
13801         (when (and gnus-article-x-face-command
13802                    (or force
13803                        ;; Check whether this face is censored.
13804                        (not gnus-article-x-face-too-ugly)
13805                        (and gnus-article-x-face-too-ugly from
13806                             (not (string-match gnus-article-x-face-too-ugly
13807                                                from))))
13808                    ;; Has to be present.
13809                    (re-search-forward "^X-Face: " nil t))
13810           ;; We now have the area of the buffer where the X-Face is stored.
13811           (let ((beg (point))
13812                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
13813             ;; We display the face.
13814             (if (symbolp gnus-article-x-face-command)
13815                 ;; The command is a lisp function, so we call it.
13816                 (if (gnus-functionp gnus-article-x-face-command)
13817                     (funcall gnus-article-x-face-command beg end)
13818                   (error "%s is not a function" gnus-article-x-face-command))
13819               ;; The command is a string, so we interpret the command
13820               ;; as a, well, command, and fork it off.
13821               (let ((process-connection-type nil))
13822                 (process-kill-without-query
13823                  (start-process
13824                   "gnus-x-face" nil "sh" "-c" gnus-article-x-face-command))
13825                 (process-send-region "gnus-x-face" beg end)
13826                 (process-send-eof "gnus-x-face")))))))))
13827
13828 (defun gnus-headers-decode-quoted-printable ()
13829   "Hack to remove QP encoding from headers."
13830   (let ((case-fold-search t)
13831         (inhibit-point-motion-hooks t)
13832         string)
13833     (goto-char (point-min))
13834     (while (re-search-forward "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
13835       (setq string (match-string 1))
13836       (narrow-to-region (match-beginning 0) (match-end 0))
13837       (delete-region (point-min) (point-max))
13838       (insert string)
13839       (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
13840       (subst-char-in-region (point-min) (point-max) ?_ ? )
13841       (widen)
13842       (goto-char (point-min)))))
13843
13844 (defun gnus-article-de-quoted-unreadable (&optional force)
13845   "Do a naive translation of a quoted-printable-encoded article.
13846 This is in no way, shape or form meant as a replacement for real MIME
13847 processing, but is simply a stop-gap measure until MIME support is
13848 written.
13849 If FORCE, decode the article whether it is marked as quoted-printable
13850 or not."
13851   (interactive (list 'force))
13852   (save-excursion
13853     (set-buffer gnus-article-buffer)
13854     (let ((case-fold-search t)
13855           (buffer-read-only nil)
13856           (type (gnus-fetch-field "content-transfer-encoding")))
13857       (when (or force
13858                 (and type (string-match "quoted-printable" type)))
13859         (gnus-headers-decode-quoted-printable)
13860         (goto-char (point-min))
13861         (search-forward "\n\n" nil 'move)
13862         (gnus-mime-decode-quoted-printable (point) (point-max))))))
13863
13864 (defun gnus-mime-decode-quoted-printable (from to)
13865   "Decode Quoted-Printable in the region between FROM and TO."
13866   (goto-char from)
13867   (while (search-forward "=" to t)
13868     (cond ((eq (following-char) ?\n)
13869            (delete-char -1)
13870            (delete-char 1))
13871           ((looking-at "[0-9A-F][0-9A-F]")
13872            (delete-char -1)
13873            (insert (hexl-hex-string-to-integer
13874                     (buffer-substring (point) (+ 2 (point)))))
13875            (delete-char 2))
13876           ((looking-at "=")
13877            (delete-char 1))
13878           ((gnus-message 3 "Malformed MIME quoted-printable message")))))
13879
13880 (defun gnus-article-hide-pgp (&optional arg)
13881   "Toggle hiding of any PGP headers and signatures in the current article.
13882 If given a negative prefix, always show; if given a positive prefix,
13883 always hide."
13884   (interactive "P")
13885   (unless (gnus-article-check-hidden-text 'pgp arg)
13886     (save-excursion
13887       (set-buffer gnus-article-buffer)
13888       (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties))
13889             buffer-read-only beg end)
13890         (widen)
13891         (goto-char (point-min))
13892         ;; Hide the "header".
13893         (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
13894              (gnus-hide-text (match-beginning 0) (match-end 0) props))
13895         (setq beg (point))
13896         ;; Hide the actual signature.
13897         (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
13898              (setq end (1+ (match-beginning 0)))
13899              (gnus-hide-text
13900               end
13901               (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
13902                   (match-end 0)
13903                 ;; Perhaps we shouldn't hide to the end of the buffer
13904                 ;; if there is no end to the signature?
13905                 (point-max))
13906               props))
13907         ;; Hide "- " PGP quotation markers.
13908         (when (and beg end)
13909           (narrow-to-region beg end)
13910           (goto-char (point-min))
13911           (while (re-search-forward "^- " nil t)
13912             (gnus-hide-text (match-beginning 0) (match-end 0) props))
13913           (widen))))))
13914
13915 (defun gnus-article-hide-signature (&optional arg)
13916   "Hide the signature in the current article.
13917 If given a negative prefix, always show; if given a positive prefix,
13918 always hide."
13919   (interactive "P")
13920   (unless (gnus-article-check-hidden-text 'signature arg)
13921     (save-excursion
13922       (set-buffer gnus-article-buffer)
13923       (save-restriction
13924         (let ((buffer-read-only nil))
13925           (when (gnus-narrow-to-signature)
13926             (gnus-hide-text-type (point-min) (point-max) 'signature)))))))
13927
13928 (defun gnus-article-strip-leading-blank-lines ()
13929   "Remove all blank lines from the beginning of the article."
13930   (interactive)
13931   (save-excursion
13932     (set-buffer gnus-article-buffer)
13933     (let (buffer-read-only)
13934       (goto-char (point-min))
13935       (when (search-forward "\n\n" nil t)
13936         (while (looking-at "[ \t]$")
13937           (gnus-delete-line))))))
13938
13939 (defun gnus-narrow-to-signature ()
13940   "Narrow to the signature."
13941   (widen)
13942   (goto-char (point-max))
13943   (when (re-search-backward gnus-signature-separator nil t)
13944     (forward-line 1)
13945     (when (or (null gnus-signature-limit)
13946               (and (numberp gnus-signature-limit)
13947                    (< (- (point-max) (point)) gnus-signature-limit))
13948               (and (gnus-functionp gnus-signature-limit)
13949                    (funcall gnus-signature-limit))
13950               (and (stringp gnus-signature-limit)
13951                    (not (re-search-forward gnus-signature-limit nil t))))
13952       (narrow-to-region (point) (point-max))
13953       t)))
13954
13955 (defun gnus-article-check-hidden-text (type arg)
13956   "Return nil if hiding is necessary."
13957   (save-excursion
13958     (set-buffer gnus-article-buffer)
13959     (let ((hide (gnus-article-hidden-text-p type)))
13960       (cond ((or (and (null arg) (eq hide 'hidden))
13961                  (and arg (< 0 (prefix-numeric-value arg))))
13962              (gnus-article-show-hidden-text type))
13963             ((eq hide 'shown)
13964              (gnus-article-show-hidden-text type t))
13965             (t nil)))))
13966
13967 (defun gnus-article-hidden-text-p (type)
13968   "Say whether the current buffer contains hidden text of type TYPE."
13969   (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type)))
13970     (when pos
13971       (if (get-text-property pos 'invisible)
13972           'hidden
13973         'shown))))
13974
13975 (defun gnus-article-hide (&optional arg force)
13976   "Hide all the gruft in the current article.
13977 This means that PGP stuff, signatures, cited text and (some)
13978 headers will be hidden.
13979 If given a prefix, show the hidden text instead."
13980   (interactive (list current-prefix-arg 'force))
13981   (gnus-article-hide-headers arg)
13982   (gnus-article-hide-pgp arg)
13983   (gnus-article-hide-citation-maybe arg force)
13984   (gnus-article-hide-signature arg))
13985
13986 (defun gnus-article-show-hidden-text (type &optional hide)
13987   "Show all hidden text of type TYPE.
13988 If HIDE, hide the text instead."
13989   (save-excursion
13990     (set-buffer gnus-article-buffer)
13991     (let ((buffer-read-only nil)
13992           (inhibit-point-motion-hooks t)
13993           (beg (point-min)))
13994       (while (gnus-goto-char (text-property-any
13995                               beg (point-max) 'gnus-type type))
13996         (setq beg (point))
13997         (forward-char)
13998         (if hide
13999             (gnus-hide-text beg (point) gnus-hidden-properties)
14000           (gnus-unhide-text beg (point)))
14001         (setq beg (point)))
14002       t)))
14003
14004 (defvar gnus-article-time-units
14005   `((year . ,(* 365.25 24 60 60))
14006     (week . ,(* 7 24 60 60))
14007     (day . ,(* 24 60 60))
14008     (hour . ,(* 60 60))
14009     (minute . 60)
14010     (second . 1))
14011   "Mapping from time units to seconds.")
14012
14013 (defun gnus-article-date-ut (&optional type highlight)
14014   "Convert DATE date to universal time in the current article.
14015 If TYPE is `local', convert to local time; if it is `lapsed', output
14016 how much time has lapsed since DATE."
14017   (interactive (list 'ut t))
14018   (let* ((header (or gnus-current-headers
14019                      (gnus-summary-article-header) ""))
14020          (date (and (vectorp header) (mail-header-date header)))
14021          (date-regexp "^Date: \\|^X-Sent: ")
14022          (now (current-time))
14023          (inhibit-point-motion-hooks t))
14024     (when (and date (not (string= date "")))
14025       (save-excursion
14026         (set-buffer gnus-article-buffer)
14027         (save-restriction
14028           (nnheader-narrow-to-headers)
14029           (let ((buffer-read-only nil))
14030             ;; Delete any old Date headers.
14031             (if (zerop (message-remove-header date-regexp t))
14032                 (beginning-of-line)
14033               (goto-char (point-max)))
14034             (insert
14035              (cond
14036               ;; Convert to the local timezone.  We have to slap a
14037               ;; `condition-case' round the calls to the timezone
14038               ;; functions since they aren't particularly resistant to
14039               ;; buggy dates.
14040               ((eq type 'local)
14041                (concat "Date: " (condition-case ()
14042                                     (timezone-make-date-arpa-standard date)
14043                                   (error date))
14044                        "\n"))
14045               ;; Convert to Universal Time.
14046               ((eq type 'ut)
14047                (concat "Date: "
14048                        (condition-case ()
14049                            (timezone-make-date-arpa-standard date nil "UT")
14050                          (error date))
14051                        "\n"))
14052               ;; Get the original date from the article.
14053               ((eq type 'original)
14054                (concat "Date: " date "\n"))
14055               ;; Do an X-Sent lapsed format.
14056               ((eq type 'lapsed)
14057                ;; If the date is seriously mangled, the timezone
14058                ;; functions are liable to bug out, so we condition-case
14059                ;; the entire thing.
14060                (let* ((real-time
14061                        (condition-case ()
14062                            (gnus-time-minus
14063                             (gnus-encode-date
14064                              (timezone-make-date-arpa-standard
14065                               (current-time-string now)
14066                               (current-time-zone now) "UT"))
14067                             (gnus-encode-date
14068                              (timezone-make-date-arpa-standard
14069                               date nil "UT")))
14070                          (error '(0 0))))
14071                       (real-sec (+ (* (float (car real-time)) 65536)
14072                                    (cadr real-time)))
14073                       (sec (abs real-sec))
14074                       num prev)
14075                  (if (zerop sec)
14076                      "X-Sent: Now\n"
14077                    (concat
14078                     "X-Sent: "
14079                     ;; This is a bit convoluted, but basically we go
14080                     ;; through the time units for years, weeks, etc,
14081                     ;; and divide things to see whether that results
14082                     ;; in positive answers.
14083                     (mapconcat
14084                      (lambda (unit)
14085                        (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
14086                            ;; The (remaining) seconds are too few to
14087                            ;; be divided into this time unit.
14088                            ""
14089                          ;; It's big enough, so we output it.
14090                          (setq sec (- sec (* num (cdr unit))))
14091                          (prog1
14092                              (concat (if prev ", " "") (int-to-string
14093                                                         (floor num))
14094                                      " " (symbol-name (car unit))
14095                                      (if (> num 1) "s" ""))
14096                            (setq prev t))))
14097                      gnus-article-time-units "")
14098                     ;; If dates are odd, then it might appear like the
14099                     ;; article was sent in the future.
14100                     (if (> real-sec 0)
14101                         " ago\n"
14102                       " in the future\n")))))
14103               (t
14104                (error "Unknown conversion type: %s" type)))))
14105           ;; Do highlighting.
14106           (when (and highlight (gnus-visual-p 'article-highlight 'highlight))
14107             (gnus-article-highlight-headers)))))))
14108
14109 (defun gnus-article-date-local (&optional highlight)
14110   "Convert the current article date to the local timezone."
14111   (interactive (list t))
14112   (gnus-article-date-ut 'local highlight))
14113
14114 (defun gnus-article-date-original (&optional highlight)
14115   "Convert the current article date to what it was originally.
14116 This is only useful if you have used some other date conversion
14117 function and want to see what the date was before converting."
14118   (interactive (list t))
14119   (gnus-article-date-ut 'original highlight))
14120
14121 (defun gnus-article-date-lapsed (&optional highlight)
14122   "Convert the current article date to time lapsed since it was sent."
14123   (interactive (list t))
14124   (gnus-article-date-ut 'lapsed highlight))
14125
14126 (defun gnus-article-maybe-highlight ()
14127   "Do some article highlighting if `gnus-visual' is non-nil."
14128   (if (gnus-visual-p 'article-highlight 'highlight)
14129       (gnus-article-highlight-some)))
14130
14131 ;; Article savers.
14132
14133 (defun gnus-output-to-rmail (file-name)
14134   "Append the current article to an Rmail file named FILE-NAME."
14135   (require 'rmail)
14136   ;; Most of these codes are borrowed from rmailout.el.
14137   (setq file-name (expand-file-name file-name))
14138   (setq rmail-default-rmail-file file-name)
14139   (let ((artbuf (current-buffer))
14140         (tmpbuf (get-buffer-create " *Gnus-output*")))
14141     (save-excursion
14142       (or (get-file-buffer file-name)
14143           (file-exists-p file-name)
14144           (if (gnus-yes-or-no-p
14145                (concat "\"" file-name "\" does not exist, create it? "))
14146               (let ((file-buffer (create-file-buffer file-name)))
14147                 (save-excursion
14148                   (set-buffer file-buffer)
14149                   (rmail-insert-rmail-file-header)
14150                   (let ((require-final-newline nil))
14151                     (write-region (point-min) (point-max) file-name t 1)))
14152                 (kill-buffer file-buffer))
14153             (error "Output file does not exist")))
14154       (set-buffer tmpbuf)
14155       (buffer-disable-undo (current-buffer))
14156       (erase-buffer)
14157       (insert-buffer-substring artbuf)
14158       (gnus-convert-article-to-rmail)
14159       ;; Decide whether to append to a file or to an Emacs buffer.
14160       (let ((outbuf (get-file-buffer file-name)))
14161         (if (not outbuf)
14162             (append-to-file (point-min) (point-max) file-name)
14163           ;; File has been visited, in buffer OUTBUF.
14164           (set-buffer outbuf)
14165           (let ((buffer-read-only nil)
14166                 (msg (and (boundp 'rmail-current-message)
14167                           (symbol-value 'rmail-current-message))))
14168             ;; If MSG is non-nil, buffer is in RMAIL mode.
14169             (if msg
14170                 (progn (widen)
14171                        (narrow-to-region (point-max) (point-max))))
14172             (insert-buffer-substring tmpbuf)
14173             (if msg
14174                 (progn
14175                   (goto-char (point-min))
14176                   (widen)
14177                   (search-backward "\^_")
14178                   (narrow-to-region (point) (point-max))
14179                   (goto-char (1+ (point-min)))
14180                   (rmail-count-new-messages t)
14181                   (rmail-show-message msg)))))))
14182     (kill-buffer tmpbuf)))
14183
14184 (defun gnus-output-to-file (file-name)
14185   "Append the current article to a file named FILE-NAME."
14186   (setq file-name (expand-file-name file-name))
14187   (let ((artbuf (current-buffer))
14188         (tmpbuf (get-buffer-create " *Gnus-output*")))
14189     (save-excursion
14190       (set-buffer tmpbuf)
14191       (buffer-disable-undo (current-buffer))
14192       (erase-buffer)
14193       (insert-buffer-substring artbuf)
14194       ;; Append newline at end of the buffer as separator, and then
14195       ;; save it to file.
14196       (goto-char (point-max))
14197       (insert "\n")
14198       (append-to-file (point-min) (point-max) file-name))
14199     (kill-buffer tmpbuf)))
14200
14201 (defun gnus-convert-article-to-rmail ()
14202   "Convert article in current buffer to Rmail message format."
14203   (let ((buffer-read-only nil))
14204     ;; Convert article directly into Babyl format.
14205     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
14206     (goto-char (point-min))
14207     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
14208     (while (search-forward "\n\^_" nil t) ;single char
14209       (replace-match "\n^_" t t))       ;2 chars: "^" and "_"
14210     (goto-char (point-max))
14211     (insert "\^_")))
14212
14213 (defun gnus-narrow-to-page (&optional arg)
14214   "Narrow the article buffer to a page.
14215 If given a numerical ARG, move forward ARG pages."
14216   (interactive "P")
14217   (setq arg (if arg (prefix-numeric-value arg) 0))
14218   (save-excursion
14219     (set-buffer gnus-article-buffer)
14220     (goto-char (point-min))
14221     (widen)
14222     (when (gnus-visual-p 'page-marker)
14223       (let ((buffer-read-only nil))
14224         (gnus-remove-text-with-property 'gnus-prev)
14225         (gnus-remove-text-with-property 'gnus-next)))
14226     (when
14227         (cond ((< arg 0)
14228                (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
14229               ((> arg 0)
14230                (re-search-forward page-delimiter nil 'move arg)))
14231       (goto-char (match-end 0)))
14232     (narrow-to-region
14233      (point)
14234      (if (re-search-forward page-delimiter nil 'move)
14235          (match-beginning 0)
14236        (point)))
14237     (when (and (gnus-visual-p 'page-marker)
14238                (not (= (point-min) 1)))
14239       (save-excursion
14240         (goto-char (point-min))
14241         (gnus-insert-prev-page-button)))
14242     (when (and (gnus-visual-p 'page-marker)
14243                (not (= (1- (point-max)) (buffer-size))))
14244       (save-excursion
14245         (goto-char (point-max))
14246         (gnus-insert-next-page-button)))))
14247
14248 ;; Article mode commands
14249
14250 (defun gnus-article-goto-next-page ()
14251   "Show the next page of the article."
14252   (interactive)
14253   (when (gnus-article-next-page)
14254     (gnus-article-read-summary-keys nil ?n)))
14255
14256 (defun gnus-article-goto-prev-page ()
14257   "Show the next page of the article."
14258   (interactive)
14259   (if (bobp) (gnus-article-read-summary-keys nil ?n)
14260     (gnus-article-prev-page nil)))
14261
14262 (defun gnus-article-next-page (&optional lines)
14263   "Show the next page of the current article.
14264 If end of article, return non-nil.  Otherwise return nil.
14265 Argument LINES specifies lines to be scrolled up."
14266   (interactive "p")
14267   (move-to-window-line -1)
14268   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
14269   (if (save-excursion
14270         (end-of-line)
14271         (and (pos-visible-in-window-p)  ;Not continuation line.
14272              (eobp)))
14273       ;; Nothing in this page.
14274       (if (or (not gnus-break-pages)
14275               (save-excursion
14276                 (save-restriction
14277                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
14278           t                             ;Nothing more.
14279         (gnus-narrow-to-page 1)         ;Go to next page.
14280         nil)
14281     ;; More in this page.
14282     (condition-case ()
14283         (scroll-up lines)
14284       (end-of-buffer
14285        ;; Long lines may cause an end-of-buffer error.
14286        (goto-char (point-max))))
14287     (move-to-window-line 0)
14288     nil))
14289
14290 (defun gnus-article-prev-page (&optional lines)
14291   "Show previous page of current article.
14292 Argument LINES specifies lines to be scrolled down."
14293   (interactive "p")
14294   (move-to-window-line 0)
14295   (if (and gnus-break-pages
14296            (bobp)
14297            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
14298       (progn
14299         (gnus-narrow-to-page -1)        ;Go to previous page.
14300         (goto-char (point-max))
14301         (recenter -1))
14302     (prog1
14303         (condition-case ()
14304             (scroll-down lines)
14305           (error nil))
14306       (move-to-window-line 0))))
14307
14308 (defun gnus-article-refer-article ()
14309   "Read article specified by message-id around point."
14310   (interactive)
14311   (let ((point (point)))
14312     (search-forward ">" nil t)          ;Move point to end of "<....>".
14313     (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
14314         (let ((message-id (match-string 1)))
14315           (goto-char point)
14316           (set-buffer gnus-summary-buffer)
14317           (gnus-summary-refer-article message-id))
14318       (goto-char (point))
14319       (error "No references around point"))))
14320
14321 (defun gnus-article-show-summary ()
14322   "Reconfigure windows to show summary buffer."
14323   (interactive)
14324   (gnus-configure-windows 'article)
14325   (gnus-summary-goto-subject gnus-current-article))
14326
14327 (defun gnus-article-describe-briefly ()
14328   "Describe article mode commands briefly."
14329   (interactive)
14330   (gnus-message 6
14331                 (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")))
14332
14333 (defun gnus-article-summary-command ()
14334   "Execute the last keystroke in the summary buffer."
14335   (interactive)
14336   (let ((obuf (current-buffer))
14337         (owin (current-window-configuration))
14338         func)
14339     (switch-to-buffer gnus-summary-buffer 'norecord)
14340     (setq func (lookup-key (current-local-map) (this-command-keys)))
14341     (call-interactively func)
14342     (set-buffer obuf)
14343     (set-window-configuration owin)
14344     (set-window-point (get-buffer-window (current-buffer)) (point))))
14345
14346 (defun gnus-article-summary-command-nosave ()
14347   "Execute the last keystroke in the summary buffer."
14348   (interactive)
14349   (let (func)
14350     (pop-to-buffer gnus-summary-buffer 'norecord)
14351     (setq func (lookup-key (current-local-map) (this-command-keys)))
14352     (call-interactively func)))
14353
14354 (defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
14355   "Read a summary buffer key sequence and execute it from the article buffer."
14356   (interactive "P")
14357   (let ((nosaves
14358          '("q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F"
14359            "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
14360            "=" "^" "\M-^"))
14361         keys)
14362     (save-excursion
14363       (set-buffer gnus-summary-buffer)
14364       (push (or key last-command-event) unread-command-events)
14365       (setq keys (read-key-sequence nil)))
14366     (message "")
14367
14368     (if (member keys nosaves)
14369         (let (func)
14370           (pop-to-buffer gnus-summary-buffer 'norecord)
14371           (if (setq func (lookup-key (current-local-map) keys))
14372               (call-interactively func)
14373             (ding)))
14374       (let ((obuf (current-buffer))
14375             (owin (current-window-configuration))
14376             (opoint (point))
14377             func in-buffer)
14378         (if not-restore-window
14379             (pop-to-buffer gnus-summary-buffer 'norecord)
14380           (switch-to-buffer gnus-summary-buffer 'norecord))
14381         (setq in-buffer (current-buffer))
14382         (if (setq func (lookup-key (current-local-map) keys))
14383             (call-interactively func)
14384           (ding))
14385         (when (eq in-buffer (current-buffer))
14386           (set-buffer obuf)
14387           (unless not-restore-window
14388             (set-window-configuration owin))
14389           (set-window-point (get-buffer-window (current-buffer)) opoint))))))
14390
14391 \f
14392 ;;;
14393 ;;; Kill file handling.
14394 ;;;
14395
14396 ;;;###autoload
14397 (defalias 'gnus-batch-kill 'gnus-batch-score)
14398 ;;;###autoload
14399 (defun gnus-batch-score ()
14400   "Run batched scoring.
14401 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
14402 Newsgroups is a list of strings in Bnews format.  If you want to score
14403 the comp hierarchy, you'd say \"comp.all\".  If you would not like to
14404 score the alt hierarchy, you'd say \"!alt.all\"."
14405   (interactive)
14406   (let* ((yes-and-no
14407           (gnus-newsrc-parse-options
14408            (apply (function concat)
14409                   (mapcar (lambda (g) (concat g " "))
14410                           command-line-args-left))))
14411          (gnus-expert-user t)
14412          (nnmail-spool-file nil)
14413          (gnus-use-dribble-file nil)
14414          (yes (car yes-and-no))
14415          (no (cdr yes-and-no))
14416          group newsrc entry
14417          ;; Disable verbose message.
14418          gnus-novice-user gnus-large-newsgroup)
14419     ;; Eat all arguments.
14420     (setq command-line-args-left nil)
14421     ;; Start Gnus.
14422     (gnus)
14423     ;; Apply kills to specified newsgroups in command line arguments.
14424     (setq newsrc (cdr gnus-newsrc-alist))
14425     (while newsrc
14426       (setq group (caar newsrc))
14427       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
14428       (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
14429                (and (car entry)
14430                     (or (eq (car entry) t)
14431                         (not (zerop (car entry)))))
14432                (if yes (string-match yes group) t)
14433                (or (null no) (not (string-match no group))))
14434           (progn
14435             (gnus-summary-read-group group nil t nil t)
14436             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
14437                  (gnus-summary-exit))))
14438       (setq newsrc (cdr newsrc)))
14439     ;; Exit Emacs.
14440     (switch-to-buffer gnus-group-buffer)
14441     (gnus-group-save-newsrc)))
14442
14443 (defun gnus-apply-kill-file ()
14444   "Apply a kill file to the current newsgroup.
14445 Returns the number of articles marked as read."
14446   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
14447           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
14448       (gnus-apply-kill-file-internal)
14449     0))
14450
14451 (defun gnus-kill-save-kill-buffer ()
14452   (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
14453     (when (get-file-buffer file)
14454       (save-excursion
14455         (set-buffer (get-file-buffer file))
14456         (and (buffer-modified-p) (save-buffer))
14457         (kill-buffer (current-buffer))))))
14458
14459 (defvar gnus-kill-file-name "KILL"
14460   "Suffix of the kill files.")
14461
14462 (defun gnus-newsgroup-kill-file (newsgroup)
14463   "Return the name of a kill file name for NEWSGROUP.
14464 If NEWSGROUP is nil, return the global kill file name instead."
14465   (cond 
14466    ;; The global KILL file is placed at top of the directory.
14467    ((or (null newsgroup)
14468         (string-equal newsgroup ""))
14469     (expand-file-name gnus-kill-file-name
14470                       (or gnus-kill-files-directory "~/News")))
14471    ;; Append ".KILL" to newsgroup name.
14472    ((gnus-use-long-file-name 'not-kill)
14473     (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
14474                               "." gnus-kill-file-name)
14475                       (or gnus-kill-files-directory "~/News")))
14476    ;; Place "KILL" under the hierarchical directory.
14477    (t
14478     (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
14479                               "/" gnus-kill-file-name)
14480                       (or gnus-kill-files-directory "~/News")))))
14481
14482 \f
14483 ;;;
14484 ;;; Dribble file
14485 ;;;
14486
14487 (defvar gnus-dribble-ignore nil)
14488 (defvar gnus-dribble-eval-file nil)
14489
14490 (defun gnus-dribble-file-name ()
14491   "Return the dribble file for the current .newsrc."
14492   (concat
14493    (if gnus-dribble-directory
14494        (concat (file-name-as-directory gnus-dribble-directory)
14495                (file-name-nondirectory gnus-current-startup-file))
14496      gnus-current-startup-file)
14497    "-dribble"))
14498
14499 (defun gnus-dribble-enter (string)
14500   "Enter STRING into the dribble buffer."
14501   (if (and (not gnus-dribble-ignore)
14502            gnus-dribble-buffer
14503            (buffer-name gnus-dribble-buffer))
14504       (let ((obuf (current-buffer)))
14505         (set-buffer gnus-dribble-buffer)
14506         (insert string "\n")
14507         (set-window-point (get-buffer-window (current-buffer)) (point-max))
14508         (set-buffer obuf))))
14509
14510 (defun gnus-dribble-read-file ()
14511   "Read the dribble file from disk."
14512   (let ((dribble-file (gnus-dribble-file-name)))
14513     (save-excursion
14514       (set-buffer (setq gnus-dribble-buffer
14515                         (get-buffer-create
14516                          (file-name-nondirectory dribble-file))))
14517       (gnus-add-current-to-buffer-list)
14518       (erase-buffer)
14519       (setq buffer-file-name dribble-file)
14520       (auto-save-mode t)
14521       (buffer-disable-undo (current-buffer))
14522       (bury-buffer (current-buffer))
14523       (set-buffer-modified-p nil)
14524       (let ((auto (make-auto-save-file-name))
14525             (gnus-dribble-ignore t))
14526         (when (or (file-exists-p auto) (file-exists-p dribble-file))
14527           ;; Load whichever file is newest -- the auto save file
14528           ;; or the "real" file.
14529           (if (file-newer-than-file-p auto dribble-file)
14530               (insert-file-contents auto)
14531             (insert-file-contents dribble-file))
14532           (unless (zerop (buffer-size))
14533             (set-buffer-modified-p t))
14534           ;; Set the file modes to reflect the .newsrc file modes.
14535           (save-buffer)
14536           (when (file-exists-p gnus-current-startup-file)
14537             (set-file-modes dribble-file
14538                             (file-modes gnus-current-startup-file)))
14539           ;; Possibly eval the file later.
14540           (when (gnus-y-or-n-p
14541                  "Auto-save file exists.  Do you want to read it? ")
14542             (setq gnus-dribble-eval-file t)))))))
14543
14544 (defun gnus-dribble-eval-file ()
14545   (if (not gnus-dribble-eval-file)
14546       ()
14547     (setq gnus-dribble-eval-file nil)
14548     (save-excursion
14549       (let ((gnus-dribble-ignore t))
14550         (set-buffer gnus-dribble-buffer)
14551         (eval-buffer (current-buffer))))))
14552
14553 (defun gnus-dribble-delete-file ()
14554   (if (file-exists-p (gnus-dribble-file-name))
14555       (delete-file (gnus-dribble-file-name)))
14556   (if gnus-dribble-buffer
14557       (save-excursion
14558         (set-buffer gnus-dribble-buffer)
14559         (let ((auto (make-auto-save-file-name)))
14560           (if (file-exists-p auto)
14561               (delete-file auto))
14562           (erase-buffer)
14563           (set-buffer-modified-p nil)))))
14564
14565 (defun gnus-dribble-save ()
14566   (if (and gnus-dribble-buffer
14567            (buffer-name gnus-dribble-buffer))
14568       (save-excursion
14569         (set-buffer gnus-dribble-buffer)
14570         (save-buffer))))
14571
14572 (defun gnus-dribble-clear ()
14573   (save-excursion
14574     (if (gnus-buffer-exists-p gnus-dribble-buffer)
14575         (progn
14576           (set-buffer gnus-dribble-buffer)
14577           (erase-buffer)
14578           (set-buffer-modified-p nil)
14579           (setq buffer-saved-size (buffer-size))))))
14580
14581 \f
14582 ;;;
14583 ;;; Server Communication
14584 ;;;
14585
14586 (defun gnus-start-news-server (&optional confirm)
14587   "Open a method for getting news.
14588 If CONFIRM is non-nil, the user will be asked for an NNTP server."
14589   (let (how)
14590     (if gnus-current-select-method
14591         ;; Stream is already opened.
14592         nil
14593       ;; Open NNTP server.
14594       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
14595       (if confirm
14596           (progn
14597             ;; Read server name with completion.
14598             (setq gnus-nntp-server
14599                   (completing-read "NNTP server: "
14600                                    (mapcar (lambda (server) (list server))
14601                                            (cons (list gnus-nntp-server)
14602                                                  gnus-secondary-servers))
14603                                    nil nil gnus-nntp-server))))
14604
14605       (if (and gnus-nntp-server
14606                (stringp gnus-nntp-server)
14607                (not (string= gnus-nntp-server "")))
14608           (setq gnus-select-method
14609                 (cond ((or (string= gnus-nntp-server "")
14610                            (string= gnus-nntp-server "::"))
14611                        (list 'nnspool (system-name)))
14612                       ((string-match "^:" gnus-nntp-server)
14613                        (list 'nnmh gnus-nntp-server
14614                              (list 'nnmh-directory
14615                                    (file-name-as-directory
14616                                     (expand-file-name
14617                                      (concat "~/" (substring
14618                                                    gnus-nntp-server 1)))))
14619                              (list 'nnmh-get-new-mail nil)))
14620                       (t
14621                        (list 'nntp gnus-nntp-server)))))
14622
14623       (setq how (car gnus-select-method))
14624       (cond ((eq how 'nnspool)
14625              (require 'nnspool)
14626              (gnus-message 5 "Looking up local news spool..."))
14627             ((eq how 'nnmh)
14628              (require 'nnmh)
14629              (gnus-message 5 "Looking up mh spool..."))
14630             (t
14631              (require 'nntp)))
14632       (setq gnus-current-select-method gnus-select-method)
14633       (run-hooks 'gnus-open-server-hook)
14634       (or
14635        ;; gnus-open-server-hook might have opened it
14636        (gnus-server-opened gnus-select-method)
14637        (gnus-open-server gnus-select-method)
14638        (gnus-y-or-n-p
14639         (format
14640          "%s (%s) open error: '%s'.     Continue? "
14641          (car gnus-select-method) (cadr gnus-select-method)
14642          (gnus-status-message gnus-select-method)))
14643        (progn
14644          (gnus-message 1 "Couldn't open server on %s"
14645                        (nth 1 gnus-select-method))
14646          (ding)
14647          nil)))))
14648
14649 (defun gnus-check-group (group)
14650   "Try to make sure that the server where GROUP exists is alive."
14651   (let ((method (gnus-find-method-for-group group)))
14652     (or (gnus-server-opened method)
14653         (gnus-open-server method))))
14654
14655 (defun gnus-check-server (&optional method silent)
14656   "Check whether the connection to METHOD is down.
14657 If METHOD is nil, use `gnus-select-method'.
14658 If it is down, start it up (again)."
14659   (let ((method (or method gnus-select-method)))
14660     ;; Transform virtual server names into select methods.
14661     (when (stringp method)
14662       (setq method (gnus-server-to-method method)))
14663     (if (gnus-server-opened method)
14664         ;; The stream is already opened.
14665         t
14666       ;; Open the server.
14667       (unless silent
14668         (gnus-message 5 "Opening %s server%s..." (car method)
14669                       (if (equal (nth 1 method) "") ""
14670                         (format " on %s" (nth 1 method)))))
14671       (run-hooks 'gnus-open-server-hook)
14672       (prog1
14673           (gnus-open-server method)
14674         (unless silent
14675           (message ""))))))
14676
14677 (defun gnus-get-function (method function)
14678   "Return a function symbol based on METHOD and FUNCTION."
14679   ;; Translate server names into methods.
14680   (unless method
14681     (error "Attempted use of a nil select method"))
14682   (when (stringp method)
14683     (setq method (gnus-server-to-method method)))
14684   (let ((func (intern (format "%s-%s" (car method) function))))
14685     ;; If the functions isn't bound, we require the backend in
14686     ;; question.
14687     (unless (fboundp func)
14688       (require (car method))
14689       (unless (fboundp func)
14690         ;; This backend doesn't implement this function.
14691         (error "No such function: %s" func)))
14692     func))
14693
14694 \f
14695 ;;;
14696 ;;; Interface functions to the backends.
14697 ;;;
14698
14699 (defun gnus-open-server (method)
14700   "Open a connection to METHOD."
14701   (when (stringp method)
14702     (setq method (gnus-server-to-method method)))
14703   (let ((elem (assoc method gnus-opened-servers)))
14704     ;; If this method was previously denied, we just return nil.
14705     (if (eq (nth 1 elem) 'denied)
14706         (progn
14707           (gnus-message 1 "Denied server")
14708           nil)
14709       ;; Open the server.
14710       (let ((result
14711              (funcall (gnus-get-function method 'open-server)
14712                       (nth 1 method) (nthcdr 2 method))))
14713         ;; If this hasn't been opened before, we add it to the list.
14714         (unless elem
14715           (setq elem (list method nil)
14716                 gnus-opened-servers (cons elem gnus-opened-servers)))
14717         ;; Set the status of this server.
14718         (setcar (cdr elem) (if result 'ok 'denied))
14719         ;; Return the result from the "open" call.
14720         result))))
14721
14722 (defun gnus-close-server (method)
14723   "Close the connection to METHOD."
14724   (when (stringp method)
14725     (setq method (gnus-server-to-method method)))
14726   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
14727
14728 (defun gnus-request-list (method)
14729   "Request the active file from METHOD."
14730   (when (stringp method)
14731     (setq method (gnus-server-to-method method)))
14732   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
14733
14734 (defun gnus-request-list-newsgroups (method)
14735   "Request the newsgroups file from METHOD."
14736   (when (stringp method)
14737     (setq method (gnus-server-to-method method)))
14738   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
14739
14740 (defun gnus-request-newgroups (date method)
14741   "Request all new groups since DATE from METHOD."
14742   (when (stringp method)
14743     (setq method (gnus-server-to-method method)))
14744   (funcall (gnus-get-function method 'request-newgroups)
14745            date (nth 1 method)))
14746
14747 (defun gnus-server-opened (method)
14748   "Check whether a connection to METHOD has been opened."
14749   (when (stringp method)
14750     (setq method (gnus-server-to-method method)))
14751   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
14752
14753 (defun gnus-status-message (method)
14754   "Return the status message from METHOD.
14755 If METHOD is a string, it is interpreted as a group name.   The method
14756 this group uses will be queried."
14757   (let ((method (if (stringp method) (gnus-find-method-for-group method)
14758                   method)))
14759     (funcall (gnus-get-function method 'status-message) (nth 1 method))))
14760
14761 (defun gnus-request-group (group &optional dont-check method)
14762   "Request GROUP.  If DONT-CHECK, no information is required."
14763   (let ((method (or method (gnus-find-method-for-group group))))
14764     (when (stringp method)
14765       (setq method (gnus-server-to-method method)))
14766     (funcall (gnus-get-function method 'request-group)
14767              (gnus-group-real-name group) (nth 1 method) dont-check)))
14768
14769 (defun gnus-request-asynchronous (group &optional articles)
14770   "Request that GROUP behave asynchronously.
14771 ARTICLES is the `data' of the group."
14772   (let ((method (gnus-find-method-for-group group)))
14773     (funcall (gnus-get-function method 'request-asynchronous)
14774              (gnus-group-real-name group) (nth 1 method) articles)))
14775
14776 (defun gnus-list-active-group (group)
14777   "Request active information on GROUP."
14778   (let ((method (gnus-find-method-for-group group))
14779         (func 'list-active-group))
14780     (when (gnus-check-backend-function func group)
14781       (funcall (gnus-get-function method func)
14782                (gnus-group-real-name group) (nth 1 method)))))
14783
14784 (defun gnus-request-group-description (group)
14785   "Request a description of GROUP."
14786   (let ((method (gnus-find-method-for-group group))
14787         (func 'request-group-description))
14788     (when (gnus-check-backend-function func group)
14789       (funcall (gnus-get-function method func)
14790                (gnus-group-real-name group) (nth 1 method)))))
14791
14792 (defun gnus-close-group (group)
14793   "Request the GROUP be closed."
14794   (let ((method (gnus-find-method-for-group group)))
14795     (funcall (gnus-get-function method 'close-group)
14796              (gnus-group-real-name group) (nth 1 method))))
14797
14798 (defun gnus-retrieve-headers (articles group &optional fetch-old)
14799   "Request headers for ARTICLES in GROUP.
14800 If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
14801   (let ((method (gnus-find-method-for-group group)))
14802     (if (and gnus-use-cache (numberp (car articles)))
14803         (gnus-cache-retrieve-headers articles group fetch-old)
14804       (funcall (gnus-get-function method 'retrieve-headers)
14805                articles (gnus-group-real-name group) (nth 1 method)
14806                fetch-old))))
14807
14808 (defun gnus-retrieve-groups (groups method)
14809   "Request active information on GROUPS from METHOD."
14810   (when (stringp method)
14811     (setq method (gnus-server-to-method method)))
14812   (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
14813
14814 (defun gnus-request-type (group &optional article)
14815   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
14816   (let ((method (gnus-find-method-for-group group)))
14817     (if (not (gnus-check-backend-function 'request-type (car method)))
14818         'unknown
14819       (funcall (gnus-get-function method 'request-type)
14820                (gnus-group-real-name group) article))))
14821
14822 (defun gnus-request-update-mark (group article mark)
14823   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
14824   (let ((method (gnus-find-method-for-group group)))
14825     (if (not (gnus-check-backend-function 'request-update-mark (car method)))
14826         mark
14827       (funcall (gnus-get-function method 'request-update-mark)
14828                (gnus-group-real-name group) article mark))))
14829
14830 (defun gnus-request-article (article group &optional buffer)
14831   "Request the ARTICLE in GROUP.
14832 ARTICLE can either be an article number or an article Message-ID.
14833 If BUFFER, insert the article in that group."
14834   (let ((method (gnus-find-method-for-group group)))
14835     (funcall (gnus-get-function method 'request-article)
14836              article (gnus-group-real-name group) (nth 1 method) buffer)))
14837
14838 (defun gnus-request-head (article group)
14839   "Request the head of ARTICLE in GROUP."
14840   (let ((method (gnus-find-method-for-group group)))
14841     (funcall (gnus-get-function method 'request-head)
14842              article (gnus-group-real-name group) (nth 1 method))))
14843
14844 (defun gnus-request-body (article group)
14845   "Request the body of ARTICLE in GROUP."
14846   (let ((method (gnus-find-method-for-group group)))
14847     (funcall (gnus-get-function method 'request-body)
14848              article (gnus-group-real-name group) (nth 1 method))))
14849
14850 (defun gnus-request-post (method)
14851   "Post the current buffer using METHOD."
14852   (when (stringp method)
14853     (setq method (gnus-server-to-method method)))
14854   (funcall (gnus-get-function method 'request-post) (nth 1 method)))
14855
14856 (defun gnus-request-scan (group method)
14857   "Request a SCAN being performed in GROUP from METHOD.
14858 If GROUP is nil, all groups on METHOD are scanned."
14859   (let ((method (if group (gnus-find-method-for-group group) method)))
14860     (funcall (gnus-get-function method 'request-scan)
14861              (and group (gnus-group-real-name group)) (nth 1 method))))
14862
14863 (defsubst gnus-request-update-info (info method)
14864   "Request that METHOD update INFO."
14865   (when (stringp method)
14866     (setq method (gnus-server-to-method method)))
14867   (when (gnus-check-backend-function 'request-update-info (car method))
14868     (funcall (gnus-get-function method 'request-update-info)
14869              (gnus-group-real-name (gnus-info-group info))
14870              info (nth 1 method))))
14871
14872 (defun gnus-request-expire-articles (articles group &optional force)
14873   (let ((method (gnus-find-method-for-group group)))
14874     (funcall (gnus-get-function method 'request-expire-articles)
14875              articles (gnus-group-real-name group) (nth 1 method)
14876              force)))
14877
14878 (defun gnus-request-move-article
14879   (article group server accept-function &optional last)
14880   (let ((method (gnus-find-method-for-group group)))
14881     (funcall (gnus-get-function method 'request-move-article)
14882              article (gnus-group-real-name group)
14883              (nth 1 method) accept-function last)))
14884
14885 (defun gnus-request-accept-article (group &optional last method)
14886   ;; Make sure there's a newline at the end of the article.
14887   (when (stringp method)
14888     (setq method (gnus-server-to-method method)))
14889   (when (and (not method)
14890              (stringp group))
14891     (setq method (gnus-find-method-for-group group)))
14892   (goto-char (point-max))
14893   (unless (bolp)
14894     (insert "\n"))
14895   (let ((func (if (symbolp group) group
14896                 (car (or method (gnus-find-method-for-group group))))))
14897     (funcall (intern (format "%s-request-accept-article" func))
14898              (if (stringp group) (gnus-group-real-name group) group)
14899              (cadr method)
14900              last)))
14901
14902 (defun gnus-request-replace-article (article group buffer)
14903   (let ((func (car (gnus-find-method-for-group group))))
14904     (funcall (intern (format "%s-request-replace-article" func))
14905              article (gnus-group-real-name group) buffer)))
14906
14907 (defun gnus-request-associate-buffer (group)
14908   (let ((method (gnus-find-method-for-group group)))
14909     (funcall (gnus-get-function method 'request-associate-buffer)
14910              (gnus-group-real-name group))))
14911
14912 (defun gnus-request-restore-buffer (article group)
14913   "Request a new buffer restored to the state of ARTICLE."
14914   (let ((method (gnus-find-method-for-group group)))
14915     (funcall (gnus-get-function method 'request-restore-buffer)
14916              article (gnus-group-real-name group) (nth 1 method))))
14917
14918 (defun gnus-request-create-group (group &optional method)
14919   (when (stringp method)
14920     (setq method (gnus-server-to-method method)))
14921   (let ((method (or method (gnus-find-method-for-group group))))
14922     (funcall (gnus-get-function method 'request-create-group)
14923              (gnus-group-real-name group) (nth 1 method))))
14924
14925 (defun gnus-request-delete-group (group &optional force)
14926   (let ((method (gnus-find-method-for-group group)))
14927     (funcall (gnus-get-function method 'request-delete-group)
14928              (gnus-group-real-name group) force (nth 1 method))))
14929
14930 (defun gnus-request-rename-group (group new-name)
14931   (let ((method (gnus-find-method-for-group group)))
14932     (funcall (gnus-get-function method 'request-rename-group)
14933              (gnus-group-real-name group)
14934              (gnus-group-real-name new-name) (nth 1 method))))
14935
14936 (defun gnus-member-of-valid (symbol group)
14937   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
14938   (memq symbol (assoc
14939                 (symbol-name (car (gnus-find-method-for-group group)))
14940                 gnus-valid-select-methods)))
14941
14942 (defun gnus-method-option-p (method option)
14943   "Return non-nil if select METHOD has OPTION as a parameter."
14944   (when (stringp method)
14945     (setq method (gnus-server-to-method method)))
14946   (memq option (assoc (format "%s" (car method))
14947                       gnus-valid-select-methods)))
14948
14949 (defun gnus-server-extend-method (group method)
14950   ;; This function "extends" a virtual server.  If the server is
14951   ;; "hello", and the select method is ("hello" (my-var "something"))
14952   ;; in the group "alt.alt", this will result in a new virtual server
14953   ;; called "hello+alt.alt".
14954   (let ((entry
14955          (gnus-copy-sequence
14956           (if (equal (car method) "native") gnus-select-method
14957             (cdr (assoc (car method) gnus-server-alist))))))
14958     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
14959     (nconc entry (cdr method))))
14960
14961 (defun gnus-find-method-for-group (group &optional info)
14962   "Find the select method that GROUP uses."
14963   (or gnus-override-method
14964       (and (not group)
14965            gnus-select-method)
14966       (let ((info (or info (gnus-get-info group)))
14967             method)
14968         (if (or (not info)
14969                 (not (setq method (gnus-info-method info)))
14970                 (equal method "native"))
14971             gnus-select-method
14972           (setq method
14973                 (cond ((stringp method)
14974                        (gnus-server-to-method method))
14975                       ((stringp (car method))
14976                        (gnus-server-extend-method group method))
14977                       (t
14978                        method)))
14979           (if (equal (cadr method) "")
14980               method
14981             (gnus-server-add-address method))))))
14982
14983 (defun gnus-check-backend-function (func group)
14984   "Check whether GROUP supports function FUNC."
14985   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
14986                   group)))
14987     (fboundp (intern (format "%s-%s" method func)))))
14988
14989 (defun gnus-methods-using (feature)
14990   "Find all methods that have FEATURE."
14991   (let ((valids gnus-valid-select-methods)
14992         outs)
14993     (while valids
14994       (if (memq feature (car valids))
14995           (setq outs (cons (car valids) outs)))
14996       (setq valids (cdr valids)))
14997     outs))
14998
14999 \f
15000 ;;;
15001 ;;; Active & Newsrc File Handling
15002 ;;;
15003
15004 (defun gnus-setup-news (&optional rawfile level dont-connect)
15005   "Setup news information.
15006 If RAWFILE is non-nil, the .newsrc file will also be read.
15007 If LEVEL is non-nil, the news will be set up at level LEVEL."
15008   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
15009
15010     (when init 
15011       ;; Clear some variables to re-initialize news information.
15012       (setq gnus-newsrc-alist nil
15013             gnus-active-hashtb nil)
15014       ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
15015       (gnus-read-newsrc-file rawfile))
15016
15017     (when (and (not (assoc "archive" gnus-server-alist))
15018                gnus-message-archive-method)
15019       (push (cons "archive" gnus-message-archive-method)
15020             gnus-server-alist))
15021
15022     ;; If we don't read the complete active file, we fill in the
15023     ;; hashtb here.
15024     (if (or (null gnus-read-active-file)
15025             (eq gnus-read-active-file 'some))
15026         (gnus-update-active-hashtb-from-killed))
15027
15028     ;; Read the active file and create `gnus-active-hashtb'.
15029     ;; If `gnus-read-active-file' is nil, then we just create an empty
15030     ;; hash table.  The partial filling out of the hash table will be
15031     ;; done in `gnus-get-unread-articles'.
15032     (and gnus-read-active-file
15033          (not level)
15034          (gnus-read-active-file))
15035
15036     (or gnus-active-hashtb
15037         (setq gnus-active-hashtb (make-vector 4095 0)))
15038
15039     ;; Initialize the cache.
15040     (when gnus-use-cache
15041       (gnus-cache-open))
15042
15043     ;; Possibly eval the dribble file.
15044     (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
15045
15046     (gnus-update-format-specifications)
15047
15048     ;; See whether we need to read the description file.
15049     (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
15050              (not gnus-description-hashtb)
15051              (not dont-connect)
15052              gnus-read-active-file)
15053         (gnus-read-all-descriptions-files))
15054
15055     ;; Find new newsgroups and treat them.
15056     (if (and init gnus-check-new-newsgroups (not level)
15057              (gnus-check-server gnus-select-method))
15058         (gnus-find-new-newsgroups))
15059
15060     ;; We might read in new NoCeM messages here.
15061     (when gnus-use-nocem 
15062       (gnus-nocem-scan-groups))
15063
15064     ;; Find the number of unread articles in each non-dead group.
15065     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
15066       (gnus-get-unread-articles level))
15067
15068     (if (and init gnus-check-bogus-newsgroups
15069              gnus-read-active-file (not level)
15070              (gnus-server-opened gnus-select-method))
15071         (gnus-check-bogus-newsgroups))))
15072
15073 (defun gnus-find-new-newsgroups (&optional arg)
15074   "Search for new newsgroups and add them.
15075 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
15076 The `-n' option line from .newsrc is respected.
15077 If ARG (the prefix), use the `ask-server' method to query
15078 the server for new groups."
15079   (interactive "P")
15080   (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups)))
15081                        (null gnus-read-active-file)
15082                        (eq gnus-read-active-file 'some))
15083                    'ask-server gnus-check-new-newsgroups)))
15084     (unless (gnus-check-first-time-used)
15085       (if (or (consp check)
15086               (eq check 'ask-server))
15087           ;; Ask the server for new groups.
15088           (gnus-ask-server-for-new-groups)
15089         ;; Go through the active hashtb and look for new groups.
15090         (let ((groups 0)
15091               group new-newsgroups)
15092           (gnus-message 5 "Looking for new newsgroups...")
15093           (unless gnus-have-read-active-file
15094             (gnus-read-active-file))
15095           (setq gnus-newsrc-last-checked-date (current-time-string))
15096           (unless gnus-killed-hashtb
15097             (gnus-make-hashtable-from-killed))
15098           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
15099           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
15100           (mapatoms
15101            (lambda (sym)
15102              (if (or (null (setq group (symbol-name sym)))
15103                      (not (boundp sym))
15104                      (null (symbol-value sym))
15105                      (gnus-gethash group gnus-killed-hashtb)
15106                      (gnus-gethash group gnus-newsrc-hashtb))
15107                  ()
15108                (let ((do-sub (gnus-matches-options-n group)))
15109                  (cond
15110                   ((eq do-sub 'subscribe)
15111                    (setq groups (1+ groups))
15112                    (gnus-sethash group group gnus-killed-hashtb)
15113                    (funcall gnus-subscribe-options-newsgroup-method group))
15114                   ((eq do-sub 'ignore)
15115                    nil)
15116                   (t
15117                    (setq groups (1+ groups))
15118                    (gnus-sethash group group gnus-killed-hashtb)
15119                    (if gnus-subscribe-hierarchical-interactive
15120                        (setq new-newsgroups (cons group new-newsgroups))
15121                      (funcall gnus-subscribe-newsgroup-method group)))))))
15122            gnus-active-hashtb)
15123           (when new-newsgroups
15124             (gnus-subscribe-hierarchical-interactive new-newsgroups))
15125           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
15126           (if (> groups 0)
15127               (gnus-message 6 "%d new newsgroup%s arrived."
15128                             groups (if (> groups 1) "s have" " has"))
15129             (gnus-message 6 "No new newsgroups.")))))))
15130
15131 (defun gnus-matches-options-n (group)
15132   ;; Returns `subscribe' if the group is to be unconditionally
15133   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
15134   ;; no match for the group.
15135
15136   ;; First we check the two user variables.
15137   (cond
15138    ((and gnus-options-subscribe
15139          (string-match gnus-options-subscribe group))
15140     'subscribe)
15141    ((and gnus-auto-subscribed-groups
15142          (string-match gnus-auto-subscribed-groups group))
15143     'subscribe)
15144    ((and gnus-options-not-subscribe
15145          (string-match gnus-options-not-subscribe group))
15146     'ignore)
15147    ;; Then we go through the list that was retrieved from the .newsrc
15148    ;; file.  This list has elements on the form
15149    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
15150    ;; is in the reverse order of the options line) is returned.
15151    (t
15152     (let ((regs gnus-newsrc-options-n))
15153       (while (and regs
15154                   (not (string-match (caar regs) group)))
15155         (setq regs (cdr regs)))
15156       (and regs (cdar regs))))))
15157
15158 (defun gnus-ask-server-for-new-groups ()
15159   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
15160          (methods (cons gnus-select-method
15161                         (nconc
15162                          (when gnus-message-archive-method
15163                            (list "archive"))
15164                          (append
15165                           (and (consp gnus-check-new-newsgroups)
15166                                gnus-check-new-newsgroups)
15167                           gnus-secondary-select-methods))))
15168          (groups 0)
15169          (new-date (current-time-string))
15170          group new-newsgroups got-new method hashtb
15171          gnus-override-subscribe-method)
15172     ;; Go through both primary and secondary select methods and
15173     ;; request new newsgroups.
15174     (while (setq method (gnus-server-get-method nil (pop methods)))
15175       (setq new-newsgroups nil)
15176       (setq gnus-override-subscribe-method method)
15177       (when (and (gnus-check-server method)
15178                  (gnus-request-newgroups date method))
15179         (save-excursion
15180           (setq got-new t)
15181           (setq hashtb (gnus-make-hashtable 100))
15182           (set-buffer nntp-server-buffer)
15183           ;; Enter all the new groups into a hashtable.
15184           (gnus-active-to-gnus-format method hashtb 'ignore)))
15185       ;; Now all new groups from `method' are in `hashtb'.
15186       (mapatoms
15187        (lambda (group-sym)
15188          (if (or (null (setq group (symbol-name group-sym)))
15189                  (null (symbol-value group-sym))
15190                  (gnus-gethash group gnus-newsrc-hashtb)
15191                  (member group gnus-zombie-list)
15192                  (member group gnus-killed-list))
15193              ;; The group is already known.
15194              ()
15195            ;; Make this group active.
15196            (when (symbol-value group-sym)
15197              (gnus-set-active group (symbol-value group-sym)))
15198            ;; Check whether we want it or not.
15199            (let ((do-sub (gnus-matches-options-n group)))
15200              (cond
15201               ((eq do-sub 'subscribe)
15202                (incf groups)
15203                (gnus-sethash group group gnus-killed-hashtb)
15204                (funcall gnus-subscribe-options-newsgroup-method group))
15205               ((eq do-sub 'ignore)
15206                nil)
15207               (t
15208                (incf groups)
15209                (gnus-sethash group group gnus-killed-hashtb)
15210                (if gnus-subscribe-hierarchical-interactive
15211                    (push group new-newsgroups)
15212                  (funcall gnus-subscribe-newsgroup-method group)))))))
15213        hashtb)
15214       (when new-newsgroups
15215         (gnus-subscribe-hierarchical-interactive new-newsgroups)))
15216     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
15217     (when (> groups 0)
15218       (gnus-message 6 "%d new newsgroup%s arrived."
15219                     groups (if (> groups 1) "s have" " has")))
15220     (and got-new (setq gnus-newsrc-last-checked-date new-date))
15221     got-new))
15222
15223 (defun gnus-check-first-time-used ()
15224   (if (or (> (length gnus-newsrc-alist) 1)
15225           (file-exists-p gnus-startup-file)
15226           (file-exists-p (concat gnus-startup-file ".el"))
15227           (file-exists-p (concat gnus-startup-file ".eld")))
15228       nil
15229     (gnus-message 6 "First time user; subscribing you to default groups")
15230     (unless gnus-have-read-active-file
15231       (gnus-read-active-file))
15232     (setq gnus-newsrc-last-checked-date (current-time-string))
15233     (let ((groups gnus-default-subscribed-newsgroups)
15234           group)
15235       (if (eq groups t)
15236           nil
15237         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
15238         (mapatoms
15239          (lambda (sym)
15240            (if (null (setq group (symbol-name sym)))
15241                ()
15242              (let ((do-sub (gnus-matches-options-n group)))
15243                (cond
15244                 ((eq do-sub 'subscribe)
15245                  (gnus-sethash group group gnus-killed-hashtb)
15246                  (funcall gnus-subscribe-options-newsgroup-method group))
15247                 ((eq do-sub 'ignore)
15248                  nil)
15249                 (t
15250                  (setq gnus-killed-list (cons group gnus-killed-list)))))))
15251          gnus-active-hashtb)
15252         (while groups
15253           (if (gnus-active (car groups))
15254               (gnus-group-change-level
15255                (car groups) gnus-level-default-subscribed gnus-level-killed))
15256           (setq groups (cdr groups)))
15257         (gnus-group-make-help-group)
15258         (and gnus-novice-user
15259              (gnus-message 7 "`A k' to list killed groups"))))))
15260
15261 (defun gnus-subscribe-group (group previous &optional method)
15262   (gnus-group-change-level
15263    (if method
15264        (list t group gnus-level-default-subscribed nil nil method)
15265      group)
15266    gnus-level-default-subscribed gnus-level-killed previous t))
15267
15268 ;; `gnus-group-change-level' is the fundamental function for changing
15269 ;; subscription levels of newsgroups.  This might mean just changing
15270 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
15271 ;; again, which subscribes/unsubscribes a group, which is equally
15272 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
15273 ;; from 8-9 to 1-7 means that you remove the group from the list of
15274 ;; killed (or zombie) groups and add them to the (kinda) subscribed
15275 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
15276 ;; which is trivial.
15277 ;; ENTRY can either be a string (newsgroup name) or a list (if
15278 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
15279 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
15280 ;; entries.
15281 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
15282 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
15283 ;; after.
15284 (defun gnus-group-change-level (entry level &optional oldlevel
15285                                       previous fromkilled)
15286   (let (group info active num)
15287     ;; Glean what info we can from the arguments
15288     (if (consp entry)
15289         (if fromkilled (setq group (nth 1 entry))
15290           (setq group (car (nth 2 entry))))
15291       (setq group entry))
15292     (if (and (stringp entry)
15293              oldlevel
15294              (< oldlevel gnus-level-zombie))
15295         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
15296     (if (and (not oldlevel)
15297              (consp entry))
15298         (setq oldlevel (gnus-info-level (nth 2 entry)))
15299       (setq oldlevel (or oldlevel 9)))
15300     (if (stringp previous)
15301         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
15302
15303     (if (and (>= oldlevel gnus-level-zombie)
15304              (gnus-gethash group gnus-newsrc-hashtb))
15305         ;; We are trying to subscribe a group that is already
15306         ;; subscribed.
15307         ()                              ; Do nothing.
15308
15309       (or (gnus-ephemeral-group-p group)
15310           (gnus-dribble-enter
15311            (format "(gnus-group-change-level %S %S %S %S %S)"
15312                    group level oldlevel (car (nth 2 previous)) fromkilled)))
15313
15314       ;; Then we remove the newgroup from any old structures, if needed.
15315       ;; If the group was killed, we remove it from the killed or zombie
15316       ;; list.  If not, and it is in fact going to be killed, we remove
15317       ;; it from the newsrc hash table and assoc.
15318       (cond
15319        ((>= oldlevel gnus-level-zombie)
15320         (if (= oldlevel gnus-level-zombie)
15321             (setq gnus-zombie-list (delete group gnus-zombie-list))
15322           (setq gnus-killed-list (delete group gnus-killed-list))))
15323        (t
15324         (if (and (>= level gnus-level-zombie)
15325                  entry)
15326             (progn
15327               (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
15328               (if (nth 3 entry)
15329                   (setcdr (gnus-gethash (car (nth 3 entry))
15330                                         gnus-newsrc-hashtb)
15331                           (cdr entry)))
15332               (setcdr (cdr entry) (cdddr entry))))))
15333
15334       ;; Finally we enter (if needed) the list where it is supposed to
15335       ;; go, and change the subscription level.  If it is to be killed,
15336       ;; we enter it into the killed or zombie list.
15337       (cond 
15338        ((>= level gnus-level-zombie)
15339         ;; Remove from the hash table.
15340         (gnus-sethash group nil gnus-newsrc-hashtb)
15341         ;; We do not enter foreign groups into the list of dead
15342         ;; groups.
15343         (unless (gnus-group-foreign-p group)
15344           (if (= level gnus-level-zombie)
15345               (setq gnus-zombie-list (cons group gnus-zombie-list))
15346             (setq gnus-killed-list (cons group gnus-killed-list)))))
15347        (t
15348         ;; If the list is to be entered into the newsrc assoc, and
15349         ;; it was killed, we have to create an entry in the newsrc
15350         ;; hashtb format and fix the pointers in the newsrc assoc.
15351         (if (< oldlevel gnus-level-zombie)
15352             ;; It was alive, and it is going to stay alive, so we
15353             ;; just change the level and don't change any pointers or
15354             ;; hash table entries.
15355             (setcar (cdaddr entry) level)
15356           (if (listp entry)
15357               (setq info (cdr entry)
15358                     num (car entry))
15359             (setq active (gnus-active group))
15360             (setq num
15361                   (if active (- (1+ (cdr active)) (car active)) t))
15362             ;; Check whether the group is foreign.  If so, the
15363             ;; foreign select method has to be entered into the
15364             ;; info.
15365             (let ((method (or gnus-override-subscribe-method
15366                               (gnus-group-method group))))
15367               (if (eq method gnus-select-method)
15368                   (setq info (list group level nil))
15369                 (setq info (list group level nil nil method)))))
15370           (unless previous
15371             (setq previous
15372                   (let ((p gnus-newsrc-alist))
15373                     (while (cddr p)
15374                       (setq p (cdr p)))
15375                     p)))
15376           (setq entry (cons info (cddr previous)))
15377           (if (cdr previous)
15378               (progn
15379                 (setcdr (cdr previous) entry)
15380                 (gnus-sethash group (cons num (cdr previous))
15381                               gnus-newsrc-hashtb))
15382             (setcdr previous entry)
15383             (gnus-sethash group (cons num previous)
15384                           gnus-newsrc-hashtb))
15385           (when (cdr entry)
15386             (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)))))
15387       (when gnus-group-change-level-function
15388         (funcall gnus-group-change-level-function group level oldlevel)))))
15389
15390 (defun gnus-kill-newsgroup (newsgroup)
15391   "Obsolete function.  Kills a newsgroup."
15392   (gnus-group-change-level
15393    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
15394
15395 (defun gnus-check-bogus-newsgroups (&optional confirm)
15396   "Remove bogus newsgroups.
15397 If CONFIRM is non-nil, the user has to confirm the deletion of every
15398 newsgroup."
15399   (let ((newsrc (cdr gnus-newsrc-alist))
15400         bogus group entry info)
15401     (gnus-message 5 "Checking bogus newsgroups...")
15402     (unless gnus-have-read-active-file
15403       (gnus-read-active-file))
15404     (when (member gnus-select-method gnus-have-read-active-file)
15405       ;; Find all bogus newsgroup that are subscribed.
15406       (while newsrc
15407         (setq info (pop newsrc)
15408               group (gnus-info-group info))
15409         (unless (or (gnus-active group) ; Active
15410                     (gnus-info-method info) ; Foreign
15411                     (and confirm
15412                          (not (gnus-y-or-n-p
15413                                (format "Remove bogus newsgroup: %s " group)))))
15414           ;; Found a bogus newsgroup.
15415           (push group bogus)))
15416       ;; Remove all bogus subscribed groups by first killing them, and
15417       ;; then removing them from the list of killed groups.
15418       (while bogus
15419         (when (setq entry (gnus-gethash (setq group (pop bogus))
15420                                         gnus-newsrc-hashtb))
15421           (gnus-group-change-level entry gnus-level-killed)
15422           (setq gnus-killed-list (delete group gnus-killed-list))))
15423       ;; Then we remove all bogus groups from the list of killed and
15424       ;; zombie groups.  They are are removed without confirmation.
15425       (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
15426             killed)
15427         (while dead-lists
15428           (setq killed (symbol-value (car dead-lists)))
15429           (while killed
15430             (unless (gnus-active (setq group (pop killed)))
15431               ;; The group is bogus.
15432               ;; !!!Slow as hell.
15433               (set (car dead-lists)
15434                    (delete group (symbol-value (car dead-lists))))))
15435           (setq dead-lists (cdr dead-lists))))
15436       (gnus-message 5 "Checking bogus newsgroups...done"))))
15437
15438 (defun gnus-check-duplicate-killed-groups ()
15439   "Remove duplicates from the list of killed groups."
15440   (interactive)
15441   (let ((killed gnus-killed-list))
15442     (while killed
15443       (gnus-message 9 "%d" (length killed))
15444       (setcdr killed (delete (car killed) (cdr killed)))
15445       (setq killed (cdr killed)))))
15446
15447 ;; We want to inline a function from gnus-cache, so we cheat here:
15448 (eval-when-compile
15449   (provide 'gnus)
15450   (require 'gnus-cache))
15451
15452 (defun gnus-get-unread-articles-in-group (info active &optional update)
15453   (when active
15454     ;; Allow the backend to update the info in the group.
15455     (when (and update 
15456                (gnus-request-update-info
15457                 info (gnus-find-method-for-group (gnus-info-group info))))
15458       (gnus-activate-group (gnus-info-group info)))
15459     (let* ((range (gnus-info-read info))
15460            (num 0))
15461       ;; If a cache is present, we may have to alter the active info.
15462       (when (and gnus-use-cache info)
15463         (inline (gnus-cache-possibly-alter-active 
15464                  (gnus-info-group info) active)))
15465       ;; Modify the list of read articles according to what articles
15466       ;; are available; then tally the unread articles and add the
15467       ;; number to the group hash table entry.
15468       (cond
15469        ((zerop (cdr active))
15470         (setq num 0))
15471        ((not range)
15472         (setq num (- (1+ (cdr active)) (car active))))
15473        ((not (listp (cdr range)))
15474         ;; Fix a single (num . num) range according to the
15475         ;; active hash table.
15476         ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
15477         (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
15478         (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
15479         ;; Compute number of unread articles.
15480         (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
15481        (t
15482         ;; The read list is a list of ranges.  Fix them according to
15483         ;; the active hash table.
15484         ;; First peel off any elements that are below the lower
15485         ;; active limit.
15486         (while (and (cdr range)
15487                     (>= (car active)
15488                         (or (and (atom (cadr range)) (cadr range))
15489                             (caadr range))))
15490           (if (numberp (car range))
15491               (setcar range
15492                       (cons (car range)
15493                             (or (and (numberp (cadr range))
15494                                      (cadr range))
15495                                 (cdadr range))))
15496             (setcdr (car range)
15497                     (or (and (numberp (nth 1 range)) (nth 1 range))
15498                         (cdadr range))))
15499           (setcdr range (cddr range)))
15500         ;; Adjust the first element to be the same as the lower limit.
15501         (if (and (not (atom (car range)))
15502                  (< (cdar range) (car active)))
15503             (setcdr (car range) (1- (car active))))
15504         ;; Then we want to peel off any elements that are higher
15505         ;; than the upper active limit.
15506         (let ((srange range))
15507           ;; Go past all legal elements.
15508           (while (and (cdr srange)
15509                       (<= (or (and (atom (cadr srange))
15510                                    (cadr srange))
15511                               (caadr srange)) (cdr active)))
15512             (setq srange (cdr srange)))
15513           (if (cdr srange)
15514               ;; Nuke all remaining illegal elements.
15515               (setcdr srange nil))
15516
15517           ;; Adjust the final element.
15518           (if (and (not (atom (car srange)))
15519                    (> (cdar srange) (cdr active)))
15520               (setcdr (car srange) (cdr active))))
15521         ;; Compute the number of unread articles.
15522         (while range
15523           (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
15524                                       (cdar range)))
15525                               (or (and (atom (car range)) (car range))
15526                                   (caar range)))))
15527           (setq range (cdr range)))
15528         (setq num (max 0 (- (cdr active) num)))))
15529       ;; Set the number of unread articles.
15530       (when info
15531         (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
15532       num)))
15533
15534 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
15535 ;; and compute how many unread articles there are in each group.
15536 (defun gnus-get-unread-articles (&optional level)
15537   (let* ((newsrc (cdr gnus-newsrc-alist))
15538          (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
15539          (foreign-level
15540           (min
15541            (cond ((and gnus-activate-foreign-newsgroups
15542                        (not (numberp gnus-activate-foreign-newsgroups)))
15543                   (1+ gnus-level-subscribed))
15544                  ((numberp gnus-activate-foreign-newsgroups)
15545                   gnus-activate-foreign-newsgroups)
15546                  (t 0))
15547            level))
15548          info group active method)
15549     (gnus-message 5 "Checking new news...")
15550
15551     (while newsrc
15552       (setq active (gnus-active (setq group (gnus-info-group
15553                                              (setq info (pop newsrc))))))
15554
15555       ;; Check newsgroups.  If the user doesn't want to check them, or
15556       ;; they can't be checked (for instance, if the news server can't
15557       ;; be reached) we just set the number of unread articles in this
15558       ;; newsgroup to t.  This means that Gnus thinks that there are
15559       ;; unread articles, but it has no idea how many.
15560       (if (and (setq method (gnus-info-method info))
15561                (not (gnus-server-equal
15562                      gnus-select-method
15563                      (setq method (gnus-server-get-method nil method))))
15564                (not (gnus-secondary-method-p method)))
15565           ;; These groups are foreign.  Check the level.
15566           (when (<= (gnus-info-level info) foreign-level)
15567             (setq active (gnus-activate-group group 'scan))
15568             (gnus-close-group group))
15569
15570         ;; These groups are native or secondary.
15571         (when (and (<= (gnus-info-level info) level)
15572                    (not gnus-read-active-file))
15573           (setq active (gnus-activate-group group 'scan))
15574           (gnus-close-group group)))
15575
15576       (if active
15577           (inline (gnus-get-unread-articles-in-group 
15578                    info active
15579                    (and method
15580                         (fboundp (intern (concat (symbol-name (car method))
15581                                                  "-request-scan"))))))
15582         ;; The group couldn't be reached, so we nix out the number of
15583         ;; unread articles and stuff.
15584         (gnus-set-active group nil)
15585         (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
15586
15587     (gnus-message 5 "Checking new news...done")))
15588
15589 ;; Create a hash table out of the newsrc alist.  The `car's of the
15590 ;; alist elements are used as keys.
15591 (defun gnus-make-hashtable-from-newsrc-alist ()
15592   (let ((alist gnus-newsrc-alist)
15593         (ohashtb gnus-newsrc-hashtb)
15594         prev)
15595     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
15596     (setq alist
15597           (setq prev (setq gnus-newsrc-alist
15598                            (if (equal (caar gnus-newsrc-alist)
15599                                       "dummy.group")
15600                                gnus-newsrc-alist
15601                              (cons (list "dummy.group" 0 nil) alist)))))
15602     (while alist
15603       (gnus-sethash
15604        (caar alist)
15605        (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
15606              prev)
15607        gnus-newsrc-hashtb)
15608       (setq prev alist
15609             alist (cdr alist)))))
15610
15611 (defun gnus-make-hashtable-from-killed ()
15612   "Create a hash table from the killed and zombie lists."
15613   (let ((lists '(gnus-killed-list gnus-zombie-list))
15614         list)
15615     (setq gnus-killed-hashtb
15616           (gnus-make-hashtable
15617            (+ (length gnus-killed-list) (length gnus-zombie-list))))
15618     (while (setq list (pop lists))
15619       (setq list (symbol-value list))
15620       (while list
15621         (gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
15622
15623 (defun gnus-activate-group (group &optional scan)
15624   ;; Check whether a group has been activated or not.
15625   ;; If SCAN, request a scan of that group as well.
15626   (let ((method (gnus-find-method-for-group group))
15627         active)
15628     (and (gnus-check-server method)
15629          ;; We escape all bugs and quit here to make it possible to
15630          ;; continue if a group is so out-there that it reports bugs
15631          ;; and stuff.
15632          (progn
15633            (and scan
15634                 (gnus-check-backend-function 'request-scan (car method))
15635                 (gnus-request-scan group method))
15636            t)
15637          (condition-case ()
15638              (gnus-request-group group)
15639         ;   (error nil)
15640            (quit nil))
15641          (save-excursion
15642            (set-buffer nntp-server-buffer)
15643            (goto-char (point-min))
15644            ;; Parse the result we got from `gnus-request-group'.
15645            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
15646                 (progn
15647                   (goto-char (match-beginning 1))
15648                   (gnus-set-active
15649                    group (setq active (cons (read (current-buffer))
15650                                             (read (current-buffer)))))
15651                   ;; Return the new active info.
15652                   active))))))
15653
15654 (defun gnus-update-read-articles (group unread)
15655   "Update the list of read and ticked articles in GROUP using the
15656 UNREAD and TICKED lists.
15657 Note: UNSELECTED has to be sorted over `<'.
15658 Returns whether the updating was successful."
15659   (let* ((active (or gnus-newsgroup-active (gnus-active group)))
15660          (entry (gnus-gethash group gnus-newsrc-hashtb))
15661          (info (nth 2 entry))
15662          (prev 1)
15663          (unread (sort (copy-sequence unread) '<))
15664          read)
15665     (if (or (not info) (not active))
15666         ;; There is no info on this group if it was, in fact,
15667         ;; killed.  Gnus stores no information on killed groups, so
15668         ;; there's nothing to be done.
15669         ;; One could store the information somewhere temporarily,
15670         ;; perhaps...  Hmmm...
15671         ()
15672       ;; Remove any negative articles numbers.
15673       (while (and unread (< (car unread) 0))
15674         (setq unread (cdr unread)))
15675       ;; Remove any expired article numbers
15676       (while (and unread (< (car unread) (car active)))
15677         (setq unread (cdr unread)))
15678       ;; Compute the ranges of read articles by looking at the list of
15679       ;; unread articles.
15680       (while unread
15681         (if (/= (car unread) prev)
15682             (setq read (cons (if (= prev (1- (car unread))) prev
15683                                (cons prev (1- (car unread)))) read)))
15684         (setq prev (1+ (car unread)))
15685         (setq unread (cdr unread)))
15686       (when (<= prev (cdr active))
15687         (setq read (cons (cons prev (cdr active)) read)))
15688       ;; Enter this list into the group info.
15689       (gnus-info-set-read
15690        info (if (> (length read) 1) (nreverse read) read))
15691       ;; Set the number of unread articles in gnus-newsrc-hashtb.
15692       (gnus-get-unread-articles-in-group info (gnus-active group))
15693       t)))
15694
15695 (defun gnus-make-articles-unread (group articles)
15696   "Mark ARTICLES in GROUP as unread."
15697   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
15698                           (gnus-gethash (gnus-group-real-name group)
15699                                         gnus-newsrc-hashtb))))
15700          (ranges (gnus-info-read info))
15701          news article)
15702     (while articles
15703       (when (gnus-member-of-range
15704              (setq article (pop articles)) ranges)
15705         (setq news (cons article news))))
15706     (when news
15707       (gnus-info-set-read
15708        info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
15709       (gnus-group-update-group group t))))
15710
15711 ;; Enter all dead groups into the hashtb.
15712 (defun gnus-update-active-hashtb-from-killed ()
15713   (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
15714         (lists (list gnus-killed-list gnus-zombie-list))
15715         killed)
15716     (while lists
15717       (setq killed (car lists))
15718       (while killed
15719         (gnus-sethash (car killed) nil hashtb)
15720         (setq killed (cdr killed)))
15721       (setq lists (cdr lists)))))
15722
15723 ;; Get the active file(s) from the backend(s).
15724 (defun gnus-read-active-file ()
15725   (gnus-group-set-mode-line)
15726   (let ((methods 
15727          (append
15728           (if (gnus-check-server gnus-select-method)
15729               ;; The native server is available.
15730               (cons gnus-select-method gnus-secondary-select-methods)
15731             ;; The native server is down, so we just do the
15732             ;; secondary ones.
15733             gnus-secondary-select-methods)
15734           ;; Also read from the archive server.
15735           (when gnus-message-archive-method
15736             (list "archive"))))
15737         list-type)
15738     (setq gnus-have-read-active-file nil)
15739     (save-excursion
15740       (set-buffer nntp-server-buffer)
15741       (while methods
15742         (let* ((method (if (stringp (car methods))
15743                            (gnus-server-get-method nil (car methods))
15744                          (car methods)))
15745                (where (nth 1 method))
15746                (mesg (format "Reading active file%s via %s..."
15747                              (if (and where (not (zerop (length where))))
15748                                  (concat " from " where) "")
15749                              (car method))))
15750           (gnus-message 5 mesg)
15751           (when (gnus-check-server method)
15752             ;; Request that the backend scan its incoming messages.
15753             (and (gnus-check-backend-function 'request-scan (car method))
15754                  (gnus-request-scan nil method))
15755             (cond
15756              ((and (eq gnus-read-active-file 'some)
15757                    (gnus-check-backend-function 'retrieve-groups (car method)))
15758               (let ((newsrc (cdr gnus-newsrc-alist))
15759                     (gmethod (gnus-server-get-method nil method))
15760                     groups info)
15761                 (while (setq info (pop newsrc))
15762                   (when (gnus-server-equal
15763                          (gnus-find-method-for-group 
15764                           (gnus-info-group info) info)
15765                          gmethod)
15766                     (push (gnus-group-real-name (gnus-info-group info)) 
15767                           groups)))
15768                 (when groups
15769                   (gnus-check-server method)
15770                   (setq list-type (gnus-retrieve-groups groups method))
15771                   (cond
15772                    ((not list-type)
15773                     (gnus-message
15774                      1 "Cannot read partial active file from %s server."
15775                      (car method))
15776                     (ding)
15777                     (sit-for 2))
15778                    ((eq list-type 'active)
15779                     (gnus-active-to-gnus-format method gnus-active-hashtb))
15780                    (t
15781                     (gnus-groups-to-gnus-format method gnus-active-hashtb))))))
15782              (t
15783               (if (not (gnus-request-list method))
15784                   (progn
15785                     (unless (equal method gnus-message-archive-method)
15786                       (gnus-message 1 "Cannot read active file from %s server."
15787                                     (car method))
15788                       (ding)))
15789                 (gnus-active-to-gnus-format method)
15790                 ;; We mark this active file as read.
15791                 (push method gnus-have-read-active-file)
15792                 (gnus-message 5 "%sdone" mesg))))))
15793         (setq methods (cdr methods))))))
15794
15795 ;; Read an active file and place the results in `gnus-active-hashtb'.
15796 (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors)
15797   (unless method
15798     (setq method gnus-select-method))
15799   (let ((cur (current-buffer))
15800         (hashtb (or hashtb
15801                     (if (and gnus-active-hashtb
15802                              (not (equal method gnus-select-method)))
15803                         gnus-active-hashtb
15804                       (setq gnus-active-hashtb
15805                             (if (equal method gnus-select-method)
15806                                 (gnus-make-hashtable
15807                                  (count-lines (point-min) (point-max)))
15808                               (gnus-make-hashtable 4096)))))))
15809     ;; Delete unnecessary lines.
15810     (goto-char (point-min))
15811     (while (search-forward "\nto." nil t)
15812       (delete-region (1+ (match-beginning 0))
15813                      (progn (forward-line 1) (point))))
15814     (or (string= gnus-ignored-newsgroups "")
15815         (progn
15816           (goto-char (point-min))
15817           (delete-matching-lines gnus-ignored-newsgroups)))
15818     ;; Make the group names readable as a lisp expression even if they
15819     ;; contain special characters.
15820     ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
15821     (goto-char (point-max))
15822     (while (re-search-backward "[][';?()#]" nil t)
15823       (insert ?\\))
15824     ;; If these are groups from a foreign select method, we insert the
15825     ;; group prefix in front of the group names.
15826     (and method (not (gnus-server-equal
15827                       (gnus-server-get-method nil method)
15828                       (gnus-server-get-method nil gnus-select-method)))
15829          (let ((prefix (gnus-group-prefixed-name "" method)))
15830            (goto-char (point-min))
15831            (while (and (not (eobp))
15832                        (progn (insert prefix)
15833                               (zerop (forward-line 1)))))))
15834     ;; Store the active file in a hash table.
15835     (goto-char (point-min))
15836     (if (string-match "%[oO]" gnus-group-line-format)
15837         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
15838         ;; If we want information on moderated groups, we use this
15839         ;; loop...
15840         (let* ((mod-hashtb (make-vector 7 0))
15841                (m (intern "m" mod-hashtb))
15842                group max min)
15843           (while (not (eobp))
15844             (condition-case nil
15845                 (progn
15846                   (narrow-to-region (point) (gnus-point-at-eol))
15847                   (setq group (let ((obarray hashtb)) (read cur)))
15848                   (if (and (numberp (setq max (read cur)))
15849                            (numberp (setq min (read cur)))
15850                            (progn
15851                              (skip-chars-forward " \t")
15852                              (not
15853                               (or (= (following-char) ?=)
15854                                   (= (following-char) ?x)
15855                                   (= (following-char) ?j)))))
15856                       (set group (cons min max))
15857                     (set group nil))
15858                   ;; Enter moderated groups into a list.
15859                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
15860                       (setq gnus-moderated-list
15861                             (cons (symbol-name group) gnus-moderated-list))))
15862               (error
15863                (and group
15864                     (symbolp group)
15865                     (set group nil))))
15866             (widen)
15867             (forward-line 1)))
15868       ;; And if we do not care about moderation, we use this loop,
15869       ;; which is faster.
15870       (let (group max min)
15871         (while (not (eobp))
15872           (condition-case ()
15873               (progn
15874                 (narrow-to-region (point) (gnus-point-at-eol))
15875                 ;; group gets set to a symbol interned in the hash table
15876                 ;; (what a hack!!) - jwz
15877                 (setq group (let ((obarray hashtb)) (read cur)))
15878                 (if (and (numberp (setq max (read cur)))
15879                          (numberp (setq min (read cur)))
15880                          (progn
15881                            (skip-chars-forward " \t")
15882                            (not
15883                             (or (= (following-char) ?=)
15884                                 (= (following-char) ?x)
15885                                 (= (following-char) ?j)))))
15886                     (set group (cons min max))
15887                   (set group nil)))
15888             (error
15889              (progn
15890                (and group
15891                     (symbolp group)
15892                     (set group nil))
15893                (or ignore-errors
15894                    (gnus-message 3 "Warning - illegal active: %s"
15895                                  (buffer-substring
15896                                   (gnus-point-at-bol) (gnus-point-at-eol)))))))
15897           (widen)
15898           (forward-line 1))))))
15899
15900 (defun gnus-groups-to-gnus-format (method &optional hashtb)
15901   ;; Parse a "groups" active file.
15902   (let ((cur (current-buffer))
15903         (hashtb (or hashtb
15904                     (if (and method gnus-active-hashtb)
15905                         gnus-active-hashtb
15906                       (setq gnus-active-hashtb
15907                             (gnus-make-hashtable
15908                              (count-lines (point-min) (point-max)))))))
15909         (prefix (and method
15910                      (not (gnus-server-equal
15911                            (gnus-server-get-method nil method)
15912                            (gnus-server-get-method nil gnus-select-method)))
15913                      (gnus-group-prefixed-name "" method))))
15914
15915     (goto-char (point-min))
15916     ;; We split this into to separate loops, one with the prefix
15917     ;; and one without to speed the reading up somewhat.
15918     (if prefix
15919         (let (min max opoint group)
15920           (while (not (eobp))
15921             (condition-case ()
15922                 (progn
15923                   (read cur) (read cur)
15924                   (setq min (read cur)
15925                         max (read cur)
15926                         opoint (point))
15927                   (skip-chars-forward " \t")
15928                   (insert prefix)
15929                   (goto-char opoint)
15930                   (set (let ((obarray hashtb)) (read cur))
15931                        (cons min max)))
15932               (error (and group (symbolp group) (set group nil))))
15933             (forward-line 1)))
15934       (let (min max group)
15935         (while (not (eobp))
15936           (condition-case ()
15937               (if (= (following-char) ?2)
15938                   (progn
15939                     (read cur) (read cur)
15940                     (setq min (read cur)
15941                           max (read cur))
15942                     (set (setq group (let ((obarray hashtb)) (read cur)))
15943                          (cons min max))))
15944             (error (and group (symbolp group) (set group nil))))
15945           (forward-line 1))))))
15946
15947 (defun gnus-read-newsrc-file (&optional force)
15948   "Read startup file.
15949 If FORCE is non-nil, the .newsrc file is read."
15950   ;; Reset variables that might be defined in the .newsrc.eld file.
15951   (let ((variables gnus-variable-list))
15952     (while variables
15953       (set (car variables) nil)
15954       (setq variables (cdr variables))))
15955   (let* ((newsrc-file gnus-current-startup-file)
15956          (quick-file (concat newsrc-file ".el")))
15957     (save-excursion
15958       ;; We always load the .newsrc.eld file.  If always contains
15959       ;; much information that can not be gotten from the .newsrc
15960       ;; file (ticked articles, killed groups, foreign methods, etc.)
15961       (gnus-read-newsrc-el-file quick-file)
15962
15963       (if (and (file-exists-p gnus-current-startup-file)
15964                (or force
15965                    (and (file-newer-than-file-p newsrc-file quick-file)
15966                         (file-newer-than-file-p newsrc-file
15967                                                 (concat quick-file "d")))
15968                    (not gnus-newsrc-alist)))
15969           ;; We read the .newsrc file.  Note that if there if a
15970           ;; .newsrc.eld file exists, it has already been read, and
15971           ;; the `gnus-newsrc-hashtb' has been created.  While reading
15972           ;; the .newsrc file, Gnus will only use the information it
15973           ;; can find there for changing the data already read -
15974           ;; ie. reading the .newsrc file will not trash the data
15975           ;; already read (except for read articles).
15976           (save-excursion
15977             (gnus-message 5 "Reading %s..." newsrc-file)
15978             (set-buffer (find-file-noselect newsrc-file))
15979             (buffer-disable-undo (current-buffer))
15980             (gnus-newsrc-to-gnus-format)
15981             (kill-buffer (current-buffer))
15982             (gnus-message 5 "Reading %s...done" newsrc-file)))
15983
15984       ;; Read any slave files.
15985       (or gnus-slave
15986           (gnus-master-read-slave-newsrc)))))
15987
15988 (defun gnus-read-newsrc-el-file (file)
15989   (let ((ding-file (concat file "d")))
15990     ;; We always, always read the .eld file.
15991     (gnus-message 5 "Reading %s..." ding-file)
15992     (let (gnus-newsrc-assoc)
15993       (condition-case nil
15994           (load ding-file t t t)
15995         (error
15996          (gnus-message 1 "Error in %s" ding-file)
15997          (ding)))
15998       (when gnus-newsrc-assoc
15999         (setq gnus-newsrc-alist gnus-newsrc-assoc)))
16000     (gnus-make-hashtable-from-newsrc-alist)
16001     (when (file-newer-than-file-p file ding-file)
16002       ;; Old format quick file
16003       (gnus-message 5 "Reading %s..." file)
16004       ;; The .el file is newer than the .eld file, so we read that one
16005       ;; as well.
16006       (gnus-read-old-newsrc-el-file file))))
16007
16008 ;; Parse the old-style quick startup file
16009 (defun gnus-read-old-newsrc-el-file (file)
16010   (let (newsrc killed marked group m info)
16011     (prog1
16012         (let ((gnus-killed-assoc nil)
16013               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
16014           (prog1
16015               (condition-case nil
16016                   (load file t t t)
16017                 (error nil))
16018             (setq newsrc gnus-newsrc-assoc
16019                   killed gnus-killed-assoc
16020                   marked gnus-marked-assoc)))
16021       (setq gnus-newsrc-alist nil)
16022       (while (setq info (gnus-get-info (setq group (pop newsrc))))
16023         (if info
16024             (progn
16025               (gnus-info-set-read info (cddr group))
16026               (gnus-info-set-level
16027                info (if (nth 1 group) gnus-level-default-subscribed
16028                       gnus-level-default-unsubscribed))
16029               (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
16030           (push (setq info
16031                       (list (car group)
16032                             (if (nth 1 group) gnus-level-default-subscribed
16033                               gnus-level-default-unsubscribed)
16034                             (cddr group)))
16035                 gnus-newsrc-alist))
16036         ;; Copy marks into info.
16037         (when (setq m (assoc (car group) marked))
16038           (unless (nthcdr 3 info)
16039             (nconc info (list nil)))
16040           (gnus-info-set-marks
16041            info (list (cons 'tick (gnus-compress-sequence 
16042                                    (sort (cdr m) '<) t))))))
16043       (setq newsrc killed)
16044       (while newsrc
16045         (setcar newsrc (caar newsrc))
16046         (setq newsrc (cdr newsrc)))
16047       (setq gnus-killed-list killed))
16048     ;; The .el file version of this variable does not begin with
16049     ;; "options", while the .eld version does, so we just add it if it
16050     ;; isn't there.
16051     (and
16052      gnus-newsrc-options
16053      (progn
16054        (and (not (string-match "^ *options" gnus-newsrc-options))
16055             (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
16056        (and (not (string-match "\n$" gnus-newsrc-options))
16057             (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
16058        ;; Finally, if we read some options lines, we parse them.
16059        (or (string= gnus-newsrc-options "")
16060            (gnus-newsrc-parse-options gnus-newsrc-options))))
16061
16062     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
16063     (gnus-make-hashtable-from-newsrc-alist)))
16064
16065 (defun gnus-make-newsrc-file (file)
16066   "Make server dependent file name by catenating FILE and server host name."
16067   (let* ((file (expand-file-name file nil))
16068          (real-file (concat file "-" (nth 1 gnus-select-method))))
16069     (if (or (file-exists-p real-file)
16070             (file-exists-p (concat real-file ".el"))
16071             (file-exists-p (concat real-file ".eld")))
16072         real-file file)))
16073
16074 (defun gnus-newsrc-to-gnus-format ()
16075   (setq gnus-newsrc-options "")
16076   (setq gnus-newsrc-options-n nil)
16077
16078   (or gnus-active-hashtb
16079       (setq gnus-active-hashtb (make-vector 4095 0)))
16080   (let ((buf (current-buffer))
16081         (already-read (> (length gnus-newsrc-alist) 1))
16082         group subscribed options-symbol newsrc Options-symbol
16083         symbol reads num1)
16084     (goto-char (point-min))
16085     ;; We intern the symbol `options' in the active hashtb so that we
16086     ;; can `eq' against it later.
16087     (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
16088     (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
16089
16090     (while (not (eobp))
16091       ;; We first read the first word on the line by narrowing and
16092       ;; then reading into `gnus-active-hashtb'.  Most groups will
16093       ;; already exist in that hashtb, so this will save some string
16094       ;; space.
16095       (narrow-to-region
16096        (point)
16097        (progn (skip-chars-forward "^ \t!:\n") (point)))
16098       (goto-char (point-min))
16099       (setq symbol
16100             (and (/= (point-min) (point-max))
16101                  (let ((obarray gnus-active-hashtb)) (read buf))))
16102       (widen)
16103       ;; Now, the symbol we have read is either `options' or a group
16104       ;; name.  If it is an options line, we just add it to a string.
16105       (cond
16106        ((or (eq symbol options-symbol)
16107             (eq symbol Options-symbol))
16108         (setq gnus-newsrc-options
16109               ;; This concating is quite inefficient, but since our
16110               ;; thorough studies show that approx 99.37% of all
16111               ;; .newsrc files only contain a single options line, we
16112               ;; don't give a damn, frankly, my dear.
16113               (concat gnus-newsrc-options
16114                       (buffer-substring
16115                        (gnus-point-at-bol)
16116                        ;; Options may continue on the next line.
16117                        (or (and (re-search-forward "^[^ \t]" nil 'move)
16118                                 (progn (beginning-of-line) (point)))
16119                            (point)))))
16120         (forward-line -1))
16121        (symbol
16122         ;; Group names can be just numbers.  
16123         (when (numberp symbol) 
16124           (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
16125         (or (boundp symbol) (set symbol nil))
16126         ;; It was a group name.
16127         (setq subscribed (= (following-char) ?:)
16128               group (symbol-name symbol)
16129               reads nil)
16130         (if (eolp)
16131             ;; If the line ends here, this is clearly a buggy line, so
16132             ;; we put point a the beginning of line and let the cond
16133             ;; below do the error handling.
16134             (beginning-of-line)
16135           ;; We skip to the beginning of the ranges.
16136           (skip-chars-forward "!: \t"))
16137         ;; We are now at the beginning of the list of read articles.
16138         ;; We read them range by range.
16139         (while
16140             (cond
16141              ((looking-at "[0-9]+")
16142               ;; We narrow and read a number instead of buffer-substring/
16143               ;; string-to-int because it's faster.  narrow/widen is
16144               ;; faster than save-restriction/narrow, and save-restriction
16145               ;; produces a garbage object.
16146               (setq num1 (progn
16147                            (narrow-to-region (match-beginning 0) (match-end 0))
16148                            (read buf)))
16149               (widen)
16150               ;; If the next character is a dash, then this is a range.
16151               (if (= (following-char) ?-)
16152                   (progn
16153                     ;; We read the upper bound of the range.
16154                     (forward-char 1)
16155                     (if (not (looking-at "[0-9]+"))
16156                         ;; This is a buggy line, by we pretend that
16157                         ;; it's kinda OK.  Perhaps the user should be
16158                         ;; dinged?
16159                         (setq reads (cons num1 reads))
16160                       (setq reads
16161                             (cons
16162                              (cons num1
16163                                    (progn
16164                                      (narrow-to-region (match-beginning 0)
16165                                                        (match-end 0))
16166                                      (read buf)))
16167                              reads))
16168                       (widen)))
16169                 ;; It was just a simple number, so we add it to the
16170                 ;; list of ranges.
16171                 (setq reads (cons num1 reads)))
16172               ;; If the next char in ?\n, then we have reached the end
16173               ;; of the line and return nil.
16174               (/= (following-char) ?\n))
16175              ((= (following-char) ?\n)
16176               ;; End of line, so we end.
16177               nil)
16178              (t
16179               ;; Not numbers and not eol, so this might be a buggy
16180               ;; line...
16181               (or (eobp)
16182                   ;; If it was eob instead of ?\n, we allow it.
16183                   (progn
16184                     ;; The line was buggy.
16185                     (setq group nil)
16186                     (gnus-message 3 "Mangled line: %s"
16187                                   (buffer-substring (gnus-point-at-bol)
16188                                                     (gnus-point-at-eol)))
16189                     (ding)
16190                     (sit-for 1)))
16191               nil))
16192           ;; Skip past ", ".  Spaces are illegal in these ranges, but
16193           ;; we allow them, because it's a common mistake to put a
16194           ;; space after the comma.
16195           (skip-chars-forward ", "))
16196
16197         ;; We have already read .newsrc.eld, so we gently update the
16198         ;; data in the hash table with the information we have just
16199         ;; read.
16200         (when group
16201           (let ((info (gnus-get-info group))
16202                 level)
16203             (if info
16204                 ;; There is an entry for this file in the alist.
16205                 (progn
16206                   (gnus-info-set-read info (nreverse reads))
16207                   ;; We update the level very gently.  In fact, we
16208                   ;; only change it if there's been a status change
16209                   ;; from subscribed to unsubscribed, or vice versa.
16210                   (setq level (gnus-info-level info))
16211                   (cond ((and (<= level gnus-level-subscribed)
16212                               (not subscribed))
16213                          (setq level (if reads
16214                                          gnus-level-default-unsubscribed
16215                                        (1+ gnus-level-default-unsubscribed))))
16216                         ((and (> level gnus-level-subscribed) subscribed)
16217                          (setq level gnus-level-default-subscribed)))
16218                   (gnus-info-set-level info level))
16219               ;; This is a new group.
16220               (setq info (list group
16221                                (if subscribed
16222                                    gnus-level-default-subscribed
16223                                  (if reads
16224                                      (1+ gnus-level-subscribed)
16225                                    gnus-level-default-unsubscribed))
16226                                (nreverse reads))))
16227             (setq newsrc (cons info newsrc))))))
16228       (forward-line 1))
16229
16230     (setq newsrc (nreverse newsrc))
16231
16232     (if (not already-read)
16233         ()
16234       ;; We now have two newsrc lists - `newsrc', which is what we
16235       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
16236       ;; what we've read from .newsrc.eld.  We have to merge these
16237       ;; lists.  We do this by "attaching" any (foreign) groups in the
16238       ;; gnus-newsrc-alist to the (native) group that precedes them.
16239       (let ((rc (cdr gnus-newsrc-alist))
16240             (prev gnus-newsrc-alist)
16241             entry mentry)
16242         (while rc
16243           (or (null (nth 4 (car rc)))   ; It's a native group.
16244               (assoc (caar rc) newsrc) ; It's already in the alist.
16245               (if (setq entry (assoc (caar prev) newsrc))
16246                   (setcdr (setq mentry (memq entry newsrc))
16247                           (cons (car rc) (cdr mentry)))
16248                 (setq newsrc (cons (car rc) newsrc))))
16249           (setq prev rc
16250                 rc (cdr rc)))))
16251
16252     (setq gnus-newsrc-alist newsrc)
16253     ;; We make the newsrc hashtb.
16254     (gnus-make-hashtable-from-newsrc-alist)
16255
16256     ;; Finally, if we read some options lines, we parse them.
16257     (or (string= gnus-newsrc-options "")
16258         (gnus-newsrc-parse-options gnus-newsrc-options))))
16259
16260 ;; Parse options lines to find "options -n !all rec.all" and stuff.
16261 ;; The return value will be a list on the form
16262 ;; ((regexp1 . ignore)
16263 ;;  (regexp2 . subscribe)...)
16264 ;; When handling new newsgroups, groups that match a `ignore' regexp
16265 ;; will be ignored, and groups that match a `subscribe' regexp will be
16266 ;; subscribed.  A line like
16267 ;; options -n !all rec.all
16268 ;; will lead to a list that looks like
16269 ;; (("^rec\\..+" . subscribe)
16270 ;;  ("^.+" . ignore))
16271 ;; So all "rec.*" groups will be subscribed, while all the other
16272 ;; groups will be ignored.  Note that "options -n !all rec.all" is very
16273 ;; different from "options -n rec.all !all".
16274 (defun gnus-newsrc-parse-options (options)
16275   (let (out eol)
16276     (save-excursion
16277       (gnus-set-work-buffer)
16278       (insert (regexp-quote options))
16279       ;; First we treat all continuation lines.
16280       (goto-char (point-min))
16281       (while (re-search-forward "\n[ \t]+" nil t)
16282         (replace-match " " t t))
16283       ;; Then we transform all "all"s into ".+"s.
16284       (goto-char (point-min))
16285       (while (re-search-forward "\\ball\\b" nil t)
16286         (replace-match ".+" t t))
16287       (goto-char (point-min))
16288       ;; We remove all other options than the "-n" ones.
16289       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
16290         (replace-match " ")
16291         (forward-char -1))
16292       (goto-char (point-min))
16293
16294       ;; We are only interested in "options -n" lines - we
16295       ;; ignore the other option lines.
16296       (while (re-search-forward "[ \t]-n" nil t)
16297         (setq eol
16298               (or (save-excursion
16299                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
16300                          (- (point) 2)))
16301                   (gnus-point-at-eol)))
16302         ;; Search for all "words"...
16303         (while (re-search-forward "[^ \t,\n]+" eol t)
16304           (if (= (char-after (match-beginning 0)) ?!)
16305               ;; If the word begins with a bang (!), this is a "not"
16306               ;; spec.  We put this spec (minus the bang) and the
16307               ;; symbol `ignore' into the list.
16308               (setq out (cons (cons (concat
16309                                      "^" (buffer-substring
16310                                           (1+ (match-beginning 0))
16311                                           (match-end 0)))
16312                                     'ignore) out))
16313             ;; There was no bang, so this is a "yes" spec.
16314             (setq out (cons (cons (concat "^" (match-string 0))
16315                                   'subscribe) out)))))
16316
16317       (setq gnus-newsrc-options-n out))))
16318
16319 (defun gnus-save-newsrc-file (&optional force)
16320   "Save .newsrc file."
16321   ;; Note: We cannot save .newsrc file if all newsgroups are removed
16322   ;; from the variable gnus-newsrc-alist.
16323   (when (and (or gnus-newsrc-alist gnus-killed-list)
16324              gnus-current-startup-file)
16325     (save-excursion
16326       (if (and (or gnus-use-dribble-file gnus-slave)
16327                (not force)
16328                (or (not gnus-dribble-buffer)
16329                    (not (buffer-name gnus-dribble-buffer))
16330                    (zerop (save-excursion
16331                             (set-buffer gnus-dribble-buffer)
16332                             (buffer-size)))))
16333           (gnus-message 4 "(No changes need to be saved)")
16334         (run-hooks 'gnus-save-newsrc-hook)
16335         (if gnus-slave
16336             (gnus-slave-save-newsrc)
16337           ;; Save .newsrc.
16338           (when gnus-save-newsrc-file
16339             (gnus-message 5 "Saving %s..." gnus-current-startup-file)
16340             (gnus-gnus-to-newsrc-format)
16341             (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
16342           ;; Save .newsrc.eld.
16343           (set-buffer (get-buffer-create " *Gnus-newsrc*"))
16344           (make-local-variable 'version-control)
16345           (setq version-control 'never)
16346           (setq buffer-file-name
16347                 (concat gnus-current-startup-file ".eld"))
16348           (gnus-add-current-to-buffer-list)
16349           (buffer-disable-undo (current-buffer))
16350           (erase-buffer)
16351           (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
16352           (gnus-gnus-to-quick-newsrc-format)
16353           (run-hooks 'gnus-save-quick-newsrc-hook)
16354           (save-buffer)
16355           (kill-buffer (current-buffer))
16356           (gnus-message
16357            5 "Saving %s.eld...done" gnus-current-startup-file))
16358         (gnus-dribble-delete-file)))))
16359
16360 (defun gnus-gnus-to-quick-newsrc-format ()
16361   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
16362   (insert ";; Gnus startup file.\n")
16363   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
16364   (insert ";; to read .newsrc.\n")
16365   (insert "(setq gnus-newsrc-file-version "
16366           (prin1-to-string gnus-version) ")\n")
16367   (let ((variables
16368          (if gnus-save-killed-list gnus-variable-list
16369            ;; Remove the `gnus-killed-list' from the list of variables
16370            ;; to be saved, if required.
16371            (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
16372         ;; Peel off the "dummy" group.
16373         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
16374         variable)
16375     ;; Insert the variables into the file.
16376     (while variables
16377       (when (and (boundp (setq variable (pop variables)))
16378                  (symbol-value variable))
16379         (insert "(setq " (symbol-name variable) " '")
16380         (prin1 (symbol-value variable) (current-buffer))
16381         (insert ")\n")))))
16382
16383 (defun gnus-gnus-to-newsrc-format ()
16384   ;; Generate and save the .newsrc file.
16385   (save-excursion
16386     (set-buffer (create-file-buffer gnus-current-startup-file))
16387     (let ((newsrc (cdr gnus-newsrc-alist))
16388           (standard-output (current-buffer))
16389           info ranges range method)
16390       (setq buffer-file-name gnus-current-startup-file)
16391       (buffer-disable-undo (current-buffer))
16392       (erase-buffer)
16393       ;; Write options.
16394       (if gnus-newsrc-options (insert gnus-newsrc-options))
16395       ;; Write subscribed and unsubscribed.
16396       (while (setq info (pop newsrc))
16397         ;; Don't write foreign groups to .newsrc.
16398         (when (or (null (setq method (gnus-info-method info)))
16399                   (equal method "native")
16400                   (gnus-server-equal method gnus-select-method))
16401           (insert (gnus-info-group info)
16402                   (if (> (gnus-info-level info) gnus-level-subscribed)
16403                       "!" ":"))
16404           (when (setq ranges (gnus-info-read info))
16405             (insert " ")
16406             (if (not (listp (cdr ranges)))
16407                 (if (= (car ranges) (cdr ranges))
16408                     (princ (car ranges))
16409                   (princ (car ranges))
16410                   (insert "-")
16411                   (princ (cdr ranges)))
16412               (while (setq range (pop ranges))
16413                 (if (or (atom range) (= (car range) (cdr range)))
16414                     (princ (or (and (atom range) range) (car range)))
16415                   (princ (car range))
16416                   (insert "-")
16417                   (princ (cdr range)))
16418                 (if ranges (insert ",")))))
16419           (insert "\n")))
16420       (make-local-variable 'version-control)
16421       (setq version-control 'never)
16422       ;; It has been reported that sometime the modtime on the .newsrc
16423       ;; file seems to be off.  We really do want to overwrite it, so
16424       ;; we clear the modtime here before saving.  It's a bit odd,
16425       ;; though...
16426       ;; sometimes the modtime clear isn't sufficient.  most brute force:
16427       ;; delete the silly thing entirely first.  but this fails to provide
16428       ;; such niceties as .newsrc~ creation.
16429       (if gnus-modtime-botch
16430           (delete-file gnus-startup-file)
16431         (clear-visited-file-modtime))
16432       (run-hooks 'gnus-save-standard-newsrc-hook)
16433       (save-buffer)
16434       (kill-buffer (current-buffer)))))
16435
16436 \f
16437 ;;;
16438 ;;; Slave functions.
16439 ;;;
16440
16441 (defun gnus-slave-save-newsrc ()
16442   (save-excursion
16443     (set-buffer gnus-dribble-buffer)
16444     (let ((slave-name
16445            (make-temp-name (concat gnus-current-startup-file "-slave-"))))
16446       (write-region (point-min) (point-max) slave-name nil 'nomesg))))
16447
16448 (defun gnus-master-read-slave-newsrc ()
16449   (let ((slave-files
16450          (directory-files
16451           (file-name-directory gnus-current-startup-file)
16452           t (concat
16453              "^" (regexp-quote
16454                   (concat
16455                    (file-name-nondirectory gnus-current-startup-file)
16456                    "-slave-")))
16457           t))
16458         file)
16459     (if (not slave-files)
16460         ()                              ; There are no slave files to read.
16461       (gnus-message 7 "Reading slave newsrcs...")
16462       (save-excursion
16463         (set-buffer (get-buffer-create " *gnus slave*"))
16464         (buffer-disable-undo (current-buffer))
16465         (setq slave-files
16466               (sort (mapcar (lambda (file)
16467                               (list (nth 5 (file-attributes file)) file))
16468                             slave-files)
16469                     (lambda (f1 f2)
16470                       (or (< (caar f1) (caar f2))
16471                           (< (nth 1 (car f1)) (nth 1 (car f2)))))))
16472         (while slave-files
16473           (erase-buffer)
16474           (setq file (nth 1 (car slave-files)))
16475           (insert-file-contents file)
16476           (if (condition-case ()
16477                   (progn
16478                     (eval-buffer (current-buffer))
16479                     t)
16480                 (error
16481                  (gnus-message 3 "Possible error in %s" file)
16482                  (ding)
16483                  (sit-for 2)
16484                  nil))
16485               (or gnus-slave ; Slaves shouldn't delete these files.
16486                   (condition-case ()
16487                       (delete-file file)
16488                     (error nil))))
16489           (setq slave-files (cdr slave-files))))
16490       (gnus-message 7 "Reading slave newsrcs...done"))))
16491
16492 \f
16493 ;;;
16494 ;;; Group description.
16495 ;;;
16496
16497 (defun gnus-read-all-descriptions-files ()
16498   (let ((methods (cons gnus-select-method 
16499                        (nconc
16500                         (when gnus-message-archive-method
16501                           (list "archive"))
16502                         gnus-secondary-select-methods))))
16503     (while methods
16504       (gnus-read-descriptions-file (car methods))
16505       (setq methods (cdr methods)))
16506     t))
16507
16508 (defun gnus-read-descriptions-file (&optional method)
16509   (let ((method (or method gnus-select-method)))
16510     (when (stringp method)
16511       (setq method (gnus-server-to-method method)))
16512     ;; We create the hashtable whether we manage to read the desc file
16513     ;; to avoid trying to re-read after a failed read.
16514     (or gnus-description-hashtb
16515         (setq gnus-description-hashtb
16516               (gnus-make-hashtable (length gnus-active-hashtb))))
16517     ;; Mark this method's desc file as read.
16518     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
16519                   gnus-description-hashtb)
16520
16521     (gnus-message 5 "Reading descriptions file via %s..." (car method))
16522     (cond
16523      ((not (gnus-check-server method))
16524       (gnus-message 1 "Couldn't open server")
16525       nil)
16526      ((not (gnus-request-list-newsgroups method))
16527       (gnus-message 1 "Couldn't read newsgroups descriptions")
16528       nil)
16529      (t
16530       (let (group)
16531         (save-excursion
16532           (save-restriction
16533             (set-buffer nntp-server-buffer)
16534             (goto-char (point-min))
16535             (if (or (search-forward "\n.\n" nil t)
16536                     (goto-char (point-max)))
16537                 (progn
16538                   (beginning-of-line)
16539                   (narrow-to-region (point-min) (point))))
16540             (goto-char (point-min))
16541             (while (not (eobp))
16542               ;; If we get an error, we set group to 0, which is not a
16543               ;; symbol...
16544               (setq group
16545                     (condition-case ()
16546                         (let ((obarray gnus-description-hashtb))
16547                           ;; Group is set to a symbol interned in this
16548                           ;; hash table.
16549                           (read nntp-server-buffer))
16550                       (error 0)))
16551               (skip-chars-forward " \t")
16552               ;; ...  which leads to this line being effectively ignored.
16553               (and (symbolp group)
16554                    (set group (buffer-substring
16555                                (point) (progn (end-of-line) (point)))))
16556               (forward-line 1))))
16557         (gnus-message 5 "Reading descriptions file...done")
16558         t)))))
16559
16560 (defun gnus-group-get-description (group)
16561   "Get the description of a group by sending XGTITLE to the server."
16562   (when (gnus-request-group-description group)
16563     (save-excursion
16564       (set-buffer nntp-server-buffer)
16565       (goto-char (point-min))
16566       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
16567         (match-string 1)))))
16568
16569 \f
16570 ;;;
16571 ;;; Buffering of read articles.
16572 ;;;
16573
16574 (defvar gnus-backlog-buffer " *Gnus Backlog*")
16575 (defvar gnus-backlog-articles nil)
16576 (defvar gnus-backlog-hashtb nil)
16577
16578 (defun gnus-backlog-buffer ()
16579   "Return the backlog buffer."
16580   (or (get-buffer gnus-backlog-buffer)
16581       (save-excursion
16582         (set-buffer (get-buffer-create gnus-backlog-buffer))
16583         (buffer-disable-undo (current-buffer))
16584         (setq buffer-read-only t)
16585         (gnus-add-current-to-buffer-list)
16586         (get-buffer gnus-backlog-buffer))))
16587
16588 (defun gnus-backlog-setup ()
16589   "Initialize backlog variables."
16590   (unless gnus-backlog-hashtb
16591     (setq gnus-backlog-hashtb (make-vector 1023 0))))
16592
16593 (gnus-add-shutdown 'gnus-backlog-shutdown 'gnus)
16594
16595 (defun gnus-backlog-shutdown ()
16596   "Clear all backlog variables and buffers."
16597   (when (get-buffer gnus-backlog-buffer)
16598     (kill-buffer gnus-backlog-buffer))
16599   (setq gnus-backlog-hashtb nil
16600         gnus-backlog-articles nil))
16601
16602 (defun gnus-backlog-enter-article (group number buffer)
16603   (gnus-backlog-setup)
16604   (let ((ident (intern (concat group ":" (int-to-string number))
16605                        gnus-backlog-hashtb))
16606         b)
16607     (if (memq ident gnus-backlog-articles)
16608         () ; It's already kept.
16609       ;; Remove the oldest article, if necessary.
16610       (and (numberp gnus-keep-backlog)
16611            (>= (length gnus-backlog-articles) gnus-keep-backlog)
16612            (gnus-backlog-remove-oldest-article))
16613       (setq gnus-backlog-articles (cons ident gnus-backlog-articles))
16614       ;; Insert the new article.
16615       (save-excursion
16616         (set-buffer (gnus-backlog-buffer))
16617         (let (buffer-read-only)
16618           (goto-char (point-max))
16619           (or (bolp) (insert "\n"))
16620           (setq b (point))
16621           (insert-buffer-substring buffer)
16622           ;; Tag the beginning of the article with the ident.
16623           (put-text-property b (1+ b) 'gnus-backlog ident))))))
16624
16625 (defun gnus-backlog-remove-oldest-article ()
16626   (save-excursion
16627     (set-buffer (gnus-backlog-buffer))
16628     (goto-char (point-min))
16629     (if (zerop (buffer-size))
16630         () ; The buffer is empty.
16631       (let ((ident (get-text-property (point) 'gnus-backlog))
16632             buffer-read-only)
16633         ;; Remove the ident from the list of articles.
16634         (when ident
16635           (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
16636         ;; Delete the article itself.
16637         (delete-region
16638          (point) (next-single-property-change
16639                   (1+ (point)) 'gnus-backlog nil (point-max)))))))
16640
16641 (defun gnus-backlog-request-article (group number buffer)
16642   (when (numberp number)
16643     (gnus-backlog-setup)
16644     (let ((ident (intern (concat group ":" (int-to-string number))
16645                          gnus-backlog-hashtb))
16646           beg end)
16647       (when (memq ident gnus-backlog-articles)
16648         ;; It was in the backlog.
16649         (save-excursion
16650           (set-buffer (gnus-backlog-buffer))
16651           (if (not (setq beg (text-property-any
16652                               (point-min) (point-max) 'gnus-backlog
16653                               ident)))
16654               ;; It wasn't in the backlog after all.
16655               (ignore
16656                (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
16657             ;; Find the end (i. e., the beginning of the next article).
16658             (setq end
16659                   (next-single-property-change
16660                    (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
16661         (let ((buffer-read-only nil))
16662           (erase-buffer)
16663           (insert-buffer-substring gnus-backlog-buffer beg end)
16664           t)))))
16665
16666 ;; Allow redefinition of Gnus functions.
16667
16668 (gnus-ems-redefine)
16669
16670 (provide 'gnus)
16671
16672 ;;; gnus.el ends here