*** 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
35 (eval-when-compile (require 'cl))
36
37 ;; Site dependent variables.  These variables should be defined in
38 ;; paths.el.
39
40 (defvar gnus-default-nntp-server nil
41   "Specify a default NNTP server.
42 This variable should be defined in paths.el, and should never be set
43 by the user.
44 If you want to change servers, you should use `gnus-select-method'.
45 See the documentation to that variable.")
46
47 (defvar gnus-backup-default-subscribed-newsgroups
48   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
49   "Default default new newsgroups the first time Gnus is run.
50 Should be set in paths.el, and shouldn't be touched by the user.")
51
52 (defvar gnus-local-domain nil
53   "Local domain name without a host name.
54 The DOMAINNAME environment variable is used instead if it is defined.
55 If the `system-name' function returns the full Internet name, there is
56 no need to set this variable.")
57
58 (defvar gnus-local-organization nil
59   "String with a description of what organization (if any) the user belongs to.
60 The ORGANIZATION environment variable is used instead if it is defined.
61 If this variable contains a function, this function will be called
62 with the current newsgroup name as the argument.  The function should
63 return a string.
64
65 In any case, if the string (either in the variable, in the environment
66 variable, or returned by the function) is a file name, the contents of
67 this file will be used as the organization.")
68
69 ;; Customization variables
70
71 ;; Don't touch this variable.
72 (defvar gnus-nntp-service "nntp"
73   "*NNTP service name (\"nntp\" or 119).
74 This is an obsolete variable, which is scarcely used.  If you use an
75 nntp server for your newsgroup and want to change the port number
76 used to 899, you would say something along these lines:
77
78  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
79
80 (defvar gnus-nntpserver-file "/etc/nntpserver"
81   "*A file with only the name of the nntp server in it.")
82
83 ;; This function is used to check both the environment variable
84 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
85 ;; an nntp server name default.
86 (defun gnus-getenv-nntpserver ()
87   (or (getenv "NNTPSERVER")
88       (and (file-readable-p gnus-nntpserver-file)
89            (save-excursion
90              (set-buffer (get-buffer-create " *gnus nntp*"))
91              (buffer-disable-undo (current-buffer))
92              (insert-file-contents gnus-nntpserver-file)
93              (let ((name (buffer-string)))
94                (prog1
95                    (if (string-match "^[ \t\n]*$" name)
96                        nil
97                      name)
98                  (kill-buffer (current-buffer))))))))
99
100 (defvar gnus-select-method
101   (nconc
102    (list 'nntp (or (condition-case ()
103                        (gnus-getenv-nntpserver)
104                      (error nil))
105                    (if (and gnus-default-nntp-server
106                             (not (string= gnus-default-nntp-server "")))
107                        gnus-default-nntp-server)
108                    (system-name)))
109    (if (or (null gnus-nntp-service)
110            (equal gnus-nntp-service "nntp"))
111        nil
112      (list gnus-nntp-service)))
113   "*Default method for selecting a newsgroup.
114 This variable should be a list, where the first element is how the
115 news is to be fetched, the second is the address.
116
117 For instance, if you want to get your news via NNTP from
118 \"flab.flab.edu\", you could say:
119
120 (setq gnus-select-method '(nntp \"flab.flab.edu\"))
121
122 If you want to use your local spool, say:
123
124 (setq gnus-select-method (list 'nnspool (system-name)))
125
126 If you use this variable, you must set `gnus-nntp-server' to nil.
127
128 There is a lot more to know about select methods and virtual servers -
129 see the manual for details.")
130
131 (defvar gnus-message-archive-method 
132   '(nnfolder "archive" (nnfolder-directory "~/Mail/archive/")
133              (nnfolder-active-file "~/Mail/archive/active")
134              (nnfolder-get-new-mail nil)
135              (nnfolder-inhibit-expiry t))
136   "*Method used for archiving messages you've sent.
137 This should be a mail method.")
138
139 (defvar gnus-refer-article-method nil
140   "*Preferred method for fetching an article by Message-ID.
141 If you are reading news from the local spool (with nnspool), fetching
142 articles by Message-ID is painfully slow.  By setting this method to an
143 nntp method, you might get acceptable results.
144
145 The value of this variable must be a valid select method as discussed
146 in the documentation of `gnus-select-method'.")
147
148 (defvar gnus-secondary-select-methods nil
149   "*A list of secondary methods that will be used for reading news.
150 This is a list where each element is a complete select method (see
151 `gnus-select-method').
152
153 If, for instance, you want to read your mail with the nnml backend,
154 you could set this variable:
155
156 (setq gnus-secondary-select-methods '((nnml \"\")))")
157
158 (defvar gnus-secondary-servers nil
159   "*List of NNTP servers that the user can choose between interactively.
160 To make Gnus query you for a server, you have to give `gnus' a
161 non-numeric prefix - `C-u M-x gnus', in short.")
162
163 (defvar gnus-nntp-server nil
164   "*The name of the host running the NNTP server.
165 This variable is semi-obsolete.  Use the `gnus-select-method'
166 variable instead.")
167
168 (defvar gnus-startup-file "~/.newsrc"
169   "*Your `.newsrc' file.
170 `.newsrc-SERVER' will be used instead if that exists.")
171
172 (defvar gnus-init-file "~/.gnus"
173   "*Your Gnus elisp startup file.
174 If a file with the .el or .elc suffixes exist, it will be read
175 instead.")
176
177 (defvar gnus-group-faq-directory
178   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
179     "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
180     "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
181     "/ftp@rtfm.mit.edu:/pub/usenet/news.answers/"
182     "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
183     "/ftp@ftp.sunet.se:/pub/usenet/"
184     "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
185     "/ftp@hwarang.postech.ac.kr:/pub/usenet/news.answers/"
186     "/ftp@ftp.hk.super.net:/mirror/faqs/")
187   "*Directory where the group FAQs are stored.
188 This will most commonly be on a remote machine, and the file will be
189 fetched by ange-ftp.
190
191 This variable can also be a list of directories.  In that case, the
192 first element in the list will be used by default, and the others will
193 be used as backup sites.
194
195 Note that Gnus uses an aol machine as the default directory.  If this
196 feels fundamentally unclean, just think of it as a way to finally get
197 something of value back from them.
198
199 If the default site is too slow, try one of these:
200
201    North America: mirrors.aol.com                /pub/rtfm/usenet
202                   ftp.seas.gwu.edu               /pub/rtfm
203                   rtfm.mit.edu                   /pub/usenet/news.answers
204    Europe:        ftp.uni-paderborn.de           /pub/FAQ
205                   src.doc.ic.ac.uk               /usenet/news-FAQS
206                   ftp.sunet.se                   /pub/usenet
207    Asia:          nctuccca.edu.tw                /USENET/FAQ
208                   hwarang.postech.ac.kr          /pub/usenet/news.answers
209                   ftp.hk.super.net               /mirror/faqs")
210
211 (defvar gnus-group-archive-directory
212   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
213   "*The address of the (ding) archives.")
214
215 (defvar gnus-group-recent-archive-directory
216   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
217   "*The address of the most recent (ding) articles.")
218
219 (defvar gnus-default-subscribed-newsgroups nil
220   "*This variable lists what newsgroups should be subscribed the first time Gnus is used.
221 It should be a list of strings.
222 If it is `t', Gnus will not do anything special the first time it is
223 started; it'll just use the normal newsgroups subscription methods.")
224
225 (defvar gnus-use-cross-reference t
226   "*Non-nil means that cross referenced articles will be marked as read.
227 If nil, ignore cross references.  If t, mark articles as read in
228 subscribed newsgroups.  If neither t nor nil, mark as read in all
229 newsgroups.")
230
231 (defvar gnus-single-article-buffer t
232   "*If non-nil, display all articles in the same buffer.
233 If nil, each group will get its own article buffer.")
234
235 (defvar gnus-use-dribble-file t
236   "*Non-nil means that Gnus will use a dribble file to store user updates.
237 If Emacs should crash without saving the .newsrc files, complete
238 information can be restored from the dribble file.")
239
240 (defvar gnus-dribble-directory nil
241   "*The directory where dribble files will be saved.
242 If this variable is nil, the directory where the .newsrc files are
243 saved will be used.")
244
245 (defvar gnus-asynchronous nil
246   "*If non-nil, Gnus will supply backends with data needed for async article fetching.")
247
248 (defvar gnus-kill-summary-on-exit t
249   "*If non-nil, kill the summary buffer when you exit from it.
250 If nil, the summary will become a \"*Dead Summary*\" buffer, and
251 it will be killed sometime later.")
252
253 (defvar gnus-large-newsgroup 200
254   "*The number of articles which indicates a large newsgroup.
255 If the number of articles in a newsgroup is greater than this value,
256 confirmation is required for selecting the newsgroup.")
257
258 ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
259 (defvar gnus-no-groups-message "No news is horrible news"
260   "*Message displayed by Gnus when no groups are available.")
261
262 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
263   "*Non-nil means that the default name of a file to save articles in is the group name.
264 If it's nil, the directory form of the group name is used instead.
265
266 If this variable is a list, and the list contains the element
267 `not-score', long file names will not be used for score files; if it
268 contains the element `not-save', long file names will not be used for
269 saving; and if it contains the element `not-kill', long file names
270 will not be used for kill files.")
271
272 (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
273   "*Name of the directory articles will be saved in (default \"~/News\").
274 Initialized from the SAVEDIR environment variable.")
275
276 (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
277   "*Name of the directory where kill files will be stored (default \"~/News\").
278 Initialized from the SAVEDIR environment variable.")
279
280 (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
281   "*A function to save articles in your favorite format.
282 The function must be interactively callable (in other words, it must
283 be an Emacs command).
284
285 Gnus provides the following functions:
286
287 * gnus-summary-save-in-rmail (Rmail format)
288 * gnus-summary-save-in-mail (Unix mail format)
289 * gnus-summary-save-in-folder (MH folder)
290 * gnus-summary-save-in-file (article format).
291 * gnus-summary-save-in-vm (use VM's folder format).")
292
293 (defvar gnus-prompt-before-saving 'always
294   "*This variable says how much prompting is to be done when saving articles.
295 If it is nil, no prompting will be done, and the articles will be
296 saved to the default files.  If this variable is `always', each and
297 every article that is saved will be preceded by a prompt, even when
298 saving large batches of articles.  If this variable is neither nil not
299 `always', there the user will be prompted once for a file name for
300 each invocation of the saving commands.")
301
302 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
303   "*A function generating a file name to save articles in Rmail format.
304 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
305
306 (defvar gnus-mail-save-name (function gnus-plain-save-name)
307   "*A function generating a file name to save articles in Unix mail format.
308 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
309
310 (defvar gnus-folder-save-name (function gnus-folder-save-name)
311   "*A function generating a file name to save articles in MH folder.
312 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
313
314 (defvar gnus-file-save-name (function gnus-numeric-save-name)
315   "*A function generating a file name to save articles in article format.
316 The function is called with NEWSGROUP, HEADERS, and optional
317 LAST-FILE.")
318
319 (defvar gnus-split-methods
320   '((gnus-article-archive-name))
321   "*Variable used to suggest where articles are to be saved.
322 For instance, if you would like to save articles related to Gnus in
323 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
324 you could set this variable to something like:
325
326  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
327    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
328
329 This variable is an alist where the where the key is the match and the
330 value is a list of possible files to save in if the match is non-nil.
331
332 If the match is a string, it is used as a regexp match on the
333 article.  If the match is a symbol, that symbol will be funcalled
334 from the buffer of the article to be saved with the newsgroup as the
335 parameter.  If it is a list, it will be evaled in the same buffer.
336
337 If this form or function returns a string, this string will be used as
338 a possible file name; and if it returns a non-nil list, that list will
339 be used as possible file names.")
340
341 (defvar gnus-move-split-methods nil
342   "*Variable used to suggest where articles are to be moved to.
343 It uses the same syntax as the `gnus-split-methods' variable.")
344
345 (defvar gnus-save-score nil
346   "*If non-nil, save group scoring info.")
347
348 (defvar gnus-use-adaptive-scoring nil
349   "*If non-nil, use some adaptive scoring scheme.")
350
351 (defvar gnus-use-cache nil
352   "*If nil, Gnus will ignore the article cache.
353 If `passive', it will allow entering (and reading) articles
354 explicitly entered into the cache.  If anything else, use the
355 cache to the full extent of the law.")
356
357 (defvar gnus-use-trees nil
358   "*If non-nil, display a thread tree buffer.")
359
360 (defvar gnus-use-grouplens nil
361   "*If non-nil, use GroupLens ratings.")
362
363 (defvar gnus-keep-backlog nil
364   "*If non-nil, Gnus will keep read articles for later re-retrieval.
365 If it is a number N, then Gnus will only keep the last N articles
366 read.  If it is neither nil nor a number, Gnus will keep all read
367 articles.  This is not a good idea.")
368
369 (defvar gnus-use-nocem nil
370   "*If non-nil, Gnus will read NoCeM cancel messages.")
371
372 (defvar gnus-use-demon nil
373   "If non-nil, Gnus might use some demons.")
374
375 (defvar gnus-use-scoring t
376   "*If non-nil, enable scoring.")
377
378 (defvar gnus-use-picons nil
379   "*If non-nil, display picons.")
380
381 (defvar gnus-fetch-old-headers nil
382   "*Non-nil means that Gnus will try to build threads by grabbing old headers.
383 If an unread article in the group refers to an older, already read (or
384 just marked as read) article, the old article will not normally be
385 displayed in the Summary buffer.  If this variable is non-nil, Gnus
386 will attempt to grab the headers to the old articles, and thereby
387 build complete threads.  If it has the value `some', only enough
388 headers to connect otherwise loose threads will be displayed.
389 This variable can also be a number.  In that case, no more than that
390 number of old headers will be fetched.
391
392 The server has to support NOV for any of this to work.")
393
394 ;see gnus-cus.el
395 ;(defvar gnus-visual t
396 ;  "*If non-nil, will do various highlighting.
397 ;If nil, no mouse highlights (or any other highlights) will be
398 ;performed.  This might speed up Gnus some when generating large group
399 ;and summary buffers.")
400
401 (defvar gnus-novice-user t
402   "*Non-nil means that you are a usenet novice.
403 If non-nil, verbose messages may be displayed and confirmations may be
404 required.")
405
406 (defvar gnus-expert-user nil
407   "*Non-nil means that you will never be asked for confirmation about anything.
408 And that means *anything*.")
409
410 (defvar gnus-verbose 7
411   "*Integer that says how verbose Gnus should be.
412 The higher the number, the more messages Gnus will flash to say what
413 it's doing.  At zero, Gnus will be totally mute; at five, Gnus will
414 display most important messages; and at ten, Gnus will keep on
415 jabbering all the time.")
416
417 (defvar gnus-keep-same-level nil
418   "*Non-nil means that the next newsgroup after the current will be on the same level.
419 When you type, for instance, `n' after reading the last article in the
420 current newsgroup, you will go to the next newsgroup.  If this variable
421 is nil, the next newsgroup will be the next from the group
422 buffer.
423 If this variable is non-nil, Gnus will either put you in the
424 next newsgroup with the same level, or, if no such newsgroup is
425 available, the next newsgroup with the lowest possible level higher
426 than the current level.
427 If this variable is `best', Gnus will make the next newsgroup the one
428 with the best level.")
429
430 (defvar gnus-summary-make-false-root 'adopt
431   "*nil means that Gnus won't gather loose threads.
432 If the root of a thread has expired or been read in a previous
433 session, the information necessary to build a complete thread has been
434 lost.  Instead of having many small sub-threads from this original thread
435 scattered all over the summary buffer, Gnus can gather them.
436
437 If non-nil, Gnus will try to gather all loose sub-threads from an
438 original thread into one large thread.
439
440 If this variable is non-nil, it should be one of `none', `adopt',
441 `dummy' or `empty'.
442
443 If this variable is `none', Gnus will not make a false root, but just
444 present the sub-threads after another.
445 If this variable is `dummy', Gnus will create a dummy root that will
446 have all the sub-threads as children.
447 If this variable is `adopt', Gnus will make one of the \"children\"
448 the parent and mark all the step-children as such.
449 If this variable is `empty', the \"children\" are printed with empty
450 subject fields.  (Or rather, they will be printed with a string
451 given by the `gnus-summary-same-subject' variable.)")
452
453 (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
454   "*A regexp to match subjects to be excluded from loose thread gathering.
455 As loose thread gathering is done on subjects only, that means that
456 there can be many false gatherings performed.  By rooting out certain
457 common subjects, gathering might become saner.")
458
459 (defvar gnus-summary-gather-subject-limit nil
460   "*Maximum length of subject comparisons when gathering loose threads.
461 Use nil to compare full subjects.  Setting this variable to a low
462 number will help gather threads that have been corrupted by
463 newsreaders chopping off subject lines, but it might also mean that
464 unrelated articles that have subject that happen to begin with the
465 same few characters will be incorrectly gathered.
466
467 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
468 comparing subjects.")
469
470 (defvar gnus-simplify-ignored-prefixes nil
471   "*Regexp, matches for which are removed from subject lines when simplifying.")
472
473 (defvar gnus-build-sparse-threads nil
474   "*If non-nil, fill in the gaps in threads.
475 If `some', only fill in the gaps that are needed to tie loose threads
476 together.  If `more', fill in all leaf nodes that Gnus can find.  If
477 non-nil and non-`some', fill in all gaps that Gnus manages to guess.")
478
479 (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
480   "Function used for gathering loose threads.
481 There are two pre-defined functions: `gnus-gather-threads-by-subject',
482 which only takes Subjects into consideration; and
483 `gnus-gather-threads-by-references', which compared the References
484 headers of the articles to find matches.")
485
486 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
487 (defvar gnus-summary-same-subject ""
488   "*String indicating that the current article has the same subject as the previous.
489 This variable will only be used if the value of
490 `gnus-summary-make-false-root' is `empty'.")
491
492 (defvar gnus-summary-goto-unread t
493   "*If non-nil, marking commands will go to the next unread article.
494 If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article,
495 whether it is read or not.")
496
497 (defvar gnus-group-goto-unread t
498   "*If non-nil, movement commands will go to the next unread and subscribed group.")
499
500 (defvar gnus-goto-next-group-when-activating t
501   "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.")
502
503 (defvar gnus-check-new-newsgroups t
504   "*Non-nil means that Gnus will add new newsgroups at startup.
505 If this variable is `ask-server', Gnus will ask the server for new
506 groups since the last time it checked.  This means that the killed list
507 is no longer necessary, so you could set `gnus-save-killed-list' to
508 nil.
509
510 A variant is to have this variable be a list of select methods.  Gnus
511 will then use the `ask-server' method on all these select methods to
512 query for new groups from all those servers.
513
514 Eg.
515   (setq gnus-check-new-newsgroups
516         '((nntp \"some.server\") (nntp \"other.server\")))
517
518 If this variable is nil, then you have to tell Gnus explicitly to
519 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
520
521 (defvar gnus-check-bogus-newsgroups nil
522   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
523 If this variable is nil, then you have to tell Gnus explicitly to
524 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
525
526 (defvar gnus-read-active-file t
527   "*Non-nil means that Gnus will read the entire active file at startup.
528 If this variable is nil, Gnus will only know about the groups in your
529 `.newsrc' file.
530
531 If this variable is `some', Gnus will try to only read the relevant
532 parts of the active file from the server.  Not all servers support
533 this, and it might be quite slow with other servers, but this should
534 generally be faster than both the t and nil value.
535
536 If you set this variable to nil or `some', you probably still want to
537 be told about new newsgroups that arrive.  To do that, set
538 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
539 properly with all servers.")
540
541 (defvar gnus-level-subscribed 5
542   "*Groups with levels less than or equal to this variable are subscribed.")
543
544 (defvar gnus-level-unsubscribed 7
545   "*Groups with levels less than or equal to this variable are unsubscribed.
546 Groups with levels less than `gnus-level-subscribed', which should be
547 less than this variable, are subscribed.")
548
549 (defvar gnus-level-zombie 8
550   "*Groups with this level are zombie groups.")
551
552 (defvar gnus-level-killed 9
553   "*Groups with this level are killed.")
554
555 (defvar gnus-level-default-subscribed 3
556   "*New subscribed groups will be subscribed at this level.")
557
558 (defvar gnus-level-default-unsubscribed 6
559   "*New unsubscribed groups will be unsubscribed at this level.")
560
561 (defvar gnus-activate-level (1+ gnus-level-subscribed)
562   "*Groups higher than this level won't be activated on startup.
563 Setting this variable to something log might save lots of time when
564 you have many groups that you aren't interested in.")
565
566 (defvar gnus-activate-foreign-newsgroups 4
567   "*If nil, Gnus will not check foreign newsgroups at startup.
568 If it is non-nil, it should be a number between one and nine.  Foreign
569 newsgroups that have a level lower or equal to this number will be
570 activated on startup.  For instance, if you want to active all
571 subscribed newsgroups, but not the rest, you'd set this variable to
572 `gnus-level-subscribed'.
573
574 If you subscribe to lots of newsgroups from different servers, startup
575 might take a while.  By setting this variable to nil, you'll save time,
576 but you won't be told how many unread articles there are in the
577 groups.")
578
579 (defvar gnus-save-newsrc-file t
580   "*Non-nil means that Gnus will save the `.newsrc' file.
581 Gnus always saves its own startup file, which is called
582 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
583 be readily understood by other newsreaders.  If you don't plan on
584 using other newsreaders, set this variable to nil to save some time on
585 exit.")
586
587 (defvar gnus-save-killed-list t
588   "*If non-nil, save the list of killed groups to the startup file.
589 If you set this variable to nil, you'll save both time (when starting
590 and quitting) and space (both memory and disk), but it will also mean
591 that Gnus has no record of which groups are new and which are old, so
592 the automatic new newsgroups subscription methods become meaningless.
593
594 You should always set `gnus-check-new-newsgroups' to `ask-server' or
595 nil if you set this variable to nil.")
596
597 (defvar gnus-interactive-catchup t
598   "*If non-nil, require your confirmation when catching up a group.")
599
600 (defvar gnus-interactive-post t
601   "*If non-nil, group name will be asked for when posting.")
602
603 (defvar gnus-interactive-exit t
604   "*If non-nil, require your confirmation when exiting Gnus.")
605
606 (defvar gnus-kill-killed t
607   "*If non-nil, Gnus will apply kill files to already killed articles.
608 If it is nil, Gnus will never apply kill files to articles that have
609 already been through the scoring process, which might very well save lots
610 of time.")
611
612 (defvar gnus-extract-address-components 'gnus-extract-address-components
613   "*Function for extracting address components from a From header.
614 Two pre-defined function exist: `gnus-extract-address-components',
615 which is the default, quite fast, and too simplistic solution, and
616 `mail-extract-address-components', which works much better, but is
617 slower.")
618
619 (defvar gnus-summary-default-score 0
620   "*Default article score level.
621 If this variable is nil, scoring will be disabled.")
622
623 (defvar gnus-summary-zcore-fuzz 0
624   "*Fuzziness factor for the zcore in the summary buffer.
625 Articles with scores closer than this to `gnus-summary-default-score'
626 will not be marked.")
627
628 (defvar gnus-simplify-subject-fuzzy-regexp nil
629   "*Strings to be removed when doing fuzzy matches.
630 This can either be a regular expression or list of regular expressions
631 that will be removed from subject strings if fuzzy subject
632 simplification is selected.")
633
634 (defvar gnus-permanently-visible-groups nil
635   "*Regexp to match groups that should always be listed in the group buffer.
636 This means that they will still be listed when there are no unread
637 articles in the groups.")
638
639 (defvar gnus-list-groups-with-ticked-articles t
640   "*If non-nil, list groups that have only ticked articles.
641 If nil, only list groups that have unread articles.")
642
643 (defvar gnus-group-default-list-level gnus-level-subscribed
644   "*Default listing level.
645 Ignored if `gnus-group-use-permanent-levels' is non-nil.")
646
647 (defvar gnus-group-use-permanent-levels nil
648   "*If non-nil, once you set a level, Gnus will use this level.")
649
650 (defvar gnus-group-list-inactive-groups t
651   "*If non-nil, inactive groups will be listed.")
652
653 (defvar gnus-show-mime nil
654   "*If non-nil, do mime processing of articles.
655 The articles will simply be fed to the function given by
656 `gnus-show-mime-method'.")
657
658 (defvar gnus-strict-mime t
659   "*If nil, MIME-decode even if there is no Mime-Version header in the article.")
660
661 (defvar gnus-show-mime-method 'metamail-buffer
662   "*Function to process a MIME message.
663 The function is called from the article buffer.")
664
665 (defvar gnus-decode-encoded-word-method (lambda ())
666   "*Function to decode a MIME encoded-words.
667 The function is called from the article buffer.")
668
669 (defvar gnus-show-threads t
670   "*If non-nil, display threads in summary mode.")
671
672 (defvar gnus-thread-hide-subtree nil
673   "*If non-nil, hide all threads initially.
674 If threads are hidden, you have to run the command
675 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
676 to expose hidden threads.")
677
678 (defvar gnus-thread-hide-killed t
679   "*If non-nil, hide killed threads automatically.")
680
681 (defvar gnus-thread-ignore-subject nil
682   "*If non-nil, ignore subjects and do all threading based on the Reference header.
683 If nil, which is the default, articles that have different subjects
684 from their parents will start separate threads.")
685
686 (defvar gnus-thread-operation-ignore-subject t
687   "*If non-nil, subjects will be ignored when doing thread commands.
688 This affects commands like `gnus-summary-kill-thread' and
689 `gnus-summary-lower-thread'.
690
691 If this variable is nil, articles in the same thread with different
692 subjects will not be included in the operation in question.  If this
693 variable is `fuzzy', only articles that have subjects that are fuzzily
694 equal will be included.")
695
696 (defvar gnus-thread-indent-level 4
697   "*Number that says how much each sub-thread should be indented.")
698
699 (defvar gnus-ignored-newsgroups
700   (purecopy (mapconcat 'identity
701                        '("^to\\."       ; not "real" groups
702                          "^[0-9. \t]+ " ; all digits in name
703                          "[][\"#'()]"   ; bogus characters
704                          )
705                        "\\|"))
706   "*A regexp to match uninteresting newsgroups in the active file.
707 Any lines in the active file matching this regular expression are
708 removed from the newsgroup list before anything else is done to it,
709 thus making them effectively non-existent.")
710
711 (defvar gnus-ignored-headers
712   "^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:"
713   "*All headers that match this regexp will be hidden.
714 This variable can also be a list of regexps of headers to be ignored.
715 If `gnus-visible-headers' is non-nil, this variable will be ignored.")
716
717 (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-"
718   "*All headers that do not match this regexp will be hidden.
719 This variable can also be a list of regexp of headers to remain visible.
720 If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
721
722 (defvar gnus-sorted-header-list
723   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
724     "^Cc:" "^Date:" "^Organization:")
725   "*This variable is a list of regular expressions.
726 If it is non-nil, headers that match the regular expressions will
727 be placed first in the article buffer in the sequence specified by
728 this list.")
729
730 (defvar gnus-boring-article-headers
731   '(empty followup-to reply-to)
732   "*Headers that are only to be displayed if they have interesting data.
733 Possible values in this list are `empty', `newsgroups', `followup-to',
734 `reply-to', and `date'.")
735
736 (defvar gnus-show-all-headers nil
737   "*If non-nil, don't hide any headers.")
738
739 (defvar gnus-save-all-headers t
740   "*If non-nil, don't remove any headers before saving.")
741
742 (defvar gnus-saved-headers gnus-visible-headers
743   "*Headers to keep if `gnus-save-all-headers' is nil.
744 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
745 If that variable is nil, however, all headers that match this regexp
746 will be kept while the rest will be deleted before saving.")
747
748 (defvar gnus-inhibit-startup-message nil
749   "*If non-nil, the startup message will not be displayed.")
750
751 (defvar gnus-signature-separator "^-- *$"
752   "Regexp matching signature separator.")
753
754 (defvar gnus-signature-limit nil
755   "Provide a limit to what is considered a signature.
756 If it is a number, no signature may not be longer (in characters) than
757 that number.  If it is a function, the function will be called without
758 any parameters, and if it returns nil, there is no signature in the
759 buffer.  If it is a string, it will be used as a regexp.  If it
760 matches, the text in question is not a signature.")
761
762 (defvar gnus-auto-extend-newsgroup t
763   "*If non-nil, extend newsgroup forward and backward when requested.")
764
765 (defvar gnus-auto-select-first t
766   "*If nil, don't select the first unread article when entering a group.
767 If this variable is `best', select the highest-scored unread article
768 in the group.  If neither nil nor `best', select the first unread
769 article.
770
771 If you want to prevent automatic selection of the first unread article
772 in some newsgroups, set the variable to nil in
773 `gnus-select-group-hook'.")
774
775 (defvar gnus-auto-select-next t
776   "*If non-nil, offer to go to the next group from the end of the previous.
777 If the value is t and the next newsgroup is empty, Gnus will exit
778 summary mode and go back to group mode.  If the value is neither nil
779 nor t, Gnus will select the following unread newsgroup.  In
780 particular, if the value is the symbol `quietly', the next unread
781 newsgroup will be selected without any confirmation, and if it is
782 `almost-quietly', the next group will be selected without any
783 confirmation if you are located on the last article in the group.
784 Finally, if this variable is `slightly-quietly', the `Z n' command
785 will go to the next group without confirmation.")
786
787 (defvar gnus-auto-select-same nil
788   "*If non-nil, select the next article with the same subject.")
789
790 (defvar gnus-summary-check-current nil
791   "*If non-nil, consider the current article when moving.
792 The \"unread\" movement commands will stay on the same line if the
793 current article is unread.")
794
795 (defvar gnus-auto-center-summary t
796   "*If non-nil, always center the current summary buffer.
797 In particular, if `vertical' do only vertical recentering.  If non-nil
798 and non-`vertical', do both horizontal and vertical recentering.")
799
800 (defvar gnus-break-pages t
801   "*If non-nil, do page breaking on articles.
802 The page delimiter is specified by the `gnus-page-delimiter'
803 variable.")
804
805 (defvar gnus-page-delimiter "^\^L"
806   "*Regexp describing what to use as article page delimiters.
807 The default value is \"^\^L\", which is a form linefeed at the
808 beginning of a line.")
809
810 (defvar gnus-use-full-window t
811   "*If non-nil, use the entire Emacs screen.")
812
813 (defvar gnus-window-configuration nil
814   "Obsolete variable.  See `gnus-buffer-configuration'.")
815
816 (defvar gnus-window-min-width 2
817   "*Minimum width of Gnus buffers.")
818
819 (defvar gnus-window-min-height 1
820   "*Minimum height of Gnus buffers.")
821
822 (defvar gnus-buffer-configuration
823   '((group
824      (vertical 1.0
825                (group 1.0 point)
826                (if gnus-carpal '(group-carpal 4))))
827     (summary
828      (vertical 1.0
829                (summary 1.0 point)
830                (if gnus-carpal '(summary-carpal 4))))
831     (article
832      (cond 
833       (gnus-use-picons
834        '(frame 1.0
835                (vertical 1.0
836                          (summary 0.25 point)
837                          (if gnus-carpal '(summary-carpal 4))
838                          (article 1.0))
839                (vertical ((height . 5) (width . 15)
840                           (user-position . t)
841                           (left . -1) (top . 1))
842                          (picons 1.0))))
843       (gnus-use-trees
844        '(vertical 1.0
845                   (summary 0.25 point)
846                   (tree 0.25)
847                   (article 1.0)))
848       (t
849        '(vertical 1.0
850                  (summary 0.25 point)
851                  (if gnus-carpal '(summary-carpal 4))
852                  (if gnus-use-trees '(tree 0.25))
853                  (article 1.0)))))
854     (server
855      (vertical 1.0
856                (server 1.0 point)
857                (if gnus-carpal '(server-carpal 2))))
858     (browse
859      (vertical 1.0
860                (browse 1.0 point)
861                (if gnus-carpal '(browse-carpal 2))))
862     (message
863      (vertical 1.0
864                (message 1.0 point)))
865     (pick
866      (vertical 1.0
867                (article 1.0 point)))
868     (info
869      (vertical 1.0
870                (info 1.0 point)))
871     (summary-faq
872      (vertical 1.0
873                (summary 0.25)
874                (faq 1.0 point)))
875     (edit-group
876      (vertical 1.0
877                (group 0.5)
878                (edit-group 1.0 point)))
879     (edit-server
880      (vertical 1.0
881                (server 0.5)
882                (edit-server 1.0 point)))
883     (edit-score
884      (vertical 1.0
885                (summary 0.25)
886                (edit-score 1.0 point)))
887     (post
888      (vertical 1.0
889                (post 1.0 point)))
890     (reply
891      (vertical 1.0
892                (article-copy 0.5)
893                (message 1.0 point)))
894     (forward
895      (vertical 1.0
896                (message 1.0 point)))
897     (reply-yank
898      (vertical 1.0
899                (message 1.0 point)))
900     (mail-bounce
901      (vertical 1.0
902                (article 0.5)
903                (message 1.0 point)))
904     (draft
905      (vertical 1.0
906                (draft 1.0 point)))
907     (pipe
908      (vertical 1.0
909                (summary 0.25 point)
910                (if gnus-carpal '(summary-carpal 4))
911                ("*Shell Command Output*" 1.0)))
912     (compose-bounce
913      (vertical 1.0
914                (article 0.5)
915                (message 1.0 point))))
916   "Window configuration for all possible Gnus buffers.
917 This variable is a list of lists.  Each of these lists has a NAME and
918 a RULE.  The NAMEs are commonsense names like `group', which names a
919 rule used when displaying the group buffer; `summary', which names a
920 rule for what happens when you enter a group and do not display an
921 article buffer; and so on.  See the value of this variable for a
922 complete list of NAMEs.
923
924 Each RULE is a list of vectors.  The first element in this vector is
925 the name of the buffer to be displayed; the second element is the
926 percentage of the screen this buffer is to occupy (a number in the
927 0.0-0.99 range); the optional third element is `point', which should
928 be present to denote which buffer point is to go to after making this
929 buffer configuration.")
930
931 (defvar gnus-window-to-buffer
932   '((group . gnus-group-buffer)
933     (summary . gnus-summary-buffer)
934     (article . gnus-article-buffer)
935     (server . gnus-server-buffer)
936     (browse . "*Gnus Browse Server*")
937     (edit-group . gnus-group-edit-buffer)
938     (edit-server . gnus-server-edit-buffer)
939     (group-carpal . gnus-carpal-group-buffer)
940     (summary-carpal . gnus-carpal-summary-buffer)
941     (server-carpal . gnus-carpal-server-buffer)
942     (browse-carpal . gnus-carpal-browse-buffer)
943     (edit-score . gnus-score-edit-buffer)
944     (message . gnus-message-buffer)
945     (faq . gnus-faq-buffer)
946     (picons . "*Picons*")
947     (tree . gnus-tree-buffer)
948     (info . gnus-info-buffer)
949     (article-copy . gnus-article-copy)
950     (draft . gnus-draft-buffer))
951   "Mapping from short symbols to buffer names or buffer variables.")
952
953 (defvar gnus-carpal nil
954   "*If non-nil, display clickable icons.")
955
956 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
957   "*Function called with a group name when new group is detected.
958 A few pre-made functions are supplied: `gnus-subscribe-randomly'
959 inserts new groups at the beginning of the list of groups;
960 `gnus-subscribe-alphabetically' inserts new groups in strict
961 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
962 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
963 for your decision; `gnus-subscribe-killed' kills all new groups.")
964
965 ;; Suggested by a bug report by Hallvard B Furuseth.
966 ;; <h.b.furuseth@usit.uio.no>.
967 (defvar gnus-subscribe-options-newsgroup-method
968   (function gnus-subscribe-alphabetically)
969   "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
970 If, for instance, you want to subscribe to all newsgroups in the
971 \"no\" and \"alt\" hierarchies, you'd put the following in your
972 .newsrc file:
973
974 options -n no.all alt.all
975
976 Gnus will the subscribe all new newsgroups in these hierarchies with
977 the subscription method in this variable.")
978
979 (defvar gnus-subscribe-hierarchical-interactive nil
980   "*If non-nil, Gnus will offer to subscribe hierarchically.
981 When a new hierarchy appears, Gnus will ask the user:
982
983 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
984
985 If the user pressed `d', Gnus will descend the hierarchy, `y' will
986 subscribe to all newsgroups in the hierarchy and `s' will skip this
987 hierarchy in its entirety.")
988
989 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
990   "*Function used for sorting the group buffer.
991 This function will be called with group info entries as the arguments
992 for the groups to be sorted.  Pre-made functions include
993 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
994 `gnus-group-sort-by-level', `gnus-group-sort-by-score', and
995 `gnus-group-sort-by-rank'.
996
997 This variable can also be a list of sorting functions.  In that case,
998 the most significant sort function should be the last function in the
999 list.")
1000
1001 ;; Mark variables suggested by Thomas Michanek
1002 ;; <Thomas.Michanek@telelogic.se>.
1003 (defvar gnus-unread-mark ? 
1004   "*Mark used for unread articles.")
1005 (defvar gnus-ticked-mark ?!
1006   "*Mark used for ticked articles.")
1007 (defvar gnus-dormant-mark ??
1008   "*Mark used for dormant articles.")
1009 (defvar gnus-del-mark ?r
1010   "*Mark used for del'd articles.")
1011 (defvar gnus-read-mark ?R
1012   "*Mark used for read articles.")
1013 (defvar gnus-expirable-mark ?E
1014   "*Mark used for expirable articles.")
1015 (defvar gnus-killed-mark ?K
1016   "*Mark used for killed articles.")
1017 (defvar gnus-souped-mark ?F
1018   "*Mark used for killed articles.")
1019 (defvar gnus-kill-file-mark ?X
1020   "*Mark used for articles killed by kill files.")
1021 (defvar gnus-low-score-mark ?Y
1022   "*Mark used for articles with a low score.")
1023 (defvar gnus-catchup-mark ?C
1024   "*Mark used for articles that are caught up.")
1025 (defvar gnus-replied-mark ?A
1026   "*Mark used for articles that have been replied to.")
1027 (defvar gnus-cached-mark ?*
1028   "*Mark used for articles that are in the cache.")
1029 (defvar gnus-saved-mark ?S
1030   "*Mark used for articles that have been saved to.")
1031 (defvar gnus-process-mark ?#
1032   "*Process mark.")
1033 (defvar gnus-ancient-mark ?O
1034   "*Mark used for ancient articles.")
1035 (defvar gnus-sparse-mark ?Q
1036   "*Mark used for sparsely reffed articles.")
1037 (defvar gnus-canceled-mark ?G
1038   "*Mark used for canceled articles.")
1039 (defvar gnus-score-over-mark ?+
1040   "*Score mark used for articles with high scores.")
1041 (defvar gnus-score-below-mark ?-
1042   "*Score mark used for articles with low scores.")
1043 (defvar gnus-empty-thread-mark ? 
1044   "*There is no thread under the article.")
1045 (defvar gnus-not-empty-thread-mark ?=
1046   "*There is a thread under the article.")
1047
1048 (defvar gnus-view-pseudo-asynchronously nil
1049   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
1050
1051 (defvar gnus-view-pseudos nil
1052   "*If `automatic', pseudo-articles will be viewed automatically.
1053 If `not-confirm', pseudos will be viewed automatically, and the user
1054 will not be asked to confirm the command.")
1055
1056 (defvar gnus-view-pseudos-separately t
1057   "*If non-nil, one pseudo-article will be created for each file to be viewed.
1058 If nil, all files that use the same viewing command will be given as a
1059 list of parameters to that command.")
1060
1061 (defvar gnus-insert-pseudo-articles t
1062   "*If non-nil, insert pseudo-articles when decoding articles.")
1063
1064 (defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)%l\n"
1065   "*Format of group lines.
1066 It works along the same lines as a normal formatting string,
1067 with some simple extensions.
1068
1069 %M    Only marked articles (character, \"*\" or \" \")
1070 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
1071 %L    Level of subscribedness (integer)
1072 %N    Number of unread articles (integer)
1073 %I    Number of dormant articles (integer)
1074 %i    Number of ticked and dormant (integer)
1075 %T    Number of ticked articles (integer)
1076 %R    Number of read articles (integer)
1077 %t    Total number of articles (integer)
1078 %y    Number of unread, unticked articles (integer)
1079 %G    Group name (string)
1080 %g    Qualified group name (string)
1081 %D    Group description (string)
1082 %s    Select method (string)
1083 %o    Moderated group (char, \"m\")
1084 %p    Process mark (char)
1085 %O    Moderated group (string, \"(m)\" or \"\")
1086 %P    Topic indentation (string)
1087 %l    Whether there are GroupLens predictions for this group (string)
1088 %n    Select from where (string)
1089 %z    A string that look like `<%s:%n>' if a foreign select method is used
1090 %u    User defined specifier.  The next character in the format string should
1091       be a letter.  Gnus will call the function gnus-user-format-function-X,
1092       where X is the letter following %u.  The function will be passed the
1093       current header as argument.  The function should return a string, which
1094       will be inserted into the buffer just like information from any other
1095       group specifier.
1096
1097 Text between %( and %) will be highlighted with `gnus-mouse-face' when
1098 the mouse point move inside the area.  There can only be one such area.
1099
1100 Note that this format specification is not always respected.  For
1101 reasons of efficiency, when listing killed groups, this specification
1102 is ignored altogether.  If the spec is changed considerably, your
1103 output may end up looking strange when listing both alive and killed
1104 groups.
1105
1106 If you use %o or %O, reading the active file will be slower and quite
1107 a bit of extra memory will be used. %D will also worsen performance.
1108 Also note that if you change the format specification to include any
1109 of these specs, you must probably re-start Gnus to see them go into
1110 effect.")
1111
1112 (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
1113   "*The format specification of the lines in the summary buffer.
1114
1115 It works along the same lines as a normal formatting string,
1116 with some simple extensions.
1117
1118 %N   Article number, left padded with spaces (string)
1119 %S   Subject (string)
1120 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
1121 %n   Name of the poster (string)
1122 %a   Extracted name of the poster (string)
1123 %A   Extracted address of the poster (string)
1124 %F   Contents of the From: header (string)
1125 %x   Contents of the Xref: header (string)
1126 %D   Date of the article (string)
1127 %d   Date of the article (string) in DD-MMM format
1128 %M   Message-id of the article (string)
1129 %r   References of the article (string)
1130 %c   Number of characters in the article (integer)
1131 %L   Number of lines in the article (integer)
1132 %I   Indentation based on thread level (a string of spaces)
1133 %T   A string with two possible values: 80 spaces if the article
1134      is on thread level two or larger and 0 spaces on level one
1135 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
1136 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
1137 %[   Opening bracket (character, \"[\" or \"<\")
1138 %]   Closing bracket (character, \"]\" or \">\")
1139 %>   Spaces of length thread-level (string)
1140 %<   Spaces of length (- 20 thread-level) (string)
1141 %i   Article score (number)
1142 %z   Article zcore (character)
1143 %t   Number of articles under the current thread (number).
1144 %e   Whether the thread is empty or not (character).
1145 %l   GroupLens score (number)
1146 %u   User defined specifier.  The next character in the format string should
1147      be a letter.  Gnus will call the function gnus-user-format-function-X,
1148      where X is the letter following %u.  The function will be passed the
1149      current header as argument.  The function should return a string, which
1150      will be inserted into the summary just like information from any other
1151      summary specifier.
1152
1153 Text between %( and %) will be highlighted with `gnus-mouse-face'
1154 when the mouse point is placed inside the area.  There can only be one
1155 such area.
1156
1157 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1158 with care.  For reasons of efficiency, Gnus will compute what column
1159 these characters will end up in, and \"hard-code\" that.  This means that
1160 it is illegal to have these specs after a variable-length spec.  Well,
1161 you might not be arrested, but your summary buffer will look strange,
1162 which is bad enough.
1163
1164 The smart choice is to have these specs as for to the left as
1165 possible.
1166
1167 This restriction may disappear in later versions of Gnus.")
1168
1169 (defvar gnus-summary-dummy-line-format
1170   "*  %(:                          :%) %S\n"
1171   "*The format specification for the dummy roots in the summary buffer.
1172 It works along the same lines as a normal formatting string,
1173 with some simple extensions.
1174
1175 %S  The subject")
1176
1177 (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
1178   "*The format specification for the summary mode line.
1179 It works along the same lines as a normal formatting string,
1180 with some simple extensions:
1181
1182 %G  Group name
1183 %p  Unprefixed group name
1184 %A  Current article number
1185 %V  Gnus version
1186 %U  Number of unread articles in the group
1187 %e  Number of unselected articles in the group
1188 %Z  A string with unread/unselected article counts
1189 %g  Shortish group name
1190 %S  Subject of the current article
1191 %u  User-defined spec
1192 %s  Current score file name
1193 %d  Number of dormant articles
1194 %r  Number of articles that have been marked as read in this session
1195 %E  Number of articles expunged by the score files")
1196
1197 (defvar gnus-article-mode-line-format "Gnus: %%b %S"
1198   "*The format specification for the article mode line.
1199 See `gnus-summary-mode-line-format' for a closer description.")
1200
1201 (defvar gnus-group-mode-line-format "Gnus: %%b {%M:%S}"
1202   "*The format specification for the group mode line.
1203 It works along the same lines as a normal formatting string,
1204 with some simple extensions:
1205
1206 %S   The native news server.
1207 %M   The native select method.")
1208
1209 (defvar gnus-valid-select-methods
1210   '(("nntp" post address prompt-address)
1211     ("nnspool" post address)
1212     ("nnvirtual" post-mail virtual prompt-address)
1213     ("nnmbox" mail respool address)
1214     ("nnml" mail respool address)
1215     ("nnmh" mail respool address)
1216     ("nndir" post-mail prompt-address address)
1217     ("nneething" none address prompt-address)
1218     ("nndoc" none address prompt-address)
1219     ("nnbabyl" mail address respool)
1220     ("nnkiboze" post address virtual)
1221     ("nnsoup" post-mail address)
1222     ("nndraft" post-mail)
1223     ("nnfolder" mail respool address))
1224   "An alist of valid select methods.
1225 The first element of each list lists should be a string with the name
1226 of the select method.  The other elements may be be the category of
1227 this method (ie. `post', `mail', `none' or whatever) or other
1228 properties that this method has (like being respoolable).
1229 If you implement a new select method, all you should have to change is
1230 this variable.  I think.")
1231
1232 (defvar gnus-updated-mode-lines '(group article summary tree)
1233   "*List of buffers that should update their mode lines.
1234 The list may contain the symbols `group', `article' and `summary'.  If
1235 the corresponding symbol is present, Gnus will keep that mode line
1236 updated with information that may be pertinent.
1237 If this variable is nil, screen refresh may be quicker.")
1238
1239 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1240 (defvar gnus-mode-non-string-length nil
1241   "*Max length of mode-line non-string contents.
1242 If this is nil, Gnus will take space as is needed, leaving the rest
1243 of the modeline intact.")
1244
1245 ;see gnus-cus.el
1246 ;(defvar gnus-mouse-face 'highlight
1247 ;  "*Face used for mouse highlighting in Gnus.
1248 ;No mouse highlights will be done if `gnus-visual' is nil.")
1249
1250 (defvar gnus-summary-mark-below nil
1251   "*Mark all articles with a score below this variable as read.
1252 This variable is local to each summary buffer and usually set by the
1253 score file.")
1254
1255 (defvar gnus-article-sort-functions '(gnus-article-sort-by-number)
1256   "*List of functions used for sorting articles in the summary buffer.
1257 This variable is only used when not using a threaded display.")
1258
1259 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
1260   "*List of functions used for sorting threads in the summary buffer.
1261 By default, threads are sorted by article number.
1262
1263 Each function takes two threads and return non-nil if the first thread
1264 should be sorted before the other.  If you use more than one function,
1265 the primary sort function should be the last.  You should probably
1266 always include `gnus-thread-sort-by-number' in the list of sorting
1267 functions -- preferably first.
1268
1269 Ready-mady functions include `gnus-thread-sort-by-number',
1270 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
1271 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
1272 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
1273
1274 (defvar gnus-thread-score-function '+
1275   "*Function used for calculating the total score of a thread.
1276
1277 The function is called with the scores of the article and each
1278 subthread and should then return the score of the thread.
1279
1280 Some functions you can use are `+', `max', or `min'.")
1281
1282 (defvar gnus-summary-expunge-below nil
1283   "All articles that have a score less than this variable will be expunged.")
1284
1285 (defvar gnus-thread-expunge-below nil
1286   "All threads that have a total score less than this variable will be expunged.
1287 See `gnus-thread-score-function' for en explanation of what a
1288 \"thread score\" is.")
1289
1290 (defvar gnus-auto-subscribed-groups
1291   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
1292   "*All new groups that match this regexp will be subscribed automatically.
1293 Note that this variable only deals with new groups.  It has no effect
1294 whatsoever on old groups.")
1295
1296 (defvar gnus-options-subscribe nil
1297   "*All new groups matching this regexp will be subscribed unconditionally.
1298 Note that this variable deals only with new newsgroups.  This variable
1299 does not affect old newsgroups.")
1300
1301 (defvar gnus-options-not-subscribe nil
1302   "*All new groups matching this regexp will be ignored.
1303 Note that this variable deals only with new newsgroups.  This variable
1304 does not affect old (already subscribed) newsgroups.")
1305
1306 (defvar gnus-auto-expirable-newsgroups nil
1307   "*Groups in which to automatically mark read articles as expirable.
1308 If non-nil, this should be a regexp that should match all groups in
1309 which to perform auto-expiry.  This only makes sense for mail groups.")
1310
1311 (defvar gnus-total-expirable-newsgroups nil
1312   "*Groups in which to perform expiry of all read articles.
1313 Use with extreme caution.  All groups that match this regexp will be
1314 expiring - which means that all read articles will be deleted after
1315 (say) one week.  (This only goes for mail groups and the like, of
1316 course.)")
1317
1318 (defvar gnus-group-uncollapsed-levels 1
1319   "Number of group name elements to leave alone when making a short group name.")
1320
1321 (defvar gnus-hidden-properties '(invisible t intangible t)
1322   "Property list to use for hiding text.")
1323
1324 (defvar gnus-modtime-botch nil
1325   "*Non-nil means .newsrc should be deleted prior to save.  
1326 Its use is due to the bogus appearance that .newsrc was modified on
1327 disc.")
1328
1329 ;; Hooks.
1330
1331 (defvar gnus-group-mode-hook nil
1332   "*A hook for Gnus group mode.")
1333
1334 (defvar gnus-summary-mode-hook nil
1335   "*A hook for Gnus summary mode.
1336 This hook is run before any variables are set in the summary buffer.")
1337
1338 (defvar gnus-article-mode-hook nil
1339   "*A hook for Gnus article mode.")
1340
1341 (defvar gnus-summary-prepare-exit-hook nil
1342   "*A hook called when preparing to exit from the summary buffer.
1343 It calls `gnus-summary-expire-articles' by default.")
1344 (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
1345
1346 (defvar gnus-summary-exit-hook nil
1347   "*A hook called on exit from the summary buffer.")
1348
1349 (defvar gnus-group-catchup-group-hook nil
1350   "*A hook run when catching up a group from the group buffer.")
1351
1352 (defvar gnus-open-server-hook nil
1353   "*A hook called just before opening connection to the news server.")
1354
1355 (defvar gnus-load-hook nil
1356   "*A hook run while Gnus is loaded.")
1357
1358 (defvar gnus-startup-hook nil
1359   "*A hook called at startup.
1360 This hook is called after Gnus is connected to the NNTP server.")
1361
1362 (defvar gnus-get-new-news-hook nil
1363   "*A hook run just before Gnus checks for new news.")
1364
1365 (defvar gnus-after-getting-new-news-hook nil
1366   "*A hook run after Gnus checks for new news.")
1367
1368 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
1369   "*A function that is called to generate the group buffer.
1370 The function is called with three arguments: The first is a number;
1371 all group with a level less or equal to that number should be listed,
1372 if the second is non-nil, empty groups should also be displayed.  If
1373 the third is non-nil, it is a number.  No groups with a level lower
1374 than this number should be displayed.
1375
1376 The only current function implemented is `gnus-group-prepare-flat'.")
1377
1378 (defvar gnus-group-prepare-hook nil
1379   "*A hook called after the group buffer has been generated.
1380 If you want to modify the group buffer, you can use this hook.")
1381
1382 (defvar gnus-summary-prepare-hook nil
1383   "*A hook called after the summary buffer has been generated.
1384 If you want to modify the summary buffer, you can use this hook.")
1385
1386 (defvar gnus-summary-generate-hook nil
1387   "*A hook run just before generating the summary buffer.
1388 This hook is commonly used to customize threading variables and the
1389 like.")
1390
1391 (defvar gnus-article-prepare-hook nil
1392   "*A hook called after an article has been prepared in the article buffer.
1393 If you want to run a special decoding program like nkf, use this hook.")
1394
1395 ;(defvar gnus-article-display-hook nil
1396 ;  "*A hook called after the article is displayed in the article buffer.
1397 ;The hook is designed to change the contents of the article
1398 ;buffer.  Typical functions that this hook may contain are
1399 ;`gnus-article-hide-headers' (hide selected headers),
1400 ;`gnus-article-maybe-highlight' (perform fancy article highlighting),
1401 ;`gnus-article-hide-signature' (hide signature) and
1402 ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
1403 ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
1404 ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
1405 ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight)
1406
1407 (defvar gnus-article-x-face-command
1408   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
1409   "String or function to be executed to display an X-Face header.
1410 If it is a string, the command will be executed in a sub-shell
1411 asynchronously.  The compressed face will be piped to this command.")
1412
1413 (defvar gnus-article-x-face-too-ugly nil
1414   "Regexp matching posters whose face shouldn't be shown automatically.")
1415
1416 (defvar gnus-select-group-hook nil
1417   "*A hook called when a newsgroup is selected.
1418
1419 If you'd like to simplify subjects like the
1420 `gnus-summary-next-same-subject' command does, you can use the
1421 following hook:
1422
1423  (setq gnus-select-group-hook
1424       (list
1425         (lambda ()
1426           (mapcar (lambda (header)
1427                      (mail-header-set-subject
1428                       header
1429                       (gnus-simplify-subject
1430                        (mail-header-subject header) 're-only)))
1431                   gnus-newsgroup-headers))))")
1432
1433 (defvar gnus-select-article-hook nil
1434   "*A hook called when an article is selected.")
1435
1436 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
1437   "*A hook called to apply kill files to a group.
1438 This hook is intended to apply a kill file to the selected newsgroup.
1439 The function `gnus-apply-kill-file' is called by default.
1440
1441 Since a general kill file is too heavy to use only for a few
1442 newsgroups, I recommend you to use a lighter hook function.  For
1443 example, if you'd like to apply a kill file to articles which contains
1444 a string `rmgroup' in subject in newsgroup `control', you can use the
1445 following hook:
1446
1447  (setq gnus-apply-kill-hook
1448       (list
1449         (lambda ()
1450           (cond ((string-match \"control\" gnus-newsgroup-name)
1451                  (gnus-kill \"Subject\" \"rmgroup\")
1452                  (gnus-expunge \"X\"))))))")
1453
1454 (defvar gnus-visual-mark-article-hook
1455   (list 'gnus-highlight-selected-summary)
1456   "*Hook run after selecting an article in the summary buffer.
1457 It is meant to be used for highlighting the article in some way.  It
1458 is not run if `gnus-visual' is nil.")
1459
1460 (defvar gnus-parse-headers-hook nil
1461   "*A hook called before parsing the headers.")
1462
1463 (defvar gnus-exit-group-hook nil
1464   "*A hook called when exiting (not quitting) summary mode.")
1465
1466 (defvar gnus-suspend-gnus-hook nil
1467   "*A hook called when suspending (not exiting) Gnus.")
1468
1469 (defvar gnus-exit-gnus-hook nil
1470   "*A hook called when exiting Gnus.")
1471
1472 (defvar gnus-after-exiting-gnus-hook nil
1473   "*A hook called after exiting Gnus.")
1474
1475 (defvar gnus-save-newsrc-hook nil
1476   "*A hook called before saving any of the newsrc files.")
1477
1478 (defvar gnus-save-quick-newsrc-hook nil
1479   "*A hook called just before saving the quick newsrc file.
1480 Can be used to turn version control on or off.")
1481
1482 (defvar gnus-save-standard-newsrc-hook nil
1483   "*A hook called just before saving the standard newsrc file.
1484 Can be used to turn version control on or off.")
1485
1486 (defvar gnus-summary-update-hook
1487   (list 'gnus-summary-highlight-line)
1488   "*A hook called when a summary line is changed.
1489 The hook will not be called if `gnus-visual' is nil.
1490
1491 The default function `gnus-summary-highlight-line' will
1492 highlight the line according to the `gnus-summary-highlight'
1493 variable.")
1494
1495 (defvar gnus-group-update-hook '(gnus-group-highlight-line)
1496   "*A hook called when a group line is changed.
1497 The hook will not be called if `gnus-visual' is nil.
1498
1499 The default function `gnus-group-highlight-line' will
1500 highlight the line according to the `gnus-group-highlight'
1501 variable.")
1502
1503 (defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
1504   "*A hook called when an article is selected for the first time.
1505 The hook is intended to mark an article as read (or unread)
1506 automatically when it is selected.")
1507
1508 (defvar gnus-group-change-level-function nil
1509   "Function run when a group level is changed.
1510 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.")
1511
1512 ;; Remove any hilit infestation.
1513 (add-hook 'gnus-startup-hook
1514           (lambda ()
1515             (remove-hook 'gnus-summary-prepare-hook
1516                          'hilit-rehighlight-buffer-quietly)
1517             (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
1518             (setq gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read))
1519             (remove-hook 'gnus-article-prepare-hook
1520                          'hilit-rehighlight-buffer-quietly)))
1521
1522 \f
1523 ;; Internal variables
1524
1525 (defvar gnus-server-alist nil
1526   "List of available servers.")
1527
1528 (defvar gnus-group-indentation-function nil)
1529
1530 (defvar gnus-topic-indentation "") ;; Obsolete variable.
1531
1532 (defvar gnus-goto-missing-group-function nil)
1533
1534 (defvar gnus-override-subscribe-method nil)
1535
1536 (defvar gnus-group-goto-next-group-function nil
1537   "Function to override finding the next group after listing groups.")
1538
1539 (defconst gnus-article-mark-lists
1540   '((marked . tick) (replied . reply)
1541     (expirable . expire) (killed . killed)
1542     (bookmarks . bookmark) (dormant . dormant)
1543     (scored . score) (saved . save)
1544     (cached . cache)
1545     ))
1546
1547 ;; Avoid highlighting in kill files.
1548 (defvar gnus-summary-inhibit-highlight nil)
1549 (defvar gnus-newsgroup-selected-overlay nil)
1550
1551 (defvar gnus-inhibit-hiding nil)
1552 (defvar gnus-group-indentation "")
1553 (defvar gnus-inhibit-limiting nil)
1554 (defvar gnus-created-frames nil)
1555
1556 (defvar gnus-article-mode-map nil)
1557 (defvar gnus-dribble-buffer nil)
1558 (defvar gnus-headers-retrieved-by nil)
1559 (defvar gnus-article-reply nil)
1560 (defvar gnus-override-method nil)
1561 (defvar gnus-article-check-size nil)
1562
1563 (defvar gnus-current-score-file nil)
1564 (defvar gnus-newsgroup-adaptive-score-file nil)
1565 (defvar gnus-scores-exclude-files nil)
1566
1567 (defvar gnus-opened-servers nil)
1568
1569 (defvar gnus-current-move-group nil)
1570
1571 (defvar gnus-newsgroup-dependencies nil)
1572 (defvar gnus-newsgroup-async nil)
1573 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1574
1575 (defvar gnus-newsgroup-adaptive nil)
1576
1577 (defvar gnus-summary-display-table nil)
1578 (defvar gnus-summary-display-article-function nil)
1579
1580 (defvar gnus-summary-highlight-line-function nil
1581   "Function called after highlighting a summary line.")
1582
1583 (defvar gnus-group-line-format-alist
1584   `((?M gnus-tmp-marked-mark ?c)
1585     (?S gnus-tmp-subscribed ?c)
1586     (?L gnus-tmp-level ?d)
1587     (?N (cond ((eq number t) "*" )
1588               ((numberp number) 
1589                (int-to-string
1590                 (+ number
1591                    (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1592                    (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
1593               (t number)) ?s)
1594     (?R gnus-tmp-number-of-read ?s)
1595     (?t gnus-tmp-number-total ?d)
1596     (?y gnus-tmp-number-of-unread ?s)
1597     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
1598     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
1599     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1600            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
1601     (?g gnus-tmp-group ?s)
1602     (?G gnus-tmp-qualified-group ?s)
1603     (?c (gnus-short-group-name gnus-tmp-group) ?s)
1604     (?D gnus-tmp-newsgroup-description ?s)
1605     (?o gnus-tmp-moderated ?c)
1606     (?O gnus-tmp-moderated-string ?s)
1607     (?p gnus-tmp-process-marked ?c)
1608     (?s gnus-tmp-news-server ?s)
1609     (?n gnus-tmp-news-method ?s)
1610     (?P gnus-group-indentation ?s)
1611     (?l gnus-tmp-grouplens ?s)
1612     (?z gnus-tmp-news-method-string ?s)
1613     (?u gnus-tmp-user-defined ?s)))
1614
1615 (defvar gnus-summary-line-format-alist
1616   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1617     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1618     (?s gnus-tmp-subject-or-nil ?s)
1619     (?n gnus-tmp-name ?s)
1620     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1621         ?s)
1622     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
1623             gnus-tmp-from) ?s)
1624     (?F gnus-tmp-from ?s)
1625     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1626     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1627     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1628     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1629     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1630     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1631     (?L gnus-tmp-lines ?d)
1632     (?I gnus-tmp-indentation ?s)
1633     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1634     (?R gnus-tmp-replied ?c)
1635     (?\[ gnus-tmp-opening-bracket ?c)
1636     (?\] gnus-tmp-closing-bracket ?c)
1637     (?\> (make-string gnus-tmp-level ? ) ?s)
1638     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1639     (?i gnus-tmp-score ?d)
1640     (?z gnus-tmp-score-char ?c)
1641     (?l (bbb-grouplens-score gnus-tmp-header) ?s)
1642     (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
1643     (?U gnus-tmp-unread ?c)
1644     (?t (gnus-summary-number-of-articles-in-thread
1645          (and (boundp 'thread) (car thread)) gnus-tmp-level)
1646         ?d)
1647     (?e (gnus-summary-number-of-articles-in-thread
1648          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1649         ?c)
1650     (?u gnus-tmp-user-defined ?s))
1651   "An alist of format specifications that can appear in summary lines,
1652 and what variables they correspond with, along with the type of the
1653 variable (string, integer, character, etc).")
1654
1655 (defvar gnus-summary-dummy-line-format-alist
1656   `((?S gnus-tmp-subject ?s)
1657     (?N gnus-tmp-number ?d)
1658     (?u gnus-tmp-user-defined ?s)))
1659
1660 (defvar gnus-summary-mode-line-format-alist
1661   `((?G gnus-tmp-group-name ?s)
1662     (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1663     (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1664     (?A gnus-tmp-article-number ?d)
1665     (?Z gnus-tmp-unread-and-unselected ?s)
1666     (?V gnus-version ?s)
1667     (?U gnus-tmp-unread ?d)
1668     (?S gnus-tmp-subject ?s)
1669     (?e gnus-tmp-unselected ?d)
1670     (?u gnus-tmp-user-defined ?s)
1671     (?d (length gnus-newsgroup-dormant) ?d)
1672     (?t (length gnus-newsgroup-marked) ?d)
1673     (?r (length gnus-newsgroup-reads) ?d)
1674     (?E gnus-newsgroup-expunged-tally ?d)
1675     (?s (gnus-current-score-file-nondirectory) ?s)))
1676
1677 (defvar gnus-article-mode-line-format-alist
1678   gnus-summary-mode-line-format-alist)
1679
1680 (defvar gnus-group-mode-line-format-alist
1681   `((?S gnus-tmp-news-server ?s)
1682     (?M gnus-tmp-news-method ?s)
1683     (?u gnus-tmp-user-defined ?s)))
1684
1685 (defvar gnus-have-read-active-file nil)
1686
1687 (defconst gnus-maintainer
1688   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1689   "The mail address of the Gnus maintainers.")
1690
1691 (defconst gnus-version "September Gnus v0.59"
1692   "Version number for this version of Gnus.")
1693
1694 (defvar gnus-info-nodes
1695   '((gnus-group-mode            "(gnus)The Group Buffer")
1696     (gnus-summary-mode          "(gnus)The Summary Buffer")
1697     (gnus-article-mode          "(gnus)The Article Buffer"))
1698   "Assoc list of major modes and related Info nodes.")
1699
1700 (defvar gnus-group-buffer "*Group*")
1701 (defvar gnus-summary-buffer "*Summary*")
1702 (defvar gnus-article-buffer "*Article*")
1703 (defvar gnus-server-buffer "*Server*")
1704
1705 (defvar gnus-work-buffer " *gnus work*")
1706
1707 (defvar gnus-original-article-buffer " *Original Article*")
1708 (defvar gnus-original-article nil)
1709
1710 (defvar gnus-buffer-list nil
1711   "Gnus buffers that should be killed on exit.")
1712
1713 (defvar gnus-slave nil
1714   "Whether this Gnus is a slave or not.")
1715
1716 (defvar gnus-variable-list
1717   '(gnus-newsrc-options gnus-newsrc-options-n
1718     gnus-newsrc-last-checked-date
1719     gnus-newsrc-alist gnus-server-alist
1720     gnus-killed-list gnus-zombie-list
1721     gnus-topic-topology gnus-topic-alist
1722     gnus-format-specs)
1723   "Gnus variables saved in the quick startup file.")
1724
1725 (defvar gnus-newsrc-options nil
1726   "Options line in the .newsrc file.")
1727
1728 (defvar gnus-newsrc-options-n nil
1729   "List of regexps representing groups to be subscribed/ignored unconditionally.")
1730
1731 (defvar gnus-newsrc-last-checked-date nil
1732   "Date Gnus last asked server for new newsgroups.")
1733
1734 (defvar gnus-topic-topology nil
1735   "The complete topic hierarchy.")
1736
1737 (defvar gnus-topic-alist nil
1738   "The complete topic-group alist.")
1739
1740 (defvar gnus-newsrc-alist nil
1741   "Assoc list of read articles.
1742 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1743
1744 (defvar gnus-newsrc-hashtb nil
1745   "Hashtable of gnus-newsrc-alist.")
1746
1747 (defvar gnus-killed-list nil
1748   "List of killed newsgroups.")
1749
1750 (defvar gnus-killed-hashtb nil
1751   "Hash table equivalent of gnus-killed-list.")
1752
1753 (defvar gnus-zombie-list nil
1754   "List of almost dead newsgroups.")
1755
1756 (defvar gnus-description-hashtb nil
1757   "Descriptions of newsgroups.")
1758
1759 (defvar gnus-list-of-killed-groups nil
1760   "List of newsgroups that have recently been killed by the user.")
1761
1762 (defvar gnus-active-hashtb nil
1763   "Hashtable of active articles.")
1764
1765 (defvar gnus-moderated-list nil
1766   "List of moderated newsgroups.")
1767
1768 (defvar gnus-group-marked nil)
1769
1770 (defvar gnus-current-startup-file nil
1771   "Startup file for the current host.")
1772
1773 (defvar gnus-last-search-regexp nil
1774   "Default regexp for article search command.")
1775
1776 (defvar gnus-last-shell-command nil
1777   "Default shell command on article.")
1778
1779 (defvar gnus-current-select-method nil
1780   "The current method for selecting a newsgroup.")
1781
1782 (defvar gnus-group-list-mode nil)
1783
1784 (defvar gnus-article-internal-prepare-hook nil)
1785
1786 (defvar gnus-newsgroup-name nil)
1787 (defvar gnus-newsgroup-begin nil)
1788 (defvar gnus-newsgroup-end nil)
1789 (defvar gnus-newsgroup-last-rmail nil)
1790 (defvar gnus-newsgroup-last-mail nil)
1791 (defvar gnus-newsgroup-last-folder nil)
1792 (defvar gnus-newsgroup-last-file nil)
1793 (defvar gnus-newsgroup-auto-expire nil)
1794 (defvar gnus-newsgroup-active nil)
1795
1796 (defvar gnus-newsgroup-data nil)
1797 (defvar gnus-newsgroup-data-reverse nil)
1798 (defvar gnus-newsgroup-limit nil)
1799 (defvar gnus-newsgroup-limits nil)
1800
1801 (defvar gnus-newsgroup-unreads nil
1802   "List of unread articles in the current newsgroup.")
1803
1804 (defvar gnus-newsgroup-unselected nil
1805   "List of unselected unread articles in the current newsgroup.")
1806
1807 (defvar gnus-newsgroup-reads nil
1808   "Alist of read articles and article marks in the current newsgroup.")
1809
1810 (defvar gnus-newsgroup-expunged-tally nil)
1811
1812 (defvar gnus-newsgroup-marked nil
1813   "List of ticked articles in the current newsgroup (a subset of unread art).")
1814
1815 (defvar gnus-newsgroup-killed nil
1816   "List of ranges of articles that have been through the scoring process.")
1817
1818 (defvar gnus-newsgroup-cached nil
1819   "List of articles that come from the article cache.")
1820
1821 (defvar gnus-newsgroup-saved nil
1822   "List of articles that have been saved.")
1823
1824 (defvar gnus-newsgroup-kill-headers nil)
1825
1826 (defvar gnus-newsgroup-replied nil
1827   "List of articles that have been replied to in the current newsgroup.")
1828
1829 (defvar gnus-newsgroup-expirable nil
1830   "List of articles in the current newsgroup that can be expired.")
1831
1832 (defvar gnus-newsgroup-processable nil
1833   "List of articles in the current newsgroup that can be processed.")
1834
1835 (defvar gnus-newsgroup-bookmarks nil
1836   "List of articles in the current newsgroup that have bookmarks.")
1837
1838 (defvar gnus-newsgroup-dormant nil
1839   "List of dormant articles in the current newsgroup.")
1840
1841 (defvar gnus-newsgroup-scored nil
1842   "List of scored articles in the current newsgroup.")
1843
1844 (defvar gnus-newsgroup-headers nil
1845   "List of article headers in the current newsgroup.")
1846
1847 (defvar gnus-newsgroup-threads nil)
1848
1849 (defvar gnus-newsgroup-prepared nil
1850   "Whether the current group has been prepared properly.")
1851
1852 (defvar gnus-newsgroup-ancient nil
1853   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1854
1855 (defvar gnus-newsgroup-sparse nil)
1856
1857 (defvar gnus-current-article nil)
1858 (defvar gnus-article-current nil)
1859 (defvar gnus-current-headers nil)
1860 (defvar gnus-have-all-headers nil)
1861 (defvar gnus-last-article nil)
1862 (defvar gnus-newsgroup-history nil)
1863 (defvar gnus-current-kill-article nil)
1864
1865 ;; Save window configuration.
1866 (defvar gnus-prev-winconf nil)
1867
1868 (defvar gnus-summary-mark-positions nil)
1869 (defvar gnus-group-mark-positions nil)
1870
1871 (defvar gnus-reffed-article-number nil)
1872
1873 ;;; Let the byte-compiler know that we know about this variable.
1874 (defvar rmail-default-rmail-file)
1875
1876 (defvar gnus-cache-removable-articles nil)
1877
1878 (defvar gnus-dead-summary nil)
1879
1880 (defconst gnus-summary-local-variables
1881   '(gnus-newsgroup-name
1882     gnus-newsgroup-begin gnus-newsgroup-end
1883     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1884     gnus-newsgroup-last-folder gnus-newsgroup-last-file
1885     gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1886     gnus-newsgroup-unselected gnus-newsgroup-marked
1887     gnus-newsgroup-reads gnus-newsgroup-saved
1888     gnus-newsgroup-replied gnus-newsgroup-expirable
1889     gnus-newsgroup-processable gnus-newsgroup-killed
1890     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1891     gnus-newsgroup-headers gnus-newsgroup-threads
1892     gnus-newsgroup-prepared gnus-summary-highlight-line-function
1893     gnus-current-article gnus-current-headers gnus-have-all-headers
1894     gnus-last-article gnus-article-internal-prepare-hook
1895     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1896     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1897     gnus-newsgroup-async 
1898     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
1899     gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
1900     gnus-newsgroup-history gnus-newsgroup-ancient
1901     gnus-newsgroup-sparse
1902     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1903     gnus-newsgroup-adaptive-score-file
1904     (gnus-newsgroup-expunged-tally . 0)
1905     gnus-cache-removable-articles gnus-newsgroup-cached
1906     gnus-newsgroup-data gnus-newsgroup-data-reverse
1907     gnus-newsgroup-limit gnus-newsgroup-limits)
1908   "Variables that are buffer-local to the summary buffers.")
1909
1910 (defconst gnus-bug-message
1911   "Sending a bug report to the Gnus Towers.
1912 ========================================
1913
1914 The buffer below is a mail buffer.  When you press `C-c C-c', it will
1915 be sent to the Gnus Bug Exterminators.
1916
1917 At the bottom of the buffer you'll see lots of variable settings.
1918 Please do not delete those.  They will tell the Bug People what your
1919 environment is, so that it will be easier to locate the bugs.
1920
1921 If you have found a bug that makes Emacs go \"beep\", set
1922 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
1923 and include the backtrace in your bug report.
1924
1925 Please describe the bug in annoying, painstaking detail.
1926
1927 Thank you for your help in stamping out bugs.
1928 ")
1929
1930 ;;; End of variables.
1931
1932 ;; Define some autoload functions Gnus might use.
1933 (eval-and-compile
1934
1935   ;; This little mapcar goes through the list below and marks the
1936   ;; symbols in question as autoloaded functions.
1937   (mapcar
1938    (lambda (package)
1939      (let ((interactive (nth 1 (memq ':interactive package))))
1940        (mapcar
1941         (lambda (function)
1942           (let (keymap)
1943             (when (consp function)
1944               (setq keymap (car (memq 'keymap function)))
1945               (setq function (car function)))
1946             (autoload function (car package) nil interactive keymap)))
1947         (if (eq (nth 1 package) ':interactive)
1948             (cdddr package)
1949           (cdr package)))))
1950    '(("metamail" metamail-buffer)
1951      ("info" Info-goto-node)
1952      ("hexl" hexl-hex-string-to-integer)
1953      ("pp" pp pp-to-string pp-eval-expression)
1954      ("mail-extr" mail-extract-address-components)
1955      ("nnmail" nnmail-split-fancy nnmail-article-group)
1956      ("nnvirtual" nnvirtual-catchup-group)
1957      ("timezone" timezone-make-date-arpa-standard timezone-fix-time
1958       timezone-make-sortable-date timezone-make-time-string)
1959      ("sendmail" mail-position-on-field mail-setup)
1960      ("rmailout" rmail-output)
1961      ("rnewspost" news-mail-other-window news-reply-yank-original
1962       news-caesar-buffer-body)
1963      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
1964       rmail-show-message)
1965      ("gnus-soup" :interactive t
1966       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
1967       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1968      ("nnsoup" nnsoup-pack-replies)
1969      ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
1970       gnus-Folder-save-name gnus-folder-save-name)
1971      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
1972      ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
1973       gnus-server-make-menu-bar gnus-article-make-menu-bar
1974       gnus-browse-make-menu-bar gnus-highlight-selected-summary
1975       gnus-summary-highlight-line gnus-carpal-setup-buffer
1976       gnus-group-highlight-line
1977       gnus-article-add-button gnus-insert-next-page-button
1978       gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu)
1979      ("gnus-vis" :interactive t
1980       gnus-article-push-button gnus-article-press-button
1981       gnus-article-highlight gnus-article-highlight-some
1982       gnus-article-highlight-headers gnus-article-highlight-signature
1983       gnus-article-add-buttons gnus-article-add-buttons-to-head
1984       gnus-article-next-button gnus-article-prev-button)
1985      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
1986       gnus-demon-add-disconnection gnus-demon-add-handler
1987       gnus-demon-remove-handler)
1988      ("gnus-demon" :interactive t
1989       gnus-demon-init gnus-demon-cancel)
1990      ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
1991       gnus-tree-open gnus-tree-close)
1992      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
1993       gnus-nocem-unwanted-article-p)
1994      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
1995      ("gnus-srvr" gnus-browse-foreign-server)
1996      ("gnus-cite" :interactive t
1997       gnus-article-highlight-citation gnus-article-hide-citation-maybe
1998       gnus-article-hide-citation gnus-article-fill-cited-article)
1999      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
2000       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
2001       gnus-execute gnus-expunge)
2002      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
2003       gnus-cache-possibly-remove-articles gnus-cache-request-article
2004       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
2005       gnus-cache-enter-remove-article gnus-cached-article-p
2006       gnus-cache-open gnus-cache-close gnus-cache-update-article)
2007      ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
2008       gnus-cache-remove-article)
2009      ("gnus-score" :interactive t
2010       gnus-summary-increase-score gnus-summary-lower-score
2011       gnus-score-flush-cache gnus-score-close
2012       gnus-score-raise-same-subject-and-select
2013       gnus-score-raise-same-subject gnus-score-default
2014       gnus-score-raise-thread gnus-score-lower-same-subject-and-select
2015       gnus-score-lower-same-subject gnus-score-lower-thread
2016       gnus-possibly-score-headers)
2017      ("gnus-score"
2018       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
2019       gnus-current-score-file-nondirectory gnus-score-adaptive
2020       gnus-score-find-trace gnus-score-file-name)
2021      ("gnus-edit" :interactive t gnus-score-customize)
2022      ("gnus-topic" :interactive t gnus-topic-mode)
2023      ("gnus-topic" gnus-topic-remove-group)
2024      ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
2025      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
2026      ("gnus-uu" :interactive t
2027       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
2028       gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
2029       gnus-uu-mark-by-regexp gnus-uu-mark-all
2030       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
2031       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
2032       gnus-uu-decode-unshar-and-save gnus-uu-decode-save
2033       gnus-uu-decode-binhex gnus-uu-decode-uu-view
2034       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
2035       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
2036       gnus-uu-decode-binhex-view)
2037      ("gnus-msg" (gnus-summary-send-map keymap)
2038       gnus-mail-yank-original gnus-mail-send-and-exit
2039       gnus-sendmail-setup-mail gnus-article-mail
2040       gnus-inews-message-id gnus-new-mail gnus-mail-reply)
2041      ("gnus-msg" :interactive t
2042       gnus-group-post-news gnus-group-mail gnus-summary-post-news
2043       gnus-summary-followup gnus-summary-followup-with-original
2044       gnus-summary-followup-and-reply
2045       gnus-summary-followup-and-reply-with-original
2046       gnus-summary-cancel-article gnus-summary-supersede-article
2047       gnus-post-news gnus-inews-news gnus-cancel-news
2048       gnus-summary-reply gnus-summary-reply-with-original
2049       gnus-summary-mail-forward gnus-summary-mail-other-window
2050       gnus-bug)
2051      ("gnus-picon" :interactive t gnus-article-display-picons
2052       gnus-group-display-picons gnus-picons-article-display-x-face)
2053      ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p 
2054       gnus-grouplens-mode)
2055      ("gnus-vm" gnus-vm-mail-setup)
2056      ("gnus-vm" :interactive t gnus-summary-save-in-vm
2057       gnus-summary-save-article-vm gnus-yank-article))))
2058
2059 \f
2060
2061 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2062 ;; If you want the cursor to go somewhere else, set these two
2063 ;; functions in some startup hook to whatever you want.
2064 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
2065 (defalias 'gnus-group-position-point 'gnus-goto-colon)
2066
2067 ;;; Various macros and substs.
2068
2069 (defun gnus-header-from (header)
2070   (mail-header-from header))
2071
2072 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
2073   "Pop to BUFFER, evaluate FORMS, and then return to the original window."
2074   (let ((tempvar (make-symbol "GnusStartBufferWindow")))
2075     `(let ((,tempvar (selected-window)))
2076        (unwind-protect
2077            (progn
2078              (pop-to-buffer ,buffer)
2079              ,@forms)
2080          (select-window ,tempvar)))))
2081
2082 (defmacro gnus-gethash (string hashtable)
2083   "Get hash value of STRING in HASHTABLE."
2084   `(symbol-value (intern-soft ,string ,hashtable)))
2085
2086 (defmacro gnus-sethash (string value hashtable)
2087   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2088   `(set (intern ,string ,hashtable) ,value))
2089
2090 (defmacro gnus-intern-safe (string hashtable)
2091   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2092   `(let ((symbol (intern ,string ,hashtable)))
2093      (or (boundp symbol)
2094          (set symbol nil))
2095      symbol))
2096
2097 (defmacro gnus-group-unread (group)
2098   "Get the currently computed number of unread articles in GROUP."
2099   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
2100
2101 (defmacro gnus-group-entry (group)
2102   "Get the newsrc entry for GROUP."
2103   `(gnus-gethash ,group gnus-newsrc-hashtb))
2104
2105 (defmacro gnus-active (group)
2106   "Get active info on GROUP."
2107   `(gnus-gethash ,group gnus-active-hashtb))
2108
2109 (defmacro gnus-set-active (group active)
2110   "Set GROUP's active info."
2111   `(gnus-sethash ,group ,active gnus-active-hashtb))
2112
2113 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2114 ;;   function `substring' might cut on a middle of multi-octet
2115 ;;   character.
2116 (defun gnus-truncate-string (str width)
2117   (substring str 0 width))
2118
2119 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
2120 ;; to limit the length of a string.  This function is necessary since
2121 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
2122 (defsubst gnus-limit-string (str width)
2123   (if (> (length str) width)
2124       (substring str 0 width)
2125     str))
2126
2127 (defsubst gnus-simplify-subject-re (subject)
2128   "Remove \"Re:\" from subject lines."
2129   (if (string-match "^[Rr][Ee]: *" subject)
2130       (substring subject (match-end 0))
2131     subject))
2132
2133 (defsubst gnus-functionp (form)
2134   "Return non-nil if FORM is funcallable."
2135   (or (and (symbolp form) (fboundp form))
2136       (and (listp form) (eq (car form) 'lambda))))
2137
2138 (defsubst gnus-goto-char (point)
2139   (and point (goto-char point)))
2140
2141 (defmacro gnus-buffer-exists-p (buffer)
2142   `(let ((buffer ,buffer))
2143      (and buffer
2144           (funcall (if (stringp buffer) 'get-buffer 'buffer-name)
2145                    buffer))))
2146
2147 (defmacro gnus-kill-buffer (buffer)
2148   `(let ((buf ,buffer))
2149      (if (gnus-buffer-exists-p buf)
2150          (kill-buffer buf))))
2151
2152 (defsubst gnus-point-at-bol ()
2153   "Return point at the beginning of the line."
2154   (let ((p (point)))
2155     (beginning-of-line)
2156     (prog1
2157         (point)
2158       (goto-char p))))
2159
2160 (defsubst gnus-point-at-eol ()
2161   "Return point at the end of the line."
2162   (let ((p (point)))
2163     (end-of-line)
2164     (prog1
2165         (point)
2166       (goto-char p))))
2167
2168 (defun gnus-alive-p ()
2169   "Say whether Gnus is running or not."
2170   (and gnus-group-buffer
2171        (get-buffer gnus-group-buffer)))
2172
2173 ;; Delete the current line (and the next N lines.);
2174 (defmacro gnus-delete-line (&optional n)
2175   `(delete-region (progn (beginning-of-line) (point))
2176                   (progn (forward-line ,(or n 1)) (point))))
2177
2178 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
2179 (defvar gnus-init-inhibit nil)
2180 (defun gnus-read-init-file (&optional inhibit-next)
2181   (if gnus-init-inhibit
2182       (setq gnus-init-inhibit nil)
2183     (setq gnus-init-inhibit inhibit-next)
2184     (and gnus-init-file
2185          (or (and (file-exists-p gnus-init-file)
2186                   ;; Don't try to load a directory.
2187                   (not (file-directory-p gnus-init-file)))
2188              (file-exists-p (concat gnus-init-file ".el"))
2189              (file-exists-p (concat gnus-init-file ".elc")))
2190          (condition-case var
2191              (load gnus-init-file nil t)
2192            (error
2193             (error "Error in %s: %s" gnus-init-file var))))))
2194
2195 ;; Info access macros.
2196
2197 (defmacro gnus-info-group (info)
2198   `(nth 0 ,info))
2199 (defmacro gnus-info-rank (info)
2200   `(nth 1 ,info))
2201 (defmacro gnus-info-read (info)
2202   `(nth 2 ,info))
2203 (defmacro gnus-info-marks (info)
2204   `(nth 3 ,info))
2205 (defmacro gnus-info-method (info)
2206   `(nth 4 ,info))
2207 (defmacro gnus-info-params (info)
2208   `(nth 5 ,info))
2209
2210 (defmacro gnus-info-level (info)
2211   `(let ((rank (gnus-info-rank ,info)))
2212      (if (consp rank)
2213          (car rank)
2214        rank)))
2215 (defmacro gnus-info-score (info)
2216   `(let ((rank (gnus-info-rank ,info)))
2217      (or (and (consp rank) (cdr rank)) 0)))
2218
2219 (defmacro gnus-info-set-group (info group)
2220   `(setcar ,info ,group))
2221 (defmacro gnus-info-set-rank (info rank)
2222   `(setcar (nthcdr 1 ,info) ,rank))
2223 (defmacro gnus-info-set-read (info read)
2224   `(setcar (nthcdr 2 ,info) ,read))
2225 (defmacro gnus-info-set-marks (info marks)
2226   `(setcar (nthcdr 3 ,info) ,marks))
2227 (defmacro gnus-info-set-method (info method)
2228   `(setcar (nthcdr 4 ,info) ,method))
2229 (defmacro gnus-info-set-params (info params)
2230   `(setcar (nthcdr 5 ,info) ,params))
2231
2232 (defmacro gnus-info-set-level (info level)
2233   `(let ((rank (cdr ,info)))
2234      (if (consp (car rank))
2235          (setcar (car rank) ,level)
2236        (setcar rank ,level))))
2237 (defmacro gnus-info-set-score (info score)
2238   `(let ((rank (cdr ,info)))
2239      (if (consp (car rank))
2240          (setcdr (car rank) ,score)
2241        (setcar rank (cons (car rank) ,score)))))
2242
2243 (defmacro gnus-get-info (group)
2244   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2245
2246 (defun gnus-byte-code (func)
2247   "Return a form that can be `eval'ed based on FUNC."
2248   (let ((fval (symbol-function func)))
2249     (if (byte-code-function-p fval)
2250         (let ((flist (append fval nil)))
2251           (setcar flist 'byte-code)
2252           flist)
2253       (cons 'progn (cddr fval)))))
2254
2255 ;;; Load the compatability functions.
2256
2257 (require 'gnus-cus)
2258 (require 'gnus-ems)
2259
2260 \f
2261 ;;;
2262 ;;; Shutdown
2263 ;;;
2264
2265 (defvar gnus-shutdown-alist nil)
2266
2267 (defun gnus-add-shutdown (function &rest symbols)
2268   "Run FUNCTION whenever one of SYMBOLS is shut down."
2269   (push (cons function symbols) gnus-shutdown-alist))
2270
2271 (defun gnus-shutdown (symbol)
2272   "Shut down everything that waits for SYMBOL."
2273   (let ((alist gnus-shutdown-alist)
2274         entry)
2275     (while (setq entry (pop alist))
2276       (when (memq symbol (cdr entry))
2277         (funcall (car entry))))))
2278
2279 \f
2280
2281 ;; Format specs.  The chunks below are the machine-generated forms
2282 ;; that are to be evaled as the result of the default format strings.
2283 ;; We write them in here to get them byte-compiled.  That way the
2284 ;; default actions will be quite fast, while still retaining the full
2285 ;; flexibility of the user-defined format specs.
2286
2287 ;; First we have lots of dummy defvars to let the compiler know these
2288 ;; are really dynamic variables.
2289
2290 (defvar gnus-tmp-unread)
2291 (defvar gnus-tmp-replied)
2292 (defvar gnus-tmp-score-char)
2293 (defvar gnus-tmp-indentation)
2294 (defvar gnus-tmp-opening-bracket)
2295 (defvar gnus-tmp-lines)
2296 (defvar gnus-tmp-name)
2297 (defvar gnus-tmp-closing-bracket)
2298 (defvar gnus-tmp-subject-or-nil)
2299 (defvar gnus-tmp-subject)
2300 (defvar gnus-tmp-marked)
2301 (defvar gnus-tmp-marked-mark)
2302 (defvar gnus-tmp-subscribed)
2303 (defvar gnus-tmp-process-marked)
2304 (defvar gnus-tmp-number-of-unread)
2305 (defvar gnus-tmp-group-name)
2306 (defvar gnus-tmp-group)
2307 (defvar gnus-tmp-article-number)
2308 (defvar gnus-tmp-unread-and-unselected)
2309 (defvar gnus-tmp-news-method)
2310 (defvar gnus-tmp-news-server)
2311 (defvar gnus-tmp-article-number)
2312 (defvar gnus-mouse-face)
2313 (defvar gnus-mouse-face-prop)
2314
2315 (defun gnus-summary-line-format-spec ()
2316   (insert gnus-tmp-unread gnus-tmp-replied
2317           gnus-tmp-score-char gnus-tmp-indentation)
2318   (put-text-property
2319    (point)
2320    (progn
2321      (insert
2322       gnus-tmp-opening-bracket
2323       (format "%4d: %-20s"
2324               gnus-tmp-lines
2325               (if (> (length gnus-tmp-name) 20)
2326                   (substring gnus-tmp-name 0 20)
2327                 gnus-tmp-name))
2328       gnus-tmp-closing-bracket)
2329      (point))
2330    gnus-mouse-face-prop gnus-mouse-face)
2331   (insert " " gnus-tmp-subject-or-nil "\n"))
2332
2333 (defvar gnus-summary-line-format-spec
2334   (gnus-byte-code 'gnus-summary-line-format-spec))
2335
2336 (defun gnus-summary-dummy-line-format-spec ()
2337   (insert "*  ")
2338   (put-text-property
2339    (point)
2340    (progn
2341      (insert ":                          :")
2342      (point))
2343    gnus-mouse-face-prop gnus-mouse-face)
2344   (insert " " gnus-tmp-subject "\n"))
2345
2346 (defvar gnus-summary-dummy-line-format-spec
2347   (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
2348
2349 (defun gnus-group-line-format-spec ()
2350   (insert gnus-tmp-marked-mark gnus-tmp-subscribed
2351           gnus-tmp-process-marked
2352           gnus-group-indentation
2353           (format "%5s: " gnus-tmp-number-of-unread))
2354   (put-text-property
2355    (point)
2356    (progn
2357      (insert gnus-tmp-group "\n")
2358      (1- (point)))
2359    gnus-mouse-face-prop gnus-mouse-face))
2360 (defvar gnus-group-line-format-spec
2361   (gnus-byte-code 'gnus-group-line-format-spec))
2362
2363 (defvar gnus-format-specs
2364   `((version . ,emacs-version)
2365     (group ,gnus-group-line-format ,gnus-group-line-format-spec)
2366     (summary-dummy ,gnus-summary-dummy-line-format
2367                    ,gnus-summary-dummy-line-format-spec)
2368     (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec)))
2369
2370 (defvar gnus-article-mode-line-format-spec nil)
2371 (defvar gnus-summary-mode-line-format-spec nil)
2372 (defvar gnus-group-mode-line-format-spec nil)
2373
2374 ;;; Phew.  All that gruft is over, fortunately.
2375
2376 \f
2377 ;;;
2378 ;;; Gnus Utility Functions
2379 ;;;
2380
2381 (defun gnus-extract-address-components (from)
2382   (let (name address)
2383     ;; First find the address - the thing with the @ in it.  This may
2384     ;; not be accurate in mail addresses, but does the trick most of
2385     ;; the time in news messages.
2386     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
2387         (setq address (substring from (match-beginning 0) (match-end 0))))
2388     ;; Then we check whether the "name <address>" format is used.
2389     (and address
2390          ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2391          ;; Linear white space is not required.
2392          (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
2393          (and (setq name (substring from 0 (match-beginning 0)))
2394               ;; Strip any quotes from the name.
2395               (string-match "\".*\"" name)
2396               (setq name (substring name 1 (1- (match-end 0))))))
2397     ;; If not, then "address (name)" is used.
2398     (or name
2399         (and (string-match "(.+)" from)
2400              (setq name (substring from (1+ (match-beginning 0))
2401                                    (1- (match-end 0)))))
2402         (and (string-match "()" from)
2403              (setq name address))
2404         ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
2405         ;; XOVER might not support folded From headers.
2406         (and (string-match "(.*" from)
2407              (setq name (substring from (1+ (match-beginning 0))
2408                                    (match-end 0)))))
2409     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2410     (list (or name from) (or address from))))
2411
2412 (defun gnus-fetch-field (field)
2413   "Return the value of the header FIELD of current article."
2414   (save-excursion
2415     (save-restriction
2416       (let ((case-fold-search t))
2417         (nnheader-narrow-to-headers)
2418         (mail-fetch-field field)))))
2419
2420 (defun gnus-goto-colon ()
2421   (beginning-of-line)
2422   (search-forward ":" (gnus-point-at-eol) t))
2423
2424 ;;;###autoload
2425 (defun gnus-update-format (var)
2426   "Update the format specification near point."
2427   (interactive
2428    (list
2429     (save-excursion
2430       (eval-defun nil)
2431       ;; Find the end of the current word.
2432       (re-search-forward "[ \t\n]" nil t)
2433       ;; Search backward.
2434       (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
2435         (match-string 1)))))
2436   (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
2437                               (match-string 1 var))))
2438          (entry (assq type gnus-format-specs))
2439          value spec)
2440     (when entry
2441       (setq gnus-format-specs (delq entry gnus-format-specs)))
2442     (set
2443      (intern (format "%s-spec" var))
2444      (gnus-parse-format (setq value (symbol-value (intern var)))
2445                         (symbol-value (intern (format "%s-alist" var)))
2446                         (not (string-match "mode" var))))
2447     (setq spec (symbol-value (intern (format "%s-spec" var))))
2448     (push (list type value spec) gnus-format-specs)
2449
2450     (pop-to-buffer "*Gnus Format*")
2451     (erase-buffer)
2452     (lisp-interaction-mode)
2453     (insert (pp-to-string spec))))
2454
2455 (defun gnus-update-format-specifications (&optional force)
2456   "Update all (necessary) format specifications."
2457   ;; Make the indentation array.
2458   (gnus-make-thread-indent-array)
2459
2460   ;; See whether all the stored info needs to be flushed.
2461   (when (or force
2462             (not (equal emacs-version
2463                         (cdr (assq 'version gnus-format-specs)))))
2464     (setq gnus-format-specs nil))
2465
2466   ;; Go through all the formats and see whether they need updating.
2467   (let ((types '(summary summary-dummy group
2468                          summary-mode group-mode article-mode))
2469         new-format entry type val)
2470     (while (setq type (pop types))
2471       ;; Jump to the proper buffer to find out the value of
2472       ;; the variable, if possible.  (It may be buffer-local.)
2473       (save-excursion
2474         (let ((buffer (intern (format "gnus-%s-buffer" type)))
2475               val)
2476           (when (and (boundp buffer)
2477                      (setq val (symbol-value buffer))
2478                      (get-buffer val)
2479                      (buffer-name (get-buffer val)))
2480             (set-buffer (get-buffer val)))
2481           (setq new-format (symbol-value
2482                             (intern (format "gnus-%s-line-format" type))))))
2483       (setq entry (cdr (assq type gnus-format-specs)))
2484       (if (and entry
2485                (equal (car entry) new-format))
2486           ;; Use the old format.
2487           (set (intern (format "gnus-%s-line-format-spec" type))
2488                (cadr entry))
2489         ;; This is a new format.
2490         (setq val
2491               (if (not (stringp new-format))
2492                   ;; This is a function call or something.
2493                   new-format
2494                 ;; This is a "real" format.
2495                 (gnus-parse-format
2496                  new-format
2497                  (symbol-value
2498                   (intern (format "gnus-%s-line-format-alist"
2499                                   (if (eq type 'article-mode)
2500                                       'summary-mode type))))
2501                  (not (string-match "mode$" (symbol-name type))))))
2502         ;; Enter the new format spec into the list.
2503         (if entry
2504             (progn
2505               (setcar (cdr entry) val)
2506               (setcar entry new-format))
2507           (push (list type new-format val) gnus-format-specs))
2508         (set (intern (format "gnus-%s-line-format-spec" type)) val))))
2509
2510   (unless (assq 'version gnus-format-specs)
2511     (push (cons 'version emacs-version) gnus-format-specs))
2512
2513   (gnus-update-group-mark-positions)
2514   (gnus-update-summary-mark-positions))
2515
2516 (defun gnus-update-summary-mark-positions ()
2517   "Compute where the summary marks are to go."
2518   (save-excursion
2519     (let ((gnus-replied-mark 129)
2520           (gnus-score-below-mark 130)
2521           (gnus-score-over-mark 130)
2522           (thread nil)
2523           (gnus-visual nil)
2524           pos)
2525       (gnus-set-work-buffer)
2526       (gnus-summary-insert-line
2527        [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
2528       (goto-char (point-min))
2529       (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
2530                                          (- (point) 2)))))
2531       (goto-char (point-min))
2532       (push (cons 'replied (and (search-forward "\201" nil t) (- (point) 2)))
2533             pos)
2534       (goto-char (point-min))
2535       (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
2536             pos)
2537       (setq gnus-summary-mark-positions pos))))
2538
2539 (defun gnus-update-group-mark-positions ()
2540   (save-excursion
2541     (let ((gnus-process-mark 128)
2542           (gnus-group-marked '("dummy.group")))
2543       (gnus-set-active "dummy.group" '(0 . 0))
2544       (gnus-set-work-buffer)
2545       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
2546       (goto-char (point-min))
2547       (setq gnus-group-mark-positions
2548             (list (cons 'process (and (search-forward "\200" nil t)
2549                                       (- (point) 2))))))))
2550
2551 (defvar gnus-mouse-face-0 'highlight)
2552 (defvar gnus-mouse-face-1 'highlight)
2553 (defvar gnus-mouse-face-2 'highlight)
2554 (defvar gnus-mouse-face-3 'highlight)
2555 (defvar gnus-mouse-face-4 'highlight)
2556
2557 (defun gnus-mouse-face-function (form type)
2558   `(put-text-property
2559     (point) (progn ,@form (point))
2560     gnus-mouse-face-prop
2561     ,(if (equal type 0)
2562          'gnus-mouse-face
2563        `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
2564
2565 (defvar gnus-face-0 'bold)
2566 (defvar gnus-face-1 'italic)
2567 (defvar gnus-face-2 'bold-italic)
2568 (defvar gnus-face-3 'bold)
2569 (defvar gnus-face-4 'bold)
2570
2571 (defun gnus-face-face-function (form type)
2572   `(put-text-property
2573     (point) (progn ,@form (point))
2574     'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
2575
2576 (defun gnus-max-width-function (el max-width)
2577   (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
2578   (if (symbolp el)
2579       `(if (> (length ,el) ,max-width)
2580            (substring ,el 0 ,max-width)
2581          ,el)
2582     `(let ((val (eval ,el)))
2583        (if (numberp val)
2584            (setq val (int-to-string val)))
2585        (if (> (length val) ,max-width)
2586            (substring val 0 ,max-width)
2587          val))))
2588
2589 (defun gnus-parse-format (format spec-alist &optional insert)
2590   ;; This function parses the FORMAT string with the help of the
2591   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
2592   ;; string.  If the FORMAT string contains the specifiers %( and %)
2593   ;; the text between them will have the mouse-face text property.
2594   (if (string-match
2595        "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
2596        format)
2597       (gnus-parse-complex-format format spec-alist)
2598     ;; This is a simple format.
2599     (gnus-parse-simple-format format spec-alist insert)))
2600
2601 (defun gnus-parse-complex-format (format spec-alist)
2602   (save-excursion
2603     (gnus-set-work-buffer)
2604     (insert format)
2605     (goto-char (point-min))
2606     (while (re-search-forward "\"" nil t)
2607       (replace-match "\\\"" nil t))
2608     (goto-char (point-min))
2609     (insert "(\"")
2610     (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
2611       (let ((number (if (match-beginning 1)
2612                         (match-string 1) "0"))
2613             (delim (aref (match-string 2) 0)))
2614         (if (or (= delim ?\() (= delim ?\{))
2615             (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
2616                                    " " number " \""))
2617           (replace-match "\")\""))))
2618     (goto-char (point-max))
2619     (insert "\")")
2620     (goto-char (point-min))
2621     (let ((form (read (current-buffer))))
2622       (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
2623
2624 (defun gnus-complex-form-to-spec (form spec-alist)
2625   (delq nil
2626         (mapcar
2627          (lambda (sform)
2628            (if (stringp sform)
2629                (gnus-parse-simple-format sform spec-alist t)
2630              (funcall (intern (format "gnus-%s-face-function" (car sform)))
2631                       (gnus-complex-form-to-spec (cddr sform) spec-alist)
2632                       (nth 1 sform))))
2633          form)))
2634
2635 (defun gnus-parse-simple-format (format spec-alist &optional insert)
2636   ;; This function parses the FORMAT string with the help of the
2637   ;; SPEC-ALIST and returns a list that can be eval'ed to return a
2638   ;; string.
2639   (let ((max-width 0)
2640         spec flist fstring newspec elem beg result dontinsert)
2641     (save-excursion
2642       (gnus-set-work-buffer)
2643       (insert format)
2644       (goto-char (point-min))
2645       (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
2646                                 nil t)
2647         (if (= (setq spec (string-to-char (match-string 2))) ?%)
2648               (setq newspec "%"
2649                     beg (1+ (match-beginning 0)))
2650           ;; First check if there are any specs that look anything like
2651           ;; "%12,12A", ie. with a "max width specification".  These have
2652           ;; to be treated specially.
2653           (if (setq beg (match-beginning 1))
2654               (setq max-width
2655                     (string-to-int
2656                      (buffer-substring
2657                       (1+ (match-beginning 1)) (match-end 1))))
2658             (setq max-width 0)
2659             (setq beg (match-beginning 2)))
2660           ;; Find the specification from `spec-alist'.
2661           (unless (setq elem (cdr (assq spec spec-alist)))
2662             (setq elem '("*" ?s)))
2663           ;; Treat user defined format specifiers specially.
2664           (when (eq (car elem) 'gnus-tmp-user-defined)
2665             (setq elem
2666                   (list
2667                    (list (intern (concat "gnus-user-format-function-"
2668                                          (match-string 3)))
2669                          'gnus-tmp-header) ?s))
2670             (delete-region (match-beginning 3) (match-end 3)))
2671           (if (not (zerop max-width))
2672               (let ((el (car elem)))
2673                 (cond ((= (cadr elem) ?c)
2674                        (setq el (list 'char-to-string el)))
2675                       ((= (cadr elem) ?d)
2676                        (setq el (list 'int-to-string el))))
2677                 (setq flist (cons (gnus-max-width-function el max-width)
2678                                   flist))
2679                 (setq newspec ?s))
2680             (progn
2681               (setq flist (cons (car elem) flist))
2682               (setq newspec (cadr elem)))))
2683         ;; Remove the old specification (and possibly a ",12" string).
2684         (delete-region beg (match-end 2))
2685         ;; Insert the new specification.
2686         (goto-char beg)
2687         (insert newspec))
2688       (setq fstring (buffer-substring 1 (point-max))))
2689     ;; Do some postprocessing to increase efficiency.
2690     (setq
2691      result
2692      (cond
2693       ;; Emptyness.
2694       ((string= fstring "")
2695        nil)
2696       ;; Not a format string.
2697       ((not (string-match "%" fstring))
2698        (list fstring))
2699       ;; A format string with just a single string spec.
2700       ((string= fstring "%s")
2701        (list (car flist)))
2702       ;; A single character.
2703       ((string= fstring "%c")
2704        (list (car flist)))
2705       ;; A single number.
2706       ((string= fstring "%d")
2707        (setq dontinsert)
2708        (if insert
2709            (list `(princ ,(car flist)))
2710          (list `(int-to-string ,(car flist)))))
2711       ;; Just lots of chars and strings.
2712       ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
2713        (nreverse flist))
2714       ;; A single string spec at the beginning of the spec.
2715       ((string-match "\\`%[sc][^%]+\\'" fstring)
2716        (list (car flist) (substring fstring 2)))
2717       ;; A single string spec in the middle of the spec.
2718       ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
2719        (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
2720       ;; A single string spec in the end of the spec.
2721       ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
2722        (list (match-string 1 fstring) (car flist)))
2723       ;; A more complex spec.
2724       (t
2725        (list (cons 'format (cons fstring (nreverse flist)))))))
2726
2727     (if insert
2728         (when result
2729           (if dontinsert
2730               result
2731             (cons 'insert result)))
2732       (cond ((stringp result)
2733              result)
2734             ((consp result)
2735              (cons 'concat result))
2736             (t "")))))
2737
2738 (defun gnus-eval-format (format &optional alist props)
2739   "Eval the format variable FORMAT, using ALIST.
2740 If PROPS, insert the result."
2741   (let ((form (gnus-parse-format format alist props)))
2742     (if props
2743         (add-text-properties (point) (progn (eval form) (point)) props)
2744       (eval form))))
2745
2746 (defun gnus-remove-text-with-property (prop)
2747   "Delete all text in the current buffer with text property PROP."
2748   (save-excursion
2749     (goto-char (point-min))
2750     (while (not (eobp))
2751       (while (get-text-property (point) prop)
2752         (delete-char 1))
2753       (goto-char (next-single-property-change (point) prop nil (point-max))))))
2754
2755 (defun gnus-set-work-buffer ()
2756   (if (get-buffer gnus-work-buffer)
2757       (progn
2758         (set-buffer gnus-work-buffer)
2759         (erase-buffer))
2760     (set-buffer (get-buffer-create gnus-work-buffer))
2761     (kill-all-local-variables)
2762     (buffer-disable-undo (current-buffer))
2763     (gnus-add-current-to-buffer-list)))
2764
2765 ;; Article file names when saving.
2766
2767 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
2768   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2769 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
2770 Otherwise, it is like ~/News/news/group/num."
2771   (let ((default
2772           (expand-file-name
2773            (concat (if (gnus-use-long-file-name 'not-save)
2774                        (gnus-capitalize-newsgroup newsgroup)
2775                      (gnus-newsgroup-directory-form newsgroup))
2776                    "/" (int-to-string (mail-header-number headers)))
2777            (or gnus-article-save-directory "~/News"))))
2778     (if (and last-file
2779              (string-equal (file-name-directory default)
2780                            (file-name-directory last-file))
2781              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2782         default
2783       (or last-file default))))
2784
2785 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
2786   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2787 If variable `gnus-use-long-file-name' is non-nil, it is
2788 ~/News/news.group/num.  Otherwise, it is like ~/News/news/group/num."
2789   (let ((default
2790           (expand-file-name
2791            (concat (if (gnus-use-long-file-name 'not-save)
2792                        newsgroup
2793                      (gnus-newsgroup-directory-form newsgroup))
2794                    "/" (int-to-string (mail-header-number headers)))
2795            (or gnus-article-save-directory "~/News"))))
2796     (if (and last-file
2797              (string-equal (file-name-directory default)
2798                            (file-name-directory last-file))
2799              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2800         default
2801       (or last-file default))))
2802
2803 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
2804   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2805 If variable `gnus-use-long-file-name' is non-nil, it is
2806 ~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
2807   (or last-file
2808       (expand-file-name
2809        (if (gnus-use-long-file-name 'not-save)
2810            (gnus-capitalize-newsgroup newsgroup)
2811          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2812        (or gnus-article-save-directory "~/News"))))
2813
2814 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2815   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2816 If variable `gnus-use-long-file-name' is non-nil, it is
2817 ~/News/news.group.  Otherwise, it is like ~/News/news/group/news."
2818   (or last-file
2819       (expand-file-name
2820        (if (gnus-use-long-file-name 'not-save)
2821            newsgroup
2822          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2823        (or gnus-article-save-directory "~/News"))))
2824
2825 ;; For subscribing new newsgroup
2826
2827 (defun gnus-subscribe-hierarchical-interactive (groups)
2828   (let ((groups (sort groups 'string<))
2829         prefixes prefix start ans group starts)
2830     (while groups
2831       (setq prefixes (list "^"))
2832       (while (and groups prefixes)
2833         (while (not (string-match (car prefixes) (car groups)))
2834           (setq prefixes (cdr prefixes)))
2835         (setq prefix (car prefixes))
2836         (setq start (1- (length prefix)))
2837         (if (and (string-match "[^\\.]\\." (car groups) start)
2838                  (cdr groups)
2839                  (setq prefix
2840                        (concat "^" (substring (car groups) 0 (match-end 0))))
2841                  (string-match prefix (cadr groups)))
2842             (progn
2843               (setq prefixes (cons prefix prefixes))
2844               (message "Descend hierarchy %s? ([y]nsq): "
2845                        (substring prefix 1 (1- (length prefix))))
2846               (setq ans (read-char))
2847               (cond ((= ans ?n)
2848                      (while (and groups
2849                                  (string-match prefix
2850                                                (setq group (car groups))))
2851                        (setq gnus-killed-list
2852                              (cons group gnus-killed-list))
2853                        (gnus-sethash group group gnus-killed-hashtb)
2854                        (setq groups (cdr groups)))
2855                      (setq starts (cdr starts)))
2856                     ((= ans ?s)
2857                      (while (and groups
2858                                  (string-match prefix
2859                                                (setq group (car groups))))
2860                        (gnus-sethash group group gnus-killed-hashtb)
2861                        (gnus-subscribe-alphabetically (car groups))
2862                        (setq groups (cdr groups)))
2863                      (setq starts (cdr starts)))
2864                     ((= ans ?q)
2865                      (while groups
2866                        (setq group (car groups))
2867                        (setq gnus-killed-list (cons group gnus-killed-list))
2868                        (gnus-sethash group group gnus-killed-hashtb)
2869                        (setq groups (cdr groups))))
2870                     (t nil)))
2871           (message "Subscribe %s? ([n]yq)" (car groups))
2872           (setq ans (read-char))
2873           (setq group (car groups))
2874           (cond ((= ans ?y)
2875                  (gnus-subscribe-alphabetically (car groups))
2876                  (gnus-sethash group group gnus-killed-hashtb))
2877                 ((= ans ?q)
2878                  (while groups
2879                    (setq group (car groups))
2880                    (setq gnus-killed-list (cons group gnus-killed-list))
2881                    (gnus-sethash group group gnus-killed-hashtb)
2882                    (setq groups (cdr groups))))
2883                 (t
2884                  (setq gnus-killed-list (cons group gnus-killed-list))
2885                  (gnus-sethash group group gnus-killed-hashtb)))
2886           (setq groups (cdr groups)))))))
2887
2888 (defun gnus-subscribe-randomly (newsgroup)
2889   "Subscribe new NEWSGROUP by making it the first newsgroup."
2890   (gnus-subscribe-newsgroup newsgroup))
2891
2892 (defun gnus-subscribe-alphabetically (newgroup)
2893   "Subscribe new NEWSGROUP and insert it in alphabetical order."
2894   (let ((groups (cdr gnus-newsrc-alist))
2895         before)
2896     (while (and (not before) groups)
2897       (if (string< newgroup (caar groups))
2898           (setq before (caar groups))
2899         (setq groups (cdr groups))))
2900     (gnus-subscribe-newsgroup newgroup before)))
2901
2902 (defun gnus-subscribe-hierarchically (newgroup)
2903   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
2904   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2905   (save-excursion
2906     (set-buffer (find-file-noselect gnus-current-startup-file))
2907     (let ((groupkey newgroup)
2908           before)
2909       (while (and (not before) groupkey)
2910         (goto-char (point-min))
2911         (let ((groupkey-re
2912                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
2913           (while (and (re-search-forward groupkey-re nil t)
2914                       (progn
2915                         (setq before (match-string 1))
2916                         (string< before newgroup)))))
2917         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
2918         (setq groupkey
2919               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
2920                   (substring groupkey (match-beginning 1) (match-end 1)))))
2921       (gnus-subscribe-newsgroup newgroup before))))
2922
2923 (defun gnus-subscribe-interactively (group)
2924   "Subscribe the new GROUP interactively.
2925 It is inserted in hierarchical newsgroup order if subscribed.  If not,
2926 it is killed."
2927   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
2928       (gnus-subscribe-hierarchically group)
2929     (push group gnus-killed-list)))
2930
2931 (defun gnus-subscribe-zombies (group)
2932   "Make the new GROUP into a zombie group."
2933   (push group gnus-zombie-list))
2934
2935 (defun gnus-subscribe-killed (group)
2936   "Make the new GROUP a killed group."
2937   (push group gnus-killed-list))
2938
2939 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
2940   "Subscribe new NEWSGROUP.
2941 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
2942 the first newsgroup."
2943   ;; We subscribe the group by changing its level to `subscribed'.
2944   (gnus-group-change-level
2945    newsgroup gnus-level-default-subscribed
2946    gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
2947   (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
2948
2949 ;; For directories
2950
2951 (defun gnus-newsgroup-directory-form (newsgroup)
2952   "Make hierarchical directory name from NEWSGROUP name."
2953   (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
2954         (len (length newsgroup))
2955         idx)
2956     ;; If this is a foreign group, we don't want to translate the
2957     ;; entire name.
2958     (if (setq idx (string-match ":" newsgroup))
2959         (aset newsgroup idx ?/)
2960       (setq idx 0))
2961     ;; Replace all occurrences of `.' with `/'.
2962     (while (< idx len)
2963       (if (= (aref newsgroup idx) ?.)
2964           (aset newsgroup idx ?/))
2965       (setq idx (1+ idx)))
2966     newsgroup))
2967
2968 (defun gnus-newsgroup-savable-name (group)
2969   ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
2970   ;; with dots.
2971   (nnheader-replace-chars-in-string group ?/ ?.))
2972
2973 (defun gnus-make-directory (dir)
2974   "Make DIRECTORY recursively."
2975   ;; Why don't we use `(make-directory dir 'parents)'?  That's just one
2976   ;; of the many mysteries of the universe.
2977   (let* ((dir (expand-file-name dir default-directory))
2978          dirs err)
2979     (if (string-match "/$" dir)
2980         (setq dir (substring dir 0 (match-beginning 0))))
2981     ;; First go down the path until we find a directory that exists.
2982     (while (not (file-exists-p dir))
2983       (setq dirs (cons dir dirs))
2984       (string-match "/[^/]+$" dir)
2985       (setq dir (substring dir 0 (match-beginning 0))))
2986     ;; Then create all the subdirs.
2987     (while (and dirs (not err))
2988       (condition-case ()
2989           (make-directory (car dirs))
2990         (error (setq err t)))
2991       (setq dirs (cdr dirs)))
2992     ;; We return whether we were successful or not.
2993     (not dirs)))
2994
2995 (defun gnus-capitalize-newsgroup (newsgroup)
2996   "Capitalize NEWSGROUP name."
2997   (and (not (zerop (length newsgroup)))
2998        (concat (char-to-string (upcase (aref newsgroup 0)))
2999                (substring newsgroup 1))))
3000
3001 ;; Various... things.
3002
3003 (defun gnus-simplify-subject (subject &optional re-only)
3004   "Remove `Re:' and words in parentheses.
3005 If RE-ONLY is non-nil, strip leading `Re:'s only."
3006   (let ((case-fold-search t))           ;Ignore case.
3007     ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
3008     (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
3009       (setq subject (substring subject (match-end 0))))
3010     ;; Remove uninteresting prefixes.
3011     (if (and (not re-only)
3012              gnus-simplify-ignored-prefixes
3013              (string-match gnus-simplify-ignored-prefixes subject))
3014         (setq subject (substring subject (match-end 0))))
3015     ;; Remove words in parentheses from end.
3016     (unless re-only
3017       (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
3018         (setq subject (substring subject 0 (match-beginning 0)))))
3019     ;; Return subject string.
3020     subject))
3021
3022 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
3023 ;; all whitespace.
3024 ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
3025 (defun gnus-simplify-buffer-fuzzy ()
3026   (goto-char (point-min))
3027   (while (search-forward "\t" nil t)
3028     (replace-match " " t t))
3029   (goto-char (point-min))
3030   (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t)
3031   (goto-char (match-beginning 0))
3032   (while (or
3033           (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
3034           (looking-at "^[[].*: .*[]]$"))
3035     (goto-char (point-min))
3036     (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
3037                               nil t)
3038       (replace-match "" t t))
3039     (goto-char (point-min))
3040     (while (re-search-forward "^[[].*: .*[]]$" nil t)
3041       (goto-char (match-end 0))
3042       (delete-char -1)
3043       (delete-region
3044        (progn (goto-char (match-beginning 0)))
3045        (re-search-forward ":"))))
3046   (goto-char (point-min))
3047   (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t)
3048     (replace-match "" t t))
3049   (goto-char (point-min))
3050   (while (re-search-forward "  +" nil t)
3051     (replace-match " " t t))
3052   (goto-char (point-min))
3053   (while (re-search-forward " $" 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   (when gnus-simplify-subject-fuzzy-regexp
3060     (if (listp gnus-simplify-subject-fuzzy-regexp)
3061         (let ((list gnus-simplify-subject-fuzzy-regexp))
3062           (while list
3063             (goto-char (point-min))
3064             (while (re-search-forward (car list) nil t)
3065               (replace-match "" t t))
3066             (setq list (cdr list))))
3067       (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
3068         (replace-match "" t t)))))
3069
3070 (defun gnus-simplify-subject-fuzzy (subject)
3071   "Siplify a subject string fuzzily."
3072   (save-excursion
3073     (gnus-set-work-buffer)
3074     (let ((case-fold-search t))
3075       (insert subject)
3076       (inline (gnus-simplify-buffer-fuzzy))
3077       (buffer-string))))
3078
3079 ;; Add the current buffer to the list of buffers to be killed on exit.
3080 (defun gnus-add-current-to-buffer-list ()
3081   (or (memq (current-buffer) gnus-buffer-list)
3082       (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
3083
3084 (defun gnus-string> (s1 s2)
3085   (not (or (string< s1 s2)
3086            (string= s1 s2))))
3087
3088 ;;; General various misc type functions.
3089
3090 (defun gnus-clear-system ()
3091   "Clear all variables and buffers."
3092   ;; Clear Gnus variables.
3093   (let ((variables gnus-variable-list))
3094     (while variables
3095       (set (car variables) nil)
3096       (setq variables (cdr variables))))
3097   ;; Clear other internal variables.
3098   (setq gnus-list-of-killed-groups nil
3099         gnus-have-read-active-file nil
3100         gnus-newsrc-alist nil
3101         gnus-newsrc-hashtb nil
3102         gnus-killed-list nil
3103         gnus-zombie-list nil
3104         gnus-killed-hashtb nil
3105         gnus-active-hashtb nil
3106         gnus-moderated-list nil
3107         gnus-description-hashtb nil
3108         gnus-current-headers nil
3109         gnus-thread-indent-array nil
3110         gnus-newsgroup-headers nil
3111         gnus-newsgroup-name nil
3112         gnus-server-alist nil
3113         gnus-group-list-mode nil
3114         gnus-opened-servers nil
3115         gnus-current-select-method nil)
3116   (gnus-shutdown 'gnus)
3117   ;; Kill the startup file.
3118   (and gnus-current-startup-file
3119        (get-file-buffer gnus-current-startup-file)
3120        (kill-buffer (get-file-buffer gnus-current-startup-file)))
3121   ;; Clear the dribble buffer.
3122   (gnus-dribble-clear)
3123   ;; Kill global KILL file buffer.
3124   (when (get-file-buffer (gnus-newsgroup-kill-file nil))
3125     (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
3126   (gnus-kill-buffer nntp-server-buffer)
3127   ;; Kill Gnus buffers.
3128   (while gnus-buffer-list
3129     (gnus-kill-buffer (pop gnus-buffer-list)))
3130   ;; Remove Gnus frames.
3131   (while gnus-created-frames
3132     (when (frame-live-p (car gnus-created-frames))
3133       ;; We slap a condition-case around this `delete-frame' to ensure 
3134       ;; agains errors if we try do delete the single frame that's left.
3135       (condition-case ()
3136           (delete-frame (car gnus-created-frames))
3137         (error nil)))
3138     (pop gnus-created-frames)))
3139
3140 (defun gnus-windows-old-to-new (setting)
3141   ;; First we take care of the really, really old Gnus 3 actions.
3142   (when (symbolp setting)
3143     (setq setting
3144           ;; Take care of ooold GNUS 3.x values.
3145           (cond ((eq setting 'SelectArticle) 'article)
3146                 ((memq setting '(SelectSubject ExpandSubject)) 'summary)
3147                 ((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group)
3148                 (t setting))))
3149   (if (or (listp setting)
3150           (not (and gnus-window-configuration
3151                     (memq setting '(group summary article)))))
3152       setting
3153     (let* ((setting (if (eq setting 'group)
3154                         (if (assq 'newsgroup gnus-window-configuration)
3155                             'newsgroup
3156                           'newsgroups) setting))
3157            (elem (cadr (assq setting gnus-window-configuration)))
3158            (total (apply '+ elem))
3159            (types '(group summary article))
3160            (pbuf (if (eq setting 'newsgroups) 'group 'summary))
3161            (i 0)
3162            perc
3163            out)
3164       (while (< i 3)
3165         (or (not (numberp (nth i elem)))
3166             (zerop (nth i elem))
3167             (progn
3168               (setq perc  (/ (float (nth 0 elem)) total))
3169               (setq out (cons (if (eq pbuf (nth i types))
3170                                   (vector (nth i types) perc 'point)
3171                                 (vector (nth i types) perc))
3172                               out))))
3173         (setq i (1+ i)))
3174       (list (nreverse out)))))
3175
3176 ;;;###autoload
3177 (defun gnus-add-configuration (conf)
3178   "Add the window configuration CONF to `gnus-buffer-configuration'."
3179   (setq gnus-buffer-configuration
3180         (cons conf (delq (assq (car conf) gnus-buffer-configuration)
3181                          gnus-buffer-configuration))))
3182
3183 (defvar gnus-frame-list nil)
3184
3185 (defun gnus-configure-frame (split &optional window)
3186   "Split WINDOW according to SPLIT."
3187   (unless window
3188     (setq window (get-buffer-window (current-buffer))))
3189   (select-window window)
3190   ;; This might be an old-stylee buffer config.
3191   (when (vectorp split)
3192     (setq split (append split nil)))
3193   (when (or (consp (car split))
3194             (vectorp (car split)))
3195     (push 1.0 split)
3196     (push 'vertical split))
3197   ;; The SPLIT might be something that is to be evaled to
3198   ;; return a new SPLIT.
3199   (while (and (not (assq (car split) gnus-window-to-buffer))
3200               (gnus-functionp (car split)))
3201     (setq split (eval split)))
3202   (let* ((type (car split))
3203          (subs (cddr split))
3204          (len (if (eq type 'horizontal) (window-width) (window-height)))
3205          (total 0)
3206          (window-min-width (or gnus-window-min-width window-min-width))
3207          (window-min-height (or gnus-window-min-height window-min-height))
3208          s result new-win rest comp-subs size sub)
3209     (cond
3210      ;; Nothing to do here.
3211      ((null split))
3212      ;; Don't switch buffers.
3213      ((null type)
3214       (and (memq 'point split) window))
3215      ;; This is a buffer to be selected.
3216      ((not (memq type '(frame horizontal vertical)))
3217       (let ((buffer (cond ((stringp type) type)
3218                           (t (cdr (assq type gnus-window-to-buffer)))))
3219             buf)
3220         (unless buffer
3221           (error "Illegal buffer type: %s" type))
3222         (unless (setq buf (get-buffer (if (symbolp buffer)
3223                                           (symbol-value buffer) buffer)))
3224           (setq buf (get-buffer-create (if (symbolp buffer)
3225                                            (symbol-value buffer) buffer))))
3226         (switch-to-buffer buf)
3227         ;; We return the window if it has the `point' spec.
3228         (and (memq 'point split) window)))
3229      ;; This is a frame split.
3230      ((eq type 'frame)
3231       (unless gnus-frame-list
3232         (setq gnus-frame-list (list (window-frame
3233                                      (get-buffer-window (current-buffer))))))
3234       (let ((i 0)
3235             params frame fresult)
3236         (while (< i (length subs))
3237           ;; Frame parameter is gotten from the sub-split.
3238           (setq params (cadr (elt subs i)))
3239           ;; It should be a list.
3240           (unless (listp params)
3241             (setq params nil))
3242           ;; Create a new frame?
3243           (unless (setq frame (elt gnus-frame-list i))
3244             (nconc gnus-frame-list (list (setq frame (make-frame params))))
3245             (push frame gnus-created-frames))
3246           ;; Is the old frame still alive?
3247           (unless (frame-live-p frame)
3248             (setcar (nthcdr i gnus-frame-list)
3249                     (setq frame (make-frame params))))
3250           ;; Select the frame in question and do more splits there.
3251           (select-frame frame)
3252           (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
3253           (incf i))
3254         ;; Select the frame that has the selected buffer.
3255         (when fresult
3256           (select-frame (window-frame fresult)))))
3257      ;; This is a normal split.
3258      (t
3259       (when (> (length subs) 0)
3260         ;; First we have to compute the sizes of all new windows.
3261         (while subs
3262           (setq sub (append (pop subs) nil))
3263           (while (and (not (assq (car sub) gnus-window-to-buffer))
3264                       (gnus-functionp (car sub)))
3265             (setq sub (eval sub)))
3266           (when sub
3267             (push sub comp-subs)
3268             (setq size (cadar comp-subs))
3269             (cond ((equal size 1.0)
3270                    (setq rest (car comp-subs))
3271                    (setq s 0))
3272                   ((floatp size)
3273                    (setq s (floor (* size len))))
3274                   ((integerp size)
3275                    (setq s size))
3276                   (t
3277                    (error "Illegal size: %s" size)))
3278             ;; Try to make sure that we are inside the safe limits.
3279             (cond ((zerop s))
3280                   ((eq type 'horizontal)
3281                    (setq s (max s window-min-width)))
3282                   ((eq type 'vertical)
3283                    (setq s (max s window-min-height))))
3284             (setcar (cdar comp-subs) s)
3285             (incf total s)))
3286         ;; Take care of the "1.0" spec.
3287         (if rest
3288             (setcar (cdr rest) (- len total))
3289           (error "No 1.0 specs in %s" split))
3290         ;; The we do the actual splitting in a nice recursive
3291         ;; fashion.
3292         (setq comp-subs (nreverse comp-subs))
3293         (while comp-subs
3294           (if (null (cdr comp-subs))
3295               (setq new-win window)
3296             (setq new-win
3297                   (split-window window (cadar comp-subs)
3298                                 (eq type 'horizontal))))
3299           (setq result (or (gnus-configure-frame
3300                             (car comp-subs) window) result))
3301           (select-window new-win)
3302           (setq window new-win)
3303           (setq comp-subs (cdr comp-subs))))
3304       ;; Return the proper window, if any.
3305       (when result
3306         (select-window result))))))
3307
3308 (defvar gnus-frame-split-p nil)
3309
3310 (defun gnus-configure-windows (setting &optional force)
3311   (setq setting (gnus-windows-old-to-new setting))
3312   (let ((split (if (symbolp setting)
3313                    (cadr (assq setting gnus-buffer-configuration))
3314                  setting))
3315         all-visible)
3316
3317     (setq gnus-frame-split-p nil)
3318
3319     (unless split
3320       (error "No such setting: %s" setting))
3321
3322     (if (and (setq all-visible (gnus-all-windows-visible-p split))
3323              (not force))
3324         ;; All the windows mentioned are already visible, so we just
3325         ;; put point in the assigned buffer, and do not touch the
3326         ;; winconf.
3327         (select-window all-visible)
3328
3329       ;; Either remove all windows or just remove all Gnus windows.
3330       (let ((frame (selected-frame)))
3331         (unwind-protect
3332             (if gnus-use-full-window
3333                 ;; We want to remove all other windows.
3334                 (if (not gnus-frame-split-p)
3335                     ;; This is not a `frame' split, so we ignore the
3336                     ;; other frames.  
3337                     (delete-other-windows)
3338                   ;; This is a `frame' split, so we delete all windows
3339                   ;; on all frames.
3340                   (mapcar 
3341                    (lambda (frame)
3342                      (unless (eq (cdr (assq 'minibuffer
3343                                             (frame-parameters frame)))
3344                                  'only)
3345                        (select-frame frame)
3346                        (delete-other-windows)))
3347                    (frame-list)))
3348               ;; Just remove some windows.
3349               (gnus-remove-some-windows)
3350               (switch-to-buffer nntp-server-buffer))
3351           (select-frame frame)))
3352
3353       (switch-to-buffer nntp-server-buffer)
3354       (gnus-configure-frame split (get-buffer-window (current-buffer))))))
3355
3356 (defun gnus-all-windows-visible-p (split)
3357   "Say whether all buffers in SPLIT are currently visible.
3358 In particular, the value returned will be the window that
3359 should have point."
3360   (let ((stack (list split))
3361         (all-visible t)
3362         type buffer win buf)
3363     (while (and (setq split (pop stack))
3364                 all-visible)
3365       ;; Be backwards compatible.
3366       (when (vectorp split)
3367         (setq split (append split nil)))
3368       (when (or (consp (car split))
3369                 (vectorp (car split)))
3370         (push 1.0 split)
3371         (push 'vertical split))
3372       ;; The SPLIT might be something that is to be evaled to
3373       ;; return a new SPLIT.
3374       (while (and (not (assq (car split) gnus-window-to-buffer))
3375                   (gnus-functionp (car split)))
3376         (setq split (eval split)))
3377
3378       (setq type (elt split 0))
3379       (cond
3380        ;; Nothing here.
3381        ((null split) t)
3382        ;; A buffer.
3383        ((not (memq type '(horizontal vertical frame)))
3384         (setq buffer (cond ((stringp type) type)
3385                            (t (cdr (assq type gnus-window-to-buffer)))))
3386         (unless buffer
3387           (error "Illegal buffer type: %s" type))
3388         (when (setq buf (get-buffer (if (symbolp buffer)
3389                                         (symbol-value buffer)
3390                                       buffer)))
3391           (setq win (get-buffer-window buf t)))
3392         (if win
3393             (when (memq 'point split)
3394                 (setq all-visible win))
3395           (setq all-visible nil)))
3396        (t
3397         (when (eq type 'frame)
3398           (setq gnus-frame-split-p t))
3399         (setq stack (append (cddr split) stack)))))
3400     (unless (eq all-visible t)
3401       all-visible)))
3402
3403 (defun gnus-window-top-edge (&optional window)
3404   (nth 1 (window-edges window)))
3405
3406 (defun gnus-remove-some-windows ()
3407   (let ((buffers gnus-window-to-buffer)
3408         buf bufs lowest-buf lowest)
3409     (save-excursion
3410       ;; Remove windows on all known Gnus buffers.
3411       (while buffers
3412         (setq buf (cdar buffers))
3413         (if (symbolp buf)
3414             (setq buf (and (boundp buf) (symbol-value buf))))
3415         (and buf
3416              (get-buffer-window buf)
3417              (progn
3418                (setq bufs (cons buf bufs))
3419                (pop-to-buffer buf)
3420                (if (or (not lowest)
3421                        (< (gnus-window-top-edge) lowest))
3422                    (progn
3423                      (setq lowest (gnus-window-top-edge))
3424                      (setq lowest-buf buf)))))
3425         (setq buffers (cdr buffers)))
3426       ;; Remove windows on *all* summary buffers.
3427       (walk-windows
3428        (lambda (win)
3429          (let ((buf (window-buffer win)))
3430            (if (string-match    "^\\*Summary" (buffer-name buf))
3431                (progn
3432                  (setq bufs (cons buf bufs))
3433                  (pop-to-buffer buf)
3434                  (if (or (not lowest)
3435                          (< (gnus-window-top-edge) lowest))
3436                      (progn
3437                        (setq lowest-buf buf)
3438                        (setq lowest (gnus-window-top-edge)))))))))
3439       (and lowest-buf
3440            (progn
3441              (pop-to-buffer lowest-buf)
3442              (switch-to-buffer nntp-server-buffer)))
3443       (while bufs
3444         (and (not (eq (car bufs) lowest-buf))
3445              (delete-windows-on (car bufs)))
3446         (setq bufs (cdr bufs))))))
3447
3448 (defun gnus-version ()
3449   "Version numbers of this version of Gnus."
3450   (interactive)
3451   (let ((methods gnus-valid-select-methods)
3452         (mess gnus-version)
3453         meth)
3454     ;; Go through all the legal select methods and add their version
3455     ;; numbers to the total version string.  Only the backends that are
3456     ;; currently in use will have their message numbers taken into
3457     ;; consideration.
3458     (while methods
3459       (setq meth (intern (concat (caar methods) "-version")))
3460       (and (boundp meth)
3461            (stringp (symbol-value meth))
3462            (setq mess (concat mess "; " (symbol-value meth))))
3463       (setq methods (cdr methods)))
3464     (gnus-message 2 mess)))
3465
3466 (defun gnus-info-find-node ()
3467   "Find Info documentation of Gnus."
3468   (interactive)
3469   ;; Enlarge info window if needed.
3470   (let ((mode major-mode)
3471         gnus-info-buffer)
3472     (Info-goto-node (cadr (assq mode gnus-info-nodes)))
3473     (setq gnus-info-buffer (current-buffer))
3474     (gnus-configure-windows 'info)))
3475
3476 (defun gnus-days-between (date1 date2)
3477   ;; Return the number of days between date1 and date2.
3478   (- (gnus-day-number date1) (gnus-day-number date2)))
3479
3480 (defun gnus-day-number (date)
3481   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
3482                      (timezone-parse-date date))))
3483     (timezone-absolute-from-gregorian
3484      (nth 1 dat) (nth 2 dat) (car dat))))
3485
3486 (defun gnus-encode-date (date)
3487   "Convert DATE to internal time."
3488   (let* ((parse (timezone-parse-date date))
3489          (date (mapcar (lambda (d) (and d (string-to-int d))) parse))
3490          (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
3491     (encode-time (caddr time) (cadr time) (car time)
3492                  (caddr date) (cadr date) (car date) (nth 4 date))))
3493
3494 (defun gnus-time-minus (t1 t2)
3495   "Subtract two internal times."
3496   (let ((borrow (< (cadr t1) (cadr t2))))
3497     (list (- (car t1) (car t2) (if borrow 1 0))
3498           (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
3499
3500 (defun gnus-file-newer-than (file date)
3501   (let ((fdate (nth 5 (file-attributes file))))
3502     (or (> (car fdate) (car date))
3503         (and (= (car fdate) (car date))
3504              (> (nth 1 fdate) (nth 1 date))))))
3505
3506 (defmacro gnus-local-set-keys (&rest plist)
3507   "Set the keys in PLIST in the current keymap."
3508   `(gnus-define-keys-1 (current-local-map) ',plist))
3509
3510 (defmacro gnus-define-keys (keymap &rest plist)
3511   "Define all keys in PLIST in KEYMAP."
3512   `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
3513
3514 (put 'gnus-define-keys 'lisp-indent-function 1)
3515 (put 'gnus-define-keys 'lisp-indent-hook 1)
3516 (put 'gnus-define-keymap 'lisp-indent-function 1)
3517 (put 'gnus-define-keymap 'lisp-indent-hook 1)
3518
3519 (defmacro gnus-define-keymap (keymap &rest plist)
3520   "Define all keys in PLIST in KEYMAP."
3521   `(gnus-define-keys-1 ,keymap (quote ,plist)))
3522
3523 (defun gnus-define-keys-1 (keymap plist)
3524   (when (null keymap)
3525     (error "Can't set keys in a null keymap"))
3526   (cond ((symbolp keymap)
3527          (setq keymap (symbol-value keymap)))
3528         ((keymapp keymap))
3529         ((listp keymap)
3530          (set (car keymap) nil)
3531          (define-prefix-command (car keymap))
3532          (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
3533          (setq keymap (symbol-value (car keymap)))))
3534   (let (key)
3535     (while plist
3536       (when (symbolp (setq key (pop plist)))
3537         (setq key (symbol-value key)))
3538       (define-key keymap key (pop plist)))))
3539
3540 (defun gnus-group-read-only-p (&optional group)
3541   "Check whether GROUP supports editing or not.
3542 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
3543 that that variable is buffer-local to the summary buffers."
3544   (let ((group (or group gnus-newsgroup-name)))
3545     (not (gnus-check-backend-function 'request-replace-article group))))
3546
3547 (defun gnus-group-total-expirable-p (group)
3548   "Check whether GROUP is total-expirable or not."
3549   (let ((params (gnus-info-params (gnus-get-info group))))
3550     (or (memq 'total-expire params)
3551         (cdr (assq 'total-expire params)) ; (total-expire . t)
3552         (and gnus-total-expirable-newsgroups ; Check var.
3553              (string-match gnus-total-expirable-newsgroups group)))))
3554
3555 (defun gnus-group-auto-expirable-p (group)
3556   "Check whether GROUP is total-expirable or not."
3557   (let ((params (gnus-info-params (gnus-get-info group))))
3558     (or (memq 'auto-expire params)
3559         (cdr (assq 'auto-expire params)) ; (auto-expire . t)
3560         (and gnus-auto-expirable-newsgroups ; Check var.
3561              (string-match gnus-auto-expirable-newsgroups group)))))
3562
3563 (defun gnus-virtual-group-p (group)
3564   "Say whether GROUP is virtual or not."
3565   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
3566                         gnus-valid-select-methods)))
3567
3568 (defsubst gnus-simplify-subject-fully (subject)
3569   "Simplify a subject string according to the user's wishes."
3570   (cond
3571    ((null gnus-summary-gather-subject-limit)
3572     (gnus-simplify-subject-re subject))
3573    ((eq gnus-summary-gather-subject-limit 'fuzzy)
3574     (gnus-simplify-subject-fuzzy subject))
3575    ((numberp gnus-summary-gather-subject-limit)
3576     (gnus-limit-string (gnus-simplify-subject-re subject)
3577                        gnus-summary-gather-subject-limit))
3578    (t
3579     subject)))
3580
3581 (defsubst gnus-subject-equal (s1 s2 &optional simple-first)
3582   "Check whether two subjects are equal.  If optional argument
3583 simple-first is t, first argument is already simplified."
3584   (cond
3585    ((null simple-first)
3586     (equal (gnus-simplify-subject-fully s1)
3587            (gnus-simplify-subject-fully s2)))
3588    (t
3589     (equal s1
3590            (gnus-simplify-subject-fully s2)))))
3591
3592 ;; Returns a list of writable groups.
3593 (defun gnus-writable-groups ()
3594   (let ((alist gnus-newsrc-alist)
3595         groups group)
3596     (while (setq group (car (pop alist)))
3597       (unless (gnus-group-read-only-p group)
3598         (push group groups)))
3599     (nreverse groups)))
3600
3601 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
3602 ;; the echo area.
3603 (defun gnus-y-or-n-p (prompt)
3604   (prog1
3605       (y-or-n-p prompt)
3606     (message "")))
3607
3608 (defun gnus-yes-or-no-p (prompt)
3609   (prog1
3610       (yes-or-no-p prompt)
3611     (message "")))
3612
3613 ;; Check whether to use long file names.
3614 (defun gnus-use-long-file-name (symbol)
3615   ;; The variable has to be set...
3616   (and gnus-use-long-file-name
3617        ;; If it isn't a list, then we return t.
3618        (or (not (listp gnus-use-long-file-name))
3619            ;; If it is a list, and the list contains `symbol', we
3620            ;; return nil.
3621            (not (memq symbol gnus-use-long-file-name)))))
3622
3623 ;; I suspect there's a better way, but I haven't taken the time to do
3624 ;; it yet. -erik selberg@cs.washington.edu
3625 (defun gnus-dd-mmm (messy-date)
3626   "Return a string like DD-MMM from a big messy string"
3627   (let ((datevec (timezone-parse-date messy-date)))
3628     (format "%2s-%s"
3629             (condition-case ()
3630                 ;; Make sure leading zeroes are stripped.
3631                 (number-to-string (string-to-number (aref datevec 2)))
3632               (error "??"))
3633             (capitalize
3634              (or (car
3635                   (nth (1- (string-to-number (aref datevec 1)))
3636                        timezone-months-assoc))
3637                  "???")))))
3638
3639 ;; Make a hash table (default and minimum size is 255).
3640 ;; Optional argument HASHSIZE specifies the table size.
3641 (defun gnus-make-hashtable (&optional hashsize)
3642   (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
3643
3644 ;; Make a number that is suitable for hashing; bigger than MIN and one
3645 ;; less than 2^x.
3646 (defun gnus-create-hash-size (min)
3647   (let ((i 1))
3648     (while (< i min)
3649       (setq i (* 2 i)))
3650     (1- i)))
3651
3652 ;; Show message if message has a lower level than `gnus-verbose'.
3653 ;; Guideline for numbers:
3654 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
3655 ;; for things that take a long time, 7 - not very important messages
3656 ;; on stuff, 9 - messages inside loops.
3657 (defun gnus-message (level &rest args)
3658   (if (<= level gnus-verbose)
3659       (apply 'message args)
3660     ;; We have to do this format thingy here even if the result isn't
3661     ;; shown - the return value has to be the same as the return value
3662     ;; from `message'.
3663     (apply 'format args)))
3664
3665 ;; Generate a unique new group name.
3666 (defun gnus-generate-new-group-name (leaf)
3667   (let ((name leaf)
3668         (num 0))
3669     (while (gnus-gethash name gnus-newsrc-hashtb)
3670       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3671     name))
3672
3673 (defsubst gnus-hide-text (b e props)
3674   "Set text PROPS on the B to E region, extending `intangble' 1 past B."
3675   (add-text-properties b e props)
3676   (when (memq 'intangible props)
3677     (put-text-property (max (1- b) (point-min))
3678                        b 'intangible (cddr (memq 'intangible props)))))
3679
3680 (defsubst gnus-unhide-text (b e)
3681   "Remove hidden text properties from region between B and E."
3682   (remove-text-properties b e gnus-hidden-properties)
3683   (when (memq 'intangible gnus-hidden-properties)
3684     (put-text-property (max (1- b) (point-min))
3685                        b 'intangible nil)))
3686
3687 (defun gnus-hide-text-type (b e type)
3688   "Hide text of TYPE between B and E."
3689   (gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties))))
3690
3691 ;; Find out whether the gnus-visual TYPE is wanted.
3692 (defun gnus-visual-p (&optional type class)
3693   (and gnus-visual                      ; Has to be non-nil, at least.
3694        (if (not type)                   ; We don't care about type.
3695            gnus-visual
3696          (if (listp gnus-visual)        ; It's a list, so we check it.
3697              (or (memq type gnus-visual)
3698                  (memq class gnus-visual))
3699            t))))
3700
3701 (defun gnus-parent-id (references)
3702   "Return the last Message-ID in REFERENCES."
3703   (when (and references
3704              (string-match "\\(<[^<>]+>\\)[ \t\n]*\\'" references))
3705     (substring references (match-beginning 1) (match-end 1))))
3706
3707 (defun gnus-split-references (references)
3708   "Return a list of Message-IDs in REFERENCES."
3709   (let ((beg 0)
3710         ids)
3711     (while (string-match "<[^>]+>" references beg)
3712       (push (substring references (match-beginning 0) (setq beg (match-end 0)))
3713             ids))
3714     (nreverse ids)))
3715
3716 (defun gnus-buffer-live-p (buffer)
3717   "Say whether BUFFER is alive or not."
3718   (and buffer
3719        (get-buffer buffer)
3720        (buffer-name (get-buffer buffer))))
3721
3722 (defun gnus-ephemeral-group-p (group)
3723   "Say whether GROUP is ephemeral or not."
3724   (gnus-group-get-parameter group 'quit-config))
3725
3726 (defun gnus-group-quit-config (group)
3727   "Return the quit-config of GROUP."
3728   (gnus-group-get-parameter group 'quit-config))
3729
3730 (defun gnus-simplify-mode-line ()
3731   "Make mode lines a bit simpler."
3732   (setq mode-line-modified "-- ")
3733   (when (listp mode-line-format)
3734     (make-local-variable 'mode-line-format)
3735     (setq mode-line-format (copy-sequence mode-line-format))
3736     (when (equal (nth 3 mode-line-format) "   ")
3737       (setcar (nthcdr 3 mode-line-format) " "))))
3738
3739 ;;; List and range functions
3740
3741 (defun gnus-last-element (list)
3742   "Return last element of LIST."
3743   (while (cdr list)
3744     (setq list (cdr list)))
3745   (car list))
3746
3747 (defun gnus-copy-sequence (list)
3748   "Do a complete, total copy of a list."
3749   (if (and (consp list) (not (consp (cdr list))))
3750       (cons (car list) (cdr list))
3751     (mapcar (lambda (elem) (if (consp elem)
3752                                (if (consp (cdr elem))
3753                                    (gnus-copy-sequence elem)
3754                                  (cons (car elem) (cdr elem)))
3755                              elem))
3756             list)))
3757
3758 (defun gnus-set-difference (list1 list2)
3759   "Return a list of elements of LIST1 that do not appear in LIST2."
3760   (let ((list1 (copy-sequence list1)))
3761     (while list2
3762       (setq list1 (delq (car list2) list1))
3763       (setq list2 (cdr list2)))
3764     list1))
3765
3766 (defun gnus-sorted-complement (list1 list2)
3767   "Return a list of elements of LIST1 that do not appear in LIST2.
3768 Both lists have to be sorted over <."
3769   (let (out)
3770     (if (or (null list1) (null list2))
3771         (or list1 list2)
3772       (while (and list1 list2)
3773         (cond ((= (car list1) (car list2))
3774                (setq list1 (cdr list1)
3775                      list2 (cdr list2)))
3776               ((< (car list1) (car list2))
3777                (setq out (cons (car list1) out))
3778                (setq list1 (cdr list1)))
3779               (t
3780                (setq out (cons (car list2) out))
3781                (setq list2 (cdr list2)))))
3782       (nconc (nreverse out) (or list1 list2)))))
3783
3784 (defun gnus-intersection (list1 list2)
3785   (let ((result nil))
3786     (while list2
3787       (if (memq (car list2) list1)
3788           (setq result (cons (car list2) result)))
3789       (setq list2 (cdr list2)))
3790     result))
3791
3792 (defun gnus-sorted-intersection (list1 list2)
3793   ;; LIST1 and LIST2 have to be sorted over <.
3794   (let (out)
3795     (while (and list1 list2)
3796       (cond ((= (car list1) (car list2))
3797              (setq out (cons (car list1) out)
3798                    list1 (cdr list1)
3799                    list2 (cdr list2)))
3800             ((< (car list1) (car list2))
3801              (setq list1 (cdr list1)))
3802             (t
3803              (setq list2 (cdr list2)))))
3804     (nreverse out)))
3805
3806 (defun gnus-set-sorted-intersection (list1 list2)
3807   ;; LIST1 and LIST2 have to be sorted over <.
3808   ;; This function modifies LIST1.
3809   (let* ((top (cons nil list1))
3810          (prev top))
3811     (while (and list1 list2)
3812       (cond ((= (car list1) (car list2))
3813              (setq prev list1
3814                    list1 (cdr list1)
3815                    list2 (cdr list2)))
3816             ((< (car list1) (car list2))
3817              (setcdr prev (cdr list1))
3818              (setq list1 (cdr list1)))
3819             (t
3820              (setq list2 (cdr list2)))))
3821     (setcdr prev nil)
3822     (cdr top)))
3823
3824 (defun gnus-compress-sequence (numbers &optional always-list)
3825   "Convert list of numbers to a list of ranges or a single range.
3826 If ALWAYS-LIST is non-nil, this function will always release a list of
3827 ranges."
3828   (let* ((first (car numbers))
3829          (last (car numbers))
3830          result)
3831     (if (null numbers)
3832         nil
3833       (if (not (listp (cdr numbers)))
3834           numbers
3835         (while numbers
3836           (cond ((= last (car numbers)) nil) ;Omit duplicated number
3837                 ((= (1+ last) (car numbers)) ;Still in sequence
3838                  (setq last (car numbers)))
3839                 (t                      ;End of one sequence
3840                  (setq result
3841                        (cons (if (= first last) first
3842                                (cons first last)) result))
3843                  (setq first (car numbers))
3844                  (setq last  (car numbers))))
3845           (setq numbers (cdr numbers)))
3846         (if (and (not always-list) (null result))
3847             (if (= first last) (list first) (cons first last))
3848           (nreverse (cons (if (= first last) first (cons first last))
3849                           result)))))))
3850
3851 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
3852 (defun gnus-uncompress-range (ranges)
3853   "Expand a list of ranges into a list of numbers.
3854 RANGES is either a single range on the form `(num . num)' or a list of
3855 these ranges."
3856   (let (first last result)
3857     (cond
3858      ((null ranges)
3859       nil)
3860      ((not (listp (cdr ranges)))
3861       (setq first (car ranges))
3862       (setq last (cdr ranges))
3863       (while (<= first last)
3864         (setq result (cons first result))
3865         (setq first (1+ first)))
3866       (nreverse result))
3867      (t
3868       (while ranges
3869         (if (atom (car ranges))
3870             (if (numberp (car ranges))
3871                 (setq result (cons (car ranges) result)))
3872           (setq first (caar ranges))
3873           (setq last  (cdar ranges))
3874           (while (<= first last)
3875             (setq result (cons first result))
3876             (setq first (1+ first))))
3877         (setq ranges (cdr ranges)))
3878       (nreverse result)))))
3879
3880 (defun gnus-add-to-range (ranges list)
3881   "Return a list of ranges that has all articles from both RANGES and LIST.
3882 Note: LIST has to be sorted over `<'."
3883   (if (not ranges)
3884       (gnus-compress-sequence list t)
3885     (setq list (copy-sequence list))
3886     (or (listp (cdr ranges))
3887         (setq ranges (list ranges)))
3888     (let ((out ranges)
3889           ilist lowest highest temp)
3890       (while (and ranges list)
3891         (setq ilist list)
3892         (setq lowest (or (and (atom (car ranges)) (car ranges))
3893                          (caar ranges)))
3894         (while (and list (cdr list) (< (cadr list) lowest))
3895           (setq list (cdr list)))
3896         (if (< (car ilist) lowest)
3897             (progn
3898               (setq temp list)
3899               (setq list (cdr list))
3900               (setcdr temp nil)
3901               (setq out (nconc (gnus-compress-sequence ilist t) out))))
3902         (setq highest (or (and (atom (car ranges)) (car ranges))
3903                           (cdar ranges)))
3904         (while (and list (<= (car list) highest))
3905           (setq list (cdr list)))
3906         (setq ranges (cdr ranges)))
3907       (if list
3908           (setq out (nconc (gnus-compress-sequence list t) out)))
3909       (setq out (sort out (lambda (r1 r2)
3910                             (< (or (and (atom r1) r1) (car r1))
3911                                (or (and (atom r2) r2) (car r2))))))
3912       (setq ranges out)
3913       (while ranges
3914         (if (atom (car ranges))
3915             (if (cdr ranges)
3916                 (if (atom (cadr ranges))
3917                     (if (= (1+ (car ranges)) (cadr ranges))
3918                         (progn
3919                           (setcar ranges (cons (car ranges)
3920                                                (cadr ranges)))
3921                           (setcdr ranges (cddr ranges))))
3922                   (if (= (1+ (car ranges)) (caadr ranges))
3923                       (progn
3924                         (setcar (cadr ranges) (car ranges))
3925                         (setcar ranges (cadr ranges))
3926                         (setcdr ranges (cddr ranges))))))
3927           (if (cdr ranges)
3928               (if (atom (cadr ranges))
3929                   (if (= (1+ (cdar ranges)) (cadr ranges))
3930                       (progn
3931                         (setcdr (car ranges) (cadr ranges))
3932                         (setcdr ranges (cddr ranges))))
3933                 (if (= (1+ (cdar ranges)) (caadr ranges))
3934                     (progn
3935                       (setcdr (car ranges) (cdadr ranges))
3936                       (setcdr ranges (cddr ranges)))))))
3937         (setq ranges (cdr ranges)))
3938       out)))
3939
3940 (defun gnus-remove-from-range (ranges list)
3941   "Return a list of ranges that has all articles from LIST removed from RANGES.
3942 Note: LIST has to be sorted over `<'."
3943   ;; !!! This function shouldn't look like this, but I've got a headache.
3944   (gnus-compress-sequence
3945    (gnus-sorted-complement
3946     (gnus-uncompress-range ranges) list)))
3947
3948 (defun gnus-member-of-range (number ranges)
3949   (if (not (listp (cdr ranges)))
3950       (and (>= number (car ranges))
3951            (<= number (cdr ranges)))
3952     (let ((not-stop t))
3953       (while (and ranges
3954                   (if (numberp (car ranges))
3955                       (>= number (car ranges))
3956                     (>= number (caar ranges)))
3957                   not-stop)
3958         (if (if (numberp (car ranges))
3959                 (= number (car ranges))
3960               (and (>= number (caar ranges))
3961                    (<= number (cdar ranges))))
3962             (setq not-stop nil))
3963         (setq ranges (cdr ranges)))
3964       (not not-stop))))
3965
3966 (defun gnus-range-length (range)
3967   "Return the length RANGE would have if uncompressed."
3968   (length (gnus-uncompress-range range)))
3969
3970 (defun gnus-sublist-p (list sublist)
3971   "Test whether all elements in SUBLIST are members of LIST."
3972   (let ((sublistp t))
3973     (while sublist
3974       (unless (memq (pop sublist) list)
3975         (setq sublistp nil
3976               sublist nil)))
3977     sublistp))
3978
3979 \f
3980 ;;;
3981 ;;; Gnus group mode
3982 ;;;
3983
3984 (defvar gnus-group-mode-map nil)
3985 (put 'gnus-group-mode 'mode-class 'special)
3986
3987 (unless gnus-group-mode-map
3988   (setq gnus-group-mode-map (make-keymap))
3989   (suppress-keymap gnus-group-mode-map)
3990
3991   (gnus-define-keys gnus-group-mode-map
3992     " " gnus-group-read-group
3993     "=" gnus-group-select-group
3994     "\r" gnus-group-select-group
3995     "\M-\r" gnus-group-quick-select-group
3996     "j" gnus-group-jump-to-group
3997     "n" gnus-group-next-unread-group
3998     "p" gnus-group-prev-unread-group
3999     "\177" gnus-group-prev-unread-group
4000     [delete] gnus-group-prev-unread-group
4001     "N" gnus-group-next-group
4002     "P" gnus-group-prev-group
4003     "\M-n" gnus-group-next-unread-group-same-level
4004     "\M-p" gnus-group-prev-unread-group-same-level
4005     "," gnus-group-best-unread-group
4006     "." gnus-group-first-unread-group
4007     "u" gnus-group-unsubscribe-current-group
4008     "U" gnus-group-unsubscribe-group
4009     "c" gnus-group-catchup-current
4010     "C" gnus-group-catchup-current-all
4011     "l" gnus-group-list-groups
4012     "L" gnus-group-list-all-groups
4013     "m" gnus-group-mail
4014     "g" gnus-group-get-new-news
4015     "\M-g" gnus-group-get-new-news-this-group
4016     "R" gnus-group-restart
4017     "r" gnus-group-read-init-file
4018     "B" gnus-group-browse-foreign-server
4019     "b" gnus-group-check-bogus-groups
4020     "F" gnus-find-new-newsgroups
4021     "\C-c\C-d" gnus-group-describe-group
4022     "\M-d" gnus-group-describe-all-groups
4023     "\C-c\C-a" gnus-group-apropos
4024     "\C-c\M-\C-a" gnus-group-description-apropos
4025     "a" gnus-group-post-news
4026     "\ek" gnus-group-edit-local-kill
4027     "\eK" gnus-group-edit-global-kill
4028     "\C-k" gnus-group-kill-group
4029     "\C-y" gnus-group-yank-group
4030     "\C-w" gnus-group-kill-region
4031     "\C-x\C-t" gnus-group-transpose-groups
4032     "\C-c\C-l" gnus-group-list-killed
4033     "\C-c\C-x" gnus-group-expire-articles
4034     "\C-c\M-\C-x" gnus-group-expire-all-groups
4035     "V" gnus-version
4036     "s" gnus-group-save-newsrc
4037     "z" gnus-group-suspend
4038     "Z" gnus-group-clear-dribble
4039     "q" gnus-group-exit
4040     "Q" gnus-group-quit
4041     "?" gnus-group-describe-briefly
4042     "\C-c\C-i" gnus-info-find-node
4043     "\M-e" gnus-group-edit-group-method
4044     "^" gnus-group-enter-server-mode
4045     gnus-mouse-2 gnus-mouse-pick-group
4046     "<" beginning-of-buffer
4047     ">" end-of-buffer
4048     "\C-c\C-b" gnus-bug
4049     "\C-c\C-s" gnus-group-sort-groups
4050     "t" gnus-topic-mode
4051     "\C-c\M-g" gnus-activate-all-groups
4052     "\M-&" gnus-group-universal-argument
4053     "#" gnus-group-mark-group
4054     "\M-#" gnus-group-unmark-group)
4055
4056   (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
4057     "m" gnus-group-mark-group
4058     "u" gnus-group-unmark-group
4059     "w" gnus-group-mark-region
4060     "m" gnus-group-mark-buffer
4061     "r" gnus-group-mark-regexp
4062     "U" gnus-group-unmark-all-groups)
4063
4064   (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
4065     "d" gnus-group-make-directory-group
4066     "h" gnus-group-make-help-group
4067     "a" gnus-group-make-archive-group
4068     "k" gnus-group-make-kiboze-group
4069     "m" gnus-group-make-group
4070     "E" gnus-group-edit-group
4071     "e" gnus-group-edit-group-method
4072     "p" gnus-group-edit-group-parameters
4073     "v" gnus-group-add-to-virtual
4074     "V" gnus-group-make-empty-virtual
4075     "D" gnus-group-enter-directory
4076     "f" gnus-group-make-doc-group
4077     "r" gnus-group-rename-group
4078     "\177" gnus-group-delete-group
4079     [delete] gnus-group-delete-group)
4080
4081    (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
4082      "b" gnus-group-brew-soup
4083      "w" gnus-soup-save-areas
4084      "s" gnus-soup-send-replies
4085      "p" gnus-soup-pack-packet
4086      "r" nnsoup-pack-replies)
4087
4088    (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
4089      "s" gnus-group-sort-groups
4090      "a" gnus-group-sort-groups-by-alphabet
4091      "u" gnus-group-sort-groups-by-unread
4092      "l" gnus-group-sort-groups-by-level
4093      "v" gnus-group-sort-groups-by-score
4094      "r" gnus-group-sort-groups-by-rank
4095      "m" gnus-group-sort-groups-by-method)
4096
4097    (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
4098      "k" gnus-group-list-killed
4099      "z" gnus-group-list-zombies
4100      "s" gnus-group-list-groups
4101      "u" gnus-group-list-all-groups
4102      "A" gnus-group-list-active
4103      "a" gnus-group-apropos
4104      "d" gnus-group-description-apropos
4105      "m" gnus-group-list-matching
4106      "M" gnus-group-list-all-matching
4107      "l" gnus-group-list-level)
4108
4109    (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
4110      "f" gnus-score-flush-cache)
4111
4112    (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
4113      "f" gnus-group-fetch-faq)
4114
4115    (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
4116      "l" gnus-group-set-current-level
4117      "t" gnus-group-unsubscribe-current-group
4118      "s" gnus-group-unsubscribe-group
4119      "k" gnus-group-kill-group
4120      "y" gnus-group-yank-group
4121      "w" gnus-group-kill-region
4122      "\C-k" gnus-group-kill-level
4123      "z" gnus-group-kill-all-zombies))
4124
4125 (defun gnus-group-mode ()
4126   "Major mode for reading news.
4127
4128 All normal editing commands are switched off.
4129 \\<gnus-group-mode-map>
4130 The group buffer lists (some of) the groups available.  For instance,
4131 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
4132 lists all zombie groups.
4133
4134 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
4135 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
4136
4137 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
4138
4139 The following commands are available:
4140
4141 \\{gnus-group-mode-map}"
4142   (interactive)
4143   (when (and menu-bar-mode
4144              (gnus-visual-p 'group-menu 'menu))
4145     (gnus-group-make-menu-bar))
4146   (kill-all-local-variables)
4147   (gnus-simplify-mode-line)
4148   (setq major-mode 'gnus-group-mode)
4149   (setq mode-name "Group")
4150   (gnus-group-set-mode-line)
4151   (setq mode-line-process nil)
4152   (use-local-map gnus-group-mode-map)
4153   (buffer-disable-undo (current-buffer))
4154   (setq truncate-lines t)
4155   (setq buffer-read-only t)
4156   (run-hooks 'gnus-group-mode-hook))
4157
4158 (defun gnus-mouse-pick-group (e)
4159   "Enter the group under the mouse pointer."
4160   (interactive "e")
4161   (mouse-set-point e)
4162   (gnus-group-read-group nil))
4163
4164 ;; Look at LEVEL and find out what the level is really supposed to be.
4165 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
4166 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
4167 (defun gnus-group-default-level (&optional level number-or-nil)
4168   (cond
4169    (gnus-group-use-permanent-levels
4170     (setq gnus-group-default-list-level
4171           (or level gnus-group-default-list-level))
4172     (or gnus-group-default-list-level gnus-level-subscribed))
4173    (number-or-nil
4174     level)
4175    (t
4176     (or level gnus-group-default-list-level gnus-level-subscribed))))
4177
4178 ;;;###autoload
4179 (defun gnus-slave-no-server (&optional arg)
4180   "Read network news as a slave, without connecting to local server"
4181   (interactive "P")
4182   (gnus-no-server arg t))
4183
4184 ;;;###autoload
4185 (defun gnus-no-server (&optional arg slave)
4186   "Read network news.
4187 If ARG is a positive number, Gnus will use that as the
4188 startup level.  If ARG is nil, Gnus will be started at level 2.
4189 If ARG is non-nil and not a positive number, Gnus will
4190 prompt the user for the name of an NNTP server to use.
4191 As opposed to `gnus', this command will not connect to the local server."
4192   (interactive "P")
4193   (let ((gnus-group-use-permanent-levels t))
4194     (gnus (or arg (1- gnus-level-default-subscribed)) t slave))
4195   (make-local-variable 'gnus-group-use-permanent-levels)
4196   (setq gnus-group-use-permanent-levels t))
4197
4198 ;;;###autoload
4199 (defun gnus-slave (&optional arg)
4200   "Read news as a slave."
4201   (interactive "P")
4202   (gnus arg nil 'slave))
4203
4204 ;;;###autoload
4205 (defun gnus-other-frame (&optional arg)
4206   "Pop up a frame to read news."
4207   (interactive "P")
4208   (if (get-buffer gnus-group-buffer)
4209       (let ((pop-up-frames t))
4210         (gnus arg))
4211     (select-frame (make-frame))
4212     (gnus arg)))
4213
4214 ;;;###autoload
4215 (defun gnus (&optional arg dont-connect slave)
4216   "Read network news.
4217 If ARG is non-nil and a positive number, Gnus will use that as the
4218 startup level.  If ARG is non-nil and not a positive number, Gnus will
4219 prompt the user for the name of an NNTP server to use."
4220   (interactive "P")
4221
4222   (if (get-buffer gnus-group-buffer)
4223       (progn
4224         (switch-to-buffer gnus-group-buffer)
4225         (gnus-group-get-new-news))
4226
4227     (gnus-clear-system)
4228     (nnheader-init-server-buffer)
4229     (gnus-read-init-file)
4230     (setq gnus-slave slave)
4231
4232     (gnus-group-setup-buffer)
4233     (let ((buffer-read-only nil))
4234       (erase-buffer)
4235       (if (not gnus-inhibit-startup-message)
4236           (progn
4237             (gnus-group-startup-message)
4238             (sit-for 0))))
4239
4240     (let ((level (and (numberp arg) (> arg 0) arg))
4241           did-connect)
4242       (unwind-protect
4243           (progn
4244             (or dont-connect
4245                 (setq did-connect
4246                       (gnus-start-news-server (and arg (not level))))))
4247         (if (and (not dont-connect)
4248                  (not did-connect))
4249             (gnus-group-quit)
4250           (run-hooks 'gnus-startup-hook)
4251           ;; NNTP server is successfully open.
4252
4253           ;; Find the current startup file name.
4254           (setq gnus-current-startup-file
4255                 (gnus-make-newsrc-file gnus-startup-file))
4256
4257           ;; Read the dribble file.
4258           (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
4259
4260           ;; Allow using GroupLens predictions.
4261           (when gnus-use-grouplens
4262             (bbb-login)
4263             (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
4264
4265           (gnus-summary-make-display-table)
4266           ;; Do the actual startup.
4267           (gnus-setup-news nil level dont-connect)
4268           ;; Generate the group buffer.
4269           (gnus-group-list-groups level)
4270           (gnus-group-first-unread-group)
4271           (gnus-configure-windows 'group)
4272           (gnus-group-set-mode-line))))))
4273
4274 (defun gnus-unload ()
4275   "Unload all Gnus features."
4276   (interactive)
4277   (or (boundp 'load-history)
4278       (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
4279   (let ((history load-history)
4280         feature)
4281     (while history
4282       (and (string-match "^\\(gnus\\|nn\\)" (caar history))
4283            (setq feature (cdr (assq 'provide (car history))))
4284            (unload-feature feature 'force))
4285       (setq history (cdr history)))))
4286
4287 (defun gnus-compile ()
4288   "Byte-compile the user-defined format specs."
4289   (interactive)
4290   (let ((entries gnus-format-specs)
4291         entry gnus-tmp-func)
4292     (save-excursion
4293       (gnus-message 7 "Compiling format specs...")
4294
4295       (while entries
4296         (setq entry (pop entries))
4297         (if (eq (car entry) 'version)
4298             (setq gnus-format-specs (delq entry gnus-format-specs))
4299           (when (and (listp (caddr entry))
4300                      (not (eq 'byte-code (caaddr entry))))
4301             (fset 'gnus-tmp-func
4302                   `(lambda () ,(caddr entry)))
4303             (byte-compile 'gnus-tmp-func)
4304             (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
4305
4306       (push (cons 'version emacs-version) gnus-format-specs)
4307
4308       (gnus-message 7 "Compiling user specs...done"))))
4309
4310 (defun gnus-indent-rigidly (start end arg)
4311   "Indent rigidly using only spaces and no tabs."
4312   (save-excursion
4313     (save-restriction
4314       (narrow-to-region start end)
4315       (indent-rigidly start end arg)
4316       (goto-char (point-min))
4317       (while (search-forward "\t" nil t)
4318         (replace-match "        " t t)))))
4319
4320 (defun gnus-group-startup-message (&optional x y)
4321   "Insert startup message in current buffer."
4322   ;; Insert the message.
4323   (erase-buffer)
4324   (insert
4325    (format "              %s
4326           _    ___ _             _
4327           _ ___ __ ___  __    _ ___
4328           __   _     ___    __  ___
4329               _           ___     _
4330              _  _ __             _
4331              ___   __            _
4332                    __           _
4333                     _      _   _
4334                    _      _    _
4335                       _  _    _
4336                   __  ___
4337                  _   _ _     _
4338                 _   _
4339               _    _
4340              _    _
4341             _
4342           __
4343
4344 "
4345            ""))
4346   ;; And then hack it.
4347   (gnus-indent-rigidly (point-min) (point-max)
4348                        (/ (max (- (window-width) (or x 46)) 0) 2))
4349   (goto-char (point-min))
4350   (forward-line 1)
4351   (let* ((pheight (count-lines (point-min) (point-max)))
4352          (wheight (window-height))
4353          (rest (- wheight pheight)))
4354     (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
4355   ;; Fontify some.
4356   (goto-char (point-min))
4357   (and (search-forward "Praxis" nil t)
4358        (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
4359   (goto-char (point-min))
4360   (let* ((mode-string (gnus-group-set-mode-line)))
4361     (setq mode-line-buffer-identification
4362           (list (concat gnus-version (substring (car mode-string) 4))))
4363     (set-buffer-modified-p t)))
4364
4365 (defun gnus-group-setup-buffer ()
4366   (or (get-buffer gnus-group-buffer)
4367       (progn
4368         (switch-to-buffer gnus-group-buffer)
4369         (gnus-add-current-to-buffer-list)
4370         (gnus-group-mode)
4371         (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
4372
4373 (defun gnus-group-list-groups (&optional level unread lowest)
4374   "List newsgroups with level LEVEL or lower that have unread articles.
4375 Default is all subscribed groups.
4376 If argument UNREAD is non-nil, groups with no unread articles are also
4377 listed."
4378   (interactive (list (if current-prefix-arg
4379                          (prefix-numeric-value current-prefix-arg)
4380                        (or
4381                         (gnus-group-default-level nil t)
4382                         gnus-group-default-list-level
4383                         gnus-level-subscribed))))
4384   (or level
4385       (setq level (car gnus-group-list-mode)
4386             unread (cdr gnus-group-list-mode)))
4387   (setq level (gnus-group-default-level level))
4388   (gnus-group-setup-buffer)             ;May call from out of group buffer
4389   (gnus-update-format-specifications)
4390   (let ((case-fold-search nil)
4391         (props (text-properties-at (gnus-point-at-bol)))
4392         (group (gnus-group-group-name)))
4393     (set-buffer gnus-group-buffer)
4394     (funcall gnus-group-prepare-function level unread lowest)
4395     (if (zerop (buffer-size))
4396         (gnus-message 5 gnus-no-groups-message)
4397       (goto-char (point-max))
4398       (when (or (not gnus-group-goto-next-group-function)
4399                 (not (funcall gnus-group-goto-next-group-function 
4400                               group props)))
4401         (if (not group)
4402             ;; Go to the first group with unread articles.
4403             (gnus-group-search-forward t)
4404           ;; Find the right group to put point on.  If the current group
4405           ;; has disappeared in the new listing, try to find the next
4406           ;; one.        If no next one can be found, just leave point at the
4407           ;; first newsgroup in the buffer.
4408           (if (not (gnus-goto-char
4409                     (text-property-any
4410                      (point-min) (point-max)
4411                      'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
4412               (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
4413                 (while (and newsrc
4414                             (not (gnus-goto-char
4415                                   (text-property-any
4416                                    (point-min) (point-max) 'gnus-group
4417                                    (gnus-intern-safe
4418                                     (caar newsrc) gnus-active-hashtb)))))
4419                   (setq newsrc (cdr newsrc)))
4420                 (or newsrc (progn (goto-char (point-max))
4421                                   (forward-line -1)))))))
4422       ;; Adjust cursor point.
4423       (gnus-group-position-point))))
4424
4425 (defun gnus-group-list-level (level &optional all)
4426   "List groups on LEVEL.
4427 If ALL (the prefix), also list groups that have no unread articles."
4428   (interactive "nList groups on level: \nP")
4429   (gnus-group-list-groups level all level))
4430
4431 (defun gnus-group-prepare-flat (level &optional all lowest regexp)
4432   "List all newsgroups with unread articles of level LEVEL or lower.
4433 If ALL is non-nil, list groups that have no unread articles.
4434 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
4435 If REGEXP, only list groups matching REGEXP."
4436   (set-buffer gnus-group-buffer)
4437   (let ((buffer-read-only nil)
4438         (newsrc (cdr gnus-newsrc-alist))
4439         (lowest (or lowest 1))
4440         info clevel unread group params)
4441     (erase-buffer)
4442     (if (< lowest gnus-level-zombie)
4443         ;; List living groups.
4444         (while newsrc
4445           (setq info (car newsrc)
4446                 group (gnus-info-group info)
4447                 params (gnus-info-params info)
4448                 newsrc (cdr newsrc)
4449                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
4450           (and unread                   ; This group might be bogus
4451                (or (not regexp)
4452                    (string-match regexp group))
4453                (<= (setq clevel (gnus-info-level info)) level)
4454                (>= clevel lowest)
4455                (or all                  ; We list all groups?
4456                    (if (eq unread t)    ; Unactivated?
4457                        gnus-group-list-inactive-groups ; We list unactivated 
4458                      (> unread 0))      ; We list groups with unread articles
4459                    (and gnus-list-groups-with-ticked-articles
4460                         (cdr (assq 'tick (gnus-info-marks info))))
4461                                         ; And groups with tickeds
4462                    ;; Check for permanent visibility.
4463                    (and gnus-permanently-visible-groups
4464                         (string-match gnus-permanently-visible-groups
4465                                       group))
4466                    (memq 'visible params)
4467                    (cdr (assq 'visible params)))
4468                (gnus-group-insert-group-line
4469                 group (gnus-info-level info)
4470                 (gnus-info-marks info) unread (gnus-info-method info)))))
4471
4472     ;; List dead groups.
4473     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
4474          (gnus-group-prepare-flat-list-dead
4475           (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
4476           gnus-level-zombie ?Z
4477           regexp))
4478     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
4479          (gnus-group-prepare-flat-list-dead
4480           (setq gnus-killed-list (sort gnus-killed-list 'string<))
4481           gnus-level-killed ?K regexp))
4482
4483     (gnus-group-set-mode-line)
4484     (setq gnus-group-list-mode (cons level all))
4485     (run-hooks 'gnus-group-prepare-hook)))
4486
4487 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
4488   ;; List zombies and killed lists somewhat faster, which was
4489   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
4490   ;; this by ignoring the group format specification altogether.
4491   (let (group)
4492     (if regexp
4493         ;; This loop is used when listing groups that match some
4494         ;; regexp.
4495         (while groups
4496           (setq group (pop groups))
4497           (when (string-match regexp group)
4498             (add-text-properties
4499              (point) (prog1 (1+ (point))
4500                        (insert " " mark "     *: " group "\n"))
4501              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4502                    'gnus-unread t
4503                    'gnus-level level))))
4504       ;; This loop is used when listing all groups.
4505       (while groups
4506         (add-text-properties
4507          (point) (prog1 (1+ (point))
4508                    (insert " " mark "     *: "
4509                            (setq group (pop groups)) "\n"))
4510          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4511                'gnus-unread t
4512                'gnus-level level))))))
4513
4514 (defmacro gnus-group-real-name (group)
4515   "Find the real name of a foreign newsgroup."
4516   `(let ((gname ,group))
4517      (if (string-match ":[^:]+$" gname)
4518          (substring gname (1+ (match-beginning 0)))
4519        gname)))
4520
4521 (defsubst gnus-server-add-address (method)
4522   (let ((method-name (symbol-name (car method))))
4523     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
4524              (not (assq (intern (concat method-name "-address")) method)))
4525         (append method (list (list (intern (concat method-name "-address"))
4526                                    (nth 1 method))))
4527       method)))
4528
4529 (defsubst gnus-server-get-method (group method)
4530   ;; Input either a server name, and extended server name, or a
4531   ;; select method, and return a select method.
4532   (cond ((stringp method)
4533          (gnus-server-to-method method))
4534         ((and (stringp (car method)) group)
4535          (gnus-server-extend-method group method))
4536         (t
4537          (gnus-server-add-address method))))
4538
4539 (defun gnus-server-to-method (server)
4540   "Map virtual server names to select methods."
4541   (or 
4542    ;; Perhaps this is the native server?
4543    (and (equal server "native") gnus-select-method)
4544    ;; It should be in the server alist.
4545    (cdr (assoc server gnus-server-alist))
4546    ;; If not, we look through all the opened server
4547    ;; to see whether we can find it there.
4548    (let ((opened gnus-opened-servers))
4549      (while (and opened
4550                  (not (equal server (format "%s:%s" (caaar opened)
4551                                             (cadaar opened)))))
4552        (pop opened))
4553      (caar opened))))
4554
4555 (defmacro gnus-method-equal (ss1 ss2)
4556   "Say whether two servers are equal."
4557   `(let ((s1 ,ss1)
4558          (s2 ,ss2))
4559      (or (equal s1 s2)
4560          (and (= (length s1) (length s2))
4561               (progn
4562                 (while (and s1 (member (car s1) s2))
4563                   (setq s1 (cdr s1)))
4564                 (null s1))))))
4565
4566 (defun gnus-server-equal (m1 m2)
4567   "Say whether two methods are equal."
4568   (let ((m1 (cond ((null m1) gnus-select-method)
4569                   ((stringp m1) (gnus-server-to-method m1))
4570                   (t m1)))
4571         (m2 (cond ((null m2) gnus-select-method)
4572                   ((stringp m2) (gnus-server-to-method m2))
4573                   (t m2))))
4574     (gnus-method-equal m1 m2)))
4575
4576 (defun gnus-group-prefixed-name (group method)
4577   "Return the whole name from GROUP and METHOD."
4578   (and (stringp method) (setq method (gnus-server-to-method method)))
4579   (concat (format "%s" (car method))
4580           (if (and
4581                (or (assoc (format "%s" (car method)) 
4582                           (gnus-methods-using 'address))
4583                    (gnus-server-equal method gnus-message-archive-method))
4584                (nth 1 method)
4585                (not (string= (nth 1 method) "")))
4586               (concat "+" (nth 1 method)))
4587           ":" group))
4588
4589 (defun gnus-group-real-prefix (group)
4590   "Return the prefix of the current group name."
4591   (if (string-match "^[^:]+:" group)
4592       (substring group 0 (match-end 0))
4593     ""))
4594
4595 (defun gnus-group-method (group)
4596   "Return the server or method used for selecting GROUP."
4597   (let ((prefix (gnus-group-real-prefix group)))
4598     (if (equal prefix "")
4599         gnus-select-method
4600       (let ((servers gnus-opened-servers)
4601             (server "")
4602             backend possible found)
4603         (if (string-match "^[^\\+]+\\+" prefix)
4604             (setq backend (intern (substring prefix 0 (1- (match-end 0))))
4605                   server (substring prefix (match-end 0) (1- (length prefix))))
4606           (setq backend (intern (substring prefix 0 (1- (length prefix))))))
4607         (while servers
4608           (when (eq (caaar servers) backend)
4609             (setq possible (caar servers))
4610             (when (equal (cadaar servers) server)
4611               (setq found (caar servers))))
4612           (pop servers))
4613         (or (car (rassoc found gnus-server-alist))
4614             found
4615             (car (rassoc possible gnus-server-alist))
4616             possible
4617             (list backend server))))))
4618
4619 (defsubst gnus-secondary-method-p (method)
4620   "Return whether METHOD is a secondary select method."
4621   (let ((methods gnus-secondary-select-methods)
4622         (gmethod (gnus-server-get-method nil method)))
4623     (while (and methods
4624                 (not (equal (gnus-server-get-method nil (car methods))
4625                             gmethod)))
4626       (setq methods (cdr methods)))
4627     methods))
4628
4629 (defun gnus-group-foreign-p (group)
4630   "Say whether a group is foreign or not."
4631   (and (not (gnus-group-native-p group))
4632        (not (gnus-group-secondary-p group))))
4633
4634 (defun gnus-group-native-p (group)
4635   "Say whether the group is native or not."
4636   (not (string-match ":" group)))
4637
4638 (defun gnus-group-secondary-p (group)
4639   "Say whether the group is secondary or not."
4640   (gnus-secondary-method-p (gnus-find-method-for-group group)))
4641
4642 (defun gnus-group-get-parameter (group &optional symbol)
4643   "Returns the group parameters for GROUP.
4644 If SYMBOL, return the value of that symbol in the group parameters."
4645   (let ((params (gnus-info-params (gnus-get-info group))))
4646     (if symbol
4647         (gnus-group-parameter-value params symbol)
4648       params)))
4649
4650 (defun gnus-group-parameter-value (params symbol)
4651   "Return the value of SYMBOL in group PARAMS."
4652   (or (car (memq symbol params))        ; It's either a simple symbol
4653       (cdr (assq symbol params))))      ; or a cons.
4654
4655 (defun gnus-group-add-parameter (group param)
4656   "Add parameter PARAM to GROUP."
4657   (let ((info (gnus-get-info group)))
4658     (if (not info)
4659         () ; This is a dead group.  We just ignore it.
4660       ;; Cons the new param to the old one and update.
4661       (gnus-group-set-info (cons param (gnus-info-params info))
4662                            group 'params))))
4663
4664 (defun gnus-group-set-parameter (group name value)
4665   "Set parameter NAME to VALUE in GROUP."
4666   (let ((info (gnus-get-info group)))
4667     (if (not info)
4668         () ; This is a dead group.  We just ignore it.
4669       (let ((old-params (gnus-info-params info))
4670             (new-params (list (cons name value))))
4671         (while old-params
4672           (if (or (not (listp (car old-params)))
4673                   (not (eq (caar old-params) name)))
4674               (setq new-params (append new-params (list (car old-params)))))
4675           (setq old-params (cdr old-params)))
4676         (gnus-group-set-info new-params group 'params)))))
4677
4678 (defun gnus-group-add-score (group &optional score)
4679   "Add SCORE to the GROUP score.
4680 If SCORE is nil, add 1 to the score of GROUP."
4681   (let ((info (gnus-get-info group)))
4682     (when info
4683       (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
4684
4685 (defun gnus-summary-bubble-group ()
4686   "Increase the score of the current group.
4687 This is a handy function to add to `gnus-summary-exit-hook' to
4688 increase the score of each group you read."
4689   (gnus-group-add-score gnus-newsgroup-name))
4690
4691 (defun gnus-group-set-info (info &optional method-only-group part)
4692   (let* ((entry (gnus-gethash
4693                  (or method-only-group (gnus-info-group info))
4694                  gnus-newsrc-hashtb))
4695          (part-info info)
4696          (info (if method-only-group (nth 2 entry) info))
4697          method)
4698     (when method-only-group
4699       (unless entry
4700         (error "Trying to change non-existent group %s" method-only-group))
4701       ;; We have received parts of the actual group info - either the
4702       ;; select method or the group parameters.  We first check
4703       ;; whether we have to extend the info, and if so, do that.
4704       (let ((len (length info))
4705             (total (if (eq part 'method) 5 6)))
4706         (when (< len total)
4707           (setcdr (nthcdr (1- len) info)
4708                   (make-list (- total len) nil)))
4709         ;; Then we enter the new info.
4710         (setcar (nthcdr (1- total) info) part-info)))
4711     (unless entry
4712       ;; This is a new group, so we just create it.
4713       (save-excursion
4714         (set-buffer gnus-group-buffer)
4715         (setq method (gnus-info-method info))
4716         (when (gnus-server-equal method "native")
4717           (setq method nil))
4718         (if method
4719             ;; It's a foreign group...
4720             (gnus-group-make-group
4721              (gnus-group-real-name (gnus-info-group info))
4722              (if (stringp method) method
4723                (prin1-to-string (car method)))
4724              (and (consp method)
4725                   (nth 1 (gnus-info-method info))))
4726           ;; It's a native group.
4727           (gnus-group-make-group (gnus-info-group info)))
4728         (gnus-message 6 "Note: New group created")
4729         (setq entry
4730               (gnus-gethash (gnus-group-prefixed-name
4731                              (gnus-group-real-name (gnus-info-group info))
4732                              (or (gnus-info-method info) gnus-select-method))
4733                             gnus-newsrc-hashtb))))
4734     ;; Whether it was a new group or not, we now have the entry, so we
4735     ;; can do the update.
4736     (if entry
4737         (progn
4738           (setcar (nthcdr 2 entry) info)
4739           (when (and (not (eq (car entry) t))
4740                      (gnus-active (gnus-info-group info)))
4741             (setcar entry (length (gnus-list-of-unread-articles (car info))))))
4742       (error "No such group: %s" (gnus-info-group info)))))
4743
4744 (defun gnus-group-set-method-info (group select-method)
4745   (gnus-group-set-info select-method group 'method))
4746
4747 (defun gnus-group-set-params-info (group params)
4748   (gnus-group-set-info params group 'params))
4749
4750 (defun gnus-group-update-group-line ()
4751   "Update the current line in the group buffer."
4752   (let* ((buffer-read-only nil)
4753          (group (gnus-group-group-name))
4754          (gnus-group-indentation (gnus-group-group-indentation))
4755          (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
4756     (and entry
4757          (not (gnus-ephemeral-group-p group))
4758          (gnus-dribble-enter
4759           (concat "(gnus-group-set-info '"
4760                   (prin1-to-string (nth 2 entry)) ")")))
4761     (gnus-delete-line)
4762     (gnus-group-insert-group-line-info group)
4763     (forward-line -1)
4764     (gnus-group-position-point)))
4765
4766 (defun gnus-group-insert-group-line-info (group)
4767   "Insert GROUP on the current line."
4768   (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
4769         active info)
4770     (if entry
4771         (progn
4772           ;; (Un)subscribed group.
4773           (setq info (nth 2 entry))
4774           (gnus-group-insert-group-line
4775            group (gnus-info-level info) (gnus-info-marks info)
4776            (or (car entry) t) (gnus-info-method info)))
4777       ;; This group is dead.
4778       (gnus-group-insert-group-line
4779        group
4780        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
4781        nil
4782        (if (setq active (gnus-active group))
4783            (- (1+ (cdr active)) (car active)) 0)
4784        nil))))
4785
4786 (defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level 
4787                                                     gnus-tmp-marked number
4788                                                     gnus-tmp-method)
4789   "Insert a group line in the group buffer."
4790   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
4791          (gnus-tmp-number-total
4792           (if gnus-tmp-active
4793               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
4794             0))
4795          (gnus-tmp-number-of-unread
4796           (if (numberp number) (int-to-string (max 0 number))
4797             "*"))
4798          (gnus-tmp-number-of-read
4799           (if (numberp number)
4800               (int-to-string (max 0 (- gnus-tmp-number-total number)))
4801             "*"))
4802          (gnus-tmp-subscribed
4803           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
4804                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
4805                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
4806                 (t ?K)))
4807          (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
4808          (gnus-tmp-newsgroup-description
4809           (if gnus-description-hashtb
4810               (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
4811             ""))
4812          (gnus-tmp-moderated
4813           (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
4814          (gnus-tmp-moderated-string
4815           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
4816          (gnus-tmp-method
4817           (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
4818          (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
4819          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
4820          (gnus-tmp-news-method-string
4821           (if gnus-tmp-method
4822               (format "(%s:%s)" (car gnus-tmp-method)
4823                       (cadr gnus-tmp-method)) ""))
4824          (gnus-tmp-marked-mark
4825           (if (and (numberp number)
4826                    (zerop number)
4827                    (cdr (assq 'tick gnus-tmp-marked)))
4828               ?* ? ))
4829          (gnus-tmp-process-marked
4830           (if (member gnus-tmp-group gnus-group-marked)
4831               gnus-process-mark ? ))
4832          (gnus-tmp-grouplens
4833           (or (and gnus-use-grouplens
4834                    (bbb-grouplens-group-p gnus-tmp-group))
4835               ""))
4836          (buffer-read-only nil)
4837          header gnus-tmp-header)        ; passed as parameter to user-funcs.
4838     (beginning-of-line)
4839     (add-text-properties
4840      (point)
4841      (prog1 (1+ (point))
4842        ;; Insert the text.
4843        (eval gnus-group-line-format-spec))
4844      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
4845        gnus-unread ,(if (numberp number)
4846                         (string-to-int gnus-tmp-number-of-unread)
4847                       t)
4848        gnus-marked ,gnus-tmp-marked-mark
4849        gnus-indentation ,gnus-group-indentation
4850        gnus-level ,gnus-tmp-level))
4851     (when (inline (gnus-visual-p 'group-highlight 'highlight))
4852       (forward-line -1)
4853       (run-hooks 'gnus-group-update-hook)
4854       (forward-line))
4855     ;; Allow XEmacs to remove front-sticky text properties.
4856     (gnus-group-remove-excess-properties)))
4857
4858 (defun gnus-group-update-group (group &optional visible-only)
4859   "Update all lines where GROUP appear.
4860 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
4861 already."
4862   (save-excursion
4863     (set-buffer gnus-group-buffer)
4864     ;; The buffer may be narrowed.
4865     (save-restriction
4866       (widen)
4867       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
4868             (loc (point-min))
4869             found buffer-read-only)
4870         ;; Enter the current status into the dribble buffer.
4871         (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
4872           (if (and entry (not (gnus-ephemeral-group-p group)))
4873               (gnus-dribble-enter
4874                (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
4875                        ")"))))
4876         ;; Find all group instances.  If topics are in use, each group
4877         ;; may be listed in more than once.
4878         (while (setq loc (text-property-any
4879                           loc (point-max) 'gnus-group ident))
4880           (setq found t)
4881           (goto-char loc)
4882           (let ((gnus-group-indentation (gnus-group-group-indentation)))
4883             (gnus-delete-line)
4884             (gnus-group-insert-group-line-info group))
4885           (setq loc (1+ loc)))
4886         (unless (or found visible-only)
4887           ;; No such line in the buffer, find out where it's supposed to
4888           ;; go, and insert it there (or at the end of the buffer).
4889           (if gnus-goto-missing-group-function
4890               (funcall gnus-goto-missing-group-function group)
4891             (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb))))
4892               (while (and entry (car entry)
4893                           (not
4894                            (gnus-goto-char
4895                             (text-property-any
4896                              (point-min) (point-max)
4897                              'gnus-group (gnus-intern-safe
4898                                           (caar entry) gnus-active-hashtb)))))
4899                 (setq entry (cdr entry)))
4900               (or entry (goto-char (point-max)))))
4901           ;; Finally insert the line.
4902           (let ((gnus-group-indentation (gnus-group-group-indentation)))
4903             (gnus-group-insert-group-line-info group)))
4904         (gnus-group-set-mode-line)))))
4905
4906 (defun gnus-group-set-mode-line ()
4907   (when (memq 'group gnus-updated-mode-lines)
4908     (let* ((gformat (or gnus-group-mode-line-format-spec
4909                         (setq gnus-group-mode-line-format-spec
4910                               (gnus-parse-format
4911                                gnus-group-mode-line-format
4912                                gnus-group-mode-line-format-alist))))
4913            (gnus-tmp-news-server (cadr gnus-select-method))
4914            (gnus-tmp-news-method (car gnus-select-method))
4915            (max-len 60)
4916            gnus-tmp-header                      ;Dummy binding for user-defined formats
4917            ;; Get the resulting string.
4918            (mode-string (eval gformat)))
4919       ;; If the line is too long, we chop it off.
4920       (when (> (length mode-string) max-len)
4921         (setq mode-string (substring mode-string 0 (- max-len 4))))
4922       (prog1
4923           (setq mode-line-buffer-identification (list mode-string))
4924         (set-buffer-modified-p t)))))
4925
4926 (defun gnus-group-group-name ()
4927   "Get the name of the newsgroup on the current line."
4928   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
4929     (and group (symbol-name group))))
4930
4931 (defun gnus-group-group-level ()
4932   "Get the level of the newsgroup on the current line."
4933   (get-text-property (gnus-point-at-bol) 'gnus-level))
4934
4935 (defun gnus-group-group-indentation ()
4936   "Get the indentation of the newsgroup on the current line."
4937   (or (get-text-property (gnus-point-at-bol) 'gnus-indentation)
4938       (and gnus-group-indentation-function
4939            (funcall gnus-group-indentation-function))
4940       ""))
4941
4942 (defun gnus-group-group-unread ()
4943   "Get the number of unread articles of the newsgroup on the current line."
4944   (get-text-property (gnus-point-at-bol) 'gnus-unread))
4945
4946 (defun gnus-group-search-forward (&optional backward all level first-too)
4947   "Find the next newsgroup with unread articles.
4948 If BACKWARD is non-nil, find the previous newsgroup instead.
4949 If ALL is non-nil, just find any newsgroup.
4950 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
4951 group exists.
4952 If FIRST-TOO, the current line is also eligible as a target."
4953   (let ((way (if backward -1 1))
4954         (low gnus-level-killed)
4955         (beg (point))
4956         pos found lev)
4957     (if (and backward (progn (beginning-of-line)) (bobp))
4958         nil
4959       (or first-too (forward-line way))
4960       (while (and
4961               (not (eobp))
4962               (not (setq
4963                     found
4964                     (and (or all
4965                              (and
4966                               (let ((unread
4967                                      (get-text-property (point) 'gnus-unread)))
4968                                 (and (numberp unread) (> unread 0)))
4969                               (setq lev (get-text-property (point)
4970                                                            'gnus-level))
4971                               (<= lev gnus-level-subscribed)))
4972                          (or (not level)
4973                              (and (setq lev (get-text-property (point)
4974                                                                'gnus-level))
4975                                   (or (= lev level)
4976                                       (and (< lev low)
4977                                            (< level lev)
4978                                            (progn
4979                                              (setq low lev)
4980                                              (setq pos (point))
4981                                              nil))))))))
4982               (zerop (forward-line way)))))
4983     (if found
4984         (progn (gnus-group-position-point) t)
4985       (goto-char (or pos beg))
4986       (and pos t))))
4987
4988 ;;; Gnus group mode commands
4989
4990 ;; Group marking.
4991
4992 (defun gnus-group-mark-group (n &optional unmark no-advance)
4993   "Mark the current group."
4994   (interactive "p")
4995   (let ((buffer-read-only nil)
4996         group)
4997     (while
4998         (and (> n 0)
4999              (setq group (gnus-group-group-name))
5000              (progn
5001                (beginning-of-line)
5002                (forward-char
5003                 (or (cdr (assq 'process gnus-group-mark-positions)) 2))
5004                (delete-char 1)
5005                (if unmark
5006                    (progn
5007                      (insert " ")
5008                      (setq gnus-group-marked (delete group gnus-group-marked)))
5009                  (insert "#")
5010                  (setq gnus-group-marked
5011                        (cons group (delete group gnus-group-marked))))
5012                t)
5013              (or no-advance (zerop (gnus-group-next-group 1))))
5014       (setq n (1- n)))
5015     (gnus-summary-position-point)
5016     n))
5017
5018 (defun gnus-group-unmark-group (n)
5019   "Remove the mark from the current group."
5020   (interactive "p")
5021   (gnus-group-mark-group n 'unmark)
5022   (gnus-group-position-point))
5023
5024 (defun gnus-group-unmark-all-groups ()
5025   "Unmark all groups."
5026   (interactive)
5027   (let ((groups gnus-group-marked))
5028     (save-excursion
5029       (while groups
5030         (gnus-group-remove-mark (pop groups)))))
5031   (gnus-group-position-point))
5032
5033 (defun gnus-group-mark-region (unmark beg end)
5034   "Mark all groups between point and mark.
5035 If UNMARK, remove the mark instead."
5036   (interactive "P\nr")
5037   (let ((num (count-lines beg end)))
5038     (save-excursion
5039       (goto-char beg)
5040       (- num (gnus-group-mark-group num unmark)))))
5041
5042 (defun gnus-group-mark-buffer (&optional unmark)
5043   "Mark all groups in the buffer.
5044 If UNMARK, remove the mark instead."
5045   (interactive "P")
5046   (gnus-group-mark-region unmark (point-min) (point-max)))
5047
5048 (defun gnus-group-mark-regexp (regexp)
5049   "Mark all groups that match some regexp."
5050   (interactive "sMark (regexp): ")
5051   (let ((alist (cdr gnus-newsrc-alist))
5052         group)
5053     (while alist
5054       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
5055         (gnus-group-set-mark group))))
5056   (gnus-group-position-point))
5057
5058 (defun gnus-group-remove-mark (group)
5059   "Remove the process mark from GROUP and move point there.
5060 Return nil if the group isn't displayed."
5061   (if (gnus-group-goto-group group)
5062       (save-excursion
5063         (gnus-group-mark-group 1 'unmark t)
5064         t)
5065     (setq gnus-group-marked
5066           (delete group gnus-group-marked))
5067     nil))
5068
5069 (defun gnus-group-set-mark (group)
5070   "Set the process mark on GROUP."
5071   (if (gnus-group-goto-group group) 
5072       (save-excursion
5073         (gnus-group-mark-group 1 nil t))
5074     (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
5075
5076 (defun gnus-group-universal-argument (arg &optional groups func)
5077   "Perform any command on all groups accoring to the process/prefix convention."
5078   (interactive "P")
5079   (let ((groups (or groups (gnus-group-process-prefix arg)))
5080         group func)
5081     (if (eq (setq func (or func
5082                            (key-binding
5083                             (read-key-sequence
5084                              (substitute-command-keys
5085                               "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
5086             'undefined)
5087         (progn
5088           (message "Undefined key")
5089           (ding))
5090       (while groups
5091         (gnus-group-remove-mark (setq group (pop groups)))
5092         (command-execute func))))
5093   (gnus-group-position-point))
5094
5095 (defun gnus-group-process-prefix (n)
5096   "Return a list of groups to work on.
5097 Take into consideration N (the prefix) and the list of marked groups."
5098   (cond
5099    (n
5100     (setq n (prefix-numeric-value n))
5101     ;; There is a prefix, so we return a list of the N next
5102     ;; groups.
5103     (let ((way (if (< n 0) -1 1))
5104           (n (abs n))
5105           group groups)
5106       (save-excursion
5107         (while (and (> n 0)
5108                     (setq group (gnus-group-group-name)))
5109           (setq groups (cons group groups))
5110           (setq n (1- n))
5111           (gnus-group-next-group way)))
5112       (nreverse groups)))
5113    ((and (boundp 'transient-mark-mode)
5114          transient-mark-mode
5115          mark-active)
5116     ;; Work on the region between point and mark.
5117     (let ((max (max (point) (mark)))
5118           groups)
5119       (save-excursion
5120         (goto-char (min (point) (mark)))
5121         (while
5122             (and
5123              (push (gnus-group-group-name) groups)
5124              (zerop (gnus-group-next-group 1))
5125              (< (point) max)))
5126         (nreverse groups))))
5127    (gnus-group-marked
5128     ;; No prefix, but a list of marked articles.
5129     (reverse gnus-group-marked))
5130    (t
5131     ;; Neither marked articles or a prefix, so we return the
5132     ;; current group.
5133     (let ((group (gnus-group-group-name)))
5134       (and group (list group))))))
5135
5136 ;; Selecting groups.
5137
5138 (defun gnus-group-read-group (&optional all no-article group)
5139   "Read news in this newsgroup.
5140 If the prefix argument ALL is non-nil, already read articles become
5141 readable.  IF ALL is a number, fetch this number of articles.  If the
5142 optional argument NO-ARTICLE is non-nil, no article will be
5143 auto-selected upon group entry.  If GROUP is non-nil, fetch that
5144 group."
5145   (interactive "P")
5146   (let ((group (or group (gnus-group-group-name)))
5147         number active marked entry)
5148     (or group (error "No group on current line"))
5149     (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
5150                                             group gnus-newsrc-hashtb)))))
5151     ;; This group might be a dead group.  In that case we have to get
5152     ;; the number of unread articles from `gnus-active-hashtb'.
5153     (setq number
5154           (cond ((numberp all) all)
5155                 (entry (car entry))
5156                 ((setq active (gnus-active group))
5157                  (- (1+ (cdr active)) (car active)))))
5158     (gnus-summary-read-group
5159      group (or all (and (numberp number)
5160                         (zerop (+ number (length (cdr (assq 'tick marked)))
5161                                   (length (cdr (assq 'dormant marked)))))))
5162      no-article)))
5163
5164 (defun gnus-group-select-group (&optional all)
5165   "Select this newsgroup.
5166 No article is selected automatically.
5167 If ALL is non-nil, already read articles become readable.
5168 If ALL is a number, fetch this number of articles."
5169   (interactive "P")
5170   (gnus-group-read-group all t))
5171
5172 (defun gnus-group-quick-select-group (&optional all)
5173   "Select the current group \"quickly\".
5174 This means that no highlighting or scoring will be performed."
5175   (interactive "P")
5176   (let (gnus-visual
5177         gnus-score-find-score-files-function
5178         gnus-apply-kill-hook
5179         gnus-summary-expunge-below)
5180     (gnus-group-read-group all t)))
5181
5182 (defun gnus-group-visible-select-group (&optional all)
5183   "Select the current group without hiding any articles."
5184   (interactive "P")
5185   (let ((gnus-inhibit-limiting t))
5186     (gnus-group-read-group all t)))
5187
5188 ;;;###autoload
5189 (defun gnus-fetch-group (group)
5190   "Start Gnus if necessary and enter GROUP.
5191 Returns whether the fetching was successful or not."
5192   (interactive "sGroup name: ")
5193   (or (get-buffer gnus-group-buffer)
5194       (gnus))
5195   (gnus-group-read-group nil nil group))
5196
5197 ;; Enter a group that is not in the group buffer.  Non-nil is returned
5198 ;; if selection was successful.
5199 (defun gnus-group-read-ephemeral-group
5200   (group method &optional activate quit-config)
5201   (let ((group (if (gnus-group-foreign-p group) group
5202                  (gnus-group-prefixed-name group method))))
5203     (gnus-sethash
5204      group
5205      `(t nil (,group ,gnus-level-default-subscribed nil nil ,method
5206                      ((quit-config . ,(if quit-config quit-config
5207                                         (cons (current-buffer) 'summary))))))
5208      gnus-newsrc-hashtb)
5209     (set-buffer gnus-group-buffer)
5210     (or (gnus-check-server method)
5211         (error "Unable to contact server: %s" (gnus-status-message method)))
5212     (if activate (or (gnus-request-group group)
5213                      (error "Couldn't request group")))
5214     (condition-case ()
5215         (gnus-group-read-group t t group)
5216       (error nil)
5217       (quit nil))))
5218
5219 (defun gnus-group-jump-to-group (group)
5220   "Jump to newsgroup GROUP."
5221   (interactive
5222    (list (completing-read
5223           "Group: " gnus-active-hashtb nil
5224           (memq gnus-select-method gnus-have-read-active-file))))
5225
5226   (if (equal group "")
5227       (error "Empty group name"))
5228
5229   (let ((b (text-property-any
5230             (point-min) (point-max)
5231             'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
5232     (unless (gnus-ephemeral-group-p group)
5233       (if b
5234           ;; Either go to the line in the group buffer...
5235           (goto-char b)
5236         ;; ... or insert the line.
5237         (or
5238          (gnus-active group)
5239          (gnus-activate-group group)
5240          (error "%s error: %s" group (gnus-status-message group)))
5241
5242         (gnus-group-update-group group)
5243         (goto-char (text-property-any
5244                     (point-min) (point-max)
5245                     'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
5246     ;; Adjust cursor point.
5247     (gnus-group-position-point)))
5248
5249 (defun gnus-group-goto-group (group)
5250   "Goto to newsgroup GROUP."
5251   (when group
5252     (let ((b (text-property-any (point-min) (point-max)
5253                                 'gnus-group (gnus-intern-safe
5254                                              group gnus-active-hashtb))))
5255       (and b (goto-char b)))))
5256
5257 (defun gnus-group-next-group (n)
5258   "Go to next N'th newsgroup.
5259 If N is negative, search backward instead.
5260 Returns the difference between N and the number of skips actually
5261 done."
5262   (interactive "p")
5263   (gnus-group-next-unread-group n t))
5264
5265 (defun gnus-group-next-unread-group (n &optional all level)
5266   "Go to next N'th unread newsgroup.
5267 If N is negative, search backward instead.
5268 If ALL is non-nil, choose any newsgroup, unread or not.
5269 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
5270 such group can be found, the next group with a level higher than
5271 LEVEL.
5272 Returns the difference between N and the number of skips actually
5273 made."
5274   (interactive "p")
5275   (let ((backward (< n 0))
5276         (n (abs n)))
5277     (while (and (> n 0)
5278                 (gnus-group-search-forward
5279                  backward (or (not gnus-group-goto-unread) all) level))
5280       (setq n (1- n)))
5281     (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
5282                                (if level " on this level or higher" "")))
5283     n))
5284
5285 (defun gnus-group-prev-group (n)
5286   "Go to previous N'th newsgroup.
5287 Returns the difference between N and the number of skips actually
5288 done."
5289   (interactive "p")
5290   (gnus-group-next-unread-group (- n) t))
5291
5292 (defun gnus-group-prev-unread-group (n)
5293   "Go to previous N'th unread newsgroup.
5294 Returns the difference between N and the number of skips actually
5295 done."
5296   (interactive "p")
5297   (gnus-group-next-unread-group (- n)))
5298
5299 (defun gnus-group-next-unread-group-same-level (n)
5300   "Go to next N'th unread newsgroup on the same level.
5301 If N is negative, search backward instead.
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 (gnus-group-group-level))
5306   (gnus-group-position-point))
5307
5308 (defun gnus-group-prev-unread-group-same-level (n)
5309   "Go to next N'th unread newsgroup on the same level.
5310 Returns the difference between N and the number of skips actually
5311 done."
5312   (interactive "p")
5313   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
5314   (gnus-group-position-point))
5315
5316 (defun gnus-group-best-unread-group (&optional exclude-group)
5317   "Go to the group with the highest level.
5318 If EXCLUDE-GROUP, do not go to that group."
5319   (interactive)
5320   (goto-char (point-min))
5321   (let ((best 100000)
5322         unread best-point)
5323     (while (setq unread (get-text-property (point) 'gnus-unread))
5324       (if (and (numberp unread) (> unread 0))
5325           (progn
5326             (if (and (get-text-property (point) 'gnus-level)
5327                      (< (get-text-property (point) 'gnus-level) best)
5328                      (or (not exclude-group)
5329                          (not (equal exclude-group (gnus-group-group-name)))))
5330                 (progn
5331                   (setq best (get-text-property (point) 'gnus-level))
5332                   (setq best-point (point))))))
5333       (forward-line 1))
5334     (if best-point (goto-char best-point))
5335     (gnus-summary-position-point)
5336     (and best-point (gnus-group-group-name))))
5337
5338 (defun gnus-group-first-unread-group ()
5339   "Go to the first group with unread articles."
5340   (interactive)
5341   (prog1
5342       (let ((opoint (point))
5343             unread)
5344         (goto-char (point-min))
5345         (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
5346                 (and (numberp unread)   ; Not a topic.
5347                      (not (zerop unread))) ; Has unread articles.
5348                 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
5349             (point)                     ; Success.
5350           (goto-char opoint)
5351           nil))                         ; Not success.
5352     (gnus-group-position-point)))
5353
5354 (defun gnus-group-enter-server-mode ()
5355   "Jump to the server buffer."
5356   (interactive)
5357   (gnus-enter-server-buffer))
5358
5359 (defun gnus-group-make-group (name &optional method address)
5360   "Add a new newsgroup.
5361 The user will be prompted for a NAME, for a select METHOD, and an
5362 ADDRESS."
5363   (interactive
5364    (cons
5365     (read-string "Group name: ")
5366     (let ((method
5367            (completing-read
5368             "Method: " (append gnus-valid-select-methods gnus-server-alist)
5369             nil t)))
5370       (if (assoc method gnus-valid-select-methods)
5371           (list method
5372                 (if (memq 'prompt-address
5373                           (assoc method gnus-valid-select-methods))
5374                     (read-string "Address: ")
5375                   ""))
5376         (list method "")))))
5377
5378   (save-excursion
5379     (set-buffer gnus-group-buffer)
5380     (let* ((meth (and method (if address (list (intern method) address)
5381                                method)))
5382            (nname (if method (gnus-group-prefixed-name name meth) name))
5383            info)
5384       (and (gnus-gethash nname gnus-newsrc-hashtb)
5385            (error "Group %s already exists" nname))
5386       (gnus-group-change-level
5387        (setq info (list t nname gnus-level-default-subscribed nil nil meth))
5388        gnus-level-default-subscribed gnus-level-killed
5389        (and (gnus-group-group-name)
5390             (gnus-gethash (gnus-group-group-name)
5391                           gnus-newsrc-hashtb))
5392        t)
5393       (gnus-set-active nname (cons 1 0))
5394       (or (gnus-ephemeral-group-p name)
5395           (gnus-dribble-enter
5396            (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
5397       (gnus-group-insert-group-line-info nname)
5398
5399       (when (assoc (symbol-name (car meth)) gnus-valid-select-methods)
5400         (require (car meth)))
5401       (gnus-check-server meth)
5402       (and (gnus-check-backend-function 'request-create-group nname)
5403            (gnus-request-create-group nname))
5404       t)))
5405
5406 (defun gnus-group-delete-group (group &optional force)
5407   "Delete the current group.
5408 If FORCE (the prefix) is non-nil, all the articles in the group will
5409 be deleted.  This is \"deleted\" as in \"removed forever from the face
5410 of the Earth\".  There is no undo."
5411   (interactive
5412    (list (gnus-group-group-name)
5413          current-prefix-arg))
5414   (or group (error "No group to rename"))
5415   (or (gnus-check-backend-function 'request-delete-group group)
5416       (error "This backend does not support group deletion"))
5417   (prog1
5418       (if (not (gnus-yes-or-no-p
5419                 (format
5420                  "Do you really want to delete %s%s? "
5421                  group (if force " and all its contents" ""))))
5422           () ; Whew!
5423         (gnus-message 6 "Deleting group %s..." group)
5424         (if (not (gnus-request-delete-group group force))
5425             (progn
5426               (gnus-message 3 "Couldn't delete group %s" group)
5427               (ding))
5428           (gnus-message 6 "Deleting group %s...done" group)
5429           (gnus-group-goto-group group)
5430           (gnus-group-kill-group 1 t)
5431           (gnus-sethash group nil gnus-active-hashtb)
5432           t))
5433     (gnus-group-position-point)))
5434
5435 (defun gnus-group-rename-group (group new-name)
5436   (interactive
5437    (list
5438     (gnus-group-group-name)
5439     (progn
5440       (or (gnus-check-backend-function
5441            'request-rename-group (gnus-group-group-name))
5442           (error "This backend does not support renaming groups"))
5443       (read-string "New group name: "))))
5444
5445   (or (gnus-check-backend-function 'request-rename-group group)
5446       (error "This backend does not support renaming groups"))
5447
5448   (or group (error "No group to rename"))
5449   (and (string-match "^[ \t]*$" new-name)
5450        (error "Not a valid group name"))
5451
5452   ;; We find the proper prefixed name.
5453   (setq new-name
5454         (gnus-group-prefixed-name
5455          (gnus-group-real-name new-name)
5456          (gnus-info-method (gnus-get-info group))))
5457
5458   (gnus-message 6 "Renaming group %s to %s..." group new-name)
5459   (prog1
5460       (if (not (gnus-request-rename-group group new-name))
5461           (progn
5462             (gnus-message 3 "Couldn't rename group %s to %s" group new-name)
5463             (ding))
5464         ;; We rename the group internally by killing it...
5465         (gnus-group-goto-group group)
5466         (gnus-group-kill-group)
5467         ;; ... changing its name ...
5468         (setcar (cdar gnus-list-of-killed-groups) new-name)
5469         ;; ... and then yanking it.  Magic!
5470         (gnus-group-yank-group)
5471         (gnus-set-active new-name (gnus-active group))
5472         (gnus-message 6 "Renaming group %s to %s...done" group new-name)
5473         new-name)
5474     (gnus-group-position-point)))
5475
5476 (defun gnus-group-edit-group (group &optional part)
5477   "Edit the group on the current line."
5478   (interactive (list (gnus-group-group-name)))
5479   (let* ((part (or part 'info))
5480          (done-func `(lambda ()
5481                        "Exit editing mode and update the information."
5482                        (interactive)
5483                        (gnus-group-edit-group-done ',part ,group)))
5484          (winconf (current-window-configuration))
5485          info)
5486     (or group (error "No group on current line"))
5487     (or (setq info (gnus-get-info group))
5488         (error "Killed group; can't be edited"))
5489     (set-buffer (get-buffer-create gnus-group-edit-buffer))
5490     (gnus-configure-windows 'edit-group)
5491     (gnus-add-current-to-buffer-list)
5492     (emacs-lisp-mode)
5493     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
5494     (use-local-map (copy-keymap emacs-lisp-mode-map))
5495     (local-set-key "\C-c\C-c" done-func)
5496     (make-local-variable 'gnus-prev-winconf)
5497     (setq gnus-prev-winconf winconf)
5498     (erase-buffer)
5499     (insert
5500      (cond
5501       ((eq part 'method)
5502        ";; Type `C-c C-c' after editing the select method.\n\n")
5503       ((eq part 'params)
5504        ";; Type `C-c C-c' after editing the group parameters.\n\n")
5505       ((eq part 'info)
5506        ";; Type `C-c C-c' after editing the group info.\n\n")))
5507     (insert
5508      (pp-to-string
5509       (cond ((eq part 'method)
5510              (or (gnus-info-method info) "native"))
5511             ((eq part 'params)
5512              (gnus-info-params info))
5513             (t info)))
5514      "\n")))
5515
5516 (defun gnus-group-edit-group-method (group)
5517   "Edit the select method of GROUP."
5518   (interactive (list (gnus-group-group-name)))
5519   (gnus-group-edit-group group 'method))
5520
5521 (defun gnus-group-edit-group-parameters (group)
5522   "Edit the group parameters of GROUP."
5523   (interactive (list (gnus-group-group-name)))
5524   (gnus-group-edit-group group 'params))
5525
5526 (defun gnus-group-edit-group-done (part group)
5527   "Get info from buffer, update variables and jump to the group buffer."
5528   (set-buffer (get-buffer-create gnus-group-edit-buffer))
5529   (goto-char (point-min))
5530   (let* ((form (read (current-buffer)))
5531          (winconf gnus-prev-winconf)
5532          (method (cond ((eq part 'info) (nth 4 form))
5533                        ((eq part 'method) form)
5534                        (t nil)))
5535          (info (cond ((eq part 'info) form)
5536                      ((eq part 'method) (gnus-get-info group))
5537                      (t nil)))
5538          (new-group (if info
5539                       (if (or (not method)
5540                               (gnus-server-equal
5541                                gnus-select-method method))
5542                           (gnus-group-real-name (car info))
5543                         (gnus-group-prefixed-name
5544                          (gnus-group-real-name (car info)) method))
5545                       nil)))
5546     (when (and new-group
5547                (not (equal new-group group)))
5548       (when (gnus-group-goto-group group)
5549         (gnus-group-kill-group 1))
5550       (gnus-activate-group new-group))
5551     ;; Set the info.
5552     (if (and info new-group)
5553         (progn
5554           (setq info (gnus-copy-sequence info))
5555           (setcar info new-group)
5556           (unless (gnus-server-equal method "native")
5557             (unless (nthcdr 3 info)
5558               (nconc info (list nil nil)))
5559             (unless (nthcdr 4 info)
5560               (nconc info (list nil)))
5561             (gnus-info-set-method info method))
5562           (gnus-group-set-info info))
5563       (gnus-group-set-info form (or new-group group) part))
5564     (kill-buffer (current-buffer))
5565     (and winconf (set-window-configuration winconf))
5566     (set-buffer gnus-group-buffer)
5567     (gnus-group-update-group (or new-group group))
5568     (gnus-group-position-point)))
5569
5570 (defun gnus-group-make-help-group ()
5571   "Create the Gnus documentation group."
5572   (interactive)
5573   (let ((path load-path)
5574         (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
5575         file dir)
5576     (and (gnus-gethash name gnus-newsrc-hashtb)
5577          (error "Documentation group already exists"))
5578     (while path
5579       (setq dir (file-name-as-directory (expand-file-name (pop path)))
5580             file nil)
5581       (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt")))
5582                 (file-exists-p
5583                  (setq file (concat (file-name-directory
5584                                      (directory-file-name dir))
5585                                     "etc/gnus-tut.txt"))))
5586         (setq path nil)))
5587     (if (not file)
5588         (message "Couldn't find doc group")
5589       (gnus-group-make-group
5590        (gnus-group-real-name name)
5591        (list 'nndoc "gnus-help"
5592              (list 'nndoc-address file)
5593              (list 'nndoc-article-type 'mbox)))))
5594   (gnus-group-position-point))
5595
5596 (defun gnus-group-make-doc-group (file type)
5597   "Create a group that uses a single file as the source."
5598   (interactive
5599    (list (read-file-name "File name: ")
5600          (and current-prefix-arg 'ask)))
5601   (when (eq type 'ask)
5602     (let ((err "")
5603           char found)
5604       (while (not found)
5605         (message
5606          "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
5607          err)
5608         (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
5609                           ((= char ?b) 'babyl)
5610                           ((= char ?d) 'digest)
5611                           ((= char ?f) 'forward)
5612                           ((= char ?a) 'mmfd)
5613                           (t (setq err (format "%c unknown. " char))
5614                              nil))))
5615       (setq type found)))
5616   (let* ((file (expand-file-name file))
5617          (name (gnus-generate-new-group-name
5618                 (gnus-group-prefixed-name
5619                  (file-name-nondirectory file) '(nndoc "")))))
5620     (gnus-group-make-group
5621      (gnus-group-real-name name)
5622      (list 'nndoc (file-name-nondirectory file)
5623            (list 'nndoc-address file)
5624            (list 'nndoc-article-type (or type 'guess))))
5625     (forward-line -1)
5626     (gnus-group-position-point)))
5627
5628 (defun gnus-group-make-archive-group (&optional all)
5629   "Create the (ding) Gnus archive group of the most recent articles.
5630 Given a prefix, create a full group."
5631   (interactive "P")
5632   (let ((group (gnus-group-prefixed-name
5633                 (if all "ding.archives" "ding.recent") '(nndir ""))))
5634     (and (gnus-gethash group gnus-newsrc-hashtb)
5635          (error "Archive group already exists"))
5636     (gnus-group-make-group
5637      (gnus-group-real-name group)
5638      (list 'nndir (if all "hpc" "edu")
5639            (list 'nndir-directory
5640                  (if all gnus-group-archive-directory
5641                    gnus-group-recent-archive-directory)))))
5642   (forward-line -1)
5643   (gnus-group-position-point))
5644
5645 (defun gnus-group-make-directory-group (dir)
5646   "Create an nndir group.
5647 The user will be prompted for a directory.  The contents of this
5648 directory will be used as a newsgroup.  The directory should contain
5649 mail messages or news articles in files that have numeric names."
5650   (interactive
5651    (list (read-file-name "Create group from directory: ")))
5652   (or (file-exists-p dir) (error "No such directory"))
5653   (or (file-directory-p dir) (error "Not a directory"))
5654   (let ((ext "")
5655         (i 0)
5656         group)
5657     (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
5658       (setq group
5659             (gnus-group-prefixed-name
5660              (concat (file-name-as-directory (directory-file-name dir))
5661                      ext)
5662              '(nndir "")))
5663       (setq ext (format "<%d>" (setq i (1+ i)))))
5664     (gnus-group-make-group
5665      (gnus-group-real-name group)
5666      (list 'nndir group (list 'nndir-directory dir))))
5667   (forward-line -1)
5668   (gnus-group-position-point))
5669
5670 (defun gnus-group-make-kiboze-group (group address scores)
5671   "Create an nnkiboze group.
5672 The user will be prompted for a name, a regexp to match groups, and
5673 score file entries for articles to include in the group."
5674   (interactive
5675    (list
5676     (read-string "nnkiboze group name: ")
5677     (read-string "Source groups (regexp): ")
5678     (let ((headers (mapcar (lambda (group) (list group))
5679                            '("subject" "from" "number" "date" "message-id"
5680                              "references" "chars" "lines" "xref"
5681                              "followup" "all" "body" "head")))
5682           scores header regexp regexps)
5683       (while (not (equal "" (setq header (completing-read
5684                                           "Match on header: " headers nil t))))
5685         (setq regexps nil)
5686         (while (not (equal "" (setq regexp (read-string
5687                                             (format "Match on %s (string): "
5688                                                     header)))))
5689           (setq regexps (cons (list regexp nil nil 'r) regexps)))
5690         (setq scores (cons (cons header regexps) scores)))
5691       scores)))
5692   (gnus-group-make-group group "nnkiboze" address)
5693   (save-excursion
5694     (gnus-set-work-buffer)
5695     (let (emacs-lisp-mode-hook)
5696       (pp scores (current-buffer)))
5697     (write-region (point-min) (point-max)
5698                   (gnus-score-file-name (concat "nnkiboze:" group))))
5699   (forward-line -1)
5700   (gnus-group-position-point))
5701
5702 (defun gnus-group-add-to-virtual (n vgroup)
5703   "Add the current group to a virtual group."
5704   (interactive
5705    (list current-prefix-arg
5706          (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
5707                           "nnvirtual:")))
5708   (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
5709       (error "%s is not an nnvirtual group" vgroup))
5710   (let* ((groups (gnus-group-process-prefix n))
5711          (method (gnus-info-method (gnus-get-info vgroup))))
5712     (setcar (cdr method)
5713             (concat
5714              (nth 1 method) "\\|"
5715              (mapconcat
5716               (lambda (s)
5717                 (gnus-group-remove-mark s)
5718                 (concat "\\(^" (regexp-quote s) "$\\)"))
5719               groups "\\|"))))
5720   (gnus-group-position-point))
5721
5722 (defun gnus-group-make-empty-virtual (group)
5723   "Create a new, fresh, empty virtual group."
5724   (interactive "sCreate new, empty virtual group: ")
5725   (let* ((method (list 'nnvirtual "^$"))
5726          (pgroup (gnus-group-prefixed-name group method)))
5727     ;; Check whether it exists already.
5728     (and (gnus-gethash pgroup gnus-newsrc-hashtb)
5729          (error "Group %s already exists." pgroup))
5730     ;; Subscribe the new group after the group on the current line.
5731     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
5732     (gnus-group-update-group pgroup)
5733     (forward-line -1)
5734     (gnus-group-position-point)))
5735
5736 (defun gnus-group-enter-directory (dir)
5737   "Enter an ephemeral nneething group."
5738   (interactive "DDirectory to read: ")
5739   (let* ((method (list 'nneething dir))
5740          (leaf (gnus-group-prefixed-name
5741                 (file-name-nondirectory (directory-file-name dir))
5742                 method))
5743          (name (gnus-generate-new-group-name leaf)))
5744     (let ((nneething-read-only t))
5745       (or (gnus-group-read-ephemeral-group
5746            name method t
5747            (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
5748                                       'summary 'group)))
5749           (error "Couldn't enter %s" dir)))))
5750
5751 ;; Group sorting commands
5752 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
5753
5754 (defun gnus-group-sort-groups (func &optional reverse)
5755   "Sort the group buffer according to FUNC.
5756 If REVERSE, reverse the sorting order."
5757   (interactive (list gnus-group-sort-function
5758                      current-prefix-arg))
5759   (let ((func (cond 
5760                ((not (listp func)) func)
5761                ((null func) func)
5762                ((= 1 (length func)) (car func))
5763                (t `(lambda (t1 t2)
5764                      ,(gnus-make-sort-function 
5765                        (reverse func)))))))
5766     ;; We peel off the dummy group from the alist.
5767     (when func
5768       (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
5769         (pop gnus-newsrc-alist))
5770       ;; Do the sorting.
5771       (setq gnus-newsrc-alist
5772             (sort gnus-newsrc-alist func))
5773       (when reverse
5774         (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
5775       ;; Regenerate the hash table.
5776       (gnus-make-hashtable-from-newsrc-alist)
5777       (gnus-group-list-groups))))
5778
5779 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
5780   "Sort the group buffer alphabetically by group name.
5781 If REVERSE, sort in reverse order."
5782   (interactive "P")
5783   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
5784
5785 (defun gnus-group-sort-groups-by-unread (&optional reverse)
5786   "Sort the group buffer by number of unread articles.
5787 If REVERSE, sort in reverse order."
5788   (interactive "P")
5789   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
5790
5791 (defun gnus-group-sort-groups-by-level (&optional reverse)
5792   "Sort the group buffer by group level.
5793 If REVERSE, sort in reverse order."
5794   (interactive "P")
5795   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
5796
5797 (defun gnus-group-sort-groups-by-score (&optional reverse)
5798   "Sort the group buffer by group score.
5799 If REVERSE, sort in reverse order."
5800   (interactive "P")
5801   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
5802
5803 (defun gnus-group-sort-groups-by-rank (&optional reverse)
5804   "Sort the group buffer by group rank.
5805 If REVERSE, sort in reverse order."
5806   (interactive "P")
5807   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
5808
5809 (defun gnus-group-sort-groups-by-method (&optional reverse)
5810   "Sort the group buffer alphabetically by backend name.
5811 If REVERSE, sort in reverse order."
5812   (interactive "P")
5813   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
5814
5815 (defun gnus-group-sort-by-alphabet (info1 info2)
5816   "Sort alphabetically."
5817   (string< (gnus-info-group info1) (gnus-info-group info2)))
5818
5819 (defun gnus-group-sort-by-unread (info1 info2)
5820   "Sort by number of unread articles."
5821   (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
5822         (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
5823     (< (or (and (numberp n1) n1) 0)
5824        (or (and (numberp n2) n2) 0))))
5825
5826 (defun gnus-group-sort-by-level (info1 info2)
5827   "Sort by level."
5828   (< (gnus-info-level info1) (gnus-info-level info2)))
5829
5830 (defun gnus-group-sort-by-method (info1 info2)
5831   "Sort alphabetically by backend name."
5832   (string< (symbol-name (car (gnus-find-method-for-group
5833                               (gnus-info-group info1) info1)))
5834            (symbol-name (car (gnus-find-method-for-group
5835                               (gnus-info-group info2) info2)))))
5836
5837 (defun gnus-group-sort-by-score (info1 info2)
5838   "Sort by group score."
5839   (< (gnus-info-score info1) (gnus-info-score info2)))
5840
5841 (defun gnus-group-sort-by-rank (info1 info2)
5842   "Sort by level and score."
5843   (let ((level1 (gnus-info-level info1))
5844         (level2 (gnus-info-level info2)))
5845     (or (< level1 level2)
5846         (and (= level1 level2)
5847              (< (gnus-info-score info1) (gnus-info-score info2))))))
5848
5849 ;; Group catching up.
5850
5851 (defun gnus-group-clear-data (n)
5852   "Clear all marks and read ranges from the current group."
5853   (interactive "P")
5854   (let ((groups (gnus-group-process-prefix n))
5855         group info)
5856     (while (setq group (pop groups))
5857       (setq info (gnus-get-info group))
5858       (gnus-info-set-read info nil)
5859       (when (gnus-info-marks info)
5860         (gnus-info-set-marks info nil))
5861       (gnus-get-unread-articles-in-group info (gnus-active group) t)
5862       (when (gnus-group-goto-group group)
5863         (gnus-group-remove-mark group)
5864         (gnus-group-update-group-line)))))
5865
5866 (defun gnus-group-catchup-current (&optional n all)
5867   "Mark all articles not marked as unread in current newsgroup as read.
5868 If prefix argument N is numeric, the ARG next newsgroups will be
5869 caught up.  If ALL is non-nil, marked articles will also be marked as
5870 read.  Cross references (Xref: header) of articles are ignored.
5871 The difference between N and actual number of newsgroups that were
5872 caught up is returned."
5873   (interactive "P")
5874   (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
5875                gnus-expert-user
5876                (gnus-y-or-n-p
5877                 (if all
5878                     "Do you really want to mark all articles as read? "
5879                   "Mark all unread articles as read? "))))
5880       n
5881     (let ((groups (gnus-group-process-prefix n))
5882           (ret 0))
5883       (while groups
5884         ;; Virtual groups have to be given special treatment.
5885         (let ((method (gnus-find-method-for-group (car groups))))
5886           (if (eq 'nnvirtual (car method))
5887               (nnvirtual-catchup-group
5888                (gnus-group-real-name (car groups)) (nth 1 method) all)))
5889         (gnus-group-remove-mark (car groups))
5890         (if (prog1
5891                 (gnus-group-goto-group (car groups))
5892               (gnus-group-catchup (car groups) all))
5893             (gnus-group-update-group-line)
5894           (setq ret (1+ ret)))
5895         (setq groups (cdr groups)))
5896       (gnus-group-next-unread-group 1)
5897       ret)))
5898
5899 (defun gnus-group-catchup-current-all (&optional n)
5900   "Mark all articles in current newsgroup as read.
5901 Cross references (Xref: header) of articles are ignored."
5902   (interactive "P")
5903   (gnus-group-catchup-current n 'all))
5904
5905 (defun gnus-group-catchup (group &optional all)
5906   "Mark all articles in GROUP as read.
5907 If ALL is non-nil, all articles are marked as read.
5908 The return value is the number of articles that were marked as read,
5909 or nil if no action could be taken."
5910   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
5911          (num (car entry)))
5912     ;; Do the updating only if the newsgroup isn't killed.
5913     (if (not (numberp (car entry)))
5914         (gnus-message 1 "Can't catch up; non-active group")
5915       ;; Do auto-expirable marks if that's required.
5916       (when (gnus-group-auto-expirable-p group)
5917         (gnus-add-marked-articles
5918          group 'expire (gnus-list-of-unread-articles group))
5919         (when all
5920           (let ((marks (nth 3 (nth 2 entry))))
5921             (gnus-add-marked-articles
5922              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
5923             (gnus-add-marked-articles
5924              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
5925       (when entry
5926         (gnus-update-read-articles group nil)
5927         ;; Also nix out the lists of marks and dormants.
5928         (when all
5929           (gnus-add-marked-articles group 'tick nil nil 'force)
5930           (gnus-add-marked-articles group 'dormant nil nil 'force))
5931         (run-hooks 'gnus-group-catchup-group-hook)
5932         num))))
5933
5934 (defun gnus-group-expire-articles (&optional n)
5935   "Expire all expirable articles in the current newsgroup."
5936   (interactive "P")
5937   (let ((groups (gnus-group-process-prefix n))
5938         group)
5939     (unless groups
5940       (error "No groups to expire"))
5941     (while (setq group (pop groups))
5942       (gnus-group-remove-mark group)
5943       (when (gnus-check-backend-function 'request-expire-articles group)
5944         (gnus-message 6 "Expiring articles in %s..." group)
5945         (let* ((info (gnus-get-info group))
5946                (expirable (if (gnus-group-total-expirable-p group)
5947                               (cons nil (gnus-list-of-read-articles group))
5948                             (assq 'expire (gnus-info-marks info))))
5949                (expiry-wait (gnus-group-get-parameter group 'expiry-wait)))
5950           (when expirable
5951             (setcdr
5952              expirable
5953              (gnus-compress-sequence
5954               (if expiry-wait
5955                   ;; We set the expiry variables to the groupp
5956                   ;; parameter. 
5957                   (let ((nnmail-expiry-wait-function nil)
5958                         (nnmail-expiry-wait expiry-wait))
5959                     (gnus-request-expire-articles
5960                      (gnus-uncompress-sequence (cdr expirable)) group))
5961                 ;; Just expire using the normal expiry values.
5962                 (gnus-request-expire-articles
5963                  (gnus-uncompress-sequence (cdr expirable)) group)))))
5964           (gnus-message 6 "Expiring articles in %s...done" group)))
5965       (gnus-group-position-point))))
5966
5967 (defun gnus-group-expire-all-groups ()
5968   "Expire all expirable articles in all newsgroups."
5969   (interactive)
5970   (save-excursion
5971     (gnus-message 5 "Expiring...")
5972     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
5973                                      (cdr gnus-newsrc-alist))))
5974       (gnus-group-expire-articles nil)))
5975   (gnus-group-position-point)
5976   (gnus-message 5 "Expiring...done"))
5977
5978 (defun gnus-group-set-current-level (n level)
5979   "Set the level of the next N groups to LEVEL."
5980   (interactive
5981    (list
5982     current-prefix-arg
5983     (string-to-int
5984      (let ((s (read-string
5985                (format "Level (default %s): "
5986                        (or (gnus-group-group-level) 
5987                            gnus-level-default-subscribed)))))
5988        (if (string-match "^\\s-*$" s)
5989            (int-to-string (or (gnus-group-group-level) 
5990                               gnus-level-default-subscribed))
5991          s)))))
5992   (or (and (>= level 1) (<= level gnus-level-killed))
5993       (error "Illegal level: %d" level))
5994   (let ((groups (gnus-group-process-prefix n))
5995         group)
5996     (while (setq group (pop groups))
5997       (gnus-group-remove-mark group)
5998       (gnus-message 6 "Changed level of %s from %d to %d"
5999                     group (or (gnus-group-group-level) gnus-level-killed)
6000                     level)
6001       (gnus-group-change-level
6002        group level (or (gnus-group-group-level) gnus-level-killed))
6003       (gnus-group-update-group-line)))
6004   (gnus-group-position-point))
6005
6006 (defun gnus-group-unsubscribe-current-group (&optional n)
6007   "Toggle subscription of the current group.
6008 If given numerical prefix, toggle the N next groups."
6009   (interactive "P")
6010   (let ((groups (gnus-group-process-prefix n))
6011         group)
6012     (while groups
6013       (setq group (car groups)
6014             groups (cdr groups))
6015       (gnus-group-remove-mark group)
6016       (gnus-group-unsubscribe-group
6017        group (if (<= (gnus-group-group-level) gnus-level-subscribed)
6018                  gnus-level-default-unsubscribed
6019                gnus-level-default-subscribed) t)
6020       (gnus-group-update-group-line))
6021     (gnus-group-next-group 1)))
6022
6023 (defun gnus-group-unsubscribe-group (group &optional level silent)
6024   "Toggle subscription to GROUP.
6025 Killed newsgroups are subscribed.  If SILENT, don't try to update the
6026 group line."
6027   (interactive
6028    (list (completing-read
6029           "Group: " gnus-active-hashtb nil
6030           (memq gnus-select-method gnus-have-read-active-file))))
6031   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
6032     (cond
6033      ((string-match "^[ \t]$" group)
6034       (error "Empty group name"))
6035      (newsrc
6036       ;; Toggle subscription flag.
6037       (gnus-group-change-level
6038        newsrc (if level level (if (<= (nth 1 (nth 2 newsrc))
6039                                       gnus-level-subscribed)
6040                                   (1+ gnus-level-subscribed)
6041                                 gnus-level-default-subscribed)))
6042       (unless silent
6043         (gnus-group-update-group group)))
6044      ((and (stringp group)
6045            (or (not (memq gnus-select-method gnus-have-read-active-file))
6046                (gnus-active group)))
6047       ;; Add new newsgroup.
6048       (gnus-group-change-level
6049        group
6050        (if level level gnus-level-default-subscribed)
6051        (or (and (member group gnus-zombie-list)
6052                 gnus-level-zombie)
6053            gnus-level-killed)
6054        (and (gnus-group-group-name)
6055             (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
6056       (unless silent
6057         (gnus-group-update-group group)))
6058      (t (error "No such newsgroup: %s" group)))
6059     (gnus-group-position-point)))
6060
6061 (defun gnus-group-transpose-groups (n)
6062   "Move the current newsgroup up N places.
6063 If given a negative prefix, move down instead.  The difference between
6064 N and the number of steps taken is returned."
6065   (interactive "p")
6066   (or (gnus-group-group-name)
6067       (error "No group on current line"))
6068   (gnus-group-kill-group 1)
6069   (prog1
6070       (forward-line (- n))
6071     (gnus-group-yank-group)
6072     (gnus-group-position-point)))
6073
6074 (defun gnus-group-kill-all-zombies ()
6075   "Kill all zombie newsgroups."
6076   (interactive)
6077   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
6078   (setq gnus-zombie-list nil)
6079   (gnus-group-list-groups))
6080
6081 (defun gnus-group-kill-region (begin end)
6082   "Kill newsgroups in current region (excluding current point).
6083 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
6084   (interactive "r")
6085   (let ((lines
6086          ;; Count lines.
6087          (save-excursion
6088            (count-lines
6089             (progn
6090               (goto-char begin)
6091               (beginning-of-line)
6092               (point))
6093             (progn
6094               (goto-char end)
6095               (beginning-of-line)
6096               (point))))))
6097     (goto-char begin)
6098     (beginning-of-line)                 ;Important when LINES < 1
6099     (gnus-group-kill-group lines)))
6100
6101 (defun gnus-group-kill-group (&optional n discard)
6102   "Kill the next N groups.
6103 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
6104 However, only groups that were alive can be yanked; already killed
6105 groups or zombie groups can't be yanked.
6106 The return value is the name of the group that was killed, or a list
6107 of groups killed."
6108   (interactive "P")
6109   (let ((buffer-read-only nil)
6110         (groups (gnus-group-process-prefix n))
6111         group entry level out)
6112     (if (< (length groups) 10)
6113         ;; This is faster when there are few groups.
6114         (while groups
6115           (push (setq group (pop groups)) out)
6116           (gnus-group-remove-mark group)
6117           (setq level (gnus-group-group-level))
6118           (gnus-delete-line)
6119           (when (and (not discard)
6120                      (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
6121             (push (cons (car entry) (nth 2 entry))
6122                   gnus-list-of-killed-groups))
6123           (gnus-group-change-level
6124            (if entry entry group) gnus-level-killed (if entry nil level)))
6125       ;; If there are lots and lots of groups to be killed, we use
6126       ;; this thing instead.
6127       (let (entry)
6128         (setq groups (nreverse groups))
6129         (while groups
6130           (gnus-group-remove-mark (setq group (pop groups)))
6131           (gnus-delete-line)
6132           (cond
6133            ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
6134             (push (cons (car entry) (nth 2 entry))
6135                   gnus-list-of-killed-groups)
6136             (setcdr (cdr entry) (cdddr entry)))
6137            ((member group gnus-zombie-list)
6138             (setq gnus-zombie-list (delete group gnus-zombie-list)))))
6139         (gnus-make-hashtable-from-newsrc-alist)))
6140
6141     (gnus-group-position-point)
6142     (if (< (length out) 2) (car out) (nreverse out))))
6143
6144 (defun gnus-group-yank-group (&optional arg)
6145   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
6146 inserting it before the current newsgroup.  The numeric ARG specifies
6147 how many newsgroups are to be yanked.  The name of the newsgroup yanked
6148 is returned, or (if several groups are yanked) a list of yanked groups
6149 is returned."
6150   (interactive "p")
6151   (setq arg (or arg 1))
6152   (let (info group prev out)
6153     (while (>= (decf arg) 0)
6154       (if (not (setq info (pop gnus-list-of-killed-groups)))
6155           (error "No more newsgroups to yank"))
6156       (push (setq group (nth 1 info)) out)
6157       ;; Find which newsgroup to insert this one before - search
6158       ;; backward until something suitable is found.  If there are no
6159       ;; other newsgroups in this buffer, just make this newsgroup the
6160       ;; first newsgroup.
6161       (setq prev (gnus-group-group-name))
6162       (gnus-group-change-level
6163        info (gnus-info-level (cdr info)) gnus-level-killed
6164        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
6165        t)
6166       (gnus-group-insert-group-line-info group))
6167     (forward-line -1)
6168     (gnus-group-position-point)
6169     (if (< (length out) 2) (car out) (nreverse out))))
6170
6171 (defun gnus-group-kill-level (level)
6172   "Kill all groups that is on a certain LEVEL."
6173   (interactive "nKill all groups on level: ")
6174   (cond
6175    ((= level gnus-level-zombie)
6176     (setq gnus-killed-list
6177           (nconc gnus-zombie-list gnus-killed-list))
6178     (setq gnus-zombie-list nil))
6179    ((and (< level gnus-level-zombie)
6180          (> level 0)
6181          (or gnus-expert-user
6182              (gnus-yes-or-no-p
6183               (format
6184                "Do you really want to kill all groups on level %d? "
6185                level))))
6186     (let* ((prev gnus-newsrc-alist)
6187            (alist (cdr prev)))
6188       (while alist
6189         (if (= (gnus-info-level level) level)
6190             (setcdr prev (cdr alist))
6191           (setq prev alist))
6192         (setq alist (cdr alist)))
6193       (gnus-make-hashtable-from-newsrc-alist)
6194       (gnus-group-list-groups)))
6195    (t
6196     (error "Can't kill; illegal level: %d" level))))
6197
6198 (defun gnus-group-list-all-groups (&optional arg)
6199   "List all newsgroups with level ARG or lower.
6200 Default is gnus-level-unsubscribed, which lists all subscribed and most
6201 unsubscribed groups."
6202   (interactive "P")
6203   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
6204
6205 ;; Redefine this to list ALL killed groups if prefix arg used.
6206 ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
6207 (defun gnus-group-list-killed (&optional arg)
6208   "List all killed newsgroups in the group buffer.
6209 If ARG is non-nil, list ALL killed groups known to Gnus.  This may
6210 entail asking the server for the groups."
6211   (interactive "P")
6212   ;; Find all possible killed newsgroups if arg.
6213   (when arg
6214     ;; First make sure active file has been read.
6215     (unless gnus-have-read-active-file
6216       (let ((gnus-read-active-file t))
6217         (gnus-read-active-file)))
6218     (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
6219     ;; Go through all newsgroups that are known to Gnus - enlarge kill list
6220     (mapatoms
6221      (lambda (sym)
6222        (let ((groups 0)
6223              (group (symbol-name sym)))
6224          (if (or (null group)
6225                  (gnus-gethash group gnus-killed-hashtb)
6226                  (gnus-gethash group gnus-newsrc-hashtb))
6227              ()
6228            (let ((do-sub (gnus-matches-options-n group)))
6229              (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
6230                  ()
6231                (setq groups (1+ groups))
6232                (setq gnus-killed-list
6233                      (cons group gnus-killed-list))
6234                (gnus-sethash group group gnus-killed-hashtb))))))
6235      gnus-active-hashtb))
6236   (if (not gnus-killed-list)
6237       (gnus-message 6 "No killed groups")
6238     (let (gnus-group-list-mode)
6239       (funcall gnus-group-prepare-function
6240                gnus-level-killed t gnus-level-killed))
6241     (goto-char (point-min)))
6242   (gnus-group-position-point))
6243
6244 (defun gnus-group-list-zombies ()
6245   "List all zombie newsgroups in the group buffer."
6246   (interactive)
6247   (if (not gnus-zombie-list)
6248       (gnus-message 6 "No zombie groups")
6249     (let (gnus-group-list-mode)
6250       (funcall gnus-group-prepare-function
6251                gnus-level-zombie t gnus-level-zombie))
6252     (goto-char (point-min)))
6253   (gnus-group-position-point))
6254
6255 (defun gnus-group-list-active ()
6256   "List all groups that are available from the server(s)."
6257   (interactive)
6258   ;; First we make sure that we have really read the active file.
6259   (unless gnus-have-read-active-file
6260     (let ((gnus-read-active-file t))
6261       (gnus-read-active-file)))
6262   ;; Find all groups and sort them.
6263   (let ((groups
6264          (sort
6265           (let (list)
6266             (mapatoms
6267              (lambda (sym)
6268                (and (symbol-value sym)
6269                     (setq list (cons (symbol-name sym) list))))
6270              gnus-active-hashtb)
6271             list)
6272           'string<))
6273         (buffer-read-only nil))
6274     (erase-buffer)
6275     (while groups
6276       (gnus-group-insert-group-line-info (pop groups)))
6277     (goto-char (point-min))))
6278
6279 (defun gnus-activate-all-groups (level)
6280   "Activate absolutely all groups."
6281   (interactive (list 7))
6282   (let ((gnus-activate-level level)
6283         (gnus-activate-foreign-newsgroups level))
6284     (gnus-group-get-new-news)))
6285
6286 (defun gnus-group-get-new-news (&optional arg)
6287   "Get newly arrived articles.
6288 If ARG is a number, it specifies which levels you are interested in
6289 re-scanning.  If ARG is non-nil and not a number, this will force
6290 \"hard\" re-reading of the active files from all servers."
6291   (interactive "P")
6292   (run-hooks 'gnus-get-new-news-hook)
6293   ;; We might read in new NoCeM messages here.
6294   (when (and gnus-use-nocem 
6295              (null arg))
6296     (gnus-nocem-scan-groups))
6297   ;; If ARG is not a number, then we read the active file.
6298   (when (and arg (not (numberp arg)))
6299     (let ((gnus-read-active-file t))
6300       (gnus-read-active-file))
6301     (setq arg nil))
6302
6303   (setq arg (gnus-group-default-level arg t))
6304   (if (and gnus-read-active-file (not arg))
6305       (progn
6306         (gnus-read-active-file)
6307         (gnus-get-unread-articles arg))
6308     (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
6309       (gnus-get-unread-articles arg)))
6310   (run-hooks 'gnus-after-getting-new-news-hook)
6311   (gnus-group-list-groups))
6312
6313 (defun gnus-group-get-new-news-this-group (&optional n)
6314   "Check for newly arrived news in the current group (and the N-1 next groups).
6315 The difference between N and the number of newsgroup checked is returned.
6316 If N is negative, this group and the N-1 previous groups will be checked."
6317   (interactive "P")
6318   (let* ((groups (gnus-group-process-prefix n))
6319          (ret (if (numberp n) (- n (length groups)) 0))
6320          group)
6321     (while groups
6322       (setq group (car groups)
6323             groups (cdr groups))
6324       (gnus-group-remove-mark group)
6325       (unless (gnus-get-new-news-in-group group)
6326         (ding)
6327         (gnus-message 3 "%s error: %s" group (gnus-status-message group))))
6328     (when gnus-goto-next-group-when-activating
6329       (gnus-group-next-unread-group 1 t))
6330     (gnus-summary-position-point)
6331     ret))
6332
6333 (defun gnus-get-new-news-in-group (group)
6334   (when (and group (gnus-activate-group group 'scan))
6335     (gnus-get-unread-articles-in-group
6336      (gnus-get-info group) (gnus-active group) t)
6337     (gnus-close-group group)
6338     (when (gnus-group-goto-group group)
6339       (gnus-group-update-group-line))
6340     t))
6341
6342 (defun gnus-group-fetch-faq (group &optional faq-dir)
6343   "Fetch the FAQ for the current group."
6344   (interactive
6345    (list
6346     (gnus-group-real-name (gnus-group-group-name))
6347     (cond (current-prefix-arg
6348            (completing-read
6349             "Faq dir: " (and (listp gnus-group-faq-directory)
6350                              gnus-group-faq-directory))))))
6351   (or faq-dir
6352       (setq faq-dir (if (listp gnus-group-faq-directory)
6353                         (car gnus-group-faq-directory)
6354                       gnus-group-faq-directory)))
6355   (or group (error "No group name given"))
6356   (let ((file (concat (file-name-as-directory faq-dir)
6357                       (gnus-group-real-name group))))
6358     (if (not (file-exists-p file))
6359         (error "No such file: %s" file)
6360       (find-file file))))
6361
6362 (defun gnus-group-describe-group (force &optional group)
6363   "Display a description of the current newsgroup."
6364   (interactive (list current-prefix-arg (gnus-group-group-name)))
6365   (and force (setq gnus-description-hashtb nil))
6366   (let ((method (gnus-find-method-for-group group))
6367         desc)
6368     (or group (error "No group name given"))
6369     (and (or (and gnus-description-hashtb
6370                   ;; We check whether this group's method has been
6371                   ;; queried for a description file.
6372                   (gnus-gethash
6373                    (gnus-group-prefixed-name "" method)
6374                    gnus-description-hashtb))
6375              (setq desc (gnus-group-get-description group))
6376              (gnus-read-descriptions-file method))
6377          (message
6378           (or desc (gnus-gethash group gnus-description-hashtb)
6379               "No description available")))))
6380
6381 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6382 (defun gnus-group-describe-all-groups (&optional force)
6383   "Pop up a buffer with descriptions of all newsgroups."
6384   (interactive "P")
6385   (and force (setq gnus-description-hashtb nil))
6386   (if (not (or gnus-description-hashtb
6387                (gnus-read-all-descriptions-files)))
6388       (error "Couldn't request descriptions file"))
6389   (let ((buffer-read-only nil)
6390         b)
6391     (erase-buffer)
6392     (mapatoms
6393      (lambda (group)
6394        (setq b (point))
6395        (insert (format "      *: %-20s %s\n" (symbol-name group)
6396                        (symbol-value group)))
6397        (add-text-properties
6398         b (1+ b) (list 'gnus-group group
6399                        'gnus-unread t 'gnus-marked nil
6400                        'gnus-level (1+ gnus-level-subscribed))))
6401      gnus-description-hashtb)
6402     (goto-char (point-min))
6403     (gnus-group-position-point)))
6404
6405 ;; Suggested by by Daniel Quinlan <quinlan@best.com>.
6406 (defun gnus-group-apropos (regexp &optional search-description)
6407   "List all newsgroups that have names that match a regexp."
6408   (interactive "sGnus apropos (regexp): ")
6409   (let ((prev "")
6410         (obuf (current-buffer))
6411         groups des)
6412     ;; Go through all newsgroups that are known to Gnus.
6413     (mapatoms
6414      (lambda (group)
6415        (and (symbol-name group)
6416             (string-match regexp (symbol-name group))
6417             (setq groups (cons (symbol-name group) groups))))
6418      gnus-active-hashtb)
6419     ;; Also go through all descriptions that are known to Gnus.
6420     (when search-description
6421       (mapatoms
6422        (lambda (group)
6423          (and (string-match regexp (symbol-value group))
6424               (gnus-active (symbol-name group))
6425               (setq groups (cons (symbol-name group) groups))))
6426        gnus-description-hashtb))
6427     (if (not groups)
6428         (gnus-message 3 "No groups matched \"%s\"." regexp)
6429       ;; Print out all the groups.
6430       (save-excursion
6431         (pop-to-buffer "*Gnus Help*")
6432         (buffer-disable-undo (current-buffer))
6433         (erase-buffer)
6434         (setq groups (sort groups 'string<))
6435         (while groups
6436           ;; Groups may be entered twice into the list of groups.
6437           (if (not (string= (car groups) prev))
6438               (progn
6439                 (insert (setq prev (car groups)) "\n")
6440                 (if (and gnus-description-hashtb
6441                          (setq des (gnus-gethash (car groups)
6442                                                  gnus-description-hashtb)))
6443                     (insert "  " des "\n"))))
6444           (setq groups (cdr groups)))
6445         (goto-char (point-min))))
6446     (pop-to-buffer obuf)))
6447
6448 (defun gnus-group-description-apropos (regexp)
6449   "List all newsgroups that have names or descriptions that match a regexp."
6450   (interactive "sGnus description apropos (regexp): ")
6451   (if (not (or gnus-description-hashtb
6452                (gnus-read-all-descriptions-files)))
6453       (error "Couldn't request descriptions file"))
6454   (gnus-group-apropos regexp t))
6455
6456 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6457 (defun gnus-group-list-matching (level regexp &optional all lowest)
6458   "List all groups with unread articles that match REGEXP.
6459 If the prefix LEVEL is non-nil, it should be a number that says which
6460 level to cut off listing groups.
6461 If ALL, also list groups with no unread articles.
6462 If LOWEST, don't list groups with level lower than LOWEST."
6463   (interactive "P\nsList newsgroups matching: ")
6464   (gnus-group-prepare-flat (or level gnus-level-subscribed)
6465                            all (or lowest 1) regexp)
6466   (goto-char (point-min))
6467   (gnus-group-position-point))
6468
6469 (defun gnus-group-list-all-matching (level regexp &optional lowest)
6470   "List all groups that match REGEXP.
6471 If the prefix LEVEL is non-nil, it should be a number that says which
6472 level to cut off listing groups.
6473 If LOWEST, don't list groups with level lower than LOWEST."
6474   (interactive "P\nsList newsgroups matching: ")
6475   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
6476
6477 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
6478 (defun gnus-group-save-newsrc (&optional force)
6479   "Save the Gnus startup files.
6480 If FORCE, force saving whether it is necessary or not."
6481   (interactive "P")
6482   (gnus-save-newsrc-file force))
6483
6484 (defun gnus-group-restart (&optional arg)
6485   "Force Gnus to read the .newsrc file."
6486   (interactive "P")
6487   (when (gnus-yes-or-no-p
6488          (format "Are you sure you want to read %s? "
6489                  gnus-current-startup-file))
6490     (gnus-save-newsrc-file)
6491     (gnus-setup-news 'force)
6492     (gnus-group-list-groups arg)))
6493
6494 (defun gnus-group-read-init-file ()
6495   "Read the Gnus elisp init file."
6496   (interactive)
6497   (gnus-read-init-file))
6498
6499 (defun gnus-group-check-bogus-groups (&optional silent)
6500   "Check bogus newsgroups.
6501 If given a prefix, don't ask for confirmation before removing a bogus
6502 group."
6503   (interactive "P")
6504   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
6505   (gnus-group-list-groups))
6506
6507 (defun gnus-group-edit-global-kill (&optional article group)
6508   "Edit the global kill file.
6509 If GROUP, edit that local kill file instead."
6510   (interactive "P")
6511   (setq gnus-current-kill-article article)
6512   (gnus-kill-file-edit-file group)
6513   (gnus-message
6514    6
6515    (substitute-command-keys
6516     (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
6517             (if group "local" "global")))))
6518
6519 (defun gnus-group-edit-local-kill (article group)
6520   "Edit a local kill file."
6521   (interactive (list nil (gnus-group-group-name)))
6522   (gnus-group-edit-global-kill article group))
6523
6524 (defun gnus-group-force-update ()
6525   "Update `.newsrc' file."
6526   (interactive)
6527   (gnus-save-newsrc-file))
6528
6529 (defun gnus-group-suspend ()
6530   "Suspend the current Gnus session.
6531 In fact, cleanup buffers except for group mode buffer.
6532 The hook gnus-suspend-gnus-hook is called before actually suspending."
6533   (interactive)
6534   (run-hooks 'gnus-suspend-gnus-hook)
6535   ;; Kill Gnus buffers except for group mode buffer.
6536   (let ((group-buf (get-buffer gnus-group-buffer)))
6537     ;; Do this on a separate list in case the user does a ^G before we finish
6538     (let ((gnus-buffer-list
6539            (delq group-buf (delq gnus-dribble-buffer
6540                                  (append gnus-buffer-list nil)))))
6541       (while gnus-buffer-list
6542         (gnus-kill-buffer (car gnus-buffer-list))
6543         (setq gnus-buffer-list (cdr gnus-buffer-list))))
6544     (if group-buf
6545         (progn
6546           (setq gnus-buffer-list (list group-buf))
6547           (bury-buffer group-buf)
6548           (delete-windows-on group-buf t)))))
6549
6550 (defun gnus-group-clear-dribble ()
6551   "Clear all information from the dribble buffer."
6552   (interactive)
6553   (gnus-dribble-clear)
6554   (gnus-message 7 "Cleared dribble buffer"))
6555
6556 (defun gnus-group-exit ()
6557   "Quit reading news after updating .newsrc.eld and .newsrc.
6558 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6559   (interactive)
6560   (when 
6561       (or noninteractive                ;For gnus-batch-kill
6562           (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
6563           (not gnus-interactive-exit)   ;Without confirmation
6564           gnus-expert-user
6565           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
6566     (run-hooks 'gnus-exit-gnus-hook)
6567     ;; Offer to save data from non-quitted summary buffers.
6568     (gnus-offer-save-summaries)
6569     ;; Save the newsrc file(s).
6570     (gnus-save-newsrc-file)
6571     ;; Kill-em-all.
6572     (gnus-close-backends)
6573     ;; Reset everything.
6574     (gnus-clear-system)
6575     ;; Allow the user to do things after cleaning up.
6576     (run-hooks 'gnus-after-exiting-gnus-hook)))
6577
6578 (defun gnus-close-backends ()
6579   ;; Send a close request to all backends that support such a request.
6580   (let ((methods gnus-valid-select-methods)
6581         func)
6582     (while methods
6583       (if (fboundp (setq func (intern (concat (caar methods)
6584                                               "-request-close"))))
6585           (funcall func))
6586       (setq methods (cdr methods)))))
6587
6588 (defun gnus-group-quit ()
6589   "Quit reading news without updating .newsrc.eld or .newsrc.
6590 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6591   (interactive)
6592   (when (or noninteractive              ;For gnus-batch-kill
6593             (zerop (buffer-size))
6594             (not (gnus-server-opened gnus-select-method))
6595             gnus-expert-user
6596             (not gnus-current-startup-file)
6597             (gnus-yes-or-no-p
6598              (format "Quit reading news without saving %s? "
6599                      (file-name-nondirectory gnus-current-startup-file))))
6600     (run-hooks 'gnus-exit-gnus-hook)
6601     (if gnus-use-full-window
6602         (delete-other-windows)
6603       (gnus-remove-some-windows))
6604     (gnus-dribble-save)
6605     (gnus-close-backends)
6606     (gnus-clear-system)
6607     ;; Allow the user to do things after cleaning up.
6608     (run-hooks 'gnus-after-exiting-gnus-hook)))
6609
6610 (defun gnus-offer-save-summaries ()
6611   "Offer to save all active summary buffers."
6612   (save-excursion
6613     (let ((buflist (buffer-list))
6614           buffers bufname)
6615       ;; Go through all buffers and find all summaries.
6616       (while buflist
6617         (and (setq bufname (buffer-name (car buflist)))
6618              (string-match "Summary" bufname)
6619              (save-excursion
6620                (set-buffer bufname)
6621                ;; We check that this is, indeed, a summary buffer.
6622                (and (eq major-mode 'gnus-summary-mode)
6623                     ;; Also make sure this isn't bogus.
6624                     gnus-newsgroup-prepared))
6625              (push bufname buffers))
6626         (setq buflist (cdr buflist)))
6627       ;; Go through all these summary buffers and offer to save them.
6628       (when buffers
6629         (map-y-or-n-p
6630          "Update summary buffer %s? "
6631          (lambda (buf) (set-buffer buf) (gnus-summary-exit))
6632          buffers)))))
6633
6634 (defun gnus-group-describe-briefly ()
6635   "Give a one line description of the group mode commands."
6636   (interactive)
6637   (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")))
6638
6639 (defun gnus-group-browse-foreign-server (method)
6640   "Browse a foreign news server.
6641 If called interactively, this function will ask for a select method
6642  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
6643 If not, METHOD should be a list where the first element is the method
6644 and the second element is the address."
6645   (interactive
6646    (list (let ((how (completing-read
6647                      "Which backend: "
6648                      (append gnus-valid-select-methods gnus-server-alist)
6649                      nil t (cons "nntp" 0))))
6650            ;; We either got a backend name or a virtual server name.
6651            ;; If the first, we also need an address.
6652            (if (assoc how gnus-valid-select-methods)
6653                (list (intern how)
6654                      ;; Suggested by mapjph@bath.ac.uk.
6655                      (completing-read
6656                       "Address: "
6657                       (mapcar (lambda (server) (list server))
6658                               gnus-secondary-servers)))
6659              ;; We got a server name, so we find the method.
6660              (gnus-server-to-method how)))))
6661   (gnus-browse-foreign-server method))
6662
6663 \f
6664 ;;;
6665 ;;; Gnus summary mode
6666 ;;;
6667
6668 (defvar gnus-summary-mode-map nil)
6669
6670 (put 'gnus-summary-mode 'mode-class 'special)
6671
6672 (unless gnus-summary-mode-map
6673   (setq gnus-summary-mode-map (make-keymap))
6674   (suppress-keymap gnus-summary-mode-map)
6675
6676   ;; Non-orthogonal keys
6677
6678   (gnus-define-keys gnus-summary-mode-map
6679     " " gnus-summary-next-page
6680     "\177" gnus-summary-prev-page
6681     [delete] gnus-summary-prev-page
6682     "\r" gnus-summary-scroll-up
6683     "n" gnus-summary-next-unread-article
6684     "p" gnus-summary-prev-unread-article
6685     "N" gnus-summary-next-article
6686     "P" gnus-summary-prev-article
6687     "\M-\C-n" gnus-summary-next-same-subject
6688     "\M-\C-p" gnus-summary-prev-same-subject
6689     "\M-n" gnus-summary-next-unread-subject
6690     "\M-p" gnus-summary-prev-unread-subject
6691     "." gnus-summary-first-unread-article
6692     "," gnus-summary-best-unread-article
6693     "\M-s" gnus-summary-search-article-forward
6694     "\M-r" gnus-summary-search-article-backward
6695     "<" gnus-summary-beginning-of-article
6696     ">" gnus-summary-end-of-article
6697     "j" gnus-summary-goto-article
6698     "^" gnus-summary-refer-parent-article
6699     "\M-^" gnus-summary-refer-article
6700     "u" gnus-summary-tick-article-forward
6701     "!" gnus-summary-tick-article-forward
6702     "U" gnus-summary-tick-article-backward
6703     "d" gnus-summary-mark-as-read-forward
6704     "D" gnus-summary-mark-as-read-backward
6705     "E" gnus-summary-mark-as-expirable
6706     "\M-u" gnus-summary-clear-mark-forward
6707     "\M-U" gnus-summary-clear-mark-backward
6708     "k" gnus-summary-kill-same-subject-and-select
6709     "\C-k" gnus-summary-kill-same-subject
6710     "\M-\C-k" gnus-summary-kill-thread
6711     "\M-\C-l" gnus-summary-lower-thread
6712     "e" gnus-summary-edit-article
6713     "#" gnus-summary-mark-as-processable
6714     "\M-#" gnus-summary-unmark-as-processable
6715     "\M-\C-t" gnus-summary-toggle-threads
6716     "\M-\C-s" gnus-summary-show-thread
6717     "\M-\C-h" gnus-summary-hide-thread
6718     "\M-\C-f" gnus-summary-next-thread
6719     "\M-\C-b" gnus-summary-prev-thread
6720     "\M-\C-u" gnus-summary-up-thread
6721     "\M-\C-d" gnus-summary-down-thread
6722     "&" gnus-summary-execute-command
6723     "c" gnus-summary-catchup-and-exit
6724     "\C-w" gnus-summary-mark-region-as-read
6725     "\C-t" gnus-summary-toggle-truncation
6726     "?" gnus-summary-mark-as-dormant
6727     "\C-c\M-\C-s" gnus-summary-limit-include-expunged
6728     "\C-c\C-s\C-n" gnus-summary-sort-by-number
6729     "\C-c\C-s\C-a" gnus-summary-sort-by-author
6730     "\C-c\C-s\C-s" gnus-summary-sort-by-subject
6731     "\C-c\C-s\C-d" gnus-summary-sort-by-date
6732     "\C-c\C-s\C-i" gnus-summary-sort-by-score
6733     "=" gnus-summary-expand-window
6734     "\C-x\C-s" gnus-summary-reselect-current-group
6735     "\M-g" gnus-summary-rescan-group
6736     "w" gnus-summary-stop-page-breaking
6737     "\C-c\C-r" gnus-summary-caesar-message
6738     "\M-t" gnus-summary-toggle-mime
6739     "f" gnus-summary-followup
6740     "F" gnus-summary-followup-with-original
6741     "C" gnus-summary-cancel-article
6742     "r" gnus-summary-reply
6743     "R" gnus-summary-reply-with-original
6744     "\C-c\C-f" gnus-summary-mail-forward
6745     "o" gnus-summary-save-article
6746     "\C-o" gnus-summary-save-article-mail
6747     "|" gnus-summary-pipe-output
6748     "\M-k" gnus-summary-edit-local-kill
6749     "\M-K" gnus-summary-edit-global-kill
6750     "V" gnus-version
6751     "\C-c\C-d" gnus-summary-describe-group
6752     "q" gnus-summary-exit
6753     "Q" gnus-summary-exit-no-update
6754     "\C-c\C-i" gnus-info-find-node
6755     gnus-mouse-2 gnus-mouse-pick-article
6756     "m" gnus-summary-mail-other-window
6757     "a" gnus-summary-post-news
6758     "x" gnus-summary-limit-to-unread
6759     "s" gnus-summary-isearch-article
6760     "t" gnus-article-hide-headers
6761     "g" gnus-summary-show-article
6762     "l" gnus-summary-goto-last-article
6763     "\C-c\C-v\C-v" gnus-uu-decode-uu-view
6764     "\C-d" gnus-summary-enter-digest-group
6765     "\C-c\C-b" gnus-bug
6766     "*" gnus-cache-enter-article
6767     "\M-*" gnus-cache-remove-article
6768     "\M-&" gnus-summary-universal-argument
6769     "\C-l" gnus-recenter
6770     "I" gnus-summary-increase-score
6771     "L" gnus-summary-lower-score
6772
6773     "V" gnus-summary-score-map
6774     "X" gnus-uu-extract-map
6775     "S" gnus-summary-send-map)
6776
6777   ;; Sort of orthogonal keymap
6778   (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
6779     "t" gnus-summary-tick-article-forward
6780     "!" gnus-summary-tick-article-forward
6781     "d" gnus-summary-mark-as-read-forward
6782     "r" gnus-summary-mark-as-read-forward
6783     "c" gnus-summary-clear-mark-forward
6784     " " gnus-summary-clear-mark-forward
6785     "e" gnus-summary-mark-as-expirable
6786     "x" gnus-summary-mark-as-expirable
6787     "?" gnus-summary-mark-as-dormant
6788     "b" gnus-summary-set-bookmark
6789     "B" gnus-summary-remove-bookmark
6790     "#" gnus-summary-mark-as-processable
6791     "\M-#" gnus-summary-unmark-as-processable
6792     "S" gnus-summary-limit-include-expunged
6793     "C" gnus-summary-catchup
6794     "H" gnus-summary-catchup-to-here
6795     "\C-c" gnus-summary-catchup-all
6796     "k" gnus-summary-kill-same-subject-and-select
6797     "K" gnus-summary-kill-same-subject
6798     "P" gnus-uu-mark-map)
6799
6800   (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mode-map)
6801     "c" gnus-summary-clear-above
6802     "u" gnus-summary-tick-above
6803     "m" gnus-summary-mark-above
6804     "k" gnus-summary-kill-below)
6805
6806   (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
6807     "/" gnus-summary-limit-to-subject
6808     "n" gnus-summary-limit-to-articles
6809     "w" gnus-summary-pop-limit
6810     "s" gnus-summary-limit-to-subject
6811     "a" gnus-summary-limit-to-author
6812     "u" gnus-summary-limit-to-unread
6813     "m" gnus-summary-limit-to-marks
6814     "v" gnus-summary-limit-to-score
6815     "D" gnus-summary-limit-include-dormant
6816     "d" gnus-summary-limit-exclude-dormant
6817     ;;  "t" gnus-summary-limit-exclude-thread
6818     "E" gnus-summary-limit-include-expunged
6819     "c" gnus-summary-limit-exclude-childless-dormant
6820     "C" gnus-summary-limit-mark-excluded-as-read)
6821
6822   (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
6823     "n" gnus-summary-next-unread-article
6824     "p" gnus-summary-prev-unread-article
6825     "N" gnus-summary-next-article
6826     "P" gnus-summary-prev-article
6827     "\C-n" gnus-summary-next-same-subject
6828     "\C-p" gnus-summary-prev-same-subject
6829     "\M-n" gnus-summary-next-unread-subject
6830     "\M-p" gnus-summary-prev-unread-subject
6831     "f" gnus-summary-first-unread-article
6832     "b" gnus-summary-best-unread-article
6833     "j" gnus-summary-goto-article
6834     "g" gnus-summary-goto-subject
6835     "l" gnus-summary-goto-last-article
6836     "p" gnus-summary-pop-article)
6837
6838   (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
6839     "k" gnus-summary-kill-thread
6840     "l" gnus-summary-lower-thread
6841     "i" gnus-summary-raise-thread
6842     "T" gnus-summary-toggle-threads
6843     "t" gnus-summary-rethread-current
6844     "^" gnus-summary-reparent-thread
6845     "s" gnus-summary-show-thread
6846     "S" gnus-summary-show-all-threads
6847     "h" gnus-summary-hide-thread
6848     "H" gnus-summary-hide-all-threads
6849     "n" gnus-summary-next-thread
6850     "p" gnus-summary-prev-thread
6851     "u" gnus-summary-up-thread
6852     "o" gnus-summary-top-thread
6853     "d" gnus-summary-down-thread
6854     "#" gnus-uu-mark-thread
6855     "\M-#" gnus-uu-unmark-thread)
6856
6857   (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
6858     "c" gnus-summary-catchup-and-exit
6859     "C" gnus-summary-catchup-all-and-exit
6860     "E" gnus-summary-exit-no-update
6861     "Q" gnus-summary-exit
6862     "Z" gnus-summary-exit
6863     "n" gnus-summary-catchup-and-goto-next-group
6864     "R" gnus-summary-reselect-current-group
6865     "G" gnus-summary-rescan-group
6866     "N" gnus-summary-next-group
6867     "P" gnus-summary-prev-group)
6868
6869   (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
6870     " " gnus-summary-next-page
6871     "n" gnus-summary-next-page
6872     "\177" gnus-summary-prev-page
6873     [delete] gnus-summary-prev-page
6874     "p" gnus-summary-prev-page
6875     "\r" gnus-summary-scroll-up
6876     "<" gnus-summary-beginning-of-article
6877     ">" gnus-summary-end-of-article
6878     "b" gnus-summary-beginning-of-article
6879     "e" gnus-summary-end-of-article
6880     "^" gnus-summary-refer-parent-article
6881     "r" gnus-summary-refer-parent-article
6882     "R" gnus-summary-refer-references
6883     "g" gnus-summary-show-article
6884     "s" gnus-summary-isearch-article)
6885
6886   (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
6887     "b" gnus-article-add-buttons
6888     "B" gnus-article-add-buttons-to-head
6889     "o" gnus-article-treat-overstrike
6890     ;;  "w" gnus-article-word-wrap
6891     "w" gnus-article-fill-cited-article
6892     "c" gnus-article-remove-cr
6893     "L" gnus-article-remove-trailing-blank-lines
6894     "q" gnus-article-de-quoted-unreadable
6895     "f" gnus-article-display-x-face
6896     "l" gnus-summary-stop-page-breaking
6897     "r" gnus-summary-caesar-message
6898     "t" gnus-article-hide-headers
6899     "v" gnus-summary-verbose-headers
6900     "m" gnus-summary-toggle-mime)
6901
6902   (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
6903     "a" gnus-article-hide
6904     "h" gnus-article-hide-headers
6905     "b" gnus-article-hide-boring-headers
6906     "s" gnus-article-hide-signature
6907     "c" gnus-article-hide-citation
6908     "p" gnus-article-hide-pgp
6909     "\C-c" gnus-article-hide-citation-maybe)
6910
6911   (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
6912     "a" gnus-article-highlight
6913     "h" gnus-article-highlight-headers
6914     "c" gnus-article-highlight-citation
6915     "s" gnus-article-highlight-signature)
6916
6917   (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
6918     "z" gnus-article-date-ut
6919     "u" gnus-article-date-ut
6920     "l" gnus-article-date-local
6921     "e" gnus-article-date-lapsed
6922     "o" gnus-article-date-original)
6923
6924   (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
6925     "v" gnus-version
6926     "f" gnus-summary-fetch-faq
6927     "d" gnus-summary-describe-group
6928     "h" gnus-summary-describe-briefly
6929     "i" gnus-info-find-node)
6930
6931   (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
6932     "e" gnus-summary-expire-articles
6933     "\M-\C-e" gnus-summary-expire-articles-now
6934     "\177" gnus-summary-delete-article
6935     [delete] gnus-summary-delete-article
6936     "m" gnus-summary-move-article
6937     "r" gnus-summary-respool-article
6938     "w" gnus-summary-edit-article
6939     "c" gnus-summary-copy-article
6940     "B" gnus-summary-crosspost-article
6941     "q" gnus-summary-respool-query
6942     "i" gnus-summary-import-article)
6943
6944   (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
6945     "o" gnus-summary-save-article
6946     "m" gnus-summary-save-article-mail
6947     "r" gnus-summary-save-article-rmail
6948     "f" gnus-summary-save-article-file
6949     "b" gnus-summary-save-article-body-file
6950     "h" gnus-summary-save-article-folder
6951     "v" gnus-summary-save-article-vm
6952     "p" gnus-summary-pipe-output
6953     "s" gnus-soup-add-article)
6954   )
6955
6956 \f
6957
6958 (defun gnus-summary-mode (&optional group)
6959   "Major mode for reading articles.
6960
6961 All normal editing commands are switched off.
6962 \\<gnus-summary-mode-map>
6963 Each line in this buffer represents one article.  To read an
6964 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
6965 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
6966 respectively.
6967
6968 You can also post articles and send mail from this buffer.  To
6969 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author
6970 of an article, type `\\[gnus-summary-reply]'.
6971
6972 There are approx. one gazillion commands you can execute in this
6973 buffer; read the info pages for more information (`\\[gnus-info-find-node]').
6974
6975 The following commands are available:
6976
6977 \\{gnus-summary-mode-map}"
6978   (interactive)
6979   (when (and menu-bar-mode
6980              (gnus-visual-p 'summary-menu 'menu))
6981     (gnus-summary-make-menu-bar))
6982   (kill-all-local-variables)
6983   (let ((locals gnus-summary-local-variables))
6984     (while locals
6985       (if (consp (car locals))
6986           (progn
6987             (make-local-variable (caar locals))
6988             (set (caar locals) (eval (cdar locals))))
6989         (make-local-variable (car locals))
6990         (set (car locals) nil))
6991       (setq locals (cdr locals))))
6992   (gnus-make-thread-indent-array)
6993   (gnus-simplify-mode-line)
6994   (setq major-mode 'gnus-summary-mode)
6995   (setq mode-name "Summary")
6996   (make-local-variable 'minor-mode-alist)
6997   (use-local-map gnus-summary-mode-map)
6998   (buffer-disable-undo (current-buffer))
6999   (setq buffer-read-only t)             ;Disable modification
7000   (setq truncate-lines t)
7001   (setq selective-display t)
7002   (setq selective-display-ellipses t)   ;Display `...'
7003   (setq buffer-display-table gnus-summary-display-table)
7004   (setq gnus-newsgroup-name group)
7005   (run-hooks 'gnus-summary-mode-hook))
7006
7007 (defun gnus-summary-make-display-table ()
7008   ;; Change the display table.  Odd characters have a tendency to mess
7009   ;; up nicely formatted displays - we make all possible glyphs
7010   ;; display only a single character.
7011
7012   ;; We start from the standard display table, if any.
7013   (setq gnus-summary-display-table
7014         (or (copy-sequence standard-display-table)
7015             (make-display-table)))
7016   ;; Nix out all the control chars...
7017   (let ((i 32))
7018     (while (>= (setq i (1- i)) 0)
7019       (aset gnus-summary-display-table i [??])))
7020   ;; ... but not newline and cr, of course. (cr is necessary for the
7021   ;; selective display).
7022   (aset gnus-summary-display-table ?\n nil)
7023   (aset gnus-summary-display-table ?\r nil)
7024   ;; We nix out any glyphs over 126 that are not set already.
7025   (let ((i 256))
7026     (while (>= (setq i (1- i)) 127)
7027       ;; Only modify if the entry is nil.
7028       (or (aref gnus-summary-display-table i)
7029           (aset gnus-summary-display-table i [??])))))
7030
7031 (defun gnus-summary-clear-local-variables ()
7032   (let ((locals gnus-summary-local-variables))
7033     (while locals
7034       (if (consp (car locals))
7035           (and (vectorp (caar locals))
7036                (set (caar locals) nil))
7037         (and (vectorp (car locals))
7038              (set (car locals) nil)))
7039       (setq locals (cdr locals)))))
7040
7041 ;; Summary data functions.
7042
7043 (defmacro gnus-data-number (data)
7044   `(car ,data))
7045
7046 (defmacro gnus-data-set-number (data number)
7047   `(setcar ,data ,number))
7048
7049 (defmacro gnus-data-mark (data)
7050   `(nth 1 ,data))
7051
7052 (defmacro gnus-data-set-mark (data mark)
7053   `(setcar (nthcdr 1 ,data) ,mark))
7054
7055 (defmacro gnus-data-pos (data)
7056   `(nth 2 ,data))
7057
7058 (defmacro gnus-data-set-pos (data pos)
7059   `(setcar (nthcdr 2 ,data) ,pos))
7060
7061 (defmacro gnus-data-header (data)
7062   `(nth 3 ,data))
7063
7064 (defmacro gnus-data-level (data)
7065   `(nth 4 ,data))
7066
7067 (defmacro gnus-data-unread-p (data)
7068   `(= (nth 1 ,data) gnus-unread-mark))
7069
7070 (defmacro gnus-data-pseudo-p (data)
7071   `(consp (nth 3 ,data)))
7072
7073 (defmacro gnus-data-find (number)
7074   `(assq ,number gnus-newsgroup-data))
7075
7076 (defmacro gnus-data-find-list (number &optional data)
7077   `(let ((bdata ,(or data 'gnus-newsgroup-data)))
7078      (memq (assq ,number bdata)
7079            bdata)))
7080
7081 (defmacro gnus-data-make (number mark pos header level)
7082   `(list ,number ,mark ,pos ,header ,level))
7083
7084 (defun gnus-data-enter (after-article number mark pos header level offset)
7085   (let ((data (gnus-data-find-list after-article)))
7086     (or data (error "No such article: %d" after-article))
7087     (setcdr data (cons (gnus-data-make number mark pos header level)
7088                        (cdr data)))
7089     (setq gnus-newsgroup-data-reverse nil)
7090     (gnus-data-update-list (cddr data) offset)))
7091
7092 (defun gnus-data-enter-list (after-article list &optional offset)
7093   (when list
7094     (let ((data (and after-article (gnus-data-find-list after-article)))
7095           (ilist list))
7096       (or data (not after-article) (error "No such article: %d" after-article))
7097       ;; Find the last element in the list to be spliced into the main
7098       ;; list.
7099       (while (cdr list)
7100         (setq list (cdr list)))
7101       (if (not data)
7102           (progn
7103             (setcdr list gnus-newsgroup-data)
7104             (setq gnus-newsgroup-data ilist)
7105             (and offset (gnus-data-update-list (cdr list) offset)))
7106         (setcdr list (cdr data))
7107         (setcdr data ilist)
7108         (and offset (gnus-data-update-list (cdr data) offset)))
7109       (setq gnus-newsgroup-data-reverse nil))))
7110
7111 (defun gnus-data-remove (article &optional offset)
7112   (let ((data gnus-newsgroup-data))
7113     (if (= (gnus-data-number (car data)) article)
7114         (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
7115               gnus-newsgroup-data-reverse nil)
7116       (while (cdr data)
7117         (and (= (gnus-data-number (cadr data)) article)
7118              (progn
7119                (setcdr data (cddr data))
7120                (and offset (gnus-data-update-list (cdr data) offset))
7121                (setq data nil
7122                      gnus-newsgroup-data-reverse nil)))
7123         (setq data (cdr data))))))
7124
7125 (defmacro gnus-data-list (backward)
7126   `(if ,backward
7127        (or gnus-newsgroup-data-reverse
7128            (setq gnus-newsgroup-data-reverse
7129                  (reverse gnus-newsgroup-data)))
7130      gnus-newsgroup-data))
7131
7132 (defun gnus-data-update-list (data offset)
7133   "Add OFFSET to the POS of all data entries in DATA."
7134   (while data
7135     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
7136     (setq data (cdr data))))
7137
7138 (defun gnus-data-compute-positions ()
7139   "Compute the positions of all articles."
7140   (let ((data gnus-newsgroup-data)
7141         pos)
7142     (while data
7143       (when (setq pos (text-property-any
7144                        (point-min) (point-max)
7145                        'gnus-number (gnus-data-number (car data))))
7146         (gnus-data-set-pos (car data) (+ pos 3)))
7147       (setq data (cdr data)))))
7148
7149 (defun gnus-summary-article-pseudo-p (article)
7150   "Say whether this article is a pseudo article or not."
7151   (not (vectorp (gnus-data-header (gnus-data-find article)))))
7152
7153 (defun gnus-article-parent-p (number)
7154   "Say whether this article is a parent or not."
7155   (let ((data (gnus-data-find-list number)))
7156     (and (cdr data)                     ; There has to be an article after...
7157          (< (gnus-data-level (car data)) ; And it has to have a higher level.
7158             (gnus-data-level (nth 1 data))))))
7159
7160 (defun gnus-article-children (number)
7161   "Return a list of all children to NUMBER."
7162   (let* ((data (gnus-data-find-list number))
7163          (level (gnus-data-level (car data)))
7164          children)
7165     (setq data (cdr data))
7166     (while (and data            
7167                 (= (gnus-data-level (car data)) (1+ level)))
7168       (push (gnus-data-number (car data)) children)
7169       (setq data (cdr data)))
7170     children))
7171
7172 (defmacro gnus-summary-skip-intangible ()
7173   "If the current article is intangible, then jump to a different article."
7174   '(let ((to (get-text-property (point) 'gnus-intangible)))
7175     (and to (gnus-summary-goto-subject to))))
7176
7177 (defmacro gnus-summary-article-intangible-p ()
7178   "Say whether this article is intangible or not."
7179   '(get-text-property (point) 'gnus-intangible))
7180
7181 ;; Some summary mode macros.
7182
7183 (defmacro gnus-summary-article-number ()
7184   "The article number of the article on the current line.
7185 If there isn's an article number here, then we return the current
7186 article number."
7187   '(progn
7188      (gnus-summary-skip-intangible)
7189      (or (get-text-property (point) 'gnus-number)
7190          (gnus-summary-last-subject))))
7191
7192 (defmacro gnus-summary-article-header (&optional number)
7193   `(gnus-data-header (gnus-data-find
7194                       ,(or number '(gnus-summary-article-number)))))
7195
7196 (defmacro gnus-summary-thread-level (&optional number)
7197   `(if (and (eq gnus-summary-make-false-root 'dummy)
7198             (get-text-property (point) 'gnus-intangible))
7199        0
7200      (gnus-data-level (gnus-data-find
7201                        ,(or number '(gnus-summary-article-number))))))
7202
7203 (defmacro gnus-summary-article-mark (&optional number)
7204   `(gnus-data-mark (gnus-data-find
7205                     ,(or number '(gnus-summary-article-number)))))
7206
7207 (defmacro gnus-summary-article-pos (&optional number)
7208   `(gnus-data-pos (gnus-data-find
7209                    ,(or number '(gnus-summary-article-number)))))
7210
7211 (defalias 'gnus-summary-subject-string 'gnus-summary-article-subject)
7212 (defmacro gnus-summary-article-subject (&optional number)
7213   "Return current subject string or nil if nothing."
7214   `(let ((headers
7215           ,(if number
7216                `(gnus-data-header (assq ,number gnus-newsgroup-data))
7217              '(gnus-data-header (assq (gnus-summary-article-number)
7218                                       gnus-newsgroup-data)))))
7219      (and headers
7220           (vectorp headers)
7221           (mail-header-subject headers))))
7222
7223 (defmacro gnus-summary-article-score (&optional number)
7224   "Return current article score."
7225   `(or (cdr (assq ,(or number '(gnus-summary-article-number))
7226                   gnus-newsgroup-scored))
7227        gnus-summary-default-score 0))
7228
7229 (defun gnus-summary-article-children (&optional number)
7230   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
7231          (level (gnus-data-level (car data)))
7232          l children)
7233     (while (and (setq data (cdr data))
7234                 (> (setq l (gnus-data-level (car data))) level))
7235       (and (= (1+ level) l)
7236            (setq children (cons (gnus-data-number (car data))
7237                                 children))))
7238     (nreverse children)))
7239
7240 (defun gnus-summary-article-parent (&optional number)
7241   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
7242                                     (gnus-data-list t)))
7243          (level (gnus-data-level (car data))))
7244     (if (zerop level)
7245         () ; This is a root.
7246       ;; We search until we find an article with a level less than
7247       ;; this one.  That function has to be the parent.
7248       (while (and (setq data (cdr data))
7249                   (not (< (gnus-data-level (car data)) level))))
7250       (and data (gnus-data-number (car data))))))
7251
7252 (defun gnus-unread-mark-p (mark)
7253   "Say whether MARK is the unread mark."
7254   (= mark gnus-unread-mark))
7255
7256 (defun gnus-read-mark-p (mark)
7257   "Say whether MARK is one of the marks that mark as read.
7258 This is all marks except unread, ticked, dormant, and expirable."
7259   (not (or (= mark gnus-unread-mark)
7260            (= mark gnus-ticked-mark)
7261            (= mark gnus-dormant-mark)
7262            (= mark gnus-expirable-mark))))
7263
7264 ;; Various summary mode internalish functions.
7265
7266 (defun gnus-mouse-pick-article (e)
7267   (interactive "e")
7268   (mouse-set-point e)
7269   (gnus-summary-next-page nil t))
7270
7271 (defun gnus-summary-setup-buffer (group)
7272   "Initialize summary buffer."
7273   (let ((buffer (concat "*Summary " group "*")))
7274     (if (get-buffer buffer)
7275         (progn
7276           (set-buffer buffer)
7277           (setq gnus-summary-buffer (current-buffer))
7278           (not gnus-newsgroup-prepared))
7279       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
7280       (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
7281       (gnus-add-current-to-buffer-list)
7282       (gnus-summary-mode group)
7283       (when gnus-carpal
7284         (gnus-carpal-setup-buffer 'summary))
7285       (unless gnus-single-article-buffer
7286         (make-local-variable 'gnus-article-buffer)
7287         (make-local-variable 'gnus-article-current)
7288         (make-local-variable 'gnus-original-article-buffer))
7289       (setq gnus-newsgroup-name group)
7290       t)))
7291
7292 (defun gnus-set-global-variables ()
7293   ;; Set the global equivalents of the summary buffer-local variables
7294   ;; to the latest values they had.  These reflect the summary buffer
7295   ;; that was in action when the last article was fetched.
7296   (when (eq major-mode 'gnus-summary-mode)
7297     (setq gnus-summary-buffer (current-buffer))
7298     (let ((name gnus-newsgroup-name)
7299           (marked gnus-newsgroup-marked)
7300           (unread gnus-newsgroup-unreads)
7301           (headers gnus-current-headers)
7302           (data gnus-newsgroup-data)
7303           (summary gnus-summary-buffer)
7304           (article-buffer gnus-article-buffer)
7305           (original gnus-original-article-buffer)
7306           (gac gnus-article-current)
7307           (score-file gnus-current-score-file))
7308       (save-excursion
7309         (set-buffer gnus-group-buffer)
7310         (setq gnus-newsgroup-name name)
7311         (setq gnus-newsgroup-marked marked)
7312         (setq gnus-newsgroup-unreads unread)
7313         (setq gnus-current-headers headers)
7314         (setq gnus-newsgroup-data data)
7315         (setq gnus-article-current gac)
7316         (setq gnus-summary-buffer summary)
7317         (setq gnus-article-buffer article-buffer)
7318         (setq gnus-original-article-buffer original)
7319         (setq gnus-current-score-file score-file)))))
7320
7321 (defun gnus-summary-last-article-p (&optional article)
7322   "Return whether ARTICLE is the last article in the buffer."
7323   (if (not (setq article (or article (gnus-summary-article-number))))
7324       t ; All non-existant numbers are the last article. :-)
7325     (cdr (gnus-data-find-list article))))
7326
7327 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
7328   "Insert a dummy root in the summary buffer."
7329   (beginning-of-line)
7330   (add-text-properties
7331    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
7332    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
7333
7334 (defvar gnus-thread-indent-array nil)
7335 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
7336 (defun gnus-make-thread-indent-array ()
7337   (let ((n 200))
7338     (unless (and gnus-thread-indent-array
7339                  (= gnus-thread-indent-level gnus-thread-indent-array-level))
7340       (setq gnus-thread-indent-array (make-vector 201 "")
7341             gnus-thread-indent-array-level gnus-thread-indent-level)
7342       (while (>= n 0)
7343         (aset gnus-thread-indent-array n
7344               (make-string (* n gnus-thread-indent-level) ? ))
7345         (setq n (1- n))))))
7346
7347 (defun gnus-summary-insert-line
7348   (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread
7349                    gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
7350                    &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
7351   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
7352          (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
7353          (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
7354          (gnus-tmp-score-char
7355           (if (or (null gnus-summary-default-score)
7356                   (<= (abs (- gnus-tmp-score gnus-summary-default-score))
7357                       gnus-summary-zcore-fuzz)) ? 
7358             (if (< gnus-tmp-score gnus-summary-default-score)
7359                 gnus-score-below-mark gnus-score-over-mark)))
7360          (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark)
7361                                  ((memq gnus-tmp-current gnus-newsgroup-cached)
7362                                   gnus-cached-mark)
7363                                  (gnus-tmp-replied gnus-replied-mark)
7364                                  ((memq gnus-tmp-current gnus-newsgroup-saved)
7365                                   gnus-saved-mark)
7366                                  (t gnus-unread-mark)))
7367          (gnus-tmp-from (mail-header-from gnus-tmp-header))
7368          (gnus-tmp-name
7369           (cond
7370            ((string-match "(.+)" gnus-tmp-from)
7371             (substring gnus-tmp-from
7372                        (1+ (match-beginning 0)) (1- (match-end 0))))
7373            ((string-match "<[^>]+> *$" gnus-tmp-from)
7374             (let ((beg (match-beginning 0)))
7375               (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
7376                        (substring gnus-tmp-from (1+ (match-beginning 0))
7377                                   (1- (match-end 0))))
7378                   (substring gnus-tmp-from 0 beg))))
7379            (t gnus-tmp-from)))
7380          (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
7381          (gnus-tmp-number (mail-header-number gnus-tmp-header))
7382          (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
7383          (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
7384          (buffer-read-only nil))
7385     (when (string= gnus-tmp-name "")
7386       (setq gnus-tmp-name gnus-tmp-from))
7387     (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
7388     (put-text-property
7389      (point)
7390      (progn (eval gnus-summary-line-format-spec) (point))
7391      'gnus-number gnus-tmp-number)
7392     (when (gnus-visual-p 'summary-highlight 'highlight)
7393       (forward-line -1)
7394       (run-hooks 'gnus-summary-update-hook)
7395       (forward-line 1))))
7396
7397 (defun gnus-summary-update-line (&optional dont-update)
7398   ;; Update summary line after change.
7399   (when (and gnus-summary-default-score
7400              (not gnus-summary-inhibit-highlight))
7401     (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
7402            (article (gnus-summary-article-number))
7403            (score (gnus-summary-article-score article)))
7404       (unless dont-update
7405         (if (and gnus-summary-mark-below
7406                  (< (gnus-summary-article-score)
7407                     gnus-summary-mark-below))
7408             ;; This article has a low score, so we mark it as read.
7409             (when (memq article gnus-newsgroup-unreads)
7410               (gnus-summary-mark-article-as-read gnus-low-score-mark))
7411           (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
7412             ;; This article was previously marked as read on account
7413             ;; of a low score, but now it has risen, so we mark it as
7414             ;; unread.
7415             (gnus-summary-mark-article-as-unread gnus-unread-mark)))
7416         (gnus-summary-update-mark
7417          (if (or (null gnus-summary-default-score)
7418                  (<= (abs (- score gnus-summary-default-score))
7419                      gnus-summary-zcore-fuzz)) ? 
7420            (if (< score gnus-summary-default-score)
7421                gnus-score-below-mark gnus-score-over-mark)) 'score))
7422       ;; Do visual highlighting.
7423       (when (gnus-visual-p 'summary-highlight 'highlight)
7424         (run-hooks 'gnus-summary-update-hook)))))
7425
7426 (defvar gnus-tmp-new-adopts nil)
7427
7428 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
7429   ;; Sum up all elements (and sub-elements) in a list.
7430   (let* ((number
7431           ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
7432           (cond
7433            ((and (consp thread) (cdr thread))
7434             (apply
7435              '+ 1 (mapcar
7436                    'gnus-summary-number-of-articles-in-thread (cdr thread))))
7437            ((null thread)
7438             1)
7439            ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
7440             1)
7441            (t 1))))
7442     (when (and level (zerop level) gnus-tmp-new-adopts)
7443       (incf number
7444             (apply '+ (mapcar
7445                        'gnus-summary-number-of-articles-in-thread
7446                        gnus-tmp-new-adopts))))
7447     (if char
7448         (if (> number 1) gnus-not-empty-thread-mark
7449           gnus-empty-thread-mark)
7450       number)))
7451
7452 (defun gnus-summary-set-local-parameters (group)
7453  "Go through the local params of GROUP and set all variable specs in that list."
7454   (let ((params (gnus-info-params (gnus-get-info group)))
7455         elem)
7456     (while params
7457       (setq elem (car params)
7458             params (cdr params))
7459       (and (consp elem)                 ; Has to be a cons.
7460            (consp (cdr elem))           ; The cdr has to be a list.
7461            (symbolp (car elem))         ; Has to be a symbol in there.
7462            (not (memq (car elem) 
7463                       '(quit-config to-address to-list to-group)))
7464            (progn                       ; So we set it.
7465              (make-local-variable (car elem))
7466              (set (car elem) (eval (nth 1 elem))))))))
7467
7468 (defun gnus-summary-read-group (group &optional show-all no-article
7469                                       kill-buffer no-display)
7470   "Start reading news in newsgroup GROUP.
7471 If SHOW-ALL is non-nil, already read articles are also listed.
7472 If NO-ARTICLE is non-nil, no article is selected initially.
7473 If NO-DISPLAY, don't generate a summary buffer."
7474   (gnus-message 5 "Retrieving newsgroup: %s..." group)
7475   (let* ((new-group (gnus-summary-setup-buffer group))
7476          (quit-config (gnus-group-quit-config group))
7477          (did-select (and new-group (gnus-select-newsgroup group show-all))))
7478     (cond
7479      ;; This summary buffer exists already, so we just select it.
7480      ((not new-group)
7481       (gnus-set-global-variables)
7482       (when kill-buffer
7483         (gnus-kill-or-deaden-summary kill-buffer))
7484       (gnus-configure-windows 'summary 'force)
7485       (gnus-set-mode-line 'summary)
7486       (gnus-summary-position-point)
7487       (message "")
7488       t)
7489      ;; We couldn't select this group.
7490      ((null did-select)
7491       (when (and (eq major-mode 'gnus-summary-mode)
7492                  (not (equal (current-buffer) kill-buffer)))
7493         (kill-buffer (current-buffer))
7494         (if (not quit-config)
7495             (progn
7496               (set-buffer gnus-group-buffer)
7497               (gnus-group-jump-to-group group)
7498               (gnus-group-next-unread-group 1))
7499           (if (not (buffer-name (car quit-config)))
7500               (gnus-configure-windows 'group 'force)
7501             (set-buffer (car quit-config))
7502             (and (eq major-mode 'gnus-summary-mode)
7503                  (gnus-set-global-variables))
7504             (gnus-configure-windows (cdr quit-config)))))
7505       (gnus-message 3 "Can't select group")
7506       nil)
7507      ;; The user did a `C-g' while prompting for number of articles,
7508      ;; so we exit this group.
7509      ((eq did-select 'quit)
7510       (and (eq major-mode 'gnus-summary-mode)
7511            (not (equal (current-buffer) kill-buffer))
7512            (kill-buffer (current-buffer)))
7513       (when kill-buffer
7514         (gnus-kill-or-deaden-summary kill-buffer))
7515       (if (not quit-config)
7516           (progn
7517             (set-buffer gnus-group-buffer)
7518             (gnus-group-jump-to-group group)
7519             (gnus-group-next-unread-group 1)
7520             (gnus-configure-windows 'group 'force))
7521         (if (not (buffer-name (car quit-config)))
7522             (gnus-configure-windows 'group 'force)
7523           (set-buffer (car quit-config))
7524           (and (eq major-mode 'gnus-summary-mode)
7525                (gnus-set-global-variables))
7526           (gnus-configure-windows (cdr quit-config))))
7527       ;; Finally signal the quit.
7528       (signal 'quit nil))
7529      ;; The group was successfully selected.
7530      (t
7531       (gnus-set-global-variables)
7532       ;; Save the active value in effect when the group was entered.
7533       (setq gnus-newsgroup-active
7534             (gnus-copy-sequence
7535              (gnus-active gnus-newsgroup-name)))
7536       ;; You can change the summary buffer in some way with this hook.
7537       (run-hooks 'gnus-select-group-hook)
7538       ;; Set any local variables in the group parameters.
7539       (gnus-summary-set-local-parameters gnus-newsgroup-name)
7540       (gnus-update-format-specifications)
7541       ;; Do score processing.
7542       (when gnus-use-scoring
7543         (gnus-possibly-score-headers))
7544       ;; Check whether to fill in the gaps in the threads.
7545       (when gnus-build-sparse-threads
7546         (gnus-build-sparse-threads))
7547       ;; Find the initial limit.
7548       (if show-all
7549           (let ((gnus-newsgroup-dormant nil))
7550             (gnus-summary-initial-limit show-all))
7551         (gnus-summary-initial-limit show-all))
7552       ;; Generate the summary buffer.
7553       (unless no-display
7554         (gnus-summary-prepare))
7555       (when gnus-use-trees
7556         (gnus-tree-open group)
7557         (setq gnus-summary-highlight-line-function
7558               'gnus-tree-highlight-article))
7559       ;; If the summary buffer is empty, but there are some low-scored
7560       ;; articles or some excluded dormants, we include these in the
7561       ;; buffer.
7562       (when (and (zerop (buffer-size))
7563                  (not no-display))
7564         (cond (gnus-newsgroup-dormant
7565                (gnus-summary-limit-include-dormant))
7566               ((and gnus-newsgroup-scored show-all)
7567                (gnus-summary-limit-include-expunged))))
7568       ;; Function `gnus-apply-kill-file' must be called in this hook.
7569       (run-hooks 'gnus-apply-kill-hook)
7570       (if (and (zerop (buffer-size))
7571                (not no-display))
7572           (progn
7573             ;; This newsgroup is empty.
7574             (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
7575             (gnus-message 6 "No unread news")
7576             (when kill-buffer
7577               (gnus-kill-or-deaden-summary kill-buffer))
7578             ;; Return nil from this function.
7579             nil)
7580         ;; Hide conversation thread subtrees.  We cannot do this in
7581         ;; gnus-summary-prepare-hook since kill processing may not
7582         ;; work with hidden articles.
7583         (and gnus-show-threads
7584              gnus-thread-hide-subtree
7585              (gnus-summary-hide-all-threads))
7586         ;; Show first unread article if requested.
7587         (if (and (not no-article)
7588                  (not no-display)
7589                  gnus-newsgroup-unreads
7590                  gnus-auto-select-first)
7591             (if (eq gnus-auto-select-first 'best)
7592                 (gnus-summary-best-unread-article)
7593               (gnus-summary-first-unread-article))
7594           ;; Don't select any articles, just move point to the first
7595           ;; article in the group.
7596           (goto-char (point-min))
7597           (gnus-summary-position-point)
7598           (gnus-set-mode-line 'summary)
7599           (gnus-configure-windows 'summary 'force))
7600         ;; If we are in async mode, we send some info to the backend.
7601         (when gnus-newsgroup-async
7602           (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data))
7603         (when kill-buffer
7604           (gnus-kill-or-deaden-summary kill-buffer))
7605         (when (get-buffer-window gnus-group-buffer t)
7606           ;; Gotta use windows, because recenter does wierd stuff if
7607           ;; the current buffer ain't the displayed window.
7608           (let ((owin (selected-window)))
7609             (select-window (get-buffer-window gnus-group-buffer t))
7610             (when (gnus-group-goto-group group)
7611               (recenter))
7612             (select-window owin))))
7613       ;; Mark this buffer as "prepared".
7614       (setq gnus-newsgroup-prepared t)
7615       t))))
7616
7617 (defun gnus-summary-prepare ()
7618   "Generate the summary buffer."
7619   (let ((buffer-read-only nil))
7620     (erase-buffer)
7621     (setq gnus-newsgroup-data nil
7622           gnus-newsgroup-data-reverse nil)
7623     (run-hooks 'gnus-summary-generate-hook)
7624     ;; Generate the buffer, either with threads or without.
7625     (when gnus-newsgroup-headers
7626       (gnus-summary-prepare-threads
7627        (if gnus-show-threads
7628            (gnus-sort-gathered-threads
7629             (funcall gnus-summary-thread-gathering-function
7630                      (gnus-sort-threads
7631                       (gnus-cut-threads (gnus-make-threads)))))
7632          ;; Unthreaded display.
7633          (gnus-sort-articles gnus-newsgroup-headers))))
7634     (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
7635     ;; Call hooks for modifying summary buffer.
7636     (goto-char (point-min))
7637     (run-hooks 'gnus-summary-prepare-hook)))
7638
7639 (defun gnus-gather-threads-by-subject (threads)
7640   "Gather threads by looking at Subject headers."
7641   (if (not gnus-summary-make-false-root)
7642       threads
7643     (let ((hashtb (gnus-make-hashtable 1023))
7644           (prev threads)
7645           (result threads)
7646           subject hthread whole-subject)
7647       (while threads
7648         (setq whole-subject (mail-header-subject (caar threads)))
7649         (setq subject
7650               (cond
7651                ;; Truncate the subject.
7652                ((numberp gnus-summary-gather-subject-limit)
7653                 (setq subject (gnus-simplify-subject-re whole-subject))
7654                 (if (> (length subject) gnus-summary-gather-subject-limit)
7655                     (substring subject 0 gnus-summary-gather-subject-limit)
7656                   subject))
7657                ;; Fuzzily simplify it.
7658                ((eq 'fuzzy gnus-summary-gather-subject-limit)
7659                 (gnus-simplify-subject-fuzzy whole-subject))
7660                ;; Just remove the leading "Re:".
7661                (t
7662                 (gnus-simplify-subject-re whole-subject))))
7663
7664         (if (and gnus-summary-gather-exclude-subject
7665                  (string-match gnus-summary-gather-exclude-subject
7666                                subject))
7667             ()          ; We don't want to do anything with this article.
7668           ;; We simplify the subject before looking it up in the
7669           ;; hash table.
7670
7671           (if (setq hthread (gnus-gethash subject hashtb))
7672               (progn
7673                 ;; We enter a dummy root into the thread, if we
7674                 ;; haven't done that already.
7675                 (unless (stringp (caar hthread))
7676                   (setcar hthread (list whole-subject (car hthread))))
7677                 ;; We add this new gathered thread to this gathered
7678                 ;; thread.
7679                 (setcdr (car hthread)
7680                         (nconc (cdar hthread) (list (car threads))))
7681                 ;; Remove it from the list of threads.
7682                 (setcdr prev (cdr threads))
7683                 (setq threads prev))
7684             ;; Enter this thread into the hash table.
7685             (gnus-sethash subject threads hashtb)))
7686         (setq prev threads)
7687         (setq threads (cdr threads)))
7688       result)))
7689
7690 (defun gnus-gather-threads-by-references (threads)
7691   "Gather threads by looking at References headers."
7692   (let ((idhashtb (gnus-make-hashtable 1023))
7693         (thhashtb (gnus-make-hashtable 1023))
7694         (prev threads)
7695         (result threads)
7696         ids references id gthread gid entered)
7697     (while threads
7698       (when (setq references (mail-header-references (caar threads)))
7699         (setq id (mail-header-id (caar threads)))
7700         (setq ids (gnus-split-references references))
7701         (setq entered nil)
7702         (while ids
7703           (if (not (setq gid (gnus-gethash (car ids) idhashtb)))
7704               (progn
7705                 (gnus-sethash (car ids) id idhashtb)
7706                 (gnus-sethash id threads thhashtb))
7707             (setq gthread (gnus-gethash gid thhashtb))
7708             (unless entered
7709               ;; We enter a dummy root into the thread, if we
7710               ;; haven't done that already.
7711               (unless (stringp (caar gthread))
7712                 (setcar gthread (list (mail-header-subject (caar gthread))
7713                                       (car gthread))))
7714               ;; We add this new gathered thread to this gathered
7715               ;; thread.
7716               (setcdr (car gthread)
7717                       (nconc (cdar gthread) (list (car threads)))))
7718             ;; Add it into the thread hash table.
7719             (gnus-sethash id gthread thhashtb)
7720             (setq entered t)
7721             ;; Remove it from the list of threads.
7722             (setcdr prev (cdr threads))
7723             (setq threads prev))
7724           (setq ids (cdr ids))))
7725       (setq prev threads)
7726       (setq threads (cdr threads)))
7727     result))
7728
7729 (defun gnus-sort-gathered-threads (threads)
7730   "Sort subtreads inside each gathered thread by article number."
7731   (let ((result threads))
7732     (while threads
7733       (when (stringp (caar threads))
7734         (setcdr (car threads)
7735                 (sort (cdar threads) 'gnus-thread-sort-by-number)))
7736       (setq threads (cdr threads)))
7737     result))
7738
7739 (defun gnus-make-threads ()
7740   "Go through the dependency hashtb and find the roots.  Return all threads."
7741   (let (threads)
7742     (mapatoms
7743      (lambda (refs)
7744        (unless (car (symbol-value refs))
7745          ;; These threads do not refer back to any other articles,
7746          ;; so they're roots.
7747          (setq threads (append (cdr (symbol-value refs)) threads))))
7748      gnus-newsgroup-dependencies)
7749     threads))
7750
7751 (defun gnus-build-sparse-threads ()
7752   (let ((headers gnus-newsgroup-headers)
7753         (deps gnus-newsgroup-dependencies)
7754         header references generation relations 
7755         cthread subject child end pthread relation)
7756     ;; First we create an alist of generations/relations, where 
7757     ;; generations is how much we trust the ralation, and the relation
7758     ;; is parent/child.
7759     (gnus-message 7 "Making sparse threads...")
7760     (save-excursion
7761       (nnheader-set-temp-buffer " *gnus sparse threads*")
7762       (while (setq header (pop headers))
7763         (when (and (setq references (mail-header-references header))
7764                    (not (string= references "")))
7765           (insert references)
7766           (setq child (mail-header-id header)
7767                 subject (mail-header-subject header))
7768           (setq generation 0)
7769           (while (search-backward ">" nil t)
7770             (setq end (1+ (point)))
7771             (when (search-backward "<" nil t)
7772               (push (list (incf generation) 
7773                           child (setq child (buffer-substring (point) end))
7774                           subject)
7775                     relations)))
7776           (push (list (1+ generation) child nil subject) relations)
7777           (erase-buffer)))
7778       (kill-buffer (current-buffer)))
7779     ;; Sort over trustworthiness.
7780     (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2)))))
7781     (while (setq relation (pop relations))
7782       (when (if (boundp (setq cthread (intern (cadr relation) deps)))
7783                 (unless (car (symbol-value cthread))
7784                   ;; Make this article the parent of these threads.
7785                   (setcar (symbol-value cthread)
7786                           (vector gnus-reffed-article-number 
7787                                   (cadddr relation) 
7788                                   "" ""
7789                                   (cadr relation) 
7790                                   (or (caddr relation) "") 0 0 "")))
7791               (set cthread (list (vector gnus-reffed-article-number
7792                                          (cadddr relation) 
7793                                          "" "" (cadr relation) 
7794                                          (or (caddr relation) "") 0 0 ""))))
7795         (push gnus-reffed-article-number gnus-newsgroup-limit)
7796         (push gnus-reffed-article-number gnus-newsgroup-sparse)
7797         (push (cons gnus-reffed-article-number gnus-sparse-mark)
7798               gnus-newsgroup-reads)
7799         (decf gnus-reffed-article-number)
7800         ;; Make this new thread the child of its parent.
7801         (if (boundp (setq pthread (intern (or (caddr relation) "none") deps)))
7802             (setcdr (symbol-value pthread)
7803                     (nconc (cdr (symbol-value pthread))
7804                            (list (symbol-value cthread))))
7805           (set pthread (list nil (symbol-value cthread))))))
7806     (gnus-message 7 "Making sparse threads...done")))
7807
7808 (defun gnus-build-old-threads ()
7809   ;; Look at all the articles that refer back to old articles, and
7810   ;; fetch the headers for the articles that aren't there.  This will
7811   ;; build complete threads - if the roots haven't been expired by the
7812   ;; server, that is.
7813   (let (id heads)
7814     (mapatoms
7815      (lambda (refs)
7816        (when (not (car (symbol-value refs)))
7817          (setq heads (cdr (symbol-value refs)))
7818          (while heads
7819            (if (memq (mail-header-number (caar heads))
7820                      gnus-newsgroup-dormant)
7821                (setq heads (cdr heads))
7822              (setq id (symbol-name refs))
7823              (while (and (setq id (gnus-build-get-header id))
7824                          (not (car (gnus-gethash
7825                                     id gnus-newsgroup-dependencies)))))
7826              (setq heads nil)))))
7827      gnus-newsgroup-dependencies)))
7828
7829 (defun gnus-build-get-header (id)
7830   ;; Look through the buffer of NOV lines and find the header to
7831   ;; ID.  Enter this line into the dependencies hash table, and return
7832   ;; the id of the parent article (if any).
7833   (let ((deps gnus-newsgroup-dependencies)
7834         found header)
7835     (prog1
7836         (save-excursion
7837           (set-buffer nntp-server-buffer)
7838           (goto-char (point-min))
7839           (while (and (not found) (search-forward id nil t))
7840             (beginning-of-line)
7841             (setq found (looking-at
7842                          (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
7843                                  (regexp-quote id))))
7844             (or found (beginning-of-line 2)))
7845           (when found
7846             (beginning-of-line)
7847             (and
7848              (setq header (gnus-nov-parse-line
7849                            (read (current-buffer)) deps))
7850              (gnus-parent-id (mail-header-references header)))))
7851       (when header
7852         (let ((number (mail-header-number header)))
7853           (push number gnus-newsgroup-limit)
7854           (push header gnus-newsgroup-headers)
7855           (if (memq number gnus-newsgroup-unselected)
7856               (progn
7857                 (push number gnus-newsgroup-unreads)
7858                 (setq gnus-newsgroup-unselected
7859                       (delq number gnus-newsgroup-unselected)))
7860             (push number gnus-newsgroup-ancient)))))))
7861
7862 (defun gnus-summary-update-article (article &optional header)
7863   "Update ARTICLE in the summary buffer."
7864   (set-buffer gnus-summary-buffer)
7865   (let* ((header (or header (gnus-summary-article-header article)))
7866          (id (mail-header-id header))
7867          (data (gnus-data-find article))
7868          (thread (gnus-id-to-thread id))
7869          (parent
7870           (gnus-id-to-thread (or (gnus-parent-id 
7871                                   (mail-header-references header))
7872                                  "tull")))
7873          (buffer-read-only nil)
7874          (old (car thread))
7875          (number (mail-header-number header))
7876          pos)
7877     (when thread
7878       (setcar thread nil)
7879       (when parent
7880         (delq thread parent))
7881       (if (gnus-summary-insert-subject id header)
7882           ;; Set the (possibly) new article number in the data structure.
7883           (gnus-data-set-number data (gnus-id-to-article id))
7884         (setcar thread old)
7885         nil))))
7886
7887 (defun gnus-rebuild-thread (id)
7888   "Rebuild the thread containing ID."
7889   (let ((buffer-read-only nil)
7890         current thread data)
7891     (if (not gnus-show-threads)
7892         (setq thread (list (car (gnus-id-to-thread id))))
7893       ;; Get the thread this article is part of.
7894       (setq thread (gnus-remove-thread id)))
7895     (setq current (save-excursion
7896                     (and (zerop (forward-line -1))
7897                          (gnus-summary-article-number))))
7898     ;; If this is a gathered thread, we have to go some re-gathering.
7899     (when (stringp (car thread))
7900       (let ((subject (car thread))
7901             roots thr)
7902         (setq thread (cdr thread))
7903         (while thread
7904           (unless (memq (setq thr (gnus-id-to-thread
7905                                       (gnus-root-id
7906                                        (mail-header-id (caar thread)))))
7907                         roots)
7908             (push thr roots))
7909           (setq thread (cdr thread)))
7910         ;; We now have all (unique) roots.
7911         (if (= (length roots) 1)
7912             ;; All the loose roots are now one solid root.
7913             (setq thread (car roots))
7914           (setq thread (cons subject (gnus-sort-threads roots))))))
7915     (let (threads)
7916       ;; We then insert this thread into the summary buffer.
7917       (let (gnus-newsgroup-data gnus-newsgroup-threads)
7918         (gnus-summary-prepare-threads (list thread))
7919         (setq data (nreverse gnus-newsgroup-data))
7920         (setq threads gnus-newsgroup-threads))
7921       ;; We splice the new data into the data structure.
7922       (gnus-data-enter-list current data)
7923       (gnus-data-compute-positions)
7924       (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
7925
7926 (defun gnus-id-to-thread (id)
7927   "Return the (sub-)thread where ID appears."
7928   (gnus-gethash id gnus-newsgroup-dependencies))
7929
7930 (defun gnus-id-to-article (id)
7931   "Return the article number of ID."
7932   (let ((thread (gnus-id-to-thread id)))
7933     (when thread
7934       (mail-header-number (car thread)))))
7935
7936 (defun gnus-id-to-header (id)
7937   "Return the article headers of ID."
7938   (car (gnus-id-to-thread id)))
7939
7940 (defun gnus-article-displayed-root-p (article)
7941   "Say whether ARTICLE is a root(ish) article."
7942   (let ((level (gnus-summary-thread-level article))
7943         particle)
7944     (cond 
7945      ((null level) nil)
7946      ((zerop level) t)
7947      ((and (= 1 level)
7948            (null (setq particle (gnus-id-to-article
7949                                  (gnus-parent-id 
7950                                   (mail-header-references 
7951                                    (gnus-summary-article-header article))))))
7952            (null (gnus-summary-thread-level particle)))))))
7953
7954 (defun gnus-root-id (id)
7955   "Return the id of the root of the thread where ID appears."
7956   (let (last-id prev)
7957     (while (and id (setq prev (car (gnus-gethash 
7958                                     id gnus-newsgroup-dependencies))))
7959       (setq last-id id
7960             id (gnus-parent-id (mail-header-references prev))))
7961     last-id))
7962
7963 (defun gnus-remove-thread (id &optional dont-remove)
7964   "Remove the thread that has ID in it."
7965   (let ((dep gnus-newsgroup-dependencies)
7966         headers thread last-id)
7967     ;; First go up in this thread until we find the root.
7968     (setq last-id (gnus-root-id id))
7969     (setq headers (list (car (gnus-id-to-thread last-id))
7970                         (caadr (gnus-id-to-thread last-id))))
7971     ;; We have now found the real root of this thread.  It might have
7972     ;; been gathered into some loose thread, so we have to search
7973     ;; through the threads to find the thread we wanted.
7974     (let ((threads gnus-newsgroup-threads)
7975           sub)
7976       (while threads
7977         (setq sub (car threads))
7978         (if (stringp (car sub))
7979             ;; This is a gathered threads, so we look at the roots
7980             ;; below it to find whether this article in in this
7981             ;; gathered root.
7982             (progn
7983               (setq sub (cdr sub))
7984               (while sub
7985                 (when (member (caar sub) headers)
7986                   (setq thread (car threads)
7987                         threads nil
7988                         sub nil))
7989                 (setq sub (cdr sub))))
7990           ;; It's an ordinary thread, so we check it.
7991           (when (eq (car sub) (car headers))
7992             (setq thread sub
7993                   threads nil)))
7994         (setq threads (cdr threads)))
7995       ;; If this article is in no thread, then it's a root.
7996       (if thread
7997           (unless dont-remove
7998             (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
7999         (setq thread (gnus-gethash last-id dep)))
8000       (when thread
8001         (prog1
8002             thread ; We return this thread.
8003           (unless dont-remove
8004             (if (stringp (car thread))
8005                 (progn
8006                   ;; If we use dummy roots, then we have to remove the
8007                   ;; dummy root as well.
8008                   (when (eq gnus-summary-make-false-root 'dummy)
8009                     ;; Uhm.
8010                     )
8011                   (setq thread (cdr thread))
8012                   (while thread
8013                     (gnus-remove-thread-1 (car thread))
8014                     (setq thread (cdr thread))))
8015               (gnus-remove-thread-1 thread))))))))
8016
8017 (defun gnus-remove-thread-1 (thread)
8018   "Remove the thread THREAD recursively."
8019   (let ((number (mail-header-number (car thread)))
8020         pos)
8021     (when (setq pos (text-property-any
8022                      (point-min) (point-max) 'gnus-number number))
8023       (goto-char pos)
8024       (gnus-delete-line)
8025       (gnus-data-remove number))
8026     (setq thread (cdr thread))
8027     (while thread
8028       (gnus-remove-thread-1 (pop thread)))))
8029
8030 (defun gnus-sort-threads (threads)
8031   "Sort THREADS."
8032   (if (not gnus-thread-sort-functions)
8033       threads
8034     (let ((func (if (= 1 (length gnus-thread-sort-functions))
8035                     (car gnus-thread-sort-functions)
8036                   `(lambda (t1 t2)
8037                      ,(gnus-make-sort-function 
8038                        (reverse gnus-thread-sort-functions))))))
8039       (gnus-message 7 "Sorting threads...")
8040       (prog1
8041           (sort threads func)
8042         (gnus-message 7 "Sorting threads...done")))))
8043
8044 (defun gnus-sort-articles (articles)
8045   "Sort ARTICLES."
8046   (when gnus-article-sort-functions
8047     (let ((func (if (= 1 (length gnus-article-sort-functions))
8048                     (car gnus-article-sort-functions)
8049                   `(lambda (t1 t2)
8050                      ,(gnus-make-sort-function 
8051                        (reverse gnus-article-sort-functions))))))
8052       (gnus-message 7 "Sorting articles...")
8053       (prog1
8054           (setq gnus-newsgroup-headers (sort articles func))
8055         (gnus-message 7 "Sorting articles...done")))))
8056
8057 (defun gnus-make-sort-function (funs)
8058   "Return a composite sort condition based on the functions in FUNC."
8059   (if (cdr funs)
8060       `(or (,(car funs) t1 t2)
8061            (and (not (,(car funs) t2 t1))
8062                 ,(gnus-make-sort-function (cdr funs))))
8063     `(,(car funs) t1 t2)))
8064                  
8065 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
8066 (defmacro gnus-thread-header (thread)
8067   ;; Return header of first article in THREAD.
8068   ;; Note that THREAD must never, ever be anything else than a variable -
8069   ;; using some other form will lead to serious barfage.
8070   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
8071   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
8072   (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
8073         (vector thread) 2))
8074
8075 (defsubst gnus-article-sort-by-number (h1 h2)
8076   "Sort articles by article number."
8077   (< (mail-header-number h1)
8078      (mail-header-number h2)))
8079
8080 (defun gnus-thread-sort-by-number (h1 h2)
8081   "Sort threads by root article number."
8082   (gnus-article-sort-by-number
8083    (gnus-thread-header h1) (gnus-thread-header h2)))
8084
8085 (defsubst gnus-article-sort-by-author (h1 h2)
8086   "Sort articles by root author."
8087   (string-lessp
8088    (let ((extract (funcall
8089                    gnus-extract-address-components
8090                    (mail-header-from h1))))
8091      (or (car extract) (cdr extract)))
8092    (let ((extract (funcall
8093                    gnus-extract-address-components
8094                    (mail-header-from h2))))
8095      (or (car extract) (cdr extract)))))
8096
8097 (defun gnus-thread-sort-by-author (h1 h2)
8098   "Sort threads by root author."
8099   (gnus-article-sort-by-author
8100    (gnus-thread-header h1)  (gnus-thread-header h2)))
8101
8102 (defsubst gnus-article-sort-by-subject (h1 h2)
8103   "Sort articles by root subject."
8104   (string-lessp
8105    (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
8106    (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
8107
8108 (defun gnus-thread-sort-by-subject (h1 h2)
8109   "Sort threads by root subject."
8110   (gnus-article-sort-by-subject
8111    (gnus-thread-header h1) (gnus-thread-header h2)))
8112
8113 (defsubst gnus-article-sort-by-date (h1 h2)
8114   "Sort articles by root article date."
8115   (string-lessp
8116    (gnus-sortable-date (mail-header-date h1))
8117    (gnus-sortable-date (mail-header-date h2))))
8118
8119 (defun gnus-thread-sort-by-date (h1 h2)
8120   "Sort threads by root article date."
8121   (gnus-article-sort-by-date
8122    (gnus-thread-header h1) (gnus-thread-header h2)))
8123
8124 (defsubst gnus-article-sort-by-score (h1 h2)
8125   "Sort articles by root article score.
8126 Unscored articles will be counted as having a score of zero."
8127   (> (or (cdr (assq (mail-header-number h1)
8128                     gnus-newsgroup-scored))
8129          gnus-summary-default-score 0)
8130      (or (cdr (assq (mail-header-number h2)
8131                     gnus-newsgroup-scored))
8132          gnus-summary-default-score 0)))
8133
8134 (defun gnus-thread-sort-by-score (h1 h2)
8135   "Sort threads by root article score."
8136   (gnus-article-sort-by-score
8137    (gnus-thread-header h1) (gnus-thread-header h2)))
8138
8139 (defun gnus-thread-sort-by-total-score (h1 h2)
8140   "Sort threads by the sum of all scores in the thread.
8141 Unscored articles will be counted as having a score of zero."
8142   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
8143
8144 (defun gnus-thread-total-score (thread)
8145   ;;  This function find the total score of THREAD.
8146   (if (consp thread)
8147       (if (stringp (car thread))
8148           (apply gnus-thread-score-function 0
8149                  (mapcar 'gnus-thread-total-score-1 (cdr thread)))
8150         (gnus-thread-total-score-1 thread))
8151     (gnus-thread-total-score-1 (list thread))))
8152
8153 (defun gnus-thread-total-score-1 (root)
8154   ;; This function find the total score of the thread below ROOT.
8155   (setq root (car root))
8156   (apply gnus-thread-score-function
8157          (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
8158              gnus-summary-default-score 0)
8159          (mapcar 'gnus-thread-total-score
8160                  (cdr (gnus-gethash (mail-header-id root)
8161                                     gnus-newsgroup-dependencies)))))
8162
8163 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
8164 (defvar gnus-tmp-prev-subject nil)
8165 (defvar gnus-tmp-false-parent nil)
8166 (defvar gnus-tmp-root-expunged nil)
8167 (defvar gnus-tmp-dummy-line nil)
8168
8169 (defun gnus-summary-prepare-threads (threads)
8170   "Prepare summary buffer from THREADS and indentation LEVEL.
8171 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
8172 or a straight list of headers."
8173   (gnus-message 7 "Generating summary...")
8174
8175   (setq gnus-newsgroup-threads threads)
8176   (beginning-of-line)
8177
8178   (let ((gnus-tmp-level 0)
8179         (default-score (or gnus-summary-default-score 0))
8180         (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
8181         thread number subject stack state gnus-tmp-gathered beg-match
8182         new-roots gnus-tmp-new-adopts thread-end
8183         gnus-tmp-header gnus-tmp-unread
8184         gnus-tmp-replied gnus-tmp-subject-or-nil
8185         gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
8186         gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
8187         gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
8188
8189     (setq gnus-tmp-prev-subject nil)
8190
8191     (if (vectorp (car threads))
8192         ;; If this is a straight (sic) list of headers, then a
8193         ;; threaded summary display isn't required, so we just create
8194         ;; an unthreaded one.
8195         (gnus-summary-prepare-unthreaded threads)
8196
8197       ;; Do the threaded display.
8198
8199       (while (or threads stack gnus-tmp-new-adopts new-roots)
8200
8201         (if (and (= gnus-tmp-level 0)
8202                  (not (setq gnus-tmp-dummy-line nil))
8203                  (or (not stack)
8204                      (= (caar stack) 0))
8205                  (not gnus-tmp-false-parent)
8206                  (or gnus-tmp-new-adopts new-roots))
8207             (if gnus-tmp-new-adopts
8208                 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
8209                       thread (list (car gnus-tmp-new-adopts))
8210                       gnus-tmp-header (caar thread)
8211                       gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
8212               (if new-roots
8213                   (setq thread (list (car new-roots))
8214                         gnus-tmp-header (caar thread)
8215                         new-roots (cdr new-roots))))
8216
8217           (if threads
8218               ;; If there are some threads, we do them before the
8219               ;; threads on the stack.
8220               (setq thread threads
8221                     gnus-tmp-header (caar thread))
8222             ;; There were no current threads, so we pop something off
8223             ;; the stack.
8224             (setq state (car stack)
8225                   gnus-tmp-level (car state)
8226                   thread (cdr state)
8227                   stack (cdr stack)
8228                   gnus-tmp-header (caar thread))))
8229
8230         (setq gnus-tmp-false-parent nil)
8231         (setq gnus-tmp-root-expunged nil)
8232         (setq thread-end nil)
8233
8234         (if (stringp gnus-tmp-header)
8235             ;; The header is a dummy root.
8236             (cond
8237              ((eq gnus-summary-make-false-root 'adopt)
8238               ;; We let the first article adopt the rest.
8239               (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
8240                                                (cddar thread)))
8241               (setq gnus-tmp-gathered
8242                     (nconc (mapcar
8243                             (lambda (h) (mail-header-number (car h)))
8244                             (cddar thread))
8245                            gnus-tmp-gathered))
8246               (setq thread (cons (list (caar thread)
8247                                        (cadar thread))
8248                                  (cdr thread)))
8249               (setq gnus-tmp-level -1
8250                     gnus-tmp-false-parent t))
8251              ((eq gnus-summary-make-false-root 'empty)
8252               ;; We print adopted articles with empty subject fields.
8253               (setq gnus-tmp-gathered
8254                     (nconc (mapcar
8255                             (lambda (h) (mail-header-number (car h)))
8256                             (cddar thread))
8257                            gnus-tmp-gathered))
8258               (setq gnus-tmp-level -1))
8259              ((eq gnus-summary-make-false-root 'dummy)
8260               ;; We remember that we probably want to output a dummy
8261               ;; root.
8262               (setq gnus-tmp-dummy-line gnus-tmp-header)
8263               (setq gnus-tmp-prev-subject gnus-tmp-header))
8264              (t
8265               ;; We do not make a root for the gathered
8266               ;; sub-threads at all.
8267               (setq gnus-tmp-level -1)))
8268
8269           (setq number (mail-header-number gnus-tmp-header)
8270                 subject (mail-header-subject gnus-tmp-header))
8271
8272           (cond
8273            ;; If the thread has changed subject, we might want to make
8274            ;; this subthread into a root.
8275            ((and (null gnus-thread-ignore-subject)
8276                  (not (zerop gnus-tmp-level))
8277                  gnus-tmp-prev-subject
8278                  (not (inline
8279                         (gnus-subject-equal gnus-tmp-prev-subject subject))))
8280             (setq new-roots (nconc new-roots (list (car thread)))
8281                   thread-end t
8282                   gnus-tmp-header nil))
8283            ;; If the article lies outside the current limit,
8284            ;; then we do not display it.
8285            ((and (not (memq number gnus-newsgroup-limit))
8286                  (not gnus-tmp-dummy-line))
8287             (setq gnus-tmp-gathered
8288                   (nconc (mapcar
8289                           (lambda (h) (mail-header-number (car h)))
8290                           (cdar thread))
8291                          gnus-tmp-gathered))
8292             (setq gnus-tmp-new-adopts (if (cdar thread)
8293                                           (append gnus-tmp-new-adopts
8294                                                   (cdar thread))
8295                                         gnus-tmp-new-adopts)
8296                   thread-end t
8297                   gnus-tmp-header nil)
8298             (when (zerop gnus-tmp-level)
8299               (setq gnus-tmp-root-expunged t)))
8300            ;; Perhaps this article is to be marked as read?
8301            ((and gnus-summary-mark-below
8302                  (< (or (cdr (assq number gnus-newsgroup-scored))
8303                         default-score)
8304                     gnus-summary-mark-below)
8305                  ;; Don't touch sparse articles.
8306                  (not (memq number gnus-newsgroup-sparse)))
8307             (setq gnus-newsgroup-unreads
8308                   (delq number gnus-newsgroup-unreads))
8309             (if gnus-newsgroup-auto-expire
8310                 (push number gnus-newsgroup-expirable)
8311               (push (cons number gnus-low-score-mark)
8312                     gnus-newsgroup-reads))))
8313
8314           (when gnus-tmp-header
8315             ;; We may have an old dummy line to output before this
8316             ;; article.
8317             (when gnus-tmp-dummy-line
8318               (gnus-summary-insert-dummy-line
8319                gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
8320               (setq gnus-tmp-dummy-line nil))
8321
8322             ;; Compute the mark.
8323             (setq
8324              gnus-tmp-unread
8325              (cond
8326               ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8327               ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8328               ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8329               ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8330               (t (or (cdr (assq number gnus-newsgroup-reads))
8331                      gnus-ancient-mark))))
8332
8333             (push (gnus-data-make number gnus-tmp-unread (1+ (point))
8334                                   gnus-tmp-header gnus-tmp-level)
8335                   gnus-newsgroup-data)
8336
8337             ;; Actually insert the line.
8338             (setq
8339              gnus-tmp-subject-or-nil
8340              (cond
8341               ((and gnus-thread-ignore-subject
8342                     gnus-tmp-prev-subject
8343                     (not (inline (gnus-subject-equal
8344                                   gnus-tmp-prev-subject subject))))
8345                subject)
8346               ((zerop gnus-tmp-level)
8347                (if (and (eq gnus-summary-make-false-root 'empty)
8348                         (memq number gnus-tmp-gathered)
8349                         gnus-tmp-prev-subject
8350                         (inline (gnus-subject-equal
8351                                  gnus-tmp-prev-subject subject)))
8352                    gnus-summary-same-subject
8353                  subject))
8354               (t gnus-summary-same-subject)))
8355             (if (and (eq gnus-summary-make-false-root 'adopt)
8356                      (= gnus-tmp-level 1)
8357                      (memq number gnus-tmp-gathered))
8358                 (setq gnus-tmp-opening-bracket ?\<
8359                       gnus-tmp-closing-bracket ?\>)
8360               (setq gnus-tmp-opening-bracket ?\[
8361                     gnus-tmp-closing-bracket ?\]))
8362             (setq
8363              gnus-tmp-indentation
8364              (aref gnus-thread-indent-array gnus-tmp-level)
8365              gnus-tmp-lines (mail-header-lines gnus-tmp-header)
8366              gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
8367                                 gnus-summary-default-score 0)
8368              gnus-tmp-score-char
8369              (if (or (null gnus-summary-default-score)
8370                      (<= (abs (- gnus-tmp-score gnus-summary-default-score))
8371                          gnus-summary-zcore-fuzz)) ? 
8372                (if (< gnus-tmp-score gnus-summary-default-score)
8373                    gnus-score-below-mark gnus-score-over-mark))
8374              gnus-tmp-replied
8375              (cond ((memq number gnus-newsgroup-processable)
8376                     gnus-process-mark)
8377                    ((memq number gnus-newsgroup-cached)
8378                     gnus-cached-mark)
8379                    ((memq number gnus-newsgroup-replied)
8380                     gnus-replied-mark)
8381                    (t gnus-unread-mark))
8382              gnus-tmp-from (mail-header-from gnus-tmp-header)
8383              gnus-tmp-name
8384              (cond
8385               ((string-match "(.+)" gnus-tmp-from)
8386                (substring gnus-tmp-from
8387                           (1+ (match-beginning 0)) (1- (match-end 0))))
8388               ((string-match "<[^>]+> *$" gnus-tmp-from)
8389                (setq beg-match (match-beginning 0))
8390                (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
8391                         (substring gnus-tmp-from (1+ (match-beginning 0))
8392                                    (1- (match-end 0))))
8393                    (substring gnus-tmp-from 0 beg-match)))
8394               (t gnus-tmp-from)))
8395             (when (string= gnus-tmp-name "")
8396               (setq gnus-tmp-name gnus-tmp-from))
8397             (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
8398             (put-text-property
8399              (point)
8400              (progn (eval gnus-summary-line-format-spec) (point))
8401              'gnus-number number)
8402             (when gnus-visual-p
8403               (forward-line -1)
8404               (run-hooks 'gnus-summary-update-hook)
8405               (forward-line 1))
8406
8407             (setq gnus-tmp-prev-subject subject)))
8408
8409         (when (nth 1 thread)
8410           (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
8411         (incf gnus-tmp-level)
8412         (setq threads (if thread-end nil (cdar thread)))
8413         (unless threads
8414           (setq gnus-tmp-level 0)))))
8415   (gnus-message 7 "Generating summary...done"))
8416
8417 (defun gnus-summary-prepare-unthreaded (headers)
8418   "Generate an unthreaded summary buffer based on HEADERS."
8419   (let (header number mark)
8420
8421     (while headers
8422       (setq header (car headers)
8423             headers (cdr headers)
8424             number (mail-header-number header))
8425
8426       ;; We may have to root out some bad articles...
8427       (when (memq number gnus-newsgroup-limit)
8428         (when (and gnus-summary-mark-below
8429                    (< (or (cdr (assq number gnus-newsgroup-scored))
8430                           gnus-summary-default-score 0)
8431                       gnus-summary-mark-below))
8432           (setq gnus-newsgroup-unreads
8433                 (delq number gnus-newsgroup-unreads))
8434           (if gnus-newsgroup-auto-expire
8435               (push number gnus-newsgroup-expirable)
8436             (push (cons number gnus-low-score-mark)
8437                   gnus-newsgroup-reads)))
8438
8439         (setq mark
8440               (cond
8441                ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8442                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8443                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8444                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8445                (t (or (cdr (assq number gnus-newsgroup-reads))
8446                       gnus-ancient-mark))))
8447         (setq gnus-newsgroup-data
8448               (cons (gnus-data-make number mark (1+ (point)) header 0)
8449                     gnus-newsgroup-data))
8450         (gnus-summary-insert-line
8451          header 0 nil mark (memq number gnus-newsgroup-replied)
8452          (memq number gnus-newsgroup-expirable)
8453          (mail-header-subject header) nil
8454          (cdr (assq number gnus-newsgroup-scored))
8455          (memq number gnus-newsgroup-processable))))))
8456
8457 (defun gnus-select-newsgroup (group &optional read-all)
8458   "Select newsgroup GROUP.
8459 If READ-ALL is non-nil, all articles in the group are selected."
8460   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
8461          (info (nth 2 entry))
8462          articles fetched-articles cached)
8463
8464     (or (gnus-check-server
8465          (setq gnus-current-select-method (gnus-find-method-for-group group)))
8466         (error "Couldn't open server"))
8467
8468     (or (and entry (not (eq (car entry) t))) ; Either it's active...
8469         (gnus-activate-group group) ; Or we can activate it...
8470         (progn ; Or we bug out.
8471           (when (equal major-mode 'gnus-summary-mode)
8472             (kill-buffer (current-buffer)))
8473           (error "Couldn't request group %s: %s"
8474                  group (gnus-status-message group))))
8475
8476     (setq gnus-newsgroup-name group)
8477     (setq gnus-newsgroup-unselected nil)
8478     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
8479
8480     (and gnus-asynchronous
8481          (gnus-check-backend-function
8482           'request-asynchronous gnus-newsgroup-name)
8483          (setq gnus-newsgroup-async
8484                (gnus-request-asynchronous gnus-newsgroup-name)))
8485
8486     ;; Adjust and set lists of article marks.
8487     (when info
8488       (gnus-adjust-marked-articles info))
8489
8490     ;; Kludge to avoid having cached articles nixed out in virtual groups.
8491     (when (gnus-virtual-group-p group)
8492       (setq cached gnus-newsgroup-cached))
8493
8494     (setq gnus-newsgroup-unreads
8495           (gnus-set-difference
8496            (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
8497            gnus-newsgroup-dormant))
8498
8499     (setq gnus-newsgroup-processable nil)
8500
8501     (setq articles (gnus-articles-to-read group read-all))
8502
8503     (cond
8504      ((null articles)
8505       ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
8506       'quit)
8507      ((eq articles 0) nil)
8508      (t
8509       ;; Init the dependencies hash table.
8510       (setq gnus-newsgroup-dependencies
8511             (gnus-make-hashtable (length articles)))
8512       ;; Retrieve the headers and read them in.
8513       (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
8514       (setq gnus-newsgroup-headers
8515             (if (eq 'nov
8516                     (setq gnus-headers-retrieved-by
8517                           (gnus-retrieve-headers
8518                            articles gnus-newsgroup-name
8519                            ;; We might want to fetch old headers, but
8520                            ;; not if there is only 1 article.
8521                            (and gnus-fetch-old-headers
8522                                 (or (and
8523                                      (not (eq gnus-fetch-old-headers 'some))
8524                                      (not (numberp gnus-fetch-old-headers)))
8525                                     (> (length articles) 1))))))
8526                 (gnus-get-newsgroup-headers-xover articles)
8527               (gnus-get-newsgroup-headers)))
8528       (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
8529
8530       ;; Kludge to avoid having cached articles nixed out in virtual groups.
8531       (when cached
8532         (setq gnus-newsgroup-cached cached))
8533
8534       ;; Set the initial limit.
8535       (setq gnus-newsgroup-limit (copy-sequence articles))
8536       ;; Remove canceled articles from the list of unread articles.
8537       (setq gnus-newsgroup-unreads
8538             (gnus-set-sorted-intersection
8539              gnus-newsgroup-unreads
8540              (setq fetched-articles
8541                    (mapcar (lambda (headers) (mail-header-number headers))
8542                            gnus-newsgroup-headers))))
8543       ;; Removed marked articles that do not exist.
8544       (gnus-update-missing-marks
8545        (gnus-sorted-complement fetched-articles articles))
8546       ;; We might want to build some more threads first.
8547       (and gnus-fetch-old-headers
8548            (eq gnus-headers-retrieved-by 'nov)
8549            (gnus-build-old-threads))
8550       ;; Check whether auto-expire is to be done in this group.
8551       (setq gnus-newsgroup-auto-expire
8552             (gnus-group-auto-expirable-p group))
8553       ;; Set up the article buffer now, if necessary.
8554       (unless gnus-single-article-buffer
8555         (gnus-article-setup-buffer))
8556       ;; First and last article in this newsgroup.
8557       (and gnus-newsgroup-headers
8558            (setq gnus-newsgroup-begin
8559                  (mail-header-number (car gnus-newsgroup-headers)))
8560            (setq gnus-newsgroup-end
8561                  (mail-header-number
8562                   (gnus-last-element gnus-newsgroup-headers))))
8563       (setq gnus-reffed-article-number -1)
8564       ;; GROUP is successfully selected.
8565       (or gnus-newsgroup-headers t)))))
8566
8567 (defun gnus-articles-to-read (group read-all)
8568   ;; Find out what articles the user wants to read.
8569   (let* ((articles
8570           ;; Select all articles if `read-all' is non-nil, or if there
8571           ;; are no unread articles.
8572           (if (or read-all
8573                   (and (zerop (length gnus-newsgroup-marked))
8574                        (zerop (length gnus-newsgroup-unreads))))
8575               (gnus-uncompress-range (gnus-active group))
8576             (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
8577                           (copy-sequence gnus-newsgroup-unreads))
8578                   '<)))
8579          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
8580          (scored (length scored-list))
8581          (number (length articles))
8582          (marked (+ (length gnus-newsgroup-marked)
8583                     (length gnus-newsgroup-dormant)))
8584          (select
8585           (cond
8586            ((numberp read-all)
8587             read-all)
8588            (t
8589             (condition-case ()
8590                 (cond
8591                  ((and (or (<= scored marked) (= scored number))
8592                        (numberp gnus-large-newsgroup)
8593                        (> number gnus-large-newsgroup))
8594                   (let ((input
8595                          (read-string
8596                           (format
8597                            "How many articles from %s (default %d): "
8598                            gnus-newsgroup-name number))))
8599                     (if (string-match "^[ \t]*$" input) number input)))
8600                  ((and (> scored marked) (< scored number))
8601                   (let ((input
8602                          (read-string
8603                           (format "%s %s (%d scored, %d total): "
8604                                   "How many articles from"
8605                                   group scored number))))
8606                     (if (string-match "^[ \t]*$" input)
8607                         number input)))
8608                  (t number))
8609               (quit nil))))))
8610     (setq select (if (stringp select) (string-to-number select) select))
8611     (if (or (null select) (zerop select))
8612         select
8613       (if (and (not (zerop scored)) (<= (abs select) scored))
8614           (progn
8615             (setq articles (sort scored-list '<))
8616             (setq number (length articles)))
8617         (setq articles (copy-sequence articles)))
8618
8619       (if (< (abs select) number)
8620           (if (< select 0)
8621               ;; Select the N oldest articles.
8622               (setcdr (nthcdr (1- (abs select)) articles) nil)
8623             ;; Select the N most recent articles.
8624             (setq articles (nthcdr (- number select) articles))))
8625       (setq gnus-newsgroup-unselected
8626             (gnus-sorted-intersection
8627              gnus-newsgroup-unreads
8628              (gnus-sorted-complement gnus-newsgroup-unreads articles)))
8629       articles)))
8630
8631 (defun gnus-killed-articles (killed articles)
8632   (let (out)
8633     (while articles
8634       (if (inline (gnus-member-of-range (car articles) killed))
8635           (setq out (cons (car articles) out)))
8636       (setq articles (cdr articles)))
8637     out))
8638
8639 (defun gnus-uncompress-marks (marks)
8640   "Uncompress the mark ranges in MARKS."
8641   (let ((uncompressed '(score bookmark))
8642         out)
8643     (while marks
8644       (if (memq (caar marks) uncompressed)
8645           (push (car marks) out)
8646         (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
8647       (setq marks (cdr marks)))
8648     out))
8649
8650 (defun gnus-adjust-marked-articles (info)
8651   "Set all article lists and remove all marks that are no longer legal."
8652   (let* ((marked-lists (gnus-info-marks info))
8653          (active (gnus-active (gnus-info-group info)))
8654          (min (car active))
8655          (max (cdr active))
8656          (types gnus-article-mark-lists)
8657          (uncompressed '(score bookmark))
8658          marks var articles article mark)
8659
8660     (while marked-lists
8661       (setq marks (pop marked-lists))
8662       (set (setq var (intern (format "gnus-newsgroup-%s"
8663                                      (car (rassq (setq mark (car marks))
8664                                                  types)))))
8665            (if (memq (car marks) uncompressed) (cdr marks)
8666              (gnus-uncompress-range (cdr marks))))
8667
8668       (setq articles (symbol-value var))
8669
8670       ;; All articles have to be subsets of the active articles.
8671       (cond
8672        ;; Adjust "simple" lists.
8673        ((memq mark '(tick dormant expirable reply killed save))
8674         (while articles
8675           (when (or (< (setq article (pop articles)) min) (> article max))
8676             (set var (delq article (symbol-value var))))))
8677        ;; Adjust assocs.
8678        ((memq mark '(score bookmark))
8679         (while articles
8680           (when (or (< (car (setq article (pop articles))) min)
8681                     (> (car article) max))
8682             (set var (delq article (symbol-value var))))))))))
8683
8684 (defun gnus-update-missing-marks (missing)
8685   "Go through the list of MISSING articles and remove them mark lists."
8686   (when missing
8687     (let ((types gnus-article-mark-lists)
8688           var m)
8689       ;; Go through all types.
8690       (while types
8691         (setq var (intern (format "gnus-newsgroup-%s" (car (pop types)))))
8692         (when (symbol-value var)
8693           ;; This list has articles.  So we delete all missing articles
8694           ;; from it.
8695           (setq m missing)
8696           (while m
8697             (set var (delq (pop m) (symbol-value var)))))))))
8698
8699 (defun gnus-update-marks ()
8700   "Enter the various lists of marked articles into the newsgroup info list."
8701   (let ((types gnus-article-mark-lists)
8702         (info (gnus-get-info gnus-newsgroup-name))
8703         (uncompressed '(score bookmark killed))
8704         type list newmarked symbol)
8705     (when info
8706       ;; Add all marks lists that are non-nil to the list of marks lists.
8707       (while types
8708         (setq type (pop types))
8709         (when (setq list (symbol-value
8710                           (setq symbol
8711                                 (intern (format "gnus-newsgroup-%s"
8712                                                 (car type))))))
8713           (push (cons (cdr type)
8714                       (if (memq (cdr type) uncompressed) list
8715                         (gnus-compress-sequence (set symbol (sort list '<)) t)))
8716                 newmarked)))
8717
8718       ;; Enter these new marks into the info of the group.
8719       (if (nthcdr 3 info)
8720           (setcar (nthcdr 3 info) newmarked)
8721         ;; Add the marks lists to the end of the info.
8722         (when newmarked
8723           (setcdr (nthcdr 2 info) (list newmarked))))
8724
8725       ;; Cut off the end of the info if there's nothing else there.
8726       (let ((i 5))
8727         (while (and (> i 2)
8728                     (not (nth i info)))
8729           (when (nthcdr (decf i) info)
8730             (setcdr (nthcdr i info) nil)))))))
8731
8732 (defun gnus-add-marked-articles (group type articles &optional info force)
8733   ;; Add ARTICLES of TYPE to the info of GROUP.
8734   ;; If INFO is non-nil, use that info.  If FORCE is non-nil, don't
8735   ;; add, but replace marked articles of TYPE with ARTICLES.
8736   (let ((info (or info (gnus-get-info group)))
8737         (uncompressed '(score bookmark killed))
8738         marked m)
8739     (or (not info)
8740         (and (not (setq marked (nthcdr 3 info)))
8741              (or (null articles)
8742                  (setcdr (nthcdr 2 info)
8743                          (list (list (cons type (gnus-compress-sequence
8744                                                  articles t)))))))
8745         (and (not (setq m (assq type (car marked))))
8746              (or (null articles)
8747                  (setcar marked
8748                          (cons (cons type (gnus-compress-sequence articles t) )
8749                                (car marked)))))
8750         (if force
8751             (if (null articles)
8752                 (setcar (nthcdr 3 info)
8753                         (delq (assq type (car marked)) (car marked)))
8754               (setcdr m (gnus-compress-sequence articles t)))
8755           (setcdr m (gnus-compress-sequence
8756                      (sort (nconc (gnus-uncompress-range (cdr m))
8757                                   (copy-sequence articles)) '<) t))))))
8758
8759 (defun gnus-set-mode-line (where)
8760   "This function sets the mode line of the article or summary buffers.
8761 If WHERE is `summary', the summary mode line format will be used."
8762   ;; Is this mode line one we keep updated?
8763   (when (memq where gnus-updated-mode-lines)
8764     (let (mode-string)
8765       (save-excursion
8766         ;; We evaluate this in the summary buffer since these
8767         ;; variables are buffer-local to that buffer.
8768         (set-buffer gnus-summary-buffer)
8769         ;; We bind all these variables that are used in the `eval' form
8770         ;; below.
8771         (let* ((mformat (symbol-value
8772                          (intern
8773                           (format "gnus-%s-mode-line-format-spec" where))))
8774                (gnus-tmp-group-name gnus-newsgroup-name)
8775                (gnus-tmp-article-number (or gnus-current-article 0))
8776                (gnus-tmp-unread gnus-newsgroup-unreads)
8777                (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
8778                (gnus-tmp-unselected (length gnus-newsgroup-unselected))
8779                (gnus-tmp-unread-and-unselected
8780                 (cond ((and (zerop gnus-tmp-unread-and-unticked)
8781                             (zerop gnus-tmp-unselected)) "")
8782                       ((zerop gnus-tmp-unselected)
8783                        (format "{%d more}" gnus-tmp-unread-and-unticked))
8784                       (t (format "{%d(+%d) more}"
8785                                  gnus-tmp-unread-and-unticked
8786                                  gnus-tmp-unselected))))
8787                (gnus-tmp-subject
8788                 (if (and gnus-current-headers
8789                          (vectorp gnus-current-headers))
8790                     (mail-header-subject gnus-current-headers) ""))
8791                max-len
8792                gnus-tmp-header);; passed as argument to any user-format-funcs
8793           (setq mode-string (eval mformat))
8794           (setq max-len (max 4 (if gnus-mode-non-string-length
8795                                    (- (frame-width)
8796                                       gnus-mode-non-string-length)
8797                                  (length mode-string))))
8798           ;; We might have to chop a bit of the string off...
8799           (when (> (length mode-string) max-len)
8800             (setq mode-string
8801                   (concat (gnus-truncate-string mode-string (- max-len 3))
8802                           "...")))
8803           ;; Pad the mode string a bit.
8804           (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
8805       ;; Update the mode line.
8806       (setq mode-line-buffer-identification (list mode-string))
8807       (set-buffer-modified-p t))))
8808
8809 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
8810   "Go through the HEADERS list and add all Xrefs to a hash table.
8811 The resulting hash table is returned, or nil if no Xrefs were found."
8812   (let* ((virtual (gnus-virtual-group-p from-newsgroup))
8813          (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
8814          (xref-hashtb (make-vector 63 0))
8815          start group entry number xrefs header)
8816     (while headers
8817       (setq header (pop headers))
8818       (when (and (setq xrefs (mail-header-xref header))
8819                  (not (memq (setq number (mail-header-number header))
8820                             unreads)))
8821         (setq start 0)
8822         (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
8823           (setq start (match-end 0))
8824           (setq group (if prefix
8825                           (concat prefix (substring xrefs (match-beginning 1)
8826                                                     (match-end 1)))
8827                         (substring xrefs (match-beginning 1) (match-end 1))))
8828           (setq number
8829                 (string-to-int (substring xrefs (match-beginning 2)
8830                                           (match-end 2))))
8831           (if (setq entry (gnus-gethash group xref-hashtb))
8832               (setcdr entry (cons number (cdr entry)))
8833             (gnus-sethash group (cons number nil) xref-hashtb)))))
8834     (and start xref-hashtb)))
8835
8836 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
8837   "Look through all the headers and mark the Xrefs as read."
8838   (let ((virtual (gnus-virtual-group-p from-newsgroup))
8839         name entry info xref-hashtb idlist method nth4)
8840     (save-excursion
8841       (set-buffer gnus-group-buffer)
8842       (when (setq xref-hashtb
8843                   (gnus-create-xref-hashtb from-newsgroup headers unreads))
8844         (mapatoms
8845          (lambda (group)
8846            (unless (string= from-newsgroup (setq name (symbol-name group)))
8847              (setq idlist (symbol-value group))
8848              ;; Dead groups are not updated.
8849              (and (prog1
8850                       (setq entry (gnus-gethash name gnus-newsrc-hashtb)
8851                             info (nth 2 entry))
8852                     (if (stringp (setq nth4 (gnus-info-method info)))
8853                         (setq nth4 (gnus-server-to-method nth4))))
8854                   ;; Only do the xrefs if the group has the same
8855                   ;; select method as the group we have just read.
8856                   (or (gnus-methods-equal-p
8857                        nth4 (gnus-find-method-for-group from-newsgroup))
8858                       virtual
8859                       (equal nth4 (setq method (gnus-find-method-for-group
8860                                                 from-newsgroup)))
8861                       (and (equal (car nth4) (car method))
8862                            (equal (nth 1 nth4) (nth 1 method))))
8863                   gnus-use-cross-reference
8864                   (or (not (eq gnus-use-cross-reference t))
8865                       virtual
8866                       ;; Only do cross-references on subscribed
8867                       ;; groups, if that is what is wanted.
8868                       (<= (gnus-info-level info) gnus-level-subscribed))
8869                   (gnus-group-make-articles-read name idlist))))
8870          xref-hashtb)))))
8871
8872 (defun gnus-group-make-articles-read (group articles)
8873   (let* ((num 0)
8874          (entry (gnus-gethash group gnus-newsrc-hashtb))
8875          (info (nth 2 entry))
8876          (active (gnus-active group))
8877          range)
8878     ;; First peel off all illegal article numbers.
8879     (if active
8880         (let ((ids articles)
8881               id first)
8882           (while ids
8883             (setq id (car ids))
8884             (if (and first (> id (cdr active)))
8885                 (progn
8886                   ;; We'll end up in this situation in one particular
8887                   ;; obscure situation.  If you re-scan a group and get
8888                   ;; a new article that is cross-posted to a different
8889                   ;; group that has not been re-scanned, you might get
8890                   ;; crossposted article that has a higher number than
8891                   ;; Gnus believes possible.  So we re-activate this
8892                   ;; group as well.  This might mean doing the
8893                   ;; crossposting thingy will *increase* the number
8894                   ;; of articles in some groups.  Tsk, tsk.
8895                   (setq active (or (gnus-activate-group group) active))))
8896             (if (or (> id (cdr active))
8897                     (< id (car active)))
8898                 (setq articles (delq id articles)))
8899             (setq ids (cdr ids)))))
8900     ;; If the read list is nil, we init it.
8901     (and active
8902          (null (gnus-info-read info))
8903          (> (car active) 1)
8904          (gnus-info-set-read info (cons 1 (1- (car active)))))
8905     ;; Then we add the read articles to the range.
8906     (gnus-info-set-read
8907      info
8908      (setq range
8909            (gnus-add-to-range
8910             (gnus-info-read info) (setq articles (sort articles '<)))))
8911     ;; Then we have to re-compute how many unread
8912     ;; articles there are in this group.
8913     (if active
8914         (progn
8915           (cond
8916            ((not range)
8917             (setq num (- (1+ (cdr active)) (car active))))
8918            ((not (listp (cdr range)))
8919             (setq num (- (cdr active) (- (1+ (cdr range))
8920                                          (car range)))))
8921            (t
8922             (while range
8923               (if (numberp (car range))
8924                   (setq num (1+ num))
8925                 (setq num (+ num (- (1+ (cdar range)) (caar range)))))
8926               (setq range (cdr range)))
8927             (setq num (- (cdr active) num))))
8928           ;; Update the number of unread articles.
8929           (setcar entry num)
8930           ;; Update the group buffer.
8931           (gnus-group-update-group group t)))))
8932
8933 (defun gnus-methods-equal-p (m1 m2)
8934   (let ((m1 (or m1 gnus-select-method))
8935         (m2 (or m2 gnus-select-method)))
8936     (or (equal m1 m2)
8937         (and (eq (car m1) (car m2))
8938              (or (not (memq 'address (assoc (symbol-name (car m1))
8939                                             gnus-valid-select-methods)))
8940                  (equal (nth 1 m1) (nth 1 m2)))))))
8941
8942 (defsubst gnus-header-value ()
8943   (buffer-substring (match-end 0) (gnus-point-at-eol)))
8944
8945 (defvar gnus-newsgroup-none-id 0)
8946
8947 (defun gnus-get-newsgroup-headers (&optional dependencies force-new)
8948   (let ((cur nntp-server-buffer)
8949         (dependencies
8950          (or dependencies
8951              (save-excursion (set-buffer gnus-summary-buffer)
8952                              gnus-newsgroup-dependencies)))
8953         headers id id-dep ref-dep end ref)
8954     (save-excursion
8955       (set-buffer nntp-server-buffer)
8956       (let ((case-fold-search t)
8957             in-reply-to header p lines)
8958         (goto-char (point-min))
8959         ;; Search to the beginning of the next header.  Error messages
8960         ;; do not begin with 2 or 3.
8961         (while (re-search-forward "^[23][0-9]+ " nil t)
8962           (setq id nil
8963                 ref nil)
8964           ;; This implementation of this function, with nine
8965           ;; search-forwards instead of the one re-search-forward and
8966           ;; a case (which basically was the old function) is actually
8967           ;; about twice as fast, even though it looks messier.  You
8968           ;; can't have everything, I guess.  Speed and elegance
8969           ;; doesn't always go hand in hand.
8970           (setq
8971            header
8972            (vector
8973             ;; Number.
8974             (prog1
8975                 (read cur)
8976               (end-of-line)
8977               (setq p (point))
8978               (narrow-to-region (point)
8979                                 (or (and (search-forward "\n.\n" nil t)
8980                                          (- (point) 2))
8981                                     (point))))
8982             ;; Subject.
8983             (progn
8984               (goto-char p)
8985               (if (search-forward "\nsubject: " nil t)
8986                   (gnus-header-value) "(none)"))
8987             ;; From.
8988             (progn
8989               (goto-char p)
8990               (if (search-forward "\nfrom: " nil t)
8991                   (gnus-header-value) "(nobody)"))
8992             ;; Date.
8993             (progn
8994               (goto-char p)
8995               (if (search-forward "\ndate: " nil t)
8996                   (gnus-header-value) ""))
8997             ;; Message-ID.
8998             (progn
8999               (goto-char p)
9000               (if (search-forward "\nmessage-id: " nil t)
9001                   (setq id (gnus-header-value))
9002                 ;; If there was no message-id, we just fake one to make
9003                 ;; subsequent routines simpler.
9004                 (setq id (concat "none+"
9005                                  (int-to-string
9006                                   (setq gnus-newsgroup-none-id
9007                                         (1+ gnus-newsgroup-none-id)))))))
9008             ;; References.
9009             (progn
9010               (goto-char p)
9011               (if (search-forward "\nreferences: " nil t)
9012                   (prog1
9013                       (gnus-header-value)
9014                     (setq end (match-end 0))
9015                     (save-excursion
9016                       (setq ref
9017                             (buffer-substring
9018                              (progn
9019                                (end-of-line)
9020                                (search-backward ">" end t)
9021                                (1+ (point)))
9022                              (progn
9023                                (search-backward "<" end t)
9024                                (point))))))
9025                 ;; Get the references from the in-reply-to header if there
9026                 ;; were no references and the in-reply-to header looks
9027                 ;; promising.
9028                 (if (and (search-forward "\nin-reply-to: " nil t)
9029                          (setq in-reply-to (gnus-header-value))
9030                          (string-match "<[^>]+>" in-reply-to))
9031                     (setq ref (substring in-reply-to (match-beginning 0)
9032                                          (match-end 0)))
9033                   (setq ref ""))))
9034             ;; Chars.
9035             0
9036             ;; Lines.
9037             (progn
9038               (goto-char p)
9039               (if (search-forward "\nlines: " nil t)
9040                   (if (numberp (setq lines (read cur)))
9041                       lines 0)
9042                 0))
9043             ;; Xref.
9044             (progn
9045               (goto-char p)
9046               (and (search-forward "\nxref: " nil t)
9047                    (gnus-header-value)))))
9048           ;; We do the threading while we read the headers.  The
9049           ;; message-id and the last reference are both entered into
9050           ;; the same hash table.  Some tippy-toeing around has to be
9051           ;; done in case an article has arrived before the article
9052           ;; which it refers to.
9053           (if (boundp (setq id-dep (intern id dependencies)))
9054               (if (and (car (symbol-value id-dep))
9055                        (not force-new))
9056                   ;; An article with this Message-ID has already
9057                   ;; been seen, so we ignore this one, except we add
9058                   ;; any additional Xrefs (in case the two articles
9059                   ;; came from different servers).
9060                   (progn
9061                     (mail-header-set-xref
9062                      (car (symbol-value id-dep))
9063                      (concat (or (mail-header-xref
9064                                   (car (symbol-value id-dep))) "")
9065                              (or (mail-header-xref header) "")))
9066                     (setq header nil))
9067                 (setcar (symbol-value id-dep) header))
9068             (set id-dep (list header)))
9069           (when header
9070             (if (boundp (setq ref-dep (intern ref dependencies)))
9071                 (setcdr (symbol-value ref-dep)
9072                         (nconc (cdr (symbol-value ref-dep))
9073                                (list (symbol-value id-dep))))
9074               (set ref-dep (list nil (symbol-value id-dep))))
9075             (setq headers (cons header headers)))
9076           (goto-char (point-max))
9077           (widen))
9078         (nreverse headers)))))
9079
9080 ;; The following macros and functions were written by Felix Lee
9081 ;; <flee@cse.psu.edu>.
9082
9083 (defmacro gnus-nov-read-integer ()
9084   '(prog1
9085        (if (= (following-char) ?\t)
9086            0
9087          (let ((num (condition-case nil (read buffer) (error nil))))
9088            (if (numberp num) num 0)))
9089      (or (eobp) (forward-char 1))))
9090
9091 (defmacro gnus-nov-skip-field ()
9092   '(search-forward "\t" eol 'move))
9093
9094 (defmacro gnus-nov-field ()
9095   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
9096
9097 ;; Goes through the xover lines and returns a list of vectors
9098 (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new)
9099   "Parse the news overview data in the server buffer, and return a
9100 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
9101   ;; Get the Xref when the users reads the articles since most/some
9102   ;; NNTP servers do not include Xrefs when using XOVER.
9103   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
9104   (let ((cur nntp-server-buffer)
9105         (dependencies gnus-newsgroup-dependencies)
9106         number headers header)
9107     (save-excursion
9108       (set-buffer nntp-server-buffer)
9109       ;; Allow the user to mangle the headers before parsing them.
9110       (run-hooks 'gnus-parse-headers-hook)
9111       ;; Allow the user to mangle the headers before parsing them.
9112       (run-hooks 'gnus-parse-headers-hook)
9113       (goto-char (point-min))
9114       (while (and sequence (not (eobp)))
9115         (setq number (read cur))
9116         (while (and sequence (< (car sequence) number))
9117           (setq sequence (cdr sequence)))
9118         (and sequence
9119              (eq number (car sequence))
9120              (progn
9121                (setq sequence (cdr sequence))
9122                (if (setq header
9123                          (inline (gnus-nov-parse-line
9124                                   number dependencies force-new)))
9125                    (setq headers (cons header headers)))))
9126         (forward-line 1))
9127       (setq headers (nreverse headers)))
9128     headers))
9129
9130 ;; This function has to be called with point after the article number
9131 ;; on the beginning of the line.
9132 (defun gnus-nov-parse-line (number dependencies &optional force-new)
9133   (let ((none 0)
9134         (eol (gnus-point-at-eol))
9135         (buffer (current-buffer))
9136         header ref id id-dep ref-dep)
9137
9138     ;; overview: [num subject from date id refs chars lines misc]
9139     (narrow-to-region (point) eol)
9140     (or (eobp) (forward-char))
9141
9142     (condition-case nil
9143         (setq header
9144               (vector
9145                number                   ; number
9146                (gnus-nov-field)         ; subject
9147                (gnus-nov-field)         ; from
9148                (gnus-nov-field)         ; date
9149                (setq id (or (gnus-nov-field)
9150                             (concat "none+"
9151                                     (int-to-string
9152                                      (setq none (1+ none)))))) ; id
9153                (progn
9154                  (save-excursion
9155                    (let ((beg (point)))
9156                      (search-forward "\t" eol)
9157                      (if (search-backward ">" beg t)
9158                          (setq ref
9159                                (buffer-substring
9160                                 (1+ (point))
9161                                 (search-backward "<" beg t)))
9162                        (setq ref nil))))
9163                  (gnus-nov-field))      ; refs
9164                (gnus-nov-read-integer)  ; chars
9165                (gnus-nov-read-integer)  ; lines
9166                (if (= (following-char) ?\n)
9167                    nil
9168                  (gnus-nov-field))      ; misc
9169                ))
9170       (error (progn
9171                (ding)
9172                (gnus-message 4 "Strange nov line")
9173                (setq header nil)
9174                (goto-char eol))))
9175
9176     (widen)
9177
9178     ;; We build the thread tree.
9179     (when header
9180       (if (boundp (setq id-dep (intern id dependencies)))
9181           (if (and (car (symbol-value id-dep))
9182                    (not force-new))
9183               ;; An article with this Message-ID has already been seen,
9184               ;; so we ignore this one, except we add any additional
9185               ;; Xrefs (in case the two articles came from different
9186               ;; servers.
9187               (progn
9188                 (mail-header-set-xref
9189                  (car (symbol-value id-dep))
9190                  (concat (or (mail-header-xref
9191                               (car (symbol-value id-dep))) "")
9192                          (or (mail-header-xref header) "")))
9193                 (setq header nil))
9194             (setcar (symbol-value id-dep) header))
9195         (set id-dep (list header))))
9196     (if header
9197         (progn
9198           (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
9199               (setcdr (symbol-value ref-dep)
9200                       (nconc (cdr (symbol-value ref-dep))
9201                              (list (symbol-value id-dep))))
9202             (set ref-dep (list nil (symbol-value id-dep))))))
9203     header))
9204
9205 (defun gnus-article-get-xrefs ()
9206   "Fill in the Xref value in `gnus-current-headers', if necessary.
9207 This is meant to be called in `gnus-article-internal-prepare-hook'."
9208   (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
9209                                  gnus-current-headers)))
9210     (or (not gnus-use-cross-reference)
9211         (not headers)
9212         (and (mail-header-xref headers)
9213              (not (string= (mail-header-xref headers) "")))
9214         (let ((case-fold-search t)
9215               xref)
9216           (save-restriction
9217             (nnheader-narrow-to-headers)
9218             (goto-char (point-min))
9219             (if (or (and (eq (downcase (following-char)) ?x)
9220                          (looking-at "Xref:"))
9221                     (search-forward "\nXref:" nil t))
9222                 (progn
9223                   (goto-char (1+ (match-end 0)))
9224                   (setq xref (buffer-substring (point)
9225                                                (progn (end-of-line) (point))))
9226                   (mail-header-set-xref headers xref))))))))
9227
9228 (defun gnus-summary-insert-subject (id &optional old-header)
9229   "Find article ID and insert the summary line for that article."
9230   (let ((header (gnus-read-header id))
9231         (number (and (numberp id) id))
9232         pos)
9233     (when header
9234       ;; Rebuild the thread that this article is part of and go to the
9235       ;; article we have fetched.
9236       (when old-header
9237         (when (setq pos (text-property-any
9238                          (point-min) (point-max) 'gnus-number 
9239                          (mail-header-number old-header)))
9240           (goto-char pos)
9241           (gnus-delete-line)
9242           (gnus-data-remove (mail-header-number old-header))))
9243       (gnus-rebuild-thread (mail-header-id header))
9244       (gnus-summary-goto-subject (setq number (mail-header-number header))))
9245     (when (and (numberp number)
9246                (> number 0))
9247       ;; We have to update the boundaries even if we can't fetch the
9248       ;; article if ID is a number -- so that the next `P' or `N'
9249       ;; command will fetch the previous (or next) article even
9250       ;; if the one we tried to fetch this time has been canceled.
9251       (and (> number gnus-newsgroup-end)
9252            (setq gnus-newsgroup-end number))
9253       (and (< number gnus-newsgroup-begin)
9254            (setq gnus-newsgroup-begin number))
9255       (setq gnus-newsgroup-unselected
9256             (delq number gnus-newsgroup-unselected)))
9257     ;; Report back a success?
9258     (and header (mail-header-number header))))
9259
9260 (defun gnus-summary-work-articles (n)
9261   "Return a list of articles to be worked upon.  The prefix argument,
9262 the list of process marked articles, and the current article will be
9263 taken into consideration."
9264   (cond
9265    ((and n (numberp n))
9266     ;; A numerical prefix has been given.
9267     (let ((backward (< n 0))
9268           (n (abs n))
9269           articles article)
9270       (save-excursion
9271         (while
9272             (and (> n 0)
9273                  (push (setq article (gnus-summary-article-number))
9274                        articles)
9275                  (if backward
9276                      (gnus-summary-find-prev nil article)
9277                    (gnus-summary-find-next nil article)))
9278           (decf n)))
9279       (nreverse articles)))
9280    ((and (boundp 'transient-mark-mode)
9281          transient-mark-mode
9282          mark-active)
9283     ;; Work on the region between point and mark.
9284     (let ((max (max (point) (mark)))
9285           articles article)
9286       (save-excursion
9287         (goto-char (min (point) (mark)))
9288         (while
9289             (and
9290              (push (setq article (gnus-summary-article-number)) articles)
9291              (gnus-summary-find-next nil article)
9292              (< (point) max)))
9293         (nreverse articles))))
9294    (gnus-newsgroup-processable
9295     ;; There are process-marked articles present.
9296     (reverse gnus-newsgroup-processable))
9297    (t
9298     ;; Just return the current article.
9299     (list (gnus-summary-article-number)))))
9300
9301 (defun gnus-summary-search-group (&optional backward use-level)
9302   "Search for next unread newsgroup.
9303 If optional argument BACKWARD is non-nil, search backward instead."
9304   (save-excursion
9305     (set-buffer gnus-group-buffer)
9306     (if (gnus-group-search-forward
9307          backward nil (if use-level (gnus-group-group-level) nil))
9308         (gnus-group-group-name))))
9309
9310 (defun gnus-summary-best-group (&optional exclude-group)
9311   "Find the name of the best unread group.
9312 If EXCLUDE-GROUP, do not go to this group."
9313   (save-excursion
9314     (set-buffer gnus-group-buffer)
9315     (save-excursion
9316       (gnus-group-best-unread-group exclude-group))))
9317
9318 (defun gnus-summary-find-next (&optional unread article backward)
9319   (if backward (gnus-summary-find-prev)
9320     (let* ((article (or article (gnus-summary-article-number)))
9321            (arts (gnus-data-find-list article))
9322            result)
9323       (when (or (not gnus-summary-check-current)
9324                 (not unread)
9325                 (not (gnus-data-unread-p (car arts))))
9326         (setq arts (cdr arts)))
9327       (when (setq result
9328                   (if unread
9329                       (progn
9330                         (while arts
9331                           (when (gnus-data-unread-p (car arts))
9332                             (setq result (car arts)
9333                                   arts nil))
9334                           (setq arts (cdr arts)))
9335                         result)
9336                     (car arts)))
9337         (goto-char (gnus-data-pos result))
9338         (gnus-data-number result)))))
9339
9340 (defun gnus-summary-find-prev (&optional unread article)
9341   (let* ((article (or article (gnus-summary-article-number)))
9342          (arts (gnus-data-find-list article (gnus-data-list 'rev)))
9343          result)
9344     (when (or (not gnus-summary-check-current)
9345               (not unread)
9346               (not (gnus-data-unread-p (car arts))))
9347       (setq arts (cdr arts)))
9348     (if (setq result
9349               (if unread
9350                   (progn
9351                     (while arts
9352                       (and (gnus-data-unread-p (car arts))
9353                            (setq result (car arts)
9354                                  arts nil))
9355                       (setq arts (cdr arts)))
9356                     result)
9357                 (car arts)))
9358         (progn
9359           (goto-char (gnus-data-pos result))
9360           (gnus-data-number result)))))
9361
9362 (defun gnus-summary-find-subject (subject &optional unread backward article)
9363   (let* ((simp-subject (gnus-simplify-subject-fully subject))
9364          (article (or article (gnus-summary-article-number)))
9365          (articles (gnus-data-list backward))
9366          (arts (gnus-data-find-list article articles))
9367          result)
9368     (when (or (not gnus-summary-check-current)
9369               (not unread)
9370               (not (gnus-data-unread-p (car arts))))
9371       (setq arts (cdr arts)))
9372     (while arts
9373       (and (or (not unread)
9374                (gnus-data-unread-p (car arts)))
9375            (vectorp (gnus-data-header (car arts)))
9376            (gnus-subject-equal
9377             simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
9378            (setq result (car arts)
9379                  arts nil))
9380       (setq arts (cdr arts)))
9381     (and result
9382          (goto-char (gnus-data-pos result))
9383          (gnus-data-number result))))
9384
9385 (defun gnus-summary-search-forward (&optional unread subject backward)
9386   "Search forward for an article.
9387 If UNREAD, look for unread articles.  If SUBJECT, look for
9388 articles with that subject.  If BACKWARD, search backward instead."
9389   (cond (subject (gnus-summary-find-subject subject unread backward))
9390         (backward (gnus-summary-find-prev unread))
9391         (t (gnus-summary-find-next unread))))
9392
9393 (defun gnus-recenter (&optional n)
9394   "Center point in window and redisplay frame.
9395 Also do horizontal recentering."
9396   (interactive "P")
9397   (when (and gnus-auto-center-summary
9398              (not (eq gnus-auto-center-summary 'vertical)))
9399     (gnus-horizontal-recenter))
9400   (recenter n))
9401
9402 (defun gnus-summary-recenter ()
9403   "Center point in the summary window.
9404 If `gnus-auto-center-summary' is nil, or the article buffer isn't
9405 displayed, no centering will be performed."
9406   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
9407   ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
9408   (let* ((top (cond ((< (window-height) 4) 0)
9409                     ((< (window-height) 7) 1)
9410                     (t 2)))
9411          (height (1- (window-height)))
9412          (bottom (save-excursion (goto-char (point-max))
9413                                  (forward-line (- height))
9414                                  (point)))
9415          (window (get-buffer-window (current-buffer))))
9416     ;; The user has to want it.
9417     (when gnus-auto-center-summary
9418       (when (get-buffer-window gnus-article-buffer)
9419        ;; Only do recentering when the article buffer is displayed,
9420        ;; Set the window start to either `bottom', which is the biggest
9421        ;; possible valid number, or the second line from the top,
9422        ;; whichever is the least.
9423        (set-window-start
9424         window (min bottom (save-excursion 
9425                              (forward-line (- top)) (point)))))
9426       ;; Do horizontal recentering while we're at it.
9427       (when (and (get-buffer-window (current-buffer) t)
9428                  (not (eq gnus-auto-center-summary 'vertical)))
9429         (let ((selected (selected-window)))
9430           (select-window (get-buffer-window (current-buffer) t))
9431           (gnus-summary-position-point)
9432           (gnus-horizontal-recenter)
9433           (select-window selected))))))
9434
9435 (defun gnus-horizontal-recenter ()
9436   "Recenter the current buffer horizontally."
9437   (if (< (current-column) (/ (window-width) 2))
9438       (set-window-hscroll (get-buffer-window (current-buffer) t) 0)
9439     (let* ((orig (point))
9440            (end (window-end (get-buffer-window (current-buffer) t)))
9441            (max 0))
9442       ;; Find the longest line currently displayed in the window.
9443       (goto-char (window-start))
9444       (while (and (not (eobp)) 
9445                   (< (point) end))
9446         (end-of-line)
9447         (setq max (max max (current-column)))
9448         (forward-line 1))
9449       (goto-char orig)
9450       ;; Scroll horizontally to center (sort of) the point.
9451       (if (> max (window-width))
9452           (set-window-hscroll 
9453            (get-buffer-window (current-buffer) t)
9454            (min (- (current-column) (/ (window-width) 3))
9455                 (+ 2 (- max (window-width)))))
9456         (set-window-hscroll (get-buffer-window (current-buffer) t) 0))
9457       max)))
9458
9459 ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
9460 (defun gnus-short-group-name (group &optional levels)
9461   "Collapse GROUP name LEVELS."
9462   (let* ((name "") 
9463          (foreign "")
9464          (depth 0) 
9465          (skip 1)
9466          (levels (or levels
9467                      (progn
9468                        (while (string-match "\\." group skip)
9469                          (setq skip (match-end 0)
9470                                depth (+ depth 1)))
9471                        depth))))
9472     (if (string-match ":" group)
9473         (setq foreign (substring group 0 (match-end 0))
9474               group (substring group (match-end 0))))
9475     (while group
9476       (if (and (string-match "\\." group)
9477                (> levels (- gnus-group-uncollapsed-levels 1)))
9478           (setq name (concat name (substring group 0 1))
9479                 group (substring group (match-end 0))
9480                 levels (- levels 1)
9481                 name (concat name "."))
9482         (setq name (concat foreign name group)
9483               group nil)))
9484     name))
9485
9486 (defun gnus-summary-jump-to-group (newsgroup)
9487   "Move point to NEWSGROUP in group mode buffer."
9488   ;; Keep update point of group mode buffer if visible.
9489   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
9490       (save-window-excursion
9491         ;; Take care of tree window mode.
9492         (if (get-buffer-window gnus-group-buffer)
9493             (pop-to-buffer gnus-group-buffer))
9494         (gnus-group-jump-to-group newsgroup))
9495     (save-excursion
9496       ;; Take care of tree window mode.
9497       (if (get-buffer-window gnus-group-buffer)
9498           (pop-to-buffer gnus-group-buffer)
9499         (set-buffer gnus-group-buffer))
9500       (gnus-group-jump-to-group newsgroup))))
9501
9502 ;; This function returns a list of article numbers based on the
9503 ;; difference between the ranges of read articles in this group and
9504 ;; the range of active articles.
9505 (defun gnus-list-of-unread-articles (group)
9506   (let* ((read (gnus-info-read (gnus-get-info group)))
9507          (active (gnus-active group))
9508          (last (cdr active))
9509          first nlast unread)
9510     ;; If none are read, then all are unread.
9511     (if (not read)
9512         (setq first (car active))
9513       ;; If the range of read articles is a single range, then the
9514       ;; first unread article is the article after the last read
9515       ;; article.  Sounds logical, doesn't it?
9516       (if (not (listp (cdr read)))
9517           (setq first (1+ (cdr read)))
9518         ;; `read' is a list of ranges.
9519         (if (/= (setq nlast (or (and (numberp (car read)) (car read))
9520                                 (caar read))) 1)
9521             (setq first 1))
9522         (while read
9523           (if first
9524               (while (< first nlast)
9525                 (setq unread (cons first unread))
9526                 (setq first (1+ first))))
9527           (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
9528           (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
9529           (setq read (cdr read)))))
9530     ;; And add the last unread articles.
9531     (while (<= first last)
9532       (setq unread (cons first unread))
9533       (setq first (1+ first)))
9534     ;; Return the list of unread articles.
9535     (nreverse unread)))
9536
9537 (defun gnus-list-of-read-articles (group)
9538   "Return a list of unread, unticked and non-dormant articles."
9539   (let* ((info (gnus-get-info group))
9540          (marked (gnus-info-marks info))
9541          (active (gnus-active group)))
9542     (and info active
9543          (gnus-set-difference
9544           (gnus-sorted-complement
9545            (gnus-uncompress-range active)
9546            (gnus-list-of-unread-articles group))
9547           (append
9548            (gnus-uncompress-range (cdr (assq 'dormant marked)))
9549            (gnus-uncompress-range (cdr (assq 'tick marked))))))))
9550
9551 ;; Various summary commands
9552
9553 (defun gnus-summary-universal-argument (arg)
9554   "Perform any operation on all articles that are process/prefixed."
9555   (interactive "P")
9556   (gnus-set-global-variables)
9557   (let ((articles (gnus-summary-work-articles arg))
9558         func article)
9559     (if (eq
9560          (setq
9561           func
9562           (key-binding
9563            (read-key-sequence
9564             (substitute-command-keys
9565              "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
9566              ))))
9567          'undefined)
9568         (progn
9569           (message "Undefined key")
9570           (ding))
9571       (save-excursion
9572         (while articles
9573           (gnus-summary-goto-subject (setq article (pop articles)))
9574           (command-execute func)
9575           (gnus-summary-remove-process-mark article)))))
9576   (gnus-summary-position-point))
9577
9578 (defun gnus-summary-toggle-truncation (&optional arg)
9579   "Toggle truncation of summary lines.
9580 With arg, turn line truncation on iff arg is positive."
9581   (interactive "P")
9582   (setq truncate-lines
9583         (if (null arg) (not truncate-lines)
9584           (> (prefix-numeric-value arg) 0)))
9585   (redraw-display))
9586
9587 (defun gnus-summary-reselect-current-group (&optional all rescan)
9588   "Exit and then reselect the current newsgroup.
9589 The prefix argument ALL means to select all articles."
9590   (interactive "P")
9591   (gnus-set-global-variables)
9592   (let ((current-subject (gnus-summary-article-number))
9593         (group gnus-newsgroup-name))
9594     (setq gnus-newsgroup-begin nil)
9595     (gnus-summary-exit)
9596     ;; We have to adjust the point of group mode buffer because the
9597     ;; current point was moved to the next unread newsgroup by
9598     ;; exiting.
9599     (gnus-summary-jump-to-group group)
9600     (when rescan
9601       (save-excursion
9602         (gnus-group-get-new-news-this-group 1)))
9603     (gnus-group-read-group all t)
9604     (gnus-summary-goto-subject current-subject)))
9605
9606 (defun gnus-summary-rescan-group (&optional all)
9607   "Exit the newsgroup, ask for new articles, and select the newsgroup."
9608   (interactive "P")
9609   (gnus-summary-reselect-current-group all t))
9610
9611 (defun gnus-summary-update-info ()
9612   (let* ((group gnus-newsgroup-name))
9613     (when gnus-newsgroup-kill-headers
9614       (setq gnus-newsgroup-killed
9615             (gnus-compress-sequence
9616              (nconc
9617               (gnus-set-sorted-intersection
9618                (gnus-uncompress-range gnus-newsgroup-killed)
9619                (setq gnus-newsgroup-unselected
9620                      (sort gnus-newsgroup-unselected '<)))
9621               (setq gnus-newsgroup-unreads
9622                     (sort gnus-newsgroup-unreads '<))) t)))
9623     (unless (listp (cdr gnus-newsgroup-killed))
9624       (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
9625     (let ((headers gnus-newsgroup-headers))
9626       (run-hooks 'gnus-exit-group-hook)
9627       (unless gnus-save-score
9628         (setq gnus-newsgroup-scored nil))
9629       ;; Set the new ranges of read articles.
9630       (gnus-update-read-articles
9631        group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
9632       ;; Set the current article marks.
9633       (gnus-update-marks)
9634       ;; Do the cross-ref thing.
9635       (when gnus-use-cross-reference
9636         (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
9637       ;; Do adaptive scoring, and possibly save score files.
9638       (when gnus-newsgroup-adaptive
9639         (gnus-score-adaptive))
9640       (when gnus-use-scoring
9641         (gnus-score-save))
9642       ;; Do not switch windows but change the buffer to work.
9643       (set-buffer gnus-group-buffer)
9644       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
9645           (gnus-group-update-group group)))))
9646
9647 (defun gnus-summary-exit (&optional temporary)
9648   "Exit reading current newsgroup, and then return to group selection mode.
9649 gnus-exit-group-hook is called with no arguments if that value is non-nil."
9650   (interactive)
9651   (gnus-set-global-variables)
9652   (gnus-kill-save-kill-buffer)
9653   (let* ((group gnus-newsgroup-name)
9654          (quit-config (gnus-group-quit-config gnus-newsgroup-name))
9655          (mode major-mode)
9656          (buf (current-buffer)))
9657     (unless temporary
9658       (run-hooks 'gnus-summary-prepare-exit-hook))
9659     ;; If we have several article buffers, we kill them at exit.
9660     (unless gnus-single-article-buffer
9661       (gnus-kill-buffer gnus-article-buffer)
9662       (gnus-kill-buffer gnus-original-article-buffer)
9663       (setq gnus-article-current nil))
9664     (when gnus-use-cache
9665       (gnus-cache-possibly-remove-articles)
9666       (gnus-cache-save-buffers))
9667     (when gnus-use-trees
9668       (gnus-tree-close group))
9669     ;; Make all changes in this group permanent.
9670     (unless quit-config
9671       (gnus-summary-update-info))
9672     (gnus-close-group group)
9673     ;; Make sure where I was, and go to next newsgroup.
9674     (set-buffer gnus-group-buffer)
9675     (unless quit-config
9676       (gnus-group-jump-to-group group)
9677       (gnus-group-next-unread-group 1))
9678     (run-hooks 'gnus-summary-exit-hook)
9679     (unless gnus-single-article-buffer
9680       (setq gnus-article-current nil))
9681     (if temporary
9682         nil                             ;Nothing to do.
9683       ;; If we have several article buffers, we kill them at exit.
9684       (unless gnus-single-article-buffer
9685         (gnus-kill-buffer gnus-article-buffer)
9686         (gnus-kill-buffer gnus-original-article-buffer)
9687         (setq gnus-article-current nil))
9688       (set-buffer buf)
9689       (if (not gnus-kill-summary-on-exit)
9690           (gnus-deaden-summary)
9691         ;; We set all buffer-local variables to nil.  It is unclear why
9692         ;; this is needed, but if we don't, buffer-local variables are
9693         ;; not garbage-collected, it seems.  This would the lead to en
9694         ;; ever-growing Emacs.
9695         (gnus-summary-clear-local-variables)
9696         (when (get-buffer gnus-article-buffer)
9697           (bury-buffer gnus-article-buffer))
9698         ;; We clear the global counterparts of the buffer-local
9699         ;; variables as well, just to be on the safe side.
9700         (gnus-configure-windows 'group 'force)
9701         (gnus-summary-clear-local-variables)
9702         ;; Return to group mode buffer.
9703         (if (eq mode 'gnus-summary-mode)
9704             (gnus-kill-buffer buf)))
9705       (setq gnus-current-select-method gnus-select-method)
9706       (pop-to-buffer gnus-group-buffer)
9707       ;; Clear the current group name.
9708       (if (not quit-config)
9709           (progn
9710             (gnus-group-jump-to-group group)
9711             (gnus-group-next-unread-group 1)
9712             (gnus-configure-windows 'group 'force))
9713         (if (not (buffer-name (car quit-config)))
9714             (gnus-configure-windows 'group 'force)
9715           (set-buffer (car quit-config))
9716           (and (eq major-mode 'gnus-summary-mode)
9717                (gnus-set-global-variables))
9718           (gnus-configure-windows (cdr quit-config))))
9719       (unless quit-config
9720         (setq gnus-newsgroup-name nil)))))
9721
9722 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
9723 (defun gnus-summary-exit-no-update (&optional no-questions)
9724   "Quit reading current newsgroup without updating read article info."
9725   (interactive)
9726   (gnus-set-global-variables)
9727   (let* ((group gnus-newsgroup-name)
9728          (quit-config (gnus-group-quit-config group)))
9729     (when (or no-questions
9730               gnus-expert-user
9731               (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
9732       ;; If we have several article buffers, we kill them at exit.
9733       (unless gnus-single-article-buffer
9734         (gnus-kill-buffer gnus-article-buffer)
9735         (gnus-kill-buffer gnus-original-article-buffer)
9736         (setq gnus-article-current nil))
9737       (if (not gnus-kill-summary-on-exit)
9738           (gnus-deaden-summary)
9739         (gnus-close-group group)
9740         (gnus-summary-clear-local-variables)
9741         (set-buffer gnus-group-buffer)
9742         (gnus-summary-clear-local-variables)
9743         (when (get-buffer gnus-summary-buffer)
9744           (kill-buffer gnus-summary-buffer)))
9745       (unless gnus-single-article-buffer
9746         (setq gnus-article-current nil))
9747       (when gnus-use-trees
9748         (gnus-tree-close group))
9749       (when (get-buffer gnus-article-buffer)
9750         (bury-buffer gnus-article-buffer))
9751       ;; Return to the group buffer.
9752       (gnus-configure-windows 'group 'force)
9753       ;; Clear the current group name.
9754       (setq gnus-newsgroup-name nil)
9755       (when (equal (gnus-group-group-name) group)
9756         (gnus-group-next-unread-group 1))
9757       (when quit-config
9758         (if (not (buffer-name (car quit-config)))
9759             (gnus-configure-windows 'group 'force)
9760           (set-buffer (car quit-config))
9761           (when (eq major-mode 'gnus-summary-mode)
9762             (gnus-set-global-variables))
9763           (gnus-configure-windows (cdr quit-config)))))))
9764
9765 ;;; Dead summaries.
9766
9767 (defvar gnus-dead-summary-mode-map nil)
9768
9769 (if gnus-dead-summary-mode-map
9770     nil
9771   (setq gnus-dead-summary-mode-map (make-keymap))
9772   (suppress-keymap gnus-dead-summary-mode-map)
9773   (substitute-key-definition
9774    'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
9775   (let ((keys '("\C-d" "\r" "\177")))
9776     (while keys
9777       (define-key gnus-dead-summary-mode-map
9778         (pop keys) 'gnus-summary-wake-up-the-dead))))
9779
9780 (defvar gnus-dead-summary-mode nil
9781   "Minor mode for Gnus summary buffers.")
9782
9783 (defun gnus-dead-summary-mode (&optional arg)
9784   "Minor mode for Gnus summary buffers."
9785   (interactive "P")
9786   (when (eq major-mode 'gnus-summary-mode)
9787     (make-local-variable 'gnus-dead-summary-mode)
9788     (setq gnus-dead-summary-mode
9789           (if (null arg) (not gnus-dead-summary-mode)
9790             (> (prefix-numeric-value arg) 0)))
9791     (when gnus-dead-summary-mode
9792       (unless (assq 'gnus-dead-summary-mode minor-mode-alist)
9793         (push '(gnus-dead-summary-mode " Dead") minor-mode-alist))
9794       (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist)
9795         (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map)
9796               minor-mode-map-alist)))))
9797
9798 (defun gnus-deaden-summary ()
9799   "Make the current summary buffer into a dead summary buffer."
9800   ;; Kill any previous dead summary buffer.
9801   (when (and gnus-dead-summary
9802              (buffer-name gnus-dead-summary))
9803     (save-excursion
9804       (set-buffer gnus-dead-summary)
9805       (when gnus-dead-summary-mode
9806         (kill-buffer (current-buffer)))))
9807   ;; Make this the current dead summary.
9808   (setq gnus-dead-summary (current-buffer))
9809   (gnus-dead-summary-mode 1)
9810   (let ((name (buffer-name)))
9811     (when (string-match "Summary" name)
9812       (rename-buffer
9813        (concat (substring name 0 (match-beginning 0)) "Dead "
9814                (substring name (match-beginning 0))) t))))
9815
9816 (defun gnus-kill-or-deaden-summary (buffer)
9817   "Kill or deaden the summary BUFFER."
9818   (cond (gnus-kill-summary-on-exit
9819          (when (and gnus-use-trees
9820                     (and (get-buffer buffer)
9821                          (buffer-name (get-buffer buffer))))
9822            (save-excursion
9823              (set-buffer (get-buffer buffer))
9824              (gnus-tree-close gnus-newsgroup-name)))
9825          (gnus-kill-buffer buffer))
9826         ((and (get-buffer buffer)
9827               (buffer-name (get-buffer buffer)))
9828          (save-excursion
9829            (set-buffer buffer)
9830            (gnus-deaden-summary)))))
9831
9832 (defun gnus-summary-wake-up-the-dead (&rest args)
9833   "Wake up the dead summary buffer."
9834   (interactive)
9835   (gnus-dead-summary-mode -1)
9836   (let ((name (buffer-name)))
9837     (when (string-match "Dead " name)
9838       (rename-buffer
9839        (concat (substring name 0 (match-beginning 0))
9840                (substring name (match-end 0))) t)))
9841   (gnus-message 3 "This dead summary is now alive again"))
9842
9843 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
9844 (defun gnus-summary-fetch-faq (&optional faq-dir)
9845   "Fetch the FAQ for the current group.
9846 If FAQ-DIR (the prefix), prompt for a directory to search for the faq
9847 in."
9848   (interactive
9849    (list
9850     (if current-prefix-arg
9851         (completing-read
9852          "Faq dir: " (and (listp gnus-group-faq-directory)
9853                           gnus-group-faq-directory)))))
9854   (let (gnus-faq-buffer)
9855     (and (setq gnus-faq-buffer
9856                (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
9857          (gnus-configure-windows 'summary-faq))))
9858
9859 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
9860 (defun gnus-summary-describe-group (&optional force)
9861   "Describe the current newsgroup."
9862   (interactive "P")
9863   (gnus-group-describe-group force gnus-newsgroup-name))
9864
9865 (defun gnus-summary-describe-briefly ()
9866   "Describe summary mode commands briefly."
9867   (interactive)
9868   (gnus-message 6
9869                 (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")))
9870
9871 ;; Walking around group mode buffer from summary mode.
9872
9873 (defun gnus-summary-next-group (&optional no-article target-group backward)
9874   "Exit current newsgroup and then select next unread newsgroup.
9875 If prefix argument NO-ARTICLE is non-nil, no article is selected
9876 initially.  If NEXT-GROUP, go to this group.  If BACKWARD, go to
9877 previous group instead."
9878   (interactive "P")
9879   (gnus-set-global-variables)
9880   (let ((current-group gnus-newsgroup-name)
9881         (current-buffer (current-buffer))
9882         entered)
9883     ;; First we semi-exit this group to update Xrefs and all variables.
9884     ;; We can't do a real exit, because the window conf must remain
9885     ;; the same in case the user is prompted for info, and we don't
9886     ;; want the window conf to change before that...
9887     (gnus-summary-exit t)
9888     (while (not entered)
9889       ;; Then we find what group we are supposed to enter.
9890       (set-buffer gnus-group-buffer)
9891       (gnus-group-jump-to-group current-group)
9892       (setq target-group
9893             (or target-group
9894                 (if (eq gnus-keep-same-level 'best)
9895                     (gnus-summary-best-group gnus-newsgroup-name)
9896                   (gnus-summary-search-group backward gnus-keep-same-level))))
9897       (if (not target-group)
9898           ;; There are no further groups, so we return to the group
9899           ;; buffer.
9900           (progn
9901             (gnus-message 5 "Returning to the group buffer")
9902             (setq entered t)
9903             (set-buffer current-buffer)
9904             (gnus-summary-exit))
9905         ;; We try to enter the target group.
9906         (gnus-group-jump-to-group target-group)
9907         (let ((unreads (gnus-group-group-unread)))
9908           (if (and (or (eq t unreads)
9909                        (and unreads (not (zerop unreads))))
9910                    (gnus-summary-read-group
9911                     target-group nil no-article current-buffer))
9912               (setq entered t)
9913             (setq current-group target-group
9914                   target-group nil)))))))
9915
9916 (defun gnus-summary-prev-group (&optional no-article)
9917   "Exit current newsgroup and then select previous unread newsgroup.
9918 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
9919   (interactive "P")
9920   (gnus-summary-next-group no-article nil t))
9921
9922 ;; Walking around summary lines.
9923
9924 (defun gnus-summary-first-subject (&optional unread)
9925   "Go to the first unread subject.
9926 If UNREAD is non-nil, go to the first unread article.
9927 Returns the article selected or nil if there are no unread articles."
9928   (interactive "P")
9929   (prog1
9930       (cond
9931        ;; Empty summary.
9932        ((null gnus-newsgroup-data)
9933         (gnus-message 3 "No articles in the group")
9934         nil)
9935        ;; Pick the first article.
9936        ((not unread)
9937         (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
9938         (gnus-data-number (car gnus-newsgroup-data)))
9939        ;; No unread articles.
9940        ((null gnus-newsgroup-unreads)
9941         (gnus-message 3 "No more unread articles")
9942         nil)
9943        ;; Find the first unread article.
9944        (t
9945         (let ((data gnus-newsgroup-data))
9946           (while (and data
9947                       (not (gnus-data-unread-p (car data))))
9948             (setq data (cdr data)))
9949           (if data
9950               (progn
9951                 (goto-char (gnus-data-pos (car data)))
9952                 (gnus-data-number (car data)))))))
9953     (gnus-summary-position-point)))
9954
9955 (defun gnus-summary-next-subject (n &optional unread dont-display)
9956   "Go to next N'th summary line.
9957 If N is negative, go to the previous N'th subject line.
9958 If UNREAD is non-nil, only unread articles are selected.
9959 The difference between N and the actual number of steps taken is
9960 returned."
9961   (interactive "p")
9962   (let ((backward (< n 0))
9963         (n (abs n)))
9964     (while (and (> n 0)
9965                 (if backward
9966                     (gnus-summary-find-prev unread)
9967                   (gnus-summary-find-next unread)))
9968       (setq n (1- n)))
9969     (if (/= 0 n) (gnus-message 7 "No more%s articles"
9970                                (if unread " unread" "")))
9971     (unless dont-display
9972       (gnus-summary-recenter)
9973       (gnus-summary-position-point))
9974     n))
9975
9976 (defun gnus-summary-next-unread-subject (n)
9977   "Go to next N'th unread summary line."
9978   (interactive "p")
9979   (gnus-summary-next-subject n t))
9980
9981 (defun gnus-summary-prev-subject (n &optional unread)
9982   "Go to previous N'th summary line.
9983 If optional argument UNREAD is non-nil, only unread article is selected."
9984   (interactive "p")
9985   (gnus-summary-next-subject (- n) unread))
9986
9987 (defun gnus-summary-prev-unread-subject (n)
9988   "Go to previous N'th unread summary line."
9989   (interactive "p")
9990   (gnus-summary-next-subject (- n) t))
9991
9992 (defun gnus-summary-goto-subject (article &optional force silent)
9993   "Go the subject line of ARTICLE.
9994 If FORCE, also allow jumping to articles not currently shown."
9995   (let ((b (point))
9996         (data (gnus-data-find article)))
9997     ;; We read in the article if we have to.
9998     (and (not data)
9999          force
10000          (gnus-summary-insert-subject article)
10001          (setq data (gnus-data-find article)))
10002     (goto-char b)
10003     (if (not data)
10004         (progn
10005           (unless silent
10006             (gnus-message 3 "Can't find article %d" article))
10007           nil)
10008       (goto-char (gnus-data-pos data))
10009       article)))
10010
10011 ;; Walking around summary lines with displaying articles.
10012
10013 (defun gnus-summary-expand-window (&optional arg)
10014   "Make the summary buffer take up the entire Emacs frame.
10015 Given a prefix, will force an `article' buffer configuration."
10016   (interactive "P")
10017   (gnus-set-global-variables)
10018   (if arg
10019       (gnus-configure-windows 'article 'force)
10020     (gnus-configure-windows 'summary 'force)))
10021
10022 (defun gnus-summary-display-article (article &optional all-header)
10023   "Display ARTICLE in article buffer."
10024   (gnus-set-global-variables)
10025   (if (null article)
10026       nil
10027     (prog1
10028         (if gnus-summary-display-article-function
10029             (funcall gnus-summary-display-article-function article all-header)
10030           (gnus-article-prepare article all-header))
10031       (run-hooks 'gnus-select-article-hook)
10032       (gnus-summary-recenter)
10033       (gnus-summary-goto-subject article)
10034       (when gnus-use-trees
10035         (gnus-possibly-generate-tree article)
10036         (gnus-highlight-selected-tree article))
10037       ;; Successfully display article.
10038       (gnus-article-set-window-start
10039        (cdr (assq article gnus-newsgroup-bookmarks)))
10040       t)))
10041
10042 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
10043   "Select the current article.
10044 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
10045 non-nil, the article will be re-fetched even if it already present in
10046 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
10047 be displayed."
10048   (let ((article (or article (gnus-summary-article-number)))
10049         (all-headers (not (not all-headers))) ;Must be T or NIL.
10050         gnus-summary-display-article-function
10051         did)
10052     (and (not pseudo)
10053          (gnus-summary-article-pseudo-p article)
10054          (error "This is a pseudo-article."))
10055     (prog1
10056         (save-excursion
10057           (set-buffer gnus-summary-buffer)
10058           (if (or (and gnus-single-article-buffer
10059                        (or (null gnus-current-article)
10060                            (null gnus-article-current)
10061                            (null (get-buffer gnus-article-buffer))
10062                            (not (eq article (cdr gnus-article-current)))
10063                            (not (equal (car gnus-article-current)
10064                                        gnus-newsgroup-name))))
10065                   (and (not gnus-single-article-buffer)
10066                        (or (null gnus-current-article)
10067                            (not (eq gnus-current-article article))))
10068                   force)
10069               ;; The requested article is different from the current article.
10070               (prog1
10071                   (gnus-summary-display-article article all-headers)
10072                 (setq did article))
10073             (if (or all-headers gnus-show-all-headers)
10074                 (gnus-article-show-all-headers))
10075             'old))
10076       (if did
10077           (gnus-article-set-window-start
10078            (cdr (assq article gnus-newsgroup-bookmarks)))))))
10079
10080 (defun gnus-summary-set-current-mark (&optional current-mark)
10081   "Obsolete function."
10082   nil)
10083
10084 (defun gnus-summary-next-article (&optional unread subject backward push)
10085   "Select the next article.
10086 If UNREAD, only unread articles are selected.
10087 If SUBJECT, only articles with SUBJECT are selected.
10088 If BACKWARD, the previous article is selected instead of the next."
10089   (interactive "P")
10090   (gnus-set-global-variables)
10091   (cond
10092    ;; Is there such an article?
10093    ((and (gnus-summary-search-forward unread subject backward)
10094          (or (gnus-summary-display-article (gnus-summary-article-number))
10095              (eq (gnus-summary-article-mark) gnus-canceled-mark)))
10096     (gnus-summary-position-point))
10097    ;; If not, we try the first unread, if that is wanted.
10098    ((and subject
10099          gnus-auto-select-same
10100          (or (gnus-summary-first-unread-article)
10101              (eq (gnus-summary-article-mark) gnus-canceled-mark)))
10102     (gnus-summary-position-point)
10103     (gnus-message 6 "Wrapped"))
10104    ;; Try to get next/previous article not displayed in this group.
10105    ((and gnus-auto-extend-newsgroup
10106          (not unread) (not subject))
10107     (gnus-summary-goto-article
10108      (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
10109      nil t))
10110    ;; Go to next/previous group.
10111    (t
10112     (or (gnus-ephemeral-group-p gnus-newsgroup-name)
10113         (gnus-summary-jump-to-group gnus-newsgroup-name))
10114     (let ((cmd last-command-char)
10115           (group
10116            (if (eq gnus-keep-same-level 'best)
10117                (gnus-summary-best-group gnus-newsgroup-name)
10118              (gnus-summary-search-group backward gnus-keep-same-level))))
10119       ;; For some reason, the group window gets selected.  We change
10120       ;; it back.
10121       (select-window (get-buffer-window (current-buffer)))
10122       ;; Select next unread newsgroup automagically.
10123       (cond
10124        ((not gnus-auto-select-next)
10125         (gnus-message 7 "No more%s articles" (if unread " unread" "")))
10126        ((or (eq gnus-auto-select-next 'quietly)
10127             (and (eq gnus-auto-select-next 'slightly-quietly)
10128                  push)
10129             (and (eq gnus-auto-select-next 'almost-quietly)
10130                  (gnus-summary-last-article-p)))
10131         ;; Select quietly.
10132         (if (gnus-ephemeral-group-p gnus-newsgroup-name)
10133             (gnus-summary-exit)
10134           (gnus-message 7 "No more%s articles (%s)..."
10135                         (if unread " unread" "")
10136                         (if group (concat "selecting " group)
10137                           "exiting"))
10138           (gnus-summary-next-group nil group backward)))
10139        (t
10140         (gnus-summary-walk-group-buffer
10141          gnus-newsgroup-name cmd unread backward)))))))
10142
10143 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
10144   (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
10145                       (?\C-p (gnus-group-prev-unread-group 1))))
10146         keve key group ended)
10147     (save-excursion
10148       (set-buffer gnus-group-buffer)
10149       (gnus-summary-jump-to-group from-group)
10150       (setq group
10151             (if (eq gnus-keep-same-level 'best)
10152                 (gnus-summary-best-group gnus-newsgroup-name)
10153               (gnus-summary-search-group backward gnus-keep-same-level))))
10154     (while (not ended)
10155       (gnus-message
10156        5 "No more%s articles%s" (if unread " unread" "")
10157        (if (and group
10158                 (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
10159            (format " (Type %s for %s [%s])"
10160                    (single-key-description cmd) group
10161                    (car (gnus-gethash group gnus-newsrc-hashtb)))
10162          (format " (Type %s to exit %s)"
10163                  (single-key-description cmd)
10164                  gnus-newsgroup-name)))
10165       ;; Confirm auto selection.
10166       (setq key (car (setq keve (gnus-read-event-char))))
10167       (setq ended t)
10168       (cond
10169        ((assq key keystrokes)
10170         (let ((obuf (current-buffer)))
10171           (switch-to-buffer gnus-group-buffer)
10172           (and group
10173                (gnus-group-jump-to-group group))
10174           (eval (cadr (assq key keystrokes)))
10175           (setq group (gnus-group-group-name))
10176           (switch-to-buffer obuf))
10177         (setq ended nil))
10178        ((equal key cmd)
10179         (if (or (not group)
10180                 (gnus-ephemeral-group-p gnus-newsgroup-name))
10181             (gnus-summary-exit)
10182           (gnus-summary-next-group nil group backward)))
10183        (t
10184         (push (cdr keve) unread-command-events))))))
10185
10186 (defun gnus-read-event-char ()
10187   "Get the next event."
10188   (let ((event (read-event)))
10189     (cons (and (numberp event) event) event)))
10190
10191 (defun gnus-summary-next-unread-article ()
10192   "Select unread article after current one."
10193   (interactive)
10194   (gnus-summary-next-article t (and gnus-auto-select-same
10195                                     (gnus-summary-article-subject))))
10196
10197 (defun gnus-summary-prev-article (&optional unread subject)
10198   "Select the article after the current one.
10199 If UNREAD is non-nil, only unread articles are selected."
10200   (interactive "P")
10201   (gnus-summary-next-article unread subject t))
10202
10203 (defun gnus-summary-prev-unread-article ()
10204   "Select unred article before current one."
10205   (interactive)
10206   (gnus-summary-prev-article t (and gnus-auto-select-same
10207                                     (gnus-summary-article-subject))))
10208
10209 (defun gnus-summary-next-page (&optional lines circular)
10210   "Show next page of the selected article.
10211 If at the end of the current article, select the next article.
10212 LINES says how many lines should be scrolled up.
10213
10214 If CIRCULAR is non-nil, go to the start of the article instead of
10215 selecting the next article when reaching the end of the current
10216 article."
10217   (interactive "P")
10218   (setq gnus-summary-buffer (current-buffer))
10219   (gnus-set-global-variables)
10220   (let ((article (gnus-summary-article-number))
10221         (endp nil))
10222     (gnus-configure-windows 'article)
10223     (if (or (null gnus-current-article)
10224             (null gnus-article-current)
10225             (/= article (cdr gnus-article-current))
10226             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
10227         ;; Selected subject is different from current article's.
10228         (gnus-summary-display-article article)
10229       (gnus-eval-in-buffer-window
10230        gnus-article-buffer
10231        (setq endp (gnus-article-next-page lines)))
10232       (if endp
10233           (cond (circular
10234                  (gnus-summary-beginning-of-article))
10235                 (lines
10236                  (gnus-message 3 "End of message"))
10237                 ((null lines)
10238                  (if (and (eq gnus-summary-goto-unread 'never)
10239                           (not (gnus-summary-last-article-p article)))
10240                      (gnus-summary-next-article)
10241                    (gnus-summary-next-unread-article))))))
10242     (gnus-summary-recenter)
10243     (gnus-summary-position-point)))
10244
10245 (defun gnus-summary-prev-page (&optional lines)
10246   "Show previous page of selected article.
10247 Argument LINES specifies lines to be scrolled down."
10248   (interactive "P")
10249   (gnus-set-global-variables)
10250   (let ((article (gnus-summary-article-number)))
10251     (gnus-configure-windows 'article)
10252     (if (or (null gnus-current-article)
10253             (null gnus-article-current)
10254             (/= article (cdr gnus-article-current))
10255             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
10256         ;; Selected subject is different from current article's.
10257         (gnus-summary-display-article article)
10258       (gnus-summary-recenter)
10259       (gnus-eval-in-buffer-window gnus-article-buffer
10260                                   (gnus-article-prev-page lines))))
10261   (gnus-summary-position-point))
10262
10263 (defun gnus-summary-scroll-up (lines)
10264   "Scroll up (or down) one line current article.
10265 Argument LINES specifies lines to be scrolled up (or down if negative)."
10266   (interactive "p")
10267   (gnus-set-global-variables)
10268   (gnus-configure-windows 'article)
10269   (gnus-summary-show-thread)
10270   (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
10271     (gnus-eval-in-buffer-window
10272      gnus-article-buffer
10273      (cond ((> lines 0)
10274             (if (gnus-article-next-page lines)
10275                 (gnus-message 3 "End of message")))
10276            ((< lines 0)
10277             (gnus-article-prev-page (- lines))))))
10278   (gnus-summary-recenter)
10279   (gnus-summary-position-point))
10280
10281 (defun gnus-summary-next-same-subject ()
10282   "Select next article which has the same subject as current one."
10283   (interactive)
10284   (gnus-set-global-variables)
10285   (gnus-summary-next-article nil (gnus-summary-article-subject)))
10286
10287 (defun gnus-summary-prev-same-subject ()
10288   "Select previous article which has the same subject as current one."
10289   (interactive)
10290   (gnus-set-global-variables)
10291   (gnus-summary-prev-article nil (gnus-summary-article-subject)))
10292
10293 (defun gnus-summary-next-unread-same-subject ()
10294   "Select next unread article which has the same subject as current one."
10295   (interactive)
10296   (gnus-set-global-variables)
10297   (gnus-summary-next-article t (gnus-summary-article-subject)))
10298
10299 (defun gnus-summary-prev-unread-same-subject ()
10300   "Select previous unread article which has the same subject as current one."
10301   (interactive)
10302   (gnus-set-global-variables)
10303   (gnus-summary-prev-article t (gnus-summary-article-subject)))
10304
10305 (defun gnus-summary-first-unread-article ()
10306   "Select the first unread article.
10307 Return nil if there are no unread articles."
10308   (interactive)
10309   (gnus-set-global-variables)
10310   (prog1
10311       (if (gnus-summary-first-subject t)
10312           (progn
10313             (gnus-summary-show-thread)
10314             (gnus-summary-first-subject t)
10315             (gnus-summary-display-article (gnus-summary-article-number))))
10316     (gnus-summary-position-point)))
10317
10318 (defun gnus-summary-best-unread-article ()
10319   "Select the unread article with the highest score."
10320   (interactive)
10321   (gnus-set-global-variables)
10322   (let ((best -1000000)
10323         (data gnus-newsgroup-data)
10324         article score)
10325     (while data
10326       (and (gnus-data-unread-p (car data))
10327            (> (setq score
10328                     (gnus-summary-article-score (gnus-data-number (car data))))
10329               best)
10330            (setq best score
10331                  article (gnus-data-number (car data))))
10332       (setq data (cdr data)))
10333     (if article
10334         (gnus-summary-goto-article article)
10335       (error "No unread articles"))
10336     (gnus-summary-position-point)))
10337
10338 (defun gnus-summary-last-subject ()
10339   "Go to the last displayed subject line in the group."
10340   (let ((article (gnus-data-number (car (gnus-data-list t)))))
10341     (when article
10342       (gnus-summary-goto-subject article))))
10343
10344 (defun gnus-summary-goto-article (article &optional all-headers force)
10345   "Fetch ARTICLE and display it if it exists.
10346 If ALL-HEADERS is non-nil, no header lines are hidden."
10347   (interactive
10348    (list
10349     (string-to-int
10350      (completing-read
10351       "Article number: "
10352       (mapcar (lambda (number) (list (int-to-string number)))
10353               gnus-newsgroup-limit)))
10354     current-prefix-arg
10355     t))
10356   (prog1
10357       (if (gnus-summary-goto-subject article force)
10358           (gnus-summary-display-article article all-headers)
10359         (gnus-message 4 "Couldn't go to article %s" article) nil)
10360     (gnus-summary-position-point)))
10361
10362 (defun gnus-summary-goto-last-article ()
10363   "Go to the previously read article."
10364   (interactive)
10365   (prog1
10366       (and gnus-last-article
10367            (gnus-summary-goto-article gnus-last-article))
10368     (gnus-summary-position-point)))
10369
10370 (defun gnus-summary-pop-article (number)
10371   "Pop one article off the history and go to the previous.
10372 NUMBER articles will be popped off."
10373   (interactive "p")
10374   (let (to)
10375     (setq gnus-newsgroup-history
10376           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
10377     (if to
10378         (gnus-summary-goto-article (car to))
10379       (error "Article history empty")))
10380   (gnus-summary-position-point))
10381
10382 ;; Summary commands and functions for limiting the summary buffer.
10383
10384 (defun gnus-summary-limit-to-articles (n)
10385   "Limit the summary buffer to the next N articles.
10386 If not given a prefix, use the process marked articles instead."
10387   (interactive "P")
10388   (gnus-set-global-variables)
10389   (prog1
10390       (let ((articles (gnus-summary-work-articles n)))
10391         (setq gnus-newsgroup-processable nil)
10392         (gnus-summary-limit articles))
10393     (gnus-summary-position-point)))
10394
10395 (defun gnus-summary-pop-limit (&optional total)
10396   "Restore the previous limit.
10397 If given a prefix, remove all limits."
10398   (interactive "P")
10399   (gnus-set-global-variables)
10400   (when total 
10401     (setq gnus-newsgroup-limits
10402           (list (mapcar (lambda (h) (mail-header-number h))
10403                         gnus-newsgroup-headers))))
10404   (unless gnus-newsgroup-limits
10405     (error "No limit to pop"))
10406   (prog1
10407       (gnus-summary-limit nil 'pop)
10408     (gnus-summary-position-point)))
10409
10410 (defun gnus-summary-limit-to-subject (subject &optional header)
10411   "Limit the summary buffer to articles that have subjects that match a regexp."
10412   (interactive "sRegexp: ")
10413   (unless header
10414     (setq header "subject"))
10415   (when (not (equal "" subject))
10416     (prog1
10417         (let ((articles (gnus-summary-find-matching
10418                          (or header "subject") subject 'all)))
10419           (or articles (error "Found no matches for \"%s\"" subject))
10420           (gnus-summary-limit articles))
10421       (gnus-summary-position-point))))
10422
10423 (defun gnus-summary-limit-to-author (from)
10424   "Limit the summary buffer to articles that have authors that match a regexp."
10425   (interactive "sRegexp: ")
10426   (gnus-summary-limit-to-subject from "from"))
10427
10428 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10429 (make-obsolete
10430  'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10431
10432 (defun gnus-summary-limit-to-unread (&optional all)
10433   "Limit the summary buffer to articles that are not marked as read.
10434 If ALL is non-nil, limit strictly to unread articles."
10435   (interactive "P")
10436   (if all
10437       (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
10438     (gnus-summary-limit-to-marks
10439      ;; Concat all the marks that say that an article is read and have
10440      ;; those removed.
10441      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
10442            gnus-killed-mark gnus-kill-file-mark
10443            gnus-low-score-mark gnus-expirable-mark
10444            gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark)
10445      'reverse)))
10446
10447 (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10448 (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10449
10450 (defun gnus-summary-limit-to-marks (marks &optional reverse)
10451   "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
10452 If REVERSE, limit the summary buffer to articles that are not marked
10453 with MARKS.  MARKS can either be a string of marks or a list of marks.
10454 Returns how many articles were removed."
10455   (interactive "sMarks: ")
10456   (gnus-set-global-variables)
10457   (prog1
10458       (let ((data gnus-newsgroup-data)
10459             (marks (if (listp marks) marks
10460                      (append marks nil))) ; Transform to list.
10461             articles)
10462         (while data
10463           (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
10464                  (memq (gnus-data-mark (car data)) marks))
10465                (setq articles (cons (gnus-data-number (car data)) articles)))
10466           (setq data (cdr data)))
10467         (gnus-summary-limit articles))
10468     (gnus-summary-position-point)))
10469
10470 (defun gnus-summary-limit-to-score (&optional score)
10471   "Limit to articles with score at or above SCORE."
10472   (interactive "P")
10473   (gnus-set-global-variables)
10474   (setq score (if score
10475                   (prefix-numeric-value score)
10476                 (or gnus-summary-default-score 0)))
10477   (let ((data gnus-newsgroup-data)
10478         articles)
10479     (while data
10480       (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
10481                 score)
10482         (push (gnus-data-number (car data)) articles))
10483       (setq data (cdr data)))
10484     (prog1
10485         (gnus-summary-limit articles)
10486       (gnus-summary-position-point))))
10487
10488 (defun gnus-summary-limit-include-dormant ()
10489   "Display all the hidden articles that are marked as dormant."
10490   (interactive)
10491   (gnus-set-global-variables)
10492   (or gnus-newsgroup-dormant
10493       (error "There are no dormant articles in this group"))
10494   (prog1
10495       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
10496     (gnus-summary-position-point)))
10497
10498 (defun gnus-summary-limit-exclude-dormant ()
10499   "Hide all dormant articles."
10500   (interactive)
10501   (gnus-set-global-variables)
10502   (prog1
10503       (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
10504     (gnus-summary-position-point)))
10505
10506 (defun gnus-summary-limit-exclude-childless-dormant ()
10507   "Hide all dormant articles that have no children."
10508   (interactive)
10509   (gnus-set-global-variables)
10510   (let ((data (gnus-data-list t))
10511         articles d children)
10512     ;; Find all articles that are either not dormant or have
10513     ;; children.
10514     (while (setq d (pop data))
10515       (when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
10516                 (and (setq children 
10517                            (gnus-article-children (gnus-data-number d)))
10518                      (let (found)
10519                        (while children
10520                          (when (memq (car children) articles)
10521                            (setq children nil
10522                                  found t))
10523                          (pop children))
10524                        found)))
10525         (push (gnus-data-number d) articles)))
10526     ;; Do the limiting.
10527     (prog1
10528         (gnus-summary-limit articles)
10529       (gnus-summary-position-point))))
10530
10531 (defun gnus-summary-limit-mark-excluded-as-read (&optional all)
10532   "Mark all unread excluded articles as read.
10533 If ALL, mark even excluded ticked and dormants as read."
10534   (interactive "P")
10535   (let ((articles (gnus-sorted-complement
10536                    (sort
10537                     (mapcar (lambda (h) (mail-header-number h))
10538                             gnus-newsgroup-headers)
10539                     '<)
10540                    (sort gnus-newsgroup-limit '<)))
10541         article)
10542     (setq gnus-newsgroup-unreads nil)
10543     (if all
10544         (setq gnus-newsgroup-dormant nil
10545               gnus-newsgroup-marked nil
10546               gnus-newsgroup-reads
10547               (nconc
10548                (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
10549                gnus-newsgroup-reads))
10550       (while (setq article (pop articles))
10551         (unless (or (memq article gnus-newsgroup-dormant)
10552                     (memq article gnus-newsgroup-marked))
10553           (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
10554
10555 (defun gnus-summary-limit (articles &optional pop)
10556   (if pop
10557       ;; We pop the previous limit off the stack and use that.
10558       (setq articles (car gnus-newsgroup-limits)
10559             gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
10560     ;; We use the new limit, so we push the old limit on the stack.
10561     (setq gnus-newsgroup-limits
10562           (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
10563   ;; Set the limit.
10564   (setq gnus-newsgroup-limit articles)
10565   (let ((total (length gnus-newsgroup-data))
10566         (data (gnus-data-find-list (gnus-summary-article-number)))
10567         found)
10568     ;; This will do all the work of generating the new summary buffer
10569     ;; according to the new limit.
10570     (gnus-summary-prepare)
10571     ;; Hide any threads, possibly.
10572     (and gnus-show-threads
10573          gnus-thread-hide-subtree
10574          (gnus-summary-hide-all-threads))
10575     ;; Try to return to the article you were at, or one in the
10576     ;; neighborhood.
10577     (if data
10578         ;; We try to find some article after the current one.
10579         (while data
10580           (and (gnus-summary-goto-subject
10581                 (gnus-data-number (car data)) nil t)
10582                (setq data nil
10583                      found t))
10584           (setq data (cdr data))))
10585     (or found
10586         ;; If there is no data, that means that we were after the last
10587         ;; article.  The same goes when we can't find any articles
10588         ;; after the current one.
10589         (progn
10590           (goto-char (point-max))
10591           (gnus-summary-find-prev)))
10592     ;; We return how many articles were removed from the summary
10593     ;; buffer as a result of the new limit.
10594     (- total (length gnus-newsgroup-data))))
10595
10596 (defsubst gnus-cut-thread (thread)
10597   "Go forwards in the thread until we find an article that we want to display."
10598   (when (eq gnus-fetch-old-headers 'some)
10599     ;; Deal with old-fetched headers.
10600     (while (and thread
10601                 (memq (mail-header-number (car thread)) 
10602                       gnus-newsgroup-ancient)
10603                 (<= (length (cdr thread)) 1))
10604       (setq thread (cadr thread))))
10605   ;; Deal with sparse threads.
10606   (when (or (eq gnus-build-sparse-threads 'some)
10607             (eq gnus-build-sparse-threads 'more))
10608     (while (and thread
10609                 (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
10610                 (= (length (cdr thread)) 1))
10611       (setq thread (cadr thread))))
10612   thread)
10613
10614 (defun gnus-cut-threads (threads)
10615   "Cut off all uninteresting articles from the beginning of threads."
10616   (when (or (eq gnus-fetch-old-headers 'some)
10617             (eq gnus-build-sparse-threads 'some)
10618             (eq gnus-build-sparse-threads 'more))
10619     (let ((th threads))
10620       (while th
10621         (setcar th (gnus-cut-thread (car th)))
10622         (setq th (cdr th)))))
10623   ;; Remove nixed out threads.
10624   (delq nil threads))
10625
10626 (defun gnus-summary-initial-limit (&optional show-if-empty)
10627   "Figure out what the initial limit is supposed to be on group entry.
10628 This entails weeding out unwanted dormants, low-scored articles,
10629 fetch-old-headers verbiage, and so on."
10630   ;; Most groups have nothing to remove.
10631   (if (or gnus-inhibit-limiting
10632           (and (null gnus-newsgroup-dormant)
10633                (not (eq gnus-fetch-old-headers 'some))
10634                (null gnus-summary-expunge-below)
10635                (not (eq gnus-build-sparse-threads 'some))
10636                (not (eq gnus-build-sparse-threads 'more))
10637                (null gnus-thread-expunge-below)
10638                (not gnus-use-nocem)))
10639       () ; Do nothing.
10640     (push gnus-newsgroup-limit gnus-newsgroup-limits)
10641     (setq gnus-newsgroup-limit nil)
10642     (mapatoms
10643      (lambda (node)
10644        (unless (car (symbol-value node))
10645          ;; These threads have no parents -- they are roots.
10646          (let ((nodes (cdr (symbol-value node)))
10647                thread)
10648            (while nodes
10649              (if (and gnus-thread-expunge-below
10650                       (< (gnus-thread-total-score (car nodes))
10651                          gnus-thread-expunge-below))
10652                  (gnus-expunge-thread (pop nodes))
10653                (setq thread (pop nodes))
10654                (gnus-summary-limit-children thread))))))
10655      gnus-newsgroup-dependencies)
10656     ;; If this limitation resulted in an empty group, we might
10657     ;; pop the previous limit and use it instead.
10658     (when (and (not gnus-newsgroup-limit)
10659                show-if-empty)
10660       (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
10661     gnus-newsgroup-limit))
10662
10663 (defun gnus-summary-limit-children (thread)
10664   "Return 1 if this subthread is visible and 0 if it is not."
10665   ;; First we get the number of visible children to this thread.  This
10666   ;; is done by recursing down the thread using this function, so this
10667   ;; will really go down to a leaf article first, before slowly
10668   ;; working its way up towards the root.
10669   (when thread
10670     (let ((children
10671            (if (cdr thread)
10672                (apply '+ (mapcar 'gnus-summary-limit-children
10673                                  (cdr thread)))
10674              0))
10675           (number (mail-header-number (car thread)))
10676           score)
10677       (if (or
10678            ;; If this article is dormant and has absolutely no visible
10679            ;; children, then this article isn't visible.
10680            (and (memq number gnus-newsgroup-dormant)
10681                 (= children 0))
10682            ;; If this is a "fetch-old-headered" and there is only one
10683            ;; visible child (or less), then we don't want this article.
10684            (and (eq gnus-fetch-old-headers 'some)
10685                 (memq number gnus-newsgroup-ancient)
10686                 (zerop children))
10687            ;; If this is a sparsely inserted article with no children,
10688            ;; we don't want it.
10689            (and (eq gnus-build-sparse-threads 'some)
10690                 (memq number gnus-newsgroup-sparse)
10691                 (zerop children))
10692            ;; If we use expunging, and this article is really
10693            ;; low-scored, then we don't want this article.
10694            (when (and gnus-summary-expunge-below
10695                       (< (setq score
10696                                (or (cdr (assq number gnus-newsgroup-scored))
10697                                    gnus-summary-default-score))
10698                          gnus-summary-expunge-below))
10699              ;; We increase the expunge-tally here, but that has
10700              ;; nothing to do with the limits, really.
10701              (incf gnus-newsgroup-expunged-tally)
10702              ;; We also mark as read here, if that's wanted.
10703              (when (and gnus-summary-mark-below
10704                         (< score gnus-summary-mark-below))
10705                (setq gnus-newsgroup-unreads
10706                      (delq number gnus-newsgroup-unreads))
10707                (if gnus-newsgroup-auto-expire
10708                    (push number gnus-newsgroup-expirable)
10709                  (push (cons number gnus-low-score-mark)
10710                        gnus-newsgroup-reads)))
10711              t)
10712            (and gnus-use-nocem
10713                 (gnus-nocem-unwanted-article-p (mail-header-id (car thread)))))
10714           ;; Nope, invisible article.
10715           0
10716         ;; Ok, this article is to be visible, so we add it to the limit
10717         ;; and return 1.
10718         (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
10719         1))))
10720
10721 (defun gnus-expunge-thread (thread)
10722   "Mark all articles in THREAD as read."
10723   (let* ((number (mail-header-number (car thread))))
10724     (incf gnus-newsgroup-expunged-tally)
10725     ;; We also mark as read here, if that's wanted.
10726     (setq gnus-newsgroup-unreads
10727           (delq number gnus-newsgroup-unreads))
10728     (if gnus-newsgroup-auto-expire
10729         (push number gnus-newsgroup-expirable)
10730       (push (cons number gnus-low-score-mark)
10731             gnus-newsgroup-reads)))
10732   ;; Go recursively through all subthreads.
10733   (mapcar 'gnus-expunge-thread (cdr thread)))
10734
10735 ;; Summary article oriented commands
10736
10737 (defun gnus-summary-refer-parent-article (n)
10738   "Refer parent article N times.
10739 The difference between N and the number of articles fetched is returned."
10740   (interactive "p")
10741   (gnus-set-global-variables)
10742   (while
10743       (and
10744        (> n 0)
10745        (let* ((header (gnus-summary-article-header))
10746               (ref
10747                ;; If we try to find the parent of the currently
10748                ;; displayed article, then we take a look at the actual
10749                ;; References header, since this is slightly more
10750                ;; reliable than the References field we got from the
10751                ;; server.
10752                (if (and (eq (mail-header-number header)
10753                             (cdr gnus-article-current))
10754                         (equal gnus-newsgroup-name
10755                                (car gnus-article-current)))
10756                    (save-excursion
10757                      (set-buffer gnus-original-article-buffer)
10758                      (nnheader-narrow-to-headers)
10759                      (prog1
10760                          (mail-fetch-field "references")
10761                        (widen)))
10762                  ;; It's not the current article, so we take a bet on
10763                  ;; the value we got from the server.
10764                  (mail-header-references header))))
10765          (if (setq ref (or ref (mail-header-references header)))
10766              (or (gnus-summary-refer-article (gnus-parent-id ref))
10767                  (gnus-message 1 "Couldn't find parent"))
10768            (gnus-message 1 "No references in article %d"
10769                          (gnus-summary-article-number))
10770            nil)))
10771     (setq n (1- n)))
10772   (gnus-summary-position-point)
10773   n)
10774
10775 (defun gnus-summary-refer-references ()
10776   "Fetch all articles mentioned in the References header.
10777 Return how many articles were fetched."
10778   (interactive)
10779   (gnus-set-global-variables)
10780   (let ((ref (mail-header-references (gnus-summary-article-header)))
10781         (current (gnus-summary-article-number))
10782         (n 0))
10783     ;; For each Message-ID in the References header...
10784     (while (string-match "<[^>]*>" ref)
10785       (incf n)
10786       ;; ... fetch that article.
10787       (gnus-summary-refer-article
10788        (prog1 (match-string 0 ref)
10789          (setq ref (substring ref (match-end 0))))))
10790     (gnus-summary-goto-subject current)
10791     (gnus-summary-position-point)
10792     n))
10793
10794 (defun gnus-summary-refer-article (message-id)
10795   "Fetch an article specified by MESSAGE-ID."
10796   (interactive "sMessage-ID: ")
10797   (when (and (stringp message-id)
10798              (not (zerop (length message-id))))
10799     ;; Construct the correct Message-ID if necessary.
10800     ;; Suggested by tale@pawl.rpi.edu.
10801     (unless (string-match "^<" message-id)
10802       (setq message-id (concat "<" message-id)))
10803     (unless (string-match ">$" message-id)
10804       (setq message-id (concat message-id ">")))
10805     (let ((header (car (gnus-gethash message-id
10806                                      gnus-newsgroup-dependencies))))
10807       (if header
10808           ;; The article is present in the buffer, to we just go to it.
10809           (gnus-summary-goto-article (mail-header-number header) nil t)
10810         ;; We fetch the article
10811         (let ((gnus-override-method gnus-refer-article-method)
10812               number)
10813           ;; Start the special refer-article method, if necessary.
10814           (when gnus-refer-article-method
10815             (gnus-check-server gnus-refer-article-method))
10816           ;; Fetch the header, and display the article.
10817           (if (setq number (gnus-summary-insert-subject message-id))
10818               (gnus-summary-select-article nil nil nil number)
10819             (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
10820
10821 (defun gnus-summary-enter-digest-group (&optional force)
10822   "Enter a digest group based on the current article."
10823   (interactive "P")
10824   (gnus-set-global-variables)
10825   (gnus-summary-select-article)
10826   (let ((name (format "%s-%d"
10827                       (gnus-group-prefixed-name
10828                        gnus-newsgroup-name (list 'nndoc ""))
10829                       gnus-current-article))
10830         (ogroup gnus-newsgroup-name)
10831         (case-fold-search t)
10832         (buf (current-buffer))
10833         dig)
10834     (save-excursion
10835       (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
10836       (insert-buffer-substring gnus-original-article-buffer)
10837       (narrow-to-region
10838        (goto-char (point-min))
10839        (or (search-forward "\n\n" nil t) (point)))
10840       (goto-char (point-min))
10841       (delete-matching-lines "^\\(Path\\):\\|^From ")
10842       (widen))
10843     (unwind-protect
10844         (if (gnus-group-read-ephemeral-group
10845              name `(nndoc ,name (nndoc-address
10846                                  ,(get-buffer dig))
10847                           (nndoc-article-type ,(if force 'digest 'guess))) t)
10848             ;; Make all postings to this group go to the parent group.
10849             (nconc (gnus-info-params (gnus-get-info name))
10850                    (list (cons 'to-group ogroup)))
10851           ;; Couldn't select this doc group.
10852           (switch-to-buffer buf)
10853           (gnus-set-global-variables)
10854           (gnus-configure-windows 'summary)
10855           (gnus-message 3 "Article couldn't be entered?"))
10856       (kill-buffer dig))))
10857
10858 (defun gnus-summary-isearch-article (&optional regexp-p)
10859   "Do incremental search forward on the current article.
10860 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
10861   (interactive "P")
10862   (gnus-set-global-variables)
10863   (gnus-summary-select-article)
10864   (gnus-configure-windows 'article)
10865   (gnus-eval-in-buffer-window
10866    gnus-article-buffer
10867    (goto-char (point-min))
10868    (isearch-forward regexp-p)))
10869
10870 (defun gnus-summary-search-article-forward (regexp &optional backward)
10871   "Search for an article containing REGEXP forward.
10872 If BACKWARD, search backward instead."
10873   (interactive
10874    (list (read-string
10875           (format "Search article %s (regexp%s): "
10876                   (if current-prefix-arg "backward" "forward")
10877                   (if gnus-last-search-regexp
10878                       (concat ", default " gnus-last-search-regexp)
10879                     "")))
10880          current-prefix-arg))
10881   (gnus-set-global-variables)
10882   (if (string-equal regexp "")
10883       (setq regexp (or gnus-last-search-regexp ""))
10884     (setq gnus-last-search-regexp regexp))
10885   (if (gnus-summary-search-article regexp backward)
10886       (gnus-article-set-window-start
10887        (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks)))
10888     (error "Search failed: \"%s\"" regexp)))
10889
10890 (defun gnus-summary-search-article-backward (regexp)
10891   "Search for an article containing REGEXP backward."
10892   (interactive
10893    (list (read-string
10894           (format "Search article backward (regexp%s): "
10895                   (if gnus-last-search-regexp
10896                       (concat ", default " gnus-last-search-regexp)
10897                     "")))))
10898   (gnus-summary-search-article-forward regexp 'backward))
10899
10900 (defun gnus-summary-search-article (regexp &optional backward)
10901   "Search for an article containing REGEXP.
10902 Optional argument BACKWARD means do search for backward.
10903 gnus-select-article-hook is not called during the search."
10904   (let ((gnus-select-article-hook nil)  ;Disable hook.
10905         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
10906         (re-search
10907          (if backward
10908              (function re-search-backward) (function re-search-forward)))
10909         (found nil)
10910         (last nil))
10911     ;; Hidden thread subtrees must be searched for ,too.
10912     (gnus-summary-show-all-threads)
10913     ;; First of all, search current article.
10914     ;; We don't want to read article again from NNTP server nor reset
10915     ;; current point.
10916     (gnus-summary-select-article)
10917     (gnus-message 9 "Searching article: %d..." gnus-current-article)
10918     (setq last gnus-current-article)
10919     (gnus-eval-in-buffer-window
10920      gnus-article-buffer
10921      (save-restriction
10922        (widen)
10923        ;; Begin search from current point.
10924        (setq found (funcall re-search regexp nil t))))
10925     ;; Then search next articles.
10926     (while (and (not found)
10927                 (gnus-summary-display-article
10928                  (if backward (gnus-summary-find-prev)
10929                    (gnus-summary-find-next))))
10930       (gnus-message 9 "Searching article: %d..." gnus-current-article)
10931       (gnus-eval-in-buffer-window
10932        gnus-article-buffer
10933        (save-restriction
10934          (widen)
10935          (goto-char (if backward (point-max) (point-min)))
10936          (setq found (funcall re-search regexp nil t)))))
10937     (message "")
10938     ;; Adjust article pointer.
10939     (or (eq last gnus-current-article)
10940         (setq gnus-last-article last))
10941     ;; Return T if found such article.
10942     found))
10943
10944 (defun gnus-summary-find-matching (header regexp &optional backward unread
10945                                           not-case-fold)
10946   "Return a list of all articles that match REGEXP on HEADER.
10947 The search stars on the current article and goes forwards unless
10948 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
10949 If UNREAD is non-nil, only unread articles will
10950 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
10951 in the comparisons."
10952   (let ((data (if (eq backward 'all) gnus-newsgroup-data
10953                 (gnus-data-find-list
10954                  (gnus-summary-article-number) (gnus-data-list backward))))
10955         (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
10956         (case-fold-search (not not-case-fold))
10957         articles d)
10958     (or (fboundp (intern (concat "mail-header-" header)))
10959         (error "%s is not a valid header" header))
10960     (while data
10961       (setq d (car data))
10962       (and (or (not unread)             ; We want all articles...
10963                (gnus-data-unread-p d))  ; Or just unreads.
10964            (vectorp (gnus-data-header d)) ; It's not a pseudo.
10965            (string-match regexp (funcall func (gnus-data-header d))) ; Match.
10966            (setq articles (cons (gnus-data-number d) articles))) ; Success!
10967       (setq data (cdr data)))
10968     (nreverse articles)))
10969
10970 (defun gnus-summary-execute-command (header regexp command &optional backward)
10971   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
10972 If HEADER is an empty string (or nil), the match is done on the entire
10973 article.  If BACKWARD (the prefix) is non-nil, search backward instead."
10974   (interactive
10975    (list (let ((completion-ignore-case t))
10976            (completing-read
10977             "Header name: "
10978             (mapcar (lambda (string) (list string))
10979                     '("Number" "Subject" "From" "Lines" "Date"
10980                       "Message-ID" "Xref" "References" "Body"))
10981             nil 'require-match))
10982          (read-string "Regexp: ")
10983          (read-key-sequence "Command: ")
10984          current-prefix-arg))
10985   (when (equal header "Body")
10986     (setq header ""))
10987   (gnus-set-global-variables)
10988   ;; Hidden thread subtrees must be searched as well.
10989   (gnus-summary-show-all-threads)
10990   ;; We don't want to change current point nor window configuration.
10991   (save-excursion
10992     (save-window-excursion
10993       (gnus-message 6 "Executing %s..." (key-description command))
10994       ;; We'd like to execute COMMAND interactively so as to give arguments.
10995       (gnus-execute header regexp
10996                     `(lambda () (call-interactively ',(key-binding command)))
10997                     backward)
10998       (gnus-message 6 "Executing %s...done" (key-description command)))))
10999
11000 (defun gnus-summary-beginning-of-article ()
11001   "Scroll the article back to the beginning."
11002   (interactive)
11003   (gnus-set-global-variables)
11004   (gnus-summary-select-article)
11005   (gnus-configure-windows 'article)
11006   (gnus-eval-in-buffer-window
11007    gnus-article-buffer
11008    (widen)
11009    (goto-char (point-min))
11010    (and gnus-break-pages (gnus-narrow-to-page))))
11011
11012 (defun gnus-summary-end-of-article ()
11013   "Scroll to the end of the article."
11014   (interactive)
11015   (gnus-set-global-variables)
11016   (gnus-summary-select-article)
11017   (gnus-configure-windows 'article)
11018   (gnus-eval-in-buffer-window
11019    gnus-article-buffer
11020    (widen)
11021    (goto-char (point-max))
11022    (recenter -3)
11023    (and gnus-break-pages (gnus-narrow-to-page))))
11024
11025 (defun gnus-summary-show-article (&optional arg)
11026   "Force re-fetching of the current article.
11027 If ARG (the prefix) is non-nil, show the raw article without any
11028 article massaging functions being run."
11029   (interactive "P")
11030   (gnus-set-global-variables)
11031   (if (not arg)
11032       ;; Select the article the normal way.
11033       (gnus-summary-select-article nil 'force)
11034     ;; Bind the article treatment functions to nil.
11035     (let ((gnus-have-all-headers t)
11036           gnus-article-display-hook
11037           gnus-article-prepare-hook
11038           gnus-visual)
11039       (gnus-summary-select-article nil 'force)))
11040 ;  (gnus-configure-windows 'article)
11041   (gnus-summary-position-point))
11042
11043 (defun gnus-summary-verbose-headers (&optional arg)
11044   "Toggle permanent full header display.
11045 If ARG is a positive number, turn header display on.
11046 If ARG is a negative number, turn header display off."
11047   (interactive "P")
11048   (gnus-set-global-variables)
11049   (gnus-summary-toggle-header arg)
11050   (setq gnus-show-all-headers
11051         (cond ((or (not (numberp arg))
11052                    (zerop arg))
11053                (not gnus-show-all-headers))
11054               ((natnump arg)
11055                t))))
11056
11057 (defun gnus-summary-toggle-header (&optional arg)
11058   "Show the headers if they are hidden, or hide them if they are shown.
11059 If ARG is a positive number, show the entire header.
11060 If ARG is a negative number, hide the unwanted header lines."
11061   (interactive "P")
11062   (gnus-set-global-variables)
11063   (save-excursion
11064     (set-buffer gnus-article-buffer)
11065     (let* ((buffer-read-only nil)
11066            (inhibit-point-motion-hooks t)
11067            (hidden (text-property-any
11068                     (goto-char (point-min)) (search-forward "\n\n")
11069                     'invisible t))
11070            e)
11071       (goto-char (point-min))
11072       (when (search-forward "\n\n" nil t)
11073         (delete-region (point-min) (1- (point))))
11074       (goto-char (point-min))
11075       (save-excursion
11076         (set-buffer gnus-original-article-buffer)
11077         (goto-char (point-min))
11078         (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
11079       (insert-buffer-substring gnus-original-article-buffer 1 e)
11080       (let ((gnus-inhibit-hiding t))
11081         (run-hooks 'gnus-article-display-hook))
11082       (if (or (not hidden) (and (numberp arg) (< arg 0)))
11083           (gnus-article-hide-headers)))))
11084
11085 (defun gnus-summary-show-all-headers ()
11086   "Make all header lines visible."
11087   (interactive)
11088   (gnus-set-global-variables)
11089   (gnus-article-show-all-headers))
11090
11091 (defun gnus-summary-toggle-mime (&optional arg)
11092   "Toggle MIME processing.
11093 If ARG is a positive number, turn MIME processing on."
11094   (interactive "P")
11095   (gnus-set-global-variables)
11096   (setq gnus-show-mime
11097         (if (null arg) (not gnus-show-mime)
11098           (> (prefix-numeric-value arg) 0)))
11099   (gnus-summary-select-article t 'force))
11100
11101 (defun gnus-summary-caesar-message (&optional arg)
11102   "Caesar rotate the current article by 13.
11103 The numerical prefix specifies how manu places to rotate each letter
11104 forward."
11105   (interactive "P")
11106   (gnus-set-global-variables)
11107   (gnus-summary-select-article)
11108   (let ((mail-header-separator ""))
11109     (gnus-eval-in-buffer-window
11110      gnus-article-buffer
11111      (save-restriction
11112        (widen)
11113        (let ((start (window-start)))
11114          (news-caesar-buffer-body arg)
11115          (set-window-start (get-buffer-window (current-buffer)) start))))))
11116
11117 (defun gnus-summary-stop-page-breaking ()
11118   "Stop page breaking in the current article."
11119   (interactive)
11120   (gnus-set-global-variables)
11121   (gnus-summary-select-article)
11122   (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
11123
11124 (defun gnus-summary-move-article (&optional n to-newsgroup select-method action)
11125   "Move the current article to a different newsgroup.
11126 If N is a positive number, move the N next articles.
11127 If N is a negative number, move the N previous articles.
11128 If N is nil and any articles have been marked with the process mark,
11129 move those articles instead.
11130 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
11131 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
11132 re-spool using this method.
11133
11134 For this function to work, both the current newsgroup and the
11135 newsgroup that you want to move to have to support the `request-move'
11136 and `request-accept' functions."
11137   (interactive "P")
11138   (unless action (setq action 'move))
11139   (gnus-set-global-variables)
11140   ;; Check whether the source group supports the required functions.
11141   (cond ((and (eq action 'move)
11142               (not (gnus-check-backend-function
11143                     'request-move-article gnus-newsgroup-name)))
11144          (error "The current group does not support article moving"))
11145         ((and (eq action 'crosspost)
11146               (not (gnus-check-backend-function
11147                     'request-replace-article gnus-newsgroup-name)))
11148          (error "The current group does not support article editing")))
11149   (let ((articles (gnus-summary-work-articles n))
11150         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
11151         (names '((move "move" "Moving")
11152                  (copy "copy" "Copying")
11153                  (crosspost "crosspost" "Crossposting")))
11154         (copy-buf (save-excursion
11155                     (nnheader-set-temp-buffer " *copy article*")))
11156         art-group to-method new-xref article to-groups)
11157     (unless (assq action names)
11158       (error "Unknown action %s" action))
11159     ;; Read the newsgroup name.
11160     (when (and (not to-newsgroup)
11161                (not select-method))
11162       (setq to-newsgroup
11163             (gnus-read-move-group-name
11164              (cadr (assq action names))
11165              gnus-current-move-group articles prefix))
11166       (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
11167     (setq to-method (if select-method (list select-method "")
11168                       (gnus-find-method-for-group to-newsgroup)))
11169     ;;(when (equal to-newsgroup gnus-newsgroup-name)
11170     ;;(error "Can't %s to the same group you're already in" action))
11171     ;; Check the method we are to move this article to...
11172     (or (gnus-check-backend-function 'request-accept-article (car to-method))
11173         (error "%s does not support article copying" (car to-method)))
11174     (or (gnus-check-server to-method)
11175         (error "Can't open server %s" (car to-method)))
11176     (gnus-message 6 "%s to %s: %s..."
11177                   (caddr (assq action names))
11178                   (or select-method to-newsgroup) articles)
11179     (while articles
11180       (setq article (pop articles))
11181       (setq
11182        art-group
11183        (cond
11184         ;; Move the article.
11185         ((eq action 'move)
11186          (gnus-request-move-article
11187           article                       ; Article to move
11188           gnus-newsgroup-name           ; From newsgrouo
11189           (nth 1 (gnus-find-method-for-group
11190                   gnus-newsgroup-name)) ; Server
11191           (list 'gnus-request-accept-article
11192                 (if select-method
11193                     (list 'quote select-method)
11194                   to-newsgroup)
11195                 (not articles))         ; Accept form
11196           (not articles)))              ; Only save nov last time
11197         ;; Copy the article.
11198         ((eq action 'copy)
11199          (save-excursion
11200            (set-buffer copy-buf)
11201            (gnus-request-article-this-buffer article gnus-newsgroup-name)
11202            (gnus-request-accept-article
11203             (if select-method select-method to-newsgroup)
11204             (not articles))))
11205         ;; Crosspost the article.
11206         ((eq action 'crosspost)
11207          (let ((xref (mail-header-xref (gnus-summary-article-header article))))
11208            (setq new-xref (concat gnus-newsgroup-name ":" article))
11209            (if (and xref (not (string= xref "")))
11210                (progn
11211                  (when (string-match "^Xref: " xref)
11212                    (setq xref (substring xref (match-end 0))))
11213                  (setq new-xref (concat xref " " new-xref)))
11214              (setq new-xref (concat (system-name) " " new-xref)))
11215            (save-excursion
11216              (set-buffer copy-buf)
11217              (gnus-request-article-this-buffer article gnus-newsgroup-name)
11218              (nnheader-replace-header "xref" new-xref)
11219              (gnus-request-accept-article
11220               (if select-method select-method to-newsgroup)
11221               (not articles)))))))
11222       (if (not art-group)
11223           (gnus-message 1 "Couldn't %s article %s"
11224                         (cadr (assq action names)) article)
11225         (let* ((entry
11226                 (or
11227                  (gnus-gethash (car art-group) gnus-newsrc-hashtb)
11228                  (gnus-gethash
11229                   (gnus-group-prefixed-name
11230                    (car art-group)
11231                    (if select-method (list select-method "")
11232                      (gnus-find-method-for-group to-newsgroup)))
11233                   gnus-newsrc-hashtb)))
11234                (info (nth 2 entry))
11235                (to-group (gnus-info-group info)))
11236           ;; Update the group that has been moved to.
11237           (when (and info
11238                      (memq action '(move copy)))
11239             (unless (member to-group to-groups)
11240               (push to-group to-groups))
11241
11242             (unless (memq article gnus-newsgroup-unreads)
11243               (gnus-info-set-read
11244                info (gnus-add-to-range (gnus-info-read info)
11245                                        (list (cdr art-group)))))
11246
11247             ;; Copy any marks over to the new group.
11248             (let ((marks gnus-article-mark-lists)
11249                   (to-article (cdr art-group)))
11250
11251               ;; See whether the article is to be put in the cache.
11252               (when gnus-use-cache
11253                 (gnus-cache-possibly-enter-article
11254                  to-group to-article
11255                  (let ((header (copy-sequence
11256                                 (gnus-summary-article-header article))))
11257                    (mail-header-set-number header to-article)
11258                    header)
11259                  (memq article gnus-newsgroup-marked)
11260                  (memq article gnus-newsgroup-dormant)
11261                  (memq article gnus-newsgroup-unreads)))
11262
11263               (while marks
11264                 (when (memq article (symbol-value
11265                                      (intern (format "gnus-newsgroup-%s"
11266                                                      (caar marks)))))
11267                   ;; If the other group is the same as this group,
11268                   ;; then we have to add the mark to the list.
11269                   (when (equal to-group gnus-newsgroup-name)
11270                     (set (intern (format "gnus-newsgroup-%s" (caar marks)))
11271                          (cons to-article
11272                                (symbol-value
11273                                 (intern (format "gnus-newsgroup-%s"
11274                                                 (caar marks)))))))
11275                   ;; Copy mark to other group.
11276                   (gnus-add-marked-articles
11277                    to-group (cdar marks) (list to-article) info))
11278                 (setq marks (cdr marks)))))
11279
11280           ;; Update the Xref header in this article to point to
11281           ;; the new crossposted article we have just created.
11282           (when (eq action 'crosspost)
11283             (save-excursion
11284               (set-buffer copy-buf)
11285               (gnus-request-article-this-buffer article gnus-newsgroup-name)
11286               (nnheader-replace-header
11287                "xref" (concat new-xref " " (gnus-group-prefixed-name
11288                                             (car art-group) to-method)
11289                               ":" (cdr art-group)))
11290               (gnus-request-replace-article
11291                article gnus-newsgroup-name (current-buffer)))))
11292
11293         (gnus-summary-goto-subject article)
11294         (when (eq action 'move)
11295           (gnus-summary-mark-article article gnus-canceled-mark)))
11296       (gnus-summary-remove-process-mark article))
11297     ;; Re-activate all groups that have been moved to.
11298     (while to-groups
11299       (gnus-activate-group (pop to-groups)))
11300     
11301     (gnus-kill-buffer copy-buf)
11302     (gnus-summary-position-point)
11303     (gnus-set-mode-line 'summary)))
11304
11305 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
11306   "Move the current article to a different newsgroup.
11307 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
11308 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
11309 re-spool using this method."
11310   (interactive "P")
11311   (gnus-summary-move-article n nil select-method 'copy))
11312
11313 (defun gnus-summary-crosspost-article (&optional n)
11314   "Crosspost the current article to some other group."
11315   (interactive "P")
11316   (gnus-summary-move-article n nil nil 'crosspost))
11317
11318 (defun gnus-summary-respool-article (&optional n respool-method)
11319   "Respool the current article.
11320 The article will be squeezed through the mail spooling process again,
11321 which means that it will be put in some mail newsgroup or other
11322 depending on `nnmail-split-methods'.
11323 If N is a positive number, respool the N next articles.
11324 If N is a negative number, respool the N previous articles.
11325 If N is nil and any articles have been marked with the process mark,
11326 respool those articles instead.
11327
11328 Respooling can be done both from mail groups and \"real\" newsgroups.
11329 In the former case, the articles in question will be moved from the
11330 current group into whatever groups they are destined to.  In the
11331 latter case, they will be copied into the relevant groups."
11332   (interactive "P")
11333   (gnus-set-global-variables)
11334   (let ((respool-methods (gnus-methods-using 'respool))
11335         (methname
11336          (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name)))))
11337     (unless respool-method
11338       (setq respool-method
11339             (completing-read
11340              "What method do you want to use when respooling? "
11341              respool-methods nil t (cons methname 0))))
11342     (unless (string= respool-method "")
11343       (if (assoc (symbol-name
11344                   (car (gnus-find-method-for-group gnus-newsgroup-name)))
11345                  respool-methods)
11346           (gnus-summary-move-article n nil (intern respool-method))
11347         (gnus-summary-copy-article n nil (intern respool-method))))))
11348
11349 (defun gnus-summary-import-article (file)
11350   "Import a random file into a mail newsgroup."
11351   (interactive "fImport file: ")
11352   (gnus-set-global-variables)
11353   (let ((group gnus-newsgroup-name)
11354         (now (current-time))
11355         atts lines)
11356     (or (gnus-check-backend-function 'request-accept-article group)
11357         (error "%s does not support article importing" group))
11358     (or (file-readable-p file)
11359         (not (file-regular-p file))
11360         (error "Can't read %s" file))
11361     (save-excursion
11362       (set-buffer (get-buffer-create " *import file*"))
11363       (buffer-disable-undo (current-buffer))
11364       (erase-buffer)
11365       (insert-file-contents file)
11366       (goto-char (point-min))
11367       (unless (nnheader-article-p)
11368         ;; This doesn't look like an article, so we fudge some headers.
11369         (setq atts (file-attributes file)
11370               lines (count-lines (point-min) (point-max)))
11371         (insert "From: " (read-string "From: ") "\n"
11372                 "Subject: " (read-string "Subject: ") "\n"
11373                 "Date: " (timezone-make-date-arpa-standard
11374                           (current-time-string (nth 5 atts))
11375                           (current-time-zone now)
11376                           (current-time-zone now)) "\n"
11377                 "Message-ID: " (gnus-inews-message-id) "\n"
11378                 "Lines: " (int-to-string lines) "\n"
11379                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
11380       (gnus-request-accept-article group t)
11381       (kill-buffer (current-buffer)))))
11382
11383 (defun gnus-summary-expire-articles ()
11384   "Expire all articles that are marked as expirable in the current group."
11385   (interactive)
11386   (gnus-set-global-variables)
11387   (when (gnus-check-backend-function
11388          'request-expire-articles gnus-newsgroup-name)
11389     ;; This backend supports expiry.
11390     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
11391            (expirable (if total
11392                           (gnus-list-of-read-articles gnus-newsgroup-name)
11393                         (setq gnus-newsgroup-expirable
11394                               (sort gnus-newsgroup-expirable '<))))
11395            (expiry-wait (gnus-group-get-parameter
11396                          gnus-newsgroup-name 'expiry-wait))
11397            es)
11398       (when expirable
11399         ;; There are expirable articles in this group, so we run them
11400         ;; through the expiry process.
11401         (gnus-message 6 "Expiring articles...")
11402         ;; The list of articles that weren't expired is returned.
11403         (if expiry-wait
11404             (let ((nnmail-expiry-wait-function nil)
11405                   (nnmail-expiry-wait expiry-wait))
11406               (setq es (gnus-request-expire-articles
11407                         expirable gnus-newsgroup-name)))
11408           (setq es (gnus-request-expire-articles
11409                     expirable gnus-newsgroup-name)))
11410         (or total (setq gnus-newsgroup-expirable es))
11411         ;; We go through the old list of expirable, and mark all
11412         ;; really expired articles as nonexistent.
11413         (unless (eq es expirable)       ;If nothing was expired, we don't mark.
11414           (let ((gnus-use-cache nil))
11415             (while expirable
11416               (unless (memq (car expirable) es)
11417                 (when (gnus-data-find (car expirable))
11418                   (gnus-summary-mark-article
11419                    (car expirable) gnus-canceled-mark)))
11420               (setq expirable (cdr expirable)))))
11421         (gnus-message 6 "Expiring articles...done")))))
11422
11423 (defun gnus-summary-expire-articles-now ()
11424   "Expunge all expirable articles in the current group.
11425 This means that *all* articles that are marked as expirable will be
11426 deleted forever, right now."
11427   (interactive)
11428   (gnus-set-global-variables)
11429   (or gnus-expert-user
11430       (gnus-y-or-n-p
11431        "Are you really, really, really sure you want to expunge? ")
11432       (error "Phew!"))
11433   (let ((nnmail-expiry-wait 'immediate)
11434         (nnmail-expiry-wait-function nil))
11435     (gnus-summary-expire-articles)))
11436
11437 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
11438 (defun gnus-summary-delete-article (&optional n)
11439   "Delete the N next (mail) articles.
11440 This command actually deletes articles.  This is not a marking
11441 command.  The article will disappear forever from your life, never to
11442 return.
11443 If N is negative, delete backwards.
11444 If N is nil and articles have been marked with the process mark,
11445 delete these instead."
11446   (interactive "P")
11447   (gnus-set-global-variables)
11448   (or (gnus-check-backend-function 'request-expire-articles
11449                                    gnus-newsgroup-name)
11450       (error "The current newsgroup does not support article deletion."))
11451   ;; Compute the list of articles to delete.
11452   (let ((articles (gnus-summary-work-articles n))
11453         not-deleted)
11454     (if (and gnus-novice-user
11455              (not (gnus-y-or-n-p
11456                    (format "Do you really want to delete %s forever? "
11457                            (if (> (length articles) 1) "these articles"
11458                              "this article")))))
11459         ()
11460       ;; Delete the articles.
11461       (setq not-deleted (gnus-request-expire-articles
11462                          articles gnus-newsgroup-name 'force))
11463       (while articles
11464         (gnus-summary-remove-process-mark (car articles))
11465         ;; The backend might not have been able to delete the article
11466         ;; after all.
11467         (or (memq (car articles) not-deleted)
11468             (gnus-summary-mark-article (car articles) gnus-canceled-mark))
11469         (setq articles (cdr articles))))
11470     (gnus-summary-position-point)
11471     (gnus-set-mode-line 'summary)
11472     not-deleted))
11473
11474 (defun gnus-summary-edit-article (&optional force)
11475   "Enter into a buffer and edit the current article.
11476 This will have permanent effect only in mail groups.
11477 If FORCE is non-nil, allow editing of articles even in read-only
11478 groups."
11479   (interactive "P")
11480   (save-excursion
11481     (set-buffer gnus-summary-buffer)
11482     (gnus-set-global-variables)
11483     (when (and (not force)
11484                (gnus-group-read-only-p))
11485       (error "The current newsgroup does not support article editing."))
11486     (gnus-summary-select-article t nil t)
11487     (gnus-configure-windows 'article)
11488     (select-window (get-buffer-window gnus-article-buffer))
11489     (gnus-message 6 "C-c C-c to end edits")
11490     (setq buffer-read-only nil)
11491     (text-mode)
11492     (use-local-map (copy-keymap (current-local-map)))
11493     (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
11494     (buffer-enable-undo)
11495     (widen)
11496     (goto-char (point-min))
11497     (search-forward "\n\n" nil t)))
11498
11499 (defun gnus-summary-edit-article-done ()
11500   "Make edits to the current article permanent."
11501   (interactive)
11502   (if (gnus-group-read-only-p)
11503       (progn
11504         (gnus-summary-edit-article-postpone)
11505         (gnus-message
11506          1 "The current newsgroup does not support article editing.")
11507         (ding))
11508     (let ((buf (format "%s" (buffer-string))))
11509       (erase-buffer)
11510       (insert buf)
11511       (if (not (gnus-request-replace-article
11512                 (cdr gnus-article-current) (car gnus-article-current)
11513                 (current-buffer)))
11514           (error "Couldn't replace article.")
11515         (gnus-article-mode)
11516         (use-local-map gnus-article-mode-map)
11517         (setq buffer-read-only t)
11518         (buffer-disable-undo (current-buffer))
11519         (gnus-configure-windows 'summary)
11520         (gnus-summary-update-article (cdr gnus-article-current))
11521         (when gnus-use-cache
11522           (gnus-cache-update-article 
11523            (cdr gnus-article-current) (car gnus-article-current))))
11524       (run-hooks 'gnus-article-display-hook)
11525       (and (gnus-visual-p 'summary-highlight 'highlight)
11526            (run-hooks 'gnus-visual-mark-article-hook)))))
11527
11528 (defun gnus-summary-edit-article-postpone ()
11529   "Postpone changes to the current article."
11530   (interactive)
11531   (gnus-article-mode)
11532   (use-local-map gnus-article-mode-map)
11533   (setq buffer-read-only t)
11534   (buffer-disable-undo (current-buffer))
11535   (gnus-configure-windows 'summary)
11536   (and (gnus-visual-p 'summary-highlight 'highlight)
11537        (run-hooks 'gnus-visual-mark-article-hook)))
11538
11539 (defun gnus-summary-respool-query ()
11540   "Query where the respool algorithm would put this article."
11541   (interactive)
11542   (gnus-set-global-variables)
11543   (gnus-summary-select-article)
11544   (save-excursion
11545     (set-buffer gnus-article-buffer)
11546     (save-restriction
11547       (goto-char (point-min))
11548       (search-forward "\n\n")
11549       (narrow-to-region (point-min) (point))
11550       (pp-eval-expression
11551        (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
11552
11553 ;; Summary score commands.
11554
11555 ;; Suggested by boubaker@cenatls.cena.dgac.fr.
11556
11557 (defun gnus-summary-raise-score (n)
11558   "Raise the score of the current article by N."
11559   (interactive "p")
11560   (gnus-set-global-variables)
11561   (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
11562
11563 (defun gnus-summary-set-score (n)
11564   "Set the score of the current article to N."
11565   (interactive "p")
11566   (gnus-set-global-variables)
11567   (save-excursion
11568     (gnus-summary-show-thread)
11569     (let ((buffer-read-only nil))
11570       ;; Set score.
11571       (gnus-summary-update-mark
11572        (if (= n (or gnus-summary-default-score 0)) ? 
11573          (if (< n (or gnus-summary-default-score 0))
11574              gnus-score-below-mark gnus-score-over-mark)) 'score))
11575     (let* ((article (gnus-summary-article-number))
11576            (score (assq article gnus-newsgroup-scored)))
11577       (if score (setcdr score n)
11578         (setq gnus-newsgroup-scored
11579               (cons (cons article n) gnus-newsgroup-scored))))
11580     (gnus-summary-update-line)))
11581
11582 (defun gnus-summary-current-score ()
11583   "Return the score of the current article."
11584   (interactive)
11585   (gnus-set-global-variables)
11586   (message "%s" (gnus-summary-article-score)))
11587
11588 ;; Summary marking commands.
11589
11590 (defun gnus-summary-kill-same-subject-and-select (&optional unmark)
11591   "Mark articles which has the same subject as read, and then select the next.
11592 If UNMARK is positive, remove any kind of mark.
11593 If UNMARK is negative, tick articles."
11594   (interactive "P")
11595   (gnus-set-global-variables)
11596   (if unmark
11597       (setq unmark (prefix-numeric-value unmark)))
11598   (let ((count
11599          (gnus-summary-mark-same-subject
11600           (gnus-summary-article-subject) unmark)))
11601     ;; Select next unread article.  If auto-select-same mode, should
11602     ;; select the first unread article.
11603     (gnus-summary-next-article t (and gnus-auto-select-same
11604                                       (gnus-summary-article-subject)))
11605     (gnus-message 7 "%d article%s marked as %s"
11606                   count (if (= count 1) " is" "s are")
11607                   (if unmark "unread" "read"))))
11608
11609 (defun gnus-summary-kill-same-subject (&optional unmark)
11610   "Mark articles which has the same subject as read.
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     ;; If marked as read, go to next unread subject.
11621     (if (null unmark)
11622         ;; Go to next unread subject.
11623         (gnus-summary-next-subject 1 t))
11624     (gnus-message 7 "%d articles are marked as %s"
11625                   count (if unmark "unread" "read"))))
11626
11627 (defun gnus-summary-mark-same-subject (subject &optional unmark)
11628   "Mark articles with same SUBJECT as read, and return marked number.
11629 If optional argument UNMARK is positive, remove any kinds of marks.
11630 If optional argument UNMARK is negative, mark articles as unread instead."
11631   (let ((count 1))
11632     (save-excursion
11633       (cond
11634        ((null unmark)                   ; Mark as read.
11635         (while (and
11636                 (progn
11637                   (gnus-summary-mark-article-as-read gnus-killed-mark)
11638                   (gnus-summary-show-thread) t)
11639                 (gnus-summary-find-subject subject))
11640           (setq count (1+ count))))
11641        ((> unmark 0)                    ; Tick.
11642         (while (and
11643                 (progn
11644                   (gnus-summary-mark-article-as-unread gnus-ticked-mark)
11645                   (gnus-summary-show-thread) t)
11646                 (gnus-summary-find-subject subject))
11647           (setq count (1+ count))))
11648        (t                               ; Mark as unread.
11649         (while (and
11650                 (progn
11651                   (gnus-summary-mark-article-as-unread gnus-unread-mark)
11652                   (gnus-summary-show-thread) t)
11653                 (gnus-summary-find-subject subject))
11654           (setq count (1+ count)))))
11655       (gnus-set-mode-line 'summary)
11656       ;; Return the number of marked articles.
11657       count)))
11658
11659 (defun gnus-summary-mark-as-processable (n &optional unmark)
11660   "Set the process mark on the next N articles.
11661 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
11662 the process mark instead.  The difference between N and the actual
11663 number of articles marked is returned."
11664   (interactive "p")
11665   (gnus-set-global-variables)
11666   (let ((backward (< n 0))
11667         (n (abs n)))
11668     (while (and
11669             (> n 0)
11670             (if unmark
11671                 (gnus-summary-remove-process-mark
11672                  (gnus-summary-article-number))
11673               (gnus-summary-set-process-mark (gnus-summary-article-number)))
11674             (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
11675       (setq n (1- n)))
11676     (if (/= 0 n) (gnus-message 7 "No more articles"))
11677     (gnus-summary-recenter)
11678     (gnus-summary-position-point)
11679     n))
11680
11681 (defun gnus-summary-unmark-as-processable (n)
11682   "Remove the process mark from the next N articles.
11683 If N is negative, mark backward instead.  The difference between N and
11684 the actual number of articles marked is returned."
11685   (interactive "p")
11686   (gnus-set-global-variables)
11687   (gnus-summary-mark-as-processable n t))
11688
11689 (defun gnus-summary-unmark-all-processable ()
11690   "Remove the process mark from all articles."
11691   (interactive)
11692   (gnus-set-global-variables)
11693   (save-excursion
11694     (while gnus-newsgroup-processable
11695       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
11696   (gnus-summary-position-point))
11697
11698 (defun gnus-summary-mark-as-expirable (n)
11699   "Mark N articles forward as expirable.
11700 If N is negative, mark backward instead.  The difference between N and
11701 the actual number of articles marked is returned."
11702   (interactive "p")
11703   (gnus-set-global-variables)
11704   (gnus-summary-mark-forward n gnus-expirable-mark))
11705
11706 (defun gnus-summary-mark-article-as-replied (article)
11707   "Mark ARTICLE replied and update the summary line."
11708   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
11709   (let ((buffer-read-only nil))
11710     (when (gnus-summary-goto-subject article)
11711       (gnus-summary-update-secondary-mark article))))
11712
11713 (defun gnus-summary-set-bookmark (article)
11714   "Set a bookmark in current article."
11715   (interactive (list (gnus-summary-article-number)))
11716   (gnus-set-global-variables)
11717   (if (or (not (get-buffer gnus-article-buffer))
11718           (not gnus-current-article)
11719           (not gnus-article-current)
11720           (not (equal gnus-newsgroup-name (car gnus-article-current))))
11721       (error "No current article selected"))
11722   ;; Remove old bookmark, if one exists.
11723   (let ((old (assq article gnus-newsgroup-bookmarks)))
11724     (if old (setq gnus-newsgroup-bookmarks
11725                   (delq old gnus-newsgroup-bookmarks))))
11726   ;; Set the new bookmark, which is on the form
11727   ;; (article-number . line-number-in-body).
11728   (setq gnus-newsgroup-bookmarks
11729         (cons
11730          (cons article
11731                (save-excursion
11732                  (set-buffer gnus-article-buffer)
11733                  (count-lines
11734                   (min (point)
11735                        (save-excursion
11736                          (goto-char (point-min))
11737                          (search-forward "\n\n" nil t)
11738                          (point)))
11739                   (point))))
11740          gnus-newsgroup-bookmarks))
11741   (gnus-message 6 "A bookmark has been added to the current article."))
11742
11743 (defun gnus-summary-remove-bookmark (article)
11744   "Remove the bookmark from the current article."
11745   (interactive (list (gnus-summary-article-number)))
11746   (gnus-set-global-variables)
11747   ;; Remove old bookmark, if one exists.
11748   (let ((old (assq article gnus-newsgroup-bookmarks)))
11749     (if old
11750         (progn
11751           (setq gnus-newsgroup-bookmarks
11752                 (delq old gnus-newsgroup-bookmarks))
11753           (gnus-message 6 "Removed bookmark."))
11754       (gnus-message 6 "No bookmark in current article."))))
11755
11756 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
11757 (defun gnus-summary-mark-as-dormant (n)
11758   "Mark N articles forward as dormant.
11759 If N is negative, mark backward instead.  The difference between N and
11760 the actual number of articles marked is returned."
11761   (interactive "p")
11762   (gnus-set-global-variables)
11763   (gnus-summary-mark-forward n gnus-dormant-mark))
11764
11765 (defun gnus-summary-set-process-mark (article)
11766   "Set the process mark on ARTICLE and update the summary line."
11767   (setq gnus-newsgroup-processable
11768         (cons article
11769               (delq article gnus-newsgroup-processable)))
11770   (when (gnus-summary-goto-subject article)
11771     (gnus-summary-show-thread)
11772     (gnus-summary-update-secondary-mark article)))
11773
11774 (defun gnus-summary-remove-process-mark (article)
11775   "Remove the process mark from ARTICLE and update the summary line."
11776   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
11777   (when (gnus-summary-goto-subject article)
11778     (gnus-summary-show-thread)
11779     (gnus-summary-update-secondary-mark article)))
11780
11781 (defun gnus-summary-set-saved-mark (article)
11782   "Set the process mark on ARTICLE and update the summary line."
11783   (push article gnus-newsgroup-saved)
11784   (when (gnus-summary-goto-subject article)
11785     (gnus-summary-update-secondary-mark article)))
11786
11787 (defun gnus-summary-mark-forward (n &optional mark no-expire)
11788   "Mark N articles as read forwards.
11789 If N is negative, mark backwards instead.
11790 Mark with MARK.  If MARK is ? , ?! or ??, articles will be
11791 marked as unread.
11792 The difference between N and the actual number of articles marked is
11793 returned."
11794   (interactive "p")
11795   (gnus-set-global-variables)
11796   (let ((backward (< n 0))
11797         (gnus-summary-goto-unread
11798          (and gnus-summary-goto-unread
11799               (not (eq gnus-summary-goto-unread 'never))
11800               (not (memq mark (list gnus-unread-mark
11801                                     gnus-ticked-mark gnus-dormant-mark)))))
11802         (n (abs n))
11803         (mark (or mark gnus-del-mark)))
11804     (while (and (> n 0)
11805                 (gnus-summary-mark-article nil mark no-expire)
11806                 (zerop (gnus-summary-next-subject
11807                         (if backward -1 1)
11808                         (and gnus-summary-goto-unread
11809                              (not (eq gnus-summary-goto-unread 'never)))
11810                         t)))
11811       (setq n (1- n)))
11812     (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
11813     (gnus-summary-recenter)
11814     (gnus-summary-position-point)
11815     (gnus-set-mode-line 'summary)
11816     n))
11817
11818 (defun gnus-summary-mark-article-as-read (mark)
11819   "Mark the current article quickly as read with MARK."
11820   (let ((article (gnus-summary-article-number)))
11821     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11822     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11823     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11824     (setq gnus-newsgroup-reads
11825           (cons (cons article mark) gnus-newsgroup-reads))
11826     ;; Possibly remove from cache, if that is used.
11827     (and gnus-use-cache (gnus-cache-enter-remove-article article))
11828     ;; Allow the backend to change the mark.
11829     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
11830     ;; Check for auto-expiry.
11831     (when (and gnus-newsgroup-auto-expire
11832                (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
11833                    (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
11834                    (= mark gnus-ancient-mark)
11835                    (= mark gnus-read-mark) (= mark gnus-souped-mark)))
11836       (setq mark gnus-expirable-mark)
11837       (push article gnus-newsgroup-expirable))
11838     ;; Set the mark in the buffer.
11839     (gnus-summary-update-mark mark 'unread)
11840     t))
11841
11842 (defun gnus-summary-mark-article-as-unread (mark)
11843   "Mark the current article quickly as unread with MARK."
11844   (let ((article (gnus-summary-article-number)))
11845     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11846     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11847     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
11848     (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
11849     (cond ((= mark gnus-ticked-mark)
11850            (push article gnus-newsgroup-marked))
11851           ((= mark gnus-dormant-mark)
11852            (push article gnus-newsgroup-dormant))
11853           (t
11854            (push article gnus-newsgroup-unreads)))
11855     (setq gnus-newsgroup-reads
11856           (delq (assq article gnus-newsgroup-reads)
11857                 gnus-newsgroup-reads))
11858
11859     ;; See whether the article is to be put in the cache.
11860     (and gnus-use-cache
11861          (vectorp (gnus-summary-article-header article))
11862          (save-excursion
11863            (gnus-cache-possibly-enter-article
11864             gnus-newsgroup-name article
11865             (gnus-summary-article-header article)
11866             (= mark gnus-ticked-mark)
11867             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
11868
11869     ;; Fix the mark.
11870     (gnus-summary-update-mark mark 'unread)
11871     t))
11872
11873 (defun gnus-summary-mark-article (&optional article mark no-expire)
11874   "Mark ARTICLE with MARK.  MARK can be any character.
11875 Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
11876 `??' (dormant) and `?E' (expirable).
11877 If MARK is nil, then the default character `?D' is used.
11878 If ARTICLE is nil, then the article on the current line will be
11879 marked."
11880   ;; The mark might be a string.
11881   (and (stringp mark)
11882        (setq mark (aref mark 0)))
11883   ;; If no mark is given, then we check auto-expiring.
11884   (and (not no-expire)
11885        gnus-newsgroup-auto-expire
11886        (or (not mark)
11887            (and (numberp mark)
11888                 (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
11889                     (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
11890                     (= mark gnus-read-mark) (= mark gnus-souped-mark))))
11891        (setq mark gnus-expirable-mark))
11892   (let* ((mark (or mark gnus-del-mark))
11893          (article (or article (gnus-summary-article-number))))
11894     (or article (error "No article on current line"))
11895     (if (or (= mark gnus-unread-mark)
11896             (= mark gnus-ticked-mark)
11897             (= mark gnus-dormant-mark))
11898         (gnus-mark-article-as-unread article mark)
11899       (gnus-mark-article-as-read article mark))
11900
11901     ;; See whether the article is to be put in the cache.
11902     (and gnus-use-cache
11903          (not (= mark gnus-canceled-mark))
11904          (vectorp (gnus-summary-article-header article))
11905          (save-excursion
11906            (gnus-cache-possibly-enter-article
11907             gnus-newsgroup-name article
11908             (gnus-summary-article-header article)
11909             (= mark gnus-ticked-mark)
11910             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
11911
11912     (if (gnus-summary-goto-subject article nil t)
11913         (let ((buffer-read-only nil))
11914           (gnus-summary-show-thread)
11915           ;; Fix the mark.
11916           (gnus-summary-update-mark mark 'unread)
11917           t))))
11918
11919 (defun gnus-summary-update-secondary-mark (article)
11920   "Update the secondary (read, process, cache) mark."
11921   (gnus-summary-update-mark
11922    (cond ((memq article gnus-newsgroup-processable)
11923           gnus-process-mark)
11924          ((memq article gnus-newsgroup-cached)
11925           gnus-cached-mark)
11926          ((memq article gnus-newsgroup-replied)
11927           gnus-replied-mark)
11928          ((memq article gnus-newsgroup-saved)
11929           gnus-saved-mark)
11930          (t gnus-unread-mark))
11931    'replied)
11932   (when (gnus-visual-p 'summary-highlight 'highlight)
11933     (run-hooks 'gnus-summary-update-hook))
11934   t)
11935
11936 (defun gnus-summary-update-mark (mark type)
11937   (beginning-of-line)
11938   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
11939         (buffer-read-only nil))
11940     (when forward
11941       ;; Go to the right position on the line.
11942       (forward-char forward)
11943       ;; Replace the old mark with the new mark.
11944       (subst-char-in-region (point) (1+ (point)) (following-char) mark)
11945       ;; Optionally update the marks by some user rule.
11946       (when (eq type 'unread)
11947         (gnus-data-set-mark
11948          (gnus-data-find (gnus-summary-article-number)) mark)
11949         (gnus-summary-update-line (eq mark gnus-unread-mark))))))
11950
11951 (defun gnus-mark-article-as-read (article &optional mark)
11952   "Enter ARTICLE in the pertinent lists and remove it from others."
11953   ;; Make the article expirable.
11954   (let ((mark (or mark gnus-del-mark)))
11955     (if (= mark gnus-expirable-mark)
11956         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
11957       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
11958     ;; Remove from unread and marked lists.
11959     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11960     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11961     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11962     (push (cons article mark) gnus-newsgroup-reads)
11963     ;; Possibly remove from cache, if that is used.
11964     (when gnus-use-cache
11965       (gnus-cache-enter-remove-article article))))
11966
11967 (defun gnus-mark-article-as-unread (article &optional mark)
11968   "Enter ARTICLE in the pertinent lists and remove it from others."
11969   (let ((mark (or mark gnus-ticked-mark)))
11970     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11971     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11972     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
11973     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11974     (cond ((= mark gnus-ticked-mark)
11975            (push article gnus-newsgroup-marked))
11976           ((= mark gnus-dormant-mark)
11977            (push article gnus-newsgroup-dormant))
11978           (t
11979            (push article gnus-newsgroup-unreads)))
11980     (setq gnus-newsgroup-reads
11981           (delq (assq article gnus-newsgroup-reads)
11982                 gnus-newsgroup-reads))))
11983
11984 (defalias 'gnus-summary-mark-as-unread-forward
11985   'gnus-summary-tick-article-forward)
11986 (make-obsolete 'gnus-summary-mark-as-unread-forward
11987                'gnus-summary-tick-article-forward)
11988 (defun gnus-summary-tick-article-forward (n)
11989   "Tick N articles forwards.
11990 If N is negative, tick backwards instead.
11991 The difference between N and the number of articles ticked is returned."
11992   (interactive "p")
11993   (gnus-summary-mark-forward n gnus-ticked-mark))
11994
11995 (defalias 'gnus-summary-mark-as-unread-backward
11996   'gnus-summary-tick-article-backward)
11997 (make-obsolete 'gnus-summary-mark-as-unread-backward
11998                'gnus-summary-tick-article-backward)
11999 (defun gnus-summary-tick-article-backward (n)
12000   "Tick N articles backwards.
12001 The difference between N and the number of articles ticked is returned."
12002   (interactive "p")
12003   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
12004
12005 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
12006 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
12007 (defun gnus-summary-tick-article (&optional article clear-mark)
12008   "Mark current article as unread.
12009 Optional 1st argument ARTICLE specifies article number to be marked as unread.
12010 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
12011   (interactive)
12012   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
12013                                        gnus-ticked-mark)))
12014
12015 (defun gnus-summary-mark-as-read-forward (n)
12016   "Mark N articles as read forwards.
12017 If N is negative, mark backwards instead.
12018 The difference between N and the actual number of articles marked is
12019 returned."
12020   (interactive "p")
12021   (gnus-summary-mark-forward n gnus-del-mark t))
12022
12023 (defun gnus-summary-mark-as-read-backward (n)
12024   "Mark the N articles as read backwards.
12025 The difference between N and the actual number of articles marked is
12026 returned."
12027   (interactive "p")
12028   (gnus-summary-mark-forward (- n) gnus-del-mark t))
12029
12030 (defun gnus-summary-mark-as-read (&optional article mark)
12031   "Mark current article as read.
12032 ARTICLE specifies the article to be marked as read.
12033 MARK specifies a string to be inserted at the beginning of the line."
12034   (gnus-summary-mark-article article mark))
12035
12036 (defun gnus-summary-clear-mark-forward (n)
12037   "Clear marks from N articles forward.
12038 If N is negative, clear backward instead.
12039 The difference between N and the number of marks cleared is returned."
12040   (interactive "p")
12041   (gnus-summary-mark-forward n gnus-unread-mark))
12042
12043 (defun gnus-summary-clear-mark-backward (n)
12044   "Clear marks from N articles backward.
12045 The difference between N and the number of marks cleared is returned."
12046   (interactive "p")
12047   (gnus-summary-mark-forward (- n) gnus-unread-mark))
12048
12049 (defun gnus-summary-mark-unread-as-read ()
12050   "Intended to be used by `gnus-summary-mark-article-hook'."
12051   (when (memq gnus-current-article gnus-newsgroup-unreads)
12052     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
12053
12054 (defun gnus-summary-mark-read-and-unread-as-read ()
12055   "Intended to be used by `gnus-summary-mark-article-hook'."
12056   (let ((mark (gnus-summary-article-mark)))
12057     (when (or (gnus-unread-mark-p mark)
12058               (gnus-read-mark-p mark))
12059       (gnus-summary-mark-article gnus-current-article gnus-read-mark))))
12060
12061 (defun gnus-summary-mark-region-as-read (point mark all)
12062   "Mark all unread articles between point and mark as read.
12063 If given a prefix, mark all articles between point and mark as read,
12064 even ticked and dormant ones."
12065   (interactive "r\nP")
12066   (save-excursion
12067     (let (article)
12068       (goto-char point)
12069       (beginning-of-line)
12070       (while (and
12071               (< (point) mark)
12072               (progn
12073                 (when (or all
12074                           (memq (setq article (gnus-summary-article-number))
12075                                 gnus-newsgroup-unreads))
12076                   (gnus-summary-mark-article article gnus-del-mark))
12077                 t)
12078               (gnus-summary-find-next))))))
12079
12080 (defun gnus-summary-mark-below (score mark)
12081   "Mark articles with score less than SCORE with MARK."
12082   (interactive "P\ncMark: ")
12083   (gnus-set-global-variables)
12084   (setq score (if score
12085                   (prefix-numeric-value score)
12086                 (or gnus-summary-default-score 0)))
12087   (save-excursion
12088     (set-buffer gnus-summary-buffer)
12089     (goto-char (point-min))
12090     (while 
12091         (progn
12092           (and (< (gnus-summary-article-score) score)
12093                (gnus-summary-mark-article nil mark))
12094           (gnus-summary-find-next)))))
12095
12096 (defun gnus-summary-kill-below (&optional score)
12097   "Mark articles with score below SCORE as read."
12098   (interactive "P")
12099   (gnus-set-global-variables)
12100   (gnus-summary-mark-below score gnus-killed-mark))
12101
12102 (defun gnus-summary-clear-above (&optional score)
12103   "Clear all marks from articles with score above SCORE."
12104   (interactive "P")
12105   (gnus-set-global-variables)
12106   (gnus-summary-mark-above score gnus-unread-mark))
12107
12108 (defun gnus-summary-tick-above (&optional score)
12109   "Tick all articles with score above SCORE."
12110   (interactive "P")
12111   (gnus-set-global-variables)
12112   (gnus-summary-mark-above score gnus-ticked-mark))
12113
12114 (defun gnus-summary-mark-above (score mark)
12115   "Mark articles with score over SCORE with MARK."
12116   (interactive "P\ncMark: ")
12117   (gnus-set-global-variables)
12118   (setq score (if score
12119                   (prefix-numeric-value score)
12120                 (or gnus-summary-default-score 0)))
12121   (save-excursion
12122     (set-buffer gnus-summary-buffer)
12123     (goto-char (point-min))
12124     (while (and (progn
12125                   (if (> (gnus-summary-article-score) score)
12126                       (gnus-summary-mark-article nil mark))
12127                   t)
12128                 (gnus-summary-find-next)))))
12129
12130 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
12131 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
12132 (defun gnus-summary-limit-include-expunged ()
12133   "Display all the hidden articles that were expunged for low scores."
12134   (interactive)
12135   (gnus-set-global-variables)
12136   (let ((buffer-read-only nil))
12137     (let ((scored gnus-newsgroup-scored)
12138           headers h)
12139       (while scored
12140         (or (gnus-summary-goto-subject (caar scored))
12141             (and (setq h (gnus-summary-article-header (caar scored)))
12142                  (< (cdar scored) gnus-summary-expunge-below)
12143                  (setq headers (cons h headers))))
12144         (setq scored (cdr scored)))
12145       (or headers (error "No expunged articles hidden."))
12146       (goto-char (point-min))
12147       (gnus-summary-prepare-unthreaded (nreverse headers)))
12148     (goto-char (point-min))
12149     (gnus-summary-position-point)))
12150
12151 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
12152   "Mark all articles not marked as unread in this newsgroup as read.
12153 If prefix argument ALL is non-nil, all articles are marked as read.
12154 If QUIETLY is non-nil, no questions will be asked.
12155 If TO-HERE is non-nil, it should be a point in the buffer.  All
12156 articles before this point will be marked as read.
12157 The number of articles marked as read is returned."
12158   (interactive "P")
12159   (gnus-set-global-variables)
12160   (prog1
12161       (if (or quietly
12162               (not gnus-interactive-catchup) ;Without confirmation?
12163               gnus-expert-user
12164               (gnus-y-or-n-p
12165                (if all
12166                    "Mark absolutely all articles as read? "
12167                  "Mark all unread articles as read? ")))
12168           (if (and not-mark
12169                    (not gnus-newsgroup-adaptive)
12170                    (not gnus-newsgroup-auto-expire))
12171               (progn
12172                 (when all
12173                   (setq gnus-newsgroup-marked nil
12174                         gnus-newsgroup-dormant nil))
12175                 (setq gnus-newsgroup-unreads nil))
12176             ;; We actually mark all articles as canceled, which we
12177             ;; have to do when using auto-expiry or adaptive scoring.
12178             (gnus-summary-show-all-threads)
12179             (if (gnus-summary-first-subject (not all))
12180                 (while (and
12181                         (if to-here (< (point) to-here) t)
12182                         (gnus-summary-mark-article-as-read gnus-catchup-mark)
12183                         (gnus-summary-find-next (not all)))))
12184             (unless to-here
12185               (setq gnus-newsgroup-unreads nil))
12186             (gnus-set-mode-line 'summary)))
12187     (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
12188       (if (and (not to-here) (eq 'nnvirtual (car method)))
12189           (nnvirtual-catchup-group
12190            (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
12191     (gnus-summary-position-point)))
12192
12193 (defun gnus-summary-catchup-to-here (&optional all)
12194   "Mark all unticked articles before the current one as read.
12195 If ALL is non-nil, also mark ticked and dormant articles as read."
12196   (interactive "P")
12197   (gnus-set-global-variables)
12198   (save-excursion
12199     (let ((beg (point)))
12200       ;; We check that there are unread articles.
12201       (when (or all (gnus-summary-find-prev))
12202         (gnus-summary-catchup all t beg))))
12203   (gnus-summary-position-point))
12204
12205 (defun gnus-summary-catchup-all (&optional quietly)
12206   "Mark all articles in this newsgroup as read."
12207   (interactive "P")
12208   (gnus-set-global-variables)
12209   (gnus-summary-catchup t quietly))
12210
12211 (defun gnus-summary-catchup-and-exit (&optional all quietly)
12212   "Mark all articles not marked as unread in this newsgroup as read, then exit.
12213 If prefix argument ALL is non-nil, all articles are marked as read."
12214   (interactive "P")
12215   (gnus-set-global-variables)
12216   (gnus-summary-catchup all quietly nil 'fast)
12217   ;; Select next newsgroup or exit.
12218   (if (eq gnus-auto-select-next 'quietly)
12219       (gnus-summary-next-group nil)
12220     (gnus-summary-exit)))
12221
12222 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
12223   "Mark all articles in this newsgroup as read, and then exit."
12224   (interactive "P")
12225   (gnus-set-global-variables)
12226   (gnus-summary-catchup-and-exit t quietly))
12227
12228 ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
12229 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
12230   "Mark all articles in this group as read and select the next group.
12231 If given a prefix, mark all articles, unread as well as ticked, as
12232 read."
12233   (interactive "P")
12234   (gnus-set-global-variables)
12235   (save-excursion
12236     (gnus-summary-catchup all))
12237   (gnus-summary-next-article t nil nil t))
12238
12239 ;; Thread-based commands.
12240
12241 (defun gnus-summary-articles-in-thread (&optional article)
12242   "Return a list of all articles in the current thread.
12243 If ARTICLE is non-nil, return all articles in the thread that starts
12244 with that article."
12245   (let* ((article (or article (gnus-summary-article-number)))
12246          (data (gnus-data-find-list article))
12247          (top-level (gnus-data-level (car data)))
12248          (top-subject
12249           (cond ((null gnus-thread-operation-ignore-subject)
12250                  (gnus-simplify-subject-re
12251                   (mail-header-subject (gnus-data-header (car data)))))
12252                 ((eq gnus-thread-operation-ignore-subject 'fuzzy)
12253                  (gnus-simplify-subject-fuzzy
12254                   (mail-header-subject (gnus-data-header (car data)))))
12255                 (t nil)))
12256          articles)
12257     (if (not data)
12258         ()                              ; This article doesn't exist.
12259       (while data
12260         (and (or (not top-subject)
12261                  (string= top-subject
12262                           (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
12263                               (gnus-simplify-subject-fuzzy
12264                                (mail-header-subject
12265                                 (gnus-data-header (car data))))
12266                             (gnus-simplify-subject-re
12267                              (mail-header-subject
12268                               (gnus-data-header (car data)))))))
12269              (setq articles (cons (gnus-data-number (car data)) articles)))
12270         (if (and (setq data (cdr data))
12271                  (> (gnus-data-level (car data)) top-level))
12272             ()
12273           (setq data nil)))
12274       ;; Return the list of articles.
12275       (nreverse articles))))
12276
12277 (defun gnus-summary-rethread-current ()
12278   "Rethread the thread the current article is part of."
12279   (interactive)
12280   (gnus-set-global-variables)
12281   (let* ((gnus-show-threads t)
12282          (article (gnus-summary-article-number))
12283          (id (mail-header-id (gnus-summary-article-header)))
12284          (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id)))))
12285     (unless id
12286       (error "No article on the current line"))
12287     (gnus-rebuild-thread id)
12288     (gnus-summary-goto-subject article)))
12289
12290 (defun gnus-summary-reparent-thread ()
12291   "Make current article child of the marked (or previous) article.
12292
12293 Note that the re-threading will only work if `gnus-thread-ignore-subject'
12294 is non-nil or the Subject: of both articles are the same."
12295   (interactive)
12296   (or (not (gnus-group-read-only-p))
12297       (error "The current newsgroup does not support article editing."))
12298   (or (<= (length gnus-newsgroup-processable) 1)
12299       (error "No more than one article may be marked."))
12300   (save-window-excursion
12301     (let ((gnus-article-buffer " *reparent*")
12302           (current-article (gnus-summary-article-number))
12303           ; first grab the marked article, otherwise one line up.
12304           (parent-article (if (not (null gnus-newsgroup-processable))
12305                               (car gnus-newsgroup-processable)
12306                             (save-excursion
12307                               (if (eq (forward-line -1) 0)
12308                                   (gnus-summary-article-number)
12309                                 (error "Beginning of summary buffer."))))))
12310       (or (not (eq current-article parent-article))
12311           (error "An article may not be self-referential."))
12312       (let ((message-id (mail-header-id 
12313                          (gnus-summary-article-header parent-article))))
12314         (or (and message-id (not (equal message-id "")))
12315             (error "No message-id in desired parent."))
12316         (gnus-summary-select-article t t nil current-article)
12317         (set-buffer gnus-article-buffer)
12318         (setq buffer-read-only nil)
12319         (let ((buf (format "%s" (buffer-string))))
12320           (erase-buffer)
12321           (insert buf))
12322         (goto-char (point-min))
12323         (if (search-forward-regexp "^References: " nil t)
12324             (insert message-id " " )
12325           (insert "References: " message-id "\n"))
12326         (or (gnus-request-replace-article current-article
12327                                           (car gnus-article-current)
12328                                           gnus-article-buffer)
12329             (error "Couldn't replace article."))
12330         (set-buffer gnus-summary-buffer)
12331         (gnus-summary-unmark-all-processable)
12332         (gnus-summary-rethread-current)
12333         (message "Article %d is now the child of article %d."
12334                  current-article parent-article)))))
12335
12336 (defun gnus-summary-toggle-threads (&optional arg)
12337   "Toggle showing conversation threads.
12338 If ARG is positive number, turn showing conversation threads on."
12339   (interactive "P")
12340   (gnus-set-global-variables)
12341   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
12342     (setq gnus-show-threads
12343           (if (null arg) (not gnus-show-threads)
12344             (> (prefix-numeric-value arg) 0)))
12345     (gnus-summary-prepare)
12346     (gnus-summary-goto-subject current)
12347     (gnus-summary-position-point)))
12348
12349 (defun gnus-summary-show-all-threads ()
12350   "Show all threads."
12351   (interactive)
12352   (gnus-set-global-variables)
12353   (save-excursion
12354     (let ((buffer-read-only nil))
12355       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
12356   (gnus-summary-position-point))
12357
12358 (defun gnus-summary-show-thread ()
12359   "Show thread subtrees.
12360 Returns nil if no thread was there to be shown."
12361   (interactive)
12362   (gnus-set-global-variables)
12363   (let ((buffer-read-only nil)
12364         (orig (point))
12365         ;; first goto end then to beg, to have point at beg after let
12366         (end (progn (end-of-line) (point)))
12367         (beg (progn (beginning-of-line) (point))))
12368     (prog1
12369         ;; Any hidden lines here?
12370         (search-forward "\r" end t)
12371       (subst-char-in-region beg end ?\^M ?\n t)
12372       (goto-char orig)
12373       (gnus-summary-position-point))))
12374
12375 (defun gnus-summary-hide-all-threads ()
12376   "Hide all thread subtrees."
12377   (interactive)
12378   (gnus-set-global-variables)
12379   (save-excursion
12380     (goto-char (point-min))
12381     (gnus-summary-hide-thread)
12382     (while (zerop (gnus-summary-next-thread 1 t))
12383       (gnus-summary-hide-thread)))
12384   (gnus-summary-position-point))
12385
12386 (defun gnus-summary-hide-thread ()
12387   "Hide thread subtrees.
12388 Returns nil if no threads were there to be hidden."
12389   (interactive)
12390   (gnus-set-global-variables)
12391   (let ((buffer-read-only nil)
12392         (start (point))
12393         (article (gnus-summary-article-number)))
12394     (goto-char start)
12395     ;; Go forward until either the buffer ends or the subthread
12396     ;; ends.
12397     (when (and (not (eobp))
12398                (or (zerop (gnus-summary-next-thread 1 t))
12399                    (goto-char (point-max))))
12400       (prog1
12401           (if (and (> (point) start)
12402                    (search-backward "\n" start t))
12403               (progn
12404                 (subst-char-in-region start (point) ?\n ?\^M)
12405                 (gnus-summary-goto-subject article))
12406             (goto-char start)
12407             nil)
12408         ;;(gnus-summary-position-point)
12409         ))))
12410
12411 (defun gnus-summary-go-to-next-thread (&optional previous)
12412   "Go to the same level (or less) next thread.
12413 If PREVIOUS is non-nil, go to previous thread instead.
12414 Return the article number moved to, or nil if moving was impossible."
12415   (let ((level (gnus-summary-thread-level))
12416         (way (if previous -1 1))
12417         (beg (point)))
12418     (forward-line way)
12419     (while (and (not (eobp))
12420                 (< level (gnus-summary-thread-level)))
12421       (forward-line way))
12422     (if (eobp)
12423         (progn
12424           (goto-char beg)
12425           nil)
12426       (setq beg (point))
12427       (prog1
12428           (gnus-summary-article-number)
12429         (goto-char beg)))))
12430
12431 (defun gnus-summary-go-to-next-thread-old (&optional previous)
12432   "Go to the same level (or less) next thread.
12433 If PREVIOUS is non-nil, go to previous thread instead.
12434 Return the article number moved to, or nil if moving was impossible."
12435   (if (and (eq gnus-summary-make-false-root 'dummy)
12436            (gnus-summary-article-intangible-p))
12437       (let ((beg (point)))
12438         (while (and (zerop (forward-line 1))
12439                     (not (gnus-summary-article-intangible-p))
12440                     (not (zerop (save-excursion 
12441                                   (gnus-summary-thread-level))))))
12442         (if (eobp)
12443             (progn
12444               (goto-char beg)
12445               nil)
12446           (point)))
12447     (let* ((level (gnus-summary-thread-level))
12448            (article (gnus-summary-article-number))
12449            (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
12450            oart)
12451       (while data
12452         (if (<= (gnus-data-level (car data)) level)
12453             (setq oart (gnus-data-number (car data))
12454                   data nil)
12455           (setq data (cdr data))))
12456       (and oart
12457            (gnus-summary-goto-subject oart)))))
12458
12459 (defun gnus-summary-next-thread (n &optional silent)
12460   "Go to the same level next N'th thread.
12461 If N is negative, search backward instead.
12462 Returns the difference between N and the number of skips actually
12463 done.
12464
12465 If SILENT, don't output messages."
12466   (interactive "p")
12467   (gnus-set-global-variables)
12468   (let ((backward (< n 0))
12469         (n (abs n))
12470         old dum int)
12471     (while (and (> n 0)
12472                 (gnus-summary-go-to-next-thread backward))
12473       (decf n))
12474     (unless silent 
12475       (gnus-summary-position-point))
12476     (when (and (not silent) (/= 0 n))
12477       (gnus-message 7 "No more threads"))
12478     n))
12479
12480 (defun gnus-summary-prev-thread (n)
12481   "Go to the same level previous N'th thread.
12482 Returns the difference between N and the number of skips actually
12483 done."
12484   (interactive "p")
12485   (gnus-set-global-variables)
12486   (gnus-summary-next-thread (- n)))
12487
12488 (defun gnus-summary-go-down-thread ()
12489   "Go down one level in the current thread."
12490   (let ((children (gnus-summary-article-children)))
12491     (and children
12492          (gnus-summary-goto-subject (car children)))))
12493
12494 (defun gnus-summary-go-up-thread ()
12495   "Go up one level in the current thread."
12496   (let ((parent (gnus-summary-article-parent)))
12497     (and parent
12498          (gnus-summary-goto-subject parent))))
12499
12500 (defun gnus-summary-down-thread (n)
12501   "Go down thread N steps.
12502 If N is negative, go up instead.
12503 Returns the difference between N and how many steps down that were
12504 taken."
12505   (interactive "p")
12506   (gnus-set-global-variables)
12507   (let ((up (< n 0))
12508         (n (abs n)))
12509     (while (and (> n 0)
12510                 (if up (gnus-summary-go-up-thread)
12511                   (gnus-summary-go-down-thread)))
12512       (setq n (1- n)))
12513     (gnus-summary-position-point)
12514     (if (/= 0 n) (gnus-message 7 "Can't go further"))
12515     n))
12516
12517 (defun gnus-summary-up-thread (n)
12518   "Go up thread N steps.
12519 If N is negative, go up instead.
12520 Returns the difference between N and how many steps down that were
12521 taken."
12522   (interactive "p")
12523   (gnus-set-global-variables)
12524   (gnus-summary-down-thread (- n)))
12525
12526 (defun gnus-summary-top-thread ()
12527   "Go to the top of the thread."
12528   (interactive)
12529   (gnus-set-global-variables)
12530   (while (gnus-summary-go-up-thread))
12531   (gnus-summary-article-number))
12532
12533 (defun gnus-summary-kill-thread (&optional unmark)
12534   "Mark articles under current thread as read.
12535 If the prefix argument is positive, remove any kinds of marks.
12536 If the prefix argument is negative, tick articles instead."
12537   (interactive "P")
12538   (gnus-set-global-variables)
12539   (if unmark
12540       (setq unmark (prefix-numeric-value unmark)))
12541   (let ((articles (gnus-summary-articles-in-thread)))
12542     (save-excursion
12543       ;; Expand the thread.
12544       (gnus-summary-show-thread)
12545       ;; Mark all the articles.
12546       (while articles
12547         (gnus-summary-goto-subject (car articles))
12548         (cond ((null unmark)
12549                (gnus-summary-mark-article-as-read gnus-killed-mark))
12550               ((> unmark 0)
12551                (gnus-summary-mark-article-as-unread gnus-unread-mark))
12552               (t
12553                (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
12554         (setq articles (cdr articles))))
12555     ;; Hide killed subtrees.
12556     (and (null unmark)
12557          gnus-thread-hide-killed
12558          (gnus-summary-hide-thread))
12559     ;; If marked as read, go to next unread subject.
12560     (if (null unmark)
12561         ;; Go to next unread subject.
12562         (gnus-summary-next-subject 1 t)))
12563   (gnus-set-mode-line 'summary))
12564
12565 ;; Summary sorting commands
12566
12567 (defun gnus-summary-sort-by-number (&optional reverse)
12568   "Sort summary buffer by article number.
12569 Argument REVERSE means reverse order."
12570   (interactive "P")
12571   (gnus-summary-sort 'number reverse))
12572
12573 (defun gnus-summary-sort-by-author (&optional reverse)
12574   "Sort summary buffer by author name alphabetically.
12575 If case-fold-search is non-nil, case of letters is ignored.
12576 Argument REVERSE means reverse order."
12577   (interactive "P")
12578   (gnus-summary-sort 'author reverse))
12579
12580 (defun gnus-summary-sort-by-subject (&optional reverse)
12581   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
12582 If case-fold-search is non-nil, case of letters is ignored.
12583 Argument REVERSE means reverse order."
12584   (interactive "P")
12585   (gnus-summary-sort 'subject reverse))
12586
12587 (defun gnus-summary-sort-by-date (&optional reverse)
12588   "Sort summary buffer by date.
12589 Argument REVERSE means reverse order."
12590   (interactive "P")
12591   (gnus-summary-sort 'date reverse))
12592
12593 (defun gnus-summary-sort-by-score (&optional reverse)
12594   "Sort summary buffer by score.
12595 Argument REVERSE means reverse order."
12596   (interactive "P")
12597   (gnus-summary-sort 'score reverse))
12598
12599 (defun gnus-summary-sort (predicate reverse)
12600   "Sort summary buffer by PREDICATE.  REVERSE means reverse order."
12601   (gnus-set-global-variables)
12602   (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
12603          (article (intern (format "gnus-article-sort-by-%s" predicate)))
12604          (gnus-thread-sort-functions
12605           (list
12606            (if (not reverse)
12607                thread
12608              `(lambda (t1 t2)
12609                 (,thread t2 t1)))))
12610          (gnus-article-sort-functions
12611           (list
12612            (if (not reverse)
12613                article
12614              `(lambda (t1 t2)
12615                 (,article t2 t1)))))
12616          (buffer-read-only)
12617          (gnus-summary-prepare-hook nil))
12618     ;; We do the sorting by regenerating the threads.
12619     (gnus-summary-prepare)
12620     ;; Hide subthreads if needed.
12621     (when (and gnus-show-threads gnus-thread-hide-subtree)
12622       (gnus-summary-hide-all-threads)))
12623   ;; If in async mode, we send some info to the backend.
12624   (when gnus-newsgroup-async
12625     (gnus-request-asynchronous
12626      gnus-newsgroup-name gnus-newsgroup-data)))
12627
12628 (defun gnus-sortable-date (date)
12629   "Make sortable string by string-lessp from DATE.
12630 Timezone package is used."
12631   (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S]
12632          (year (aref date 0))
12633          (month (aref date 1))
12634          (day (aref date 2)))
12635     (timezone-make-sortable-date
12636      year month day
12637      (timezone-make-time-string
12638       (aref date 3) (aref date 4) (aref date 5)))))
12639
12640 ;; Summary saving commands.
12641
12642 (defun gnus-summary-save-article (&optional n not-saved)
12643   "Save the current article using the default saver function.
12644 If N is a positive number, save the N next articles.
12645 If N is a negative number, save the N previous articles.
12646 If N is nil and any articles have been marked with the process mark,
12647 save those articles instead.
12648 The variable `gnus-default-article-saver' specifies the saver function."
12649   (interactive "P")
12650   (gnus-set-global-variables)
12651   (let ((articles (gnus-summary-work-articles n))
12652         file header article)
12653     (while articles
12654       (setq header (gnus-summary-article-header
12655                     (setq article (pop articles))))
12656       (if (not (vectorp header))
12657           ;; This is a pseudo-article.
12658           (if (assq 'name header)
12659               (gnus-copy-file (cdr (assq 'name header)))
12660             (gnus-message 1 "Article %d is unsaveable" article))
12661         ;; This is a real article.
12662         (save-window-excursion
12663           (gnus-summary-select-article t nil nil article))
12664         (unless gnus-save-all-headers
12665           ;; Remove headers accoring to `gnus-saved-headers'.
12666           (let ((gnus-visible-headers
12667                  (or gnus-saved-headers gnus-visible-headers)))
12668             (gnus-article-hide-headers nil t)))
12669         ;; Remove any X-Gnus lines.
12670         (save-excursion
12671           (set-buffer gnus-article-buffer)
12672           (save-restriction
12673             (let ((buffer-read-only nil))
12674               (nnheader-narrow-to-headers)
12675               (while (re-search-forward "^X-Gnus" nil t)
12676                 (gnus-delete-line)))))
12677         (save-window-excursion
12678           (if (not gnus-default-article-saver)
12679               (error "No default saver is defined.")
12680             (setq file (funcall
12681                         gnus-default-article-saver
12682                         (cond
12683                          ((not gnus-prompt-before-saving)
12684                           'default)
12685                          ((eq gnus-prompt-before-saving 'always)
12686                           nil)
12687                          (t file))))))
12688         (gnus-summary-remove-process-mark article)
12689         (unless not-saved
12690           (gnus-summary-set-saved-mark article))))
12691     (gnus-summary-position-point)
12692     n))
12693
12694 (defun gnus-summary-pipe-output (&optional arg)
12695   "Pipe the current article to a subprocess.
12696 If N is a positive number, pipe the N next articles.
12697 If N is a negative number, pipe the N previous articles.
12698 If N is nil and any articles have been marked with the process mark,
12699 pipe those articles instead."
12700   (interactive "P")
12701   (gnus-set-global-variables)
12702   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
12703     (gnus-summary-save-article arg t))
12704   (gnus-configure-windows 'pipe))
12705
12706 (defun gnus-summary-save-article-mail (&optional arg)
12707   "Append the current article to an mail file.
12708 If N is a positive number, save the N next articles.
12709 If N is a negative number, save the N previous articles.
12710 If N is nil and any articles have been marked with the process mark,
12711 save those articles instead."
12712   (interactive "P")
12713   (gnus-set-global-variables)
12714   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
12715     (gnus-summary-save-article arg)))
12716
12717 (defun gnus-summary-save-article-rmail (&optional arg)
12718   "Append the current article to an rmail file.
12719 If N is a positive number, save the N next articles.
12720 If N is a negative number, save the N previous articles.
12721 If N is nil and any articles have been marked with the process mark,
12722 save those articles instead."
12723   (interactive "P")
12724   (gnus-set-global-variables)
12725   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
12726     (gnus-summary-save-article arg)))
12727
12728 (defun gnus-summary-save-article-file (&optional arg)
12729   "Append the current article to a file.
12730 If N is a positive number, save the N next articles.
12731 If N is a negative number, save the N previous articles.
12732 If N is nil and any articles have been marked with the process mark,
12733 save those articles instead."
12734   (interactive "P")
12735   (gnus-set-global-variables)
12736   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
12737     (gnus-summary-save-article arg)))
12738
12739 (defun gnus-summary-save-article-body-file (&optional arg)
12740   "Append the current article body to a file.
12741 If N is a positive number, save the N next articles.
12742 If N is a negative number, save the N previous articles.
12743 If N is nil and any articles have been marked with the process mark,
12744 save those articles instead."
12745   (interactive "P")
12746   (gnus-set-global-variables)
12747   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
12748     (gnus-summary-save-article arg)))
12749
12750 (defun gnus-get-split-value (methods)
12751   "Return a value based on the split METHODS."
12752   (let (split-name method result match)
12753     (when methods
12754       (save-excursion
12755         (set-buffer gnus-original-article-buffer)
12756         (save-restriction
12757           (nnheader-narrow-to-headers)
12758           (while methods
12759             (goto-char (point-min))
12760             (setq method (pop methods))
12761             (setq match (car method))
12762             (when (cond
12763                    ((stringp match)
12764                     ;; Regular expression.
12765                     (condition-case ()
12766                         (re-search-forward match nil t)
12767                       (error nil)))
12768                    ((gnus-functionp match)
12769                     ;; Function.
12770                     (save-restriction
12771                       (widen)
12772                       (setq result (funcall match gnus-newsgroup-name))))
12773                    ((consp match)
12774                     ;; Form.
12775                     (save-restriction
12776                       (widen)
12777                       (setq result (eval match)))))
12778               (setq split-name (append (cdr method) split-name))
12779               (cond ((stringp result)
12780                      (push result split-name))
12781                     ((consp result)
12782                      (setq split-name (append result split-name)))))))))
12783     split-name))
12784
12785 (defun gnus-read-move-group-name (prompt default articles prefix)
12786   "Read a group name."
12787   (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
12788          (prom
12789           (format "Where do you want to %s %s? "
12790                   prompt
12791                   (if (> (length articles) 1)
12792                       (format "these %d articles" (length articles))
12793                     "this article")))
12794          (to-newsgroup
12795           (cond
12796            ((null split-name)
12797             (completing-read
12798              (concat prom
12799                      (if default
12800                          (format "(default %s) " default)
12801                        ""))
12802              gnus-active-hashtb nil nil prefix))
12803            ((= 1 (length split-name))
12804             (completing-read prom gnus-active-hashtb
12805                              nil nil (cons (car split-name) 0)))
12806            (t
12807             (completing-read
12808              prom (mapcar (lambda (el) (list el)) (nreverse split-name)))))))
12809
12810     (when to-newsgroup
12811       (if (or (string= to-newsgroup "")
12812               (string= to-newsgroup prefix))
12813           (setq to-newsgroup (or default "")))
12814       (or (gnus-active to-newsgroup)
12815           (gnus-activate-group to-newsgroup)
12816           (error "No such group: %s" to-newsgroup)))
12817     to-newsgroup))
12818
12819 (defun gnus-read-save-file-name (prompt default-name)
12820   (let* ((split-name (gnus-get-split-value gnus-split-methods))
12821          (file
12822           ;; Let the split methods have their say.
12823           (cond
12824            ;; No split name was found.
12825            ((null split-name)
12826             (read-file-name
12827              (concat prompt " (default "
12828                      (file-name-nondirectory default-name) ") ")
12829              (file-name-directory default-name)
12830              default-name))
12831            ;; A single split name was found
12832            ((= 1 (length split-name))
12833             (read-file-name
12834              (concat prompt " (default " (car split-name) ") ")
12835              gnus-article-save-directory
12836              (concat gnus-article-save-directory (car split-name))))
12837            ;; A list of splits was found.
12838            (t
12839             (setq split-name (mapcar (lambda (el) (list el))
12840                                      (nreverse split-name)))
12841             (let ((result (completing-read
12842                            (concat prompt " ") split-name nil nil)))
12843               (concat gnus-article-save-directory
12844                       (if (string= result "")
12845                           (caar split-name)
12846                         result)))))))
12847     ;; If we have read a directory, we append the default file name.
12848     (when (file-directory-p file)
12849       (setq file (concat (file-name-as-directory file)
12850                          (file-name-nondirectory default-name))))
12851     ;; Possibly translate some charaters.
12852     (nnheader-translate-file-chars file)))
12853
12854 (defun gnus-article-archive-name (group)
12855   "Return the first instance of an \"Archive-name\" in the current buffer."
12856   (let ((case-fold-search t))
12857     (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
12858       (match-string 1))))
12859
12860 (defun gnus-summary-save-in-rmail (&optional filename)
12861   "Append this article to Rmail file.
12862 Optional argument FILENAME specifies file name.
12863 Directory to save to is default to `gnus-article-save-directory' which
12864 is initialized from the SAVEDIR environment variable."
12865   (interactive)
12866   (gnus-set-global-variables)
12867   (let ((default-name
12868           (funcall gnus-rmail-save-name gnus-newsgroup-name
12869                    gnus-current-headers gnus-newsgroup-last-rmail)))
12870     (setq filename
12871           (cond ((eq filename 'default)
12872                  default-name)
12873                 (filename filename)
12874                 (t (gnus-read-save-file-name
12875                     "Save in rmail file:" default-name))))
12876     (gnus-make-directory (file-name-directory filename))
12877     (gnus-eval-in-buffer-window
12878      gnus-original-article-buffer
12879      (save-excursion
12880        (save-restriction
12881          (widen)
12882          (gnus-output-to-rmail filename))))
12883     ;; Remember the directory name to save articles
12884     (setq gnus-newsgroup-last-rmail filename)))
12885
12886 (defun gnus-summary-save-in-mail (&optional filename)
12887   "Append this article to Unix mail file.
12888 Optional argument FILENAME specifies file name.
12889 Directory to save to is default to `gnus-article-save-directory' which
12890 is initialized from the SAVEDIR environment variable."
12891   (interactive)
12892   (gnus-set-global-variables)
12893   (let ((default-name
12894           (funcall gnus-mail-save-name gnus-newsgroup-name
12895                    gnus-current-headers gnus-newsgroup-last-mail)))
12896     (setq filename
12897           (cond ((eq filename 'default)
12898                  default-name)
12899                 (filename filename)
12900                 (t (gnus-read-save-file-name
12901                     "Save in Unix mail file:" default-name))))
12902     (setq filename
12903           (expand-file-name filename
12904                             (and default-name
12905                                  (file-name-directory default-name))))
12906     (gnus-make-directory (file-name-directory filename))
12907     (gnus-eval-in-buffer-window
12908      gnus-original-article-buffer
12909      (save-excursion
12910        (save-restriction
12911          (widen)
12912          (if (and (file-readable-p filename) (mail-file-babyl-p filename))
12913              (gnus-output-to-rmail filename)
12914            (let ((mail-use-rfc822 t))
12915              (rmail-output filename 1 t t))))))
12916     ;; Remember the directory name to save articles.
12917     (setq gnus-newsgroup-last-mail filename)))
12918
12919 (defun gnus-summary-save-in-file (&optional filename)
12920   "Append this article to file.
12921 Optional argument FILENAME specifies file name.
12922 Directory to save to is default to `gnus-article-save-directory' which
12923 is initialized from the SAVEDIR environment variable."
12924   (interactive)
12925   (gnus-set-global-variables)
12926   (let ((default-name
12927           (funcall gnus-file-save-name gnus-newsgroup-name
12928                    gnus-current-headers gnus-newsgroup-last-file)))
12929     (setq filename
12930           (cond ((eq filename 'default)
12931                  default-name)
12932                 (filename filename)
12933                 (t (gnus-read-save-file-name
12934                     "Save in file:" default-name))))
12935     (gnus-make-directory (file-name-directory filename))
12936     (gnus-eval-in-buffer-window
12937      gnus-original-article-buffer
12938      (save-excursion
12939        (save-restriction
12940          (widen)
12941          (gnus-output-to-file filename))))
12942     ;; Remember the directory name to save articles.
12943     (setq gnus-newsgroup-last-file filename)))
12944
12945 (defun gnus-summary-save-body-in-file (&optional filename)
12946   "Append this article body to a file.
12947 Optional argument FILENAME specifies file name.
12948 The directory to save in defaults to `gnus-article-save-directory' which
12949 is initialized from the SAVEDIR environment variable."
12950   (interactive)
12951   (gnus-set-global-variables)
12952   (let ((default-name
12953           (funcall gnus-file-save-name gnus-newsgroup-name
12954                    gnus-current-headers gnus-newsgroup-last-file)))
12955     (setq filename
12956           (cond ((eq filename 'default)
12957                  default-name)
12958                 (filename filename)
12959                 (t (gnus-read-save-file-name
12960                     "Save body in file:" default-name))))
12961     (gnus-make-directory (file-name-directory filename))
12962     (gnus-eval-in-buffer-window
12963      gnus-article-buffer
12964      (save-excursion
12965        (save-restriction
12966          (widen)
12967          (goto-char (point-min))
12968          (and (search-forward "\n\n" nil t)
12969               (narrow-to-region (point) (point-max)))
12970          (gnus-output-to-file filename))))
12971     ;; Remember the directory name to save articles.
12972     (setq gnus-newsgroup-last-file filename)))
12973
12974 (defun gnus-summary-save-in-pipe (&optional command)
12975   "Pipe this article to subprocess."
12976   (interactive)
12977   (gnus-set-global-variables)
12978   (setq command
12979         (cond ((eq command 'default)
12980                gnus-last-shell-command)
12981               (command command)
12982               (t (read-string "Shell command on article: "
12983                               gnus-last-shell-command))))
12984   (if (string-equal command "")
12985       (setq command gnus-last-shell-command))
12986   (gnus-eval-in-buffer-window
12987    gnus-article-buffer
12988    (save-restriction
12989      (widen)
12990      (shell-command-on-region (point-min) (point-max) command nil)))
12991   (setq gnus-last-shell-command command))
12992
12993 ;; Summary extract commands
12994
12995 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
12996   (let ((buffer-read-only nil)
12997         (article (gnus-summary-article-number))
12998         after-article b e)
12999     (or (gnus-summary-goto-subject article)
13000         (error (format "No such article: %d" article)))
13001     (gnus-summary-position-point)
13002     ;; If all commands are to be bunched up on one line, we collect
13003     ;; them here.
13004     (if gnus-view-pseudos-separately
13005         ()
13006       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
13007             files action)
13008         (while ps
13009           (setq action (cdr (assq 'action (car ps))))
13010           (setq files (list (cdr (assq 'name (car ps)))))
13011           (while (and ps (cdr ps)
13012                       (string= (or action "1")
13013                                (or (cdr (assq 'action (cadr ps))) "2")))
13014             (setq files (cons (cdr (assq 'name (cadr ps))) files))
13015             (setcdr ps (cddr ps)))
13016           (if (not files)
13017               ()
13018             (if (not (string-match "%s" action))
13019                 (setq files (cons " " files)))
13020             (setq files (cons " " files))
13021             (and (assq 'execute (car ps))
13022                  (setcdr (assq 'execute (car ps))
13023                          (funcall (if (string-match "%s" action)
13024                                       'format 'concat)
13025                                   action
13026                                   (mapconcat (lambda (f) f) files " ")))))
13027           (setq ps (cdr ps)))))
13028     (if (and gnus-view-pseudos (not not-view))
13029         (while pslist
13030           (and (assq 'execute (car pslist))
13031                (gnus-execute-command (cdr (assq 'execute (car pslist)))
13032                                      (eq gnus-view-pseudos 'not-confirm)))
13033           (setq pslist (cdr pslist)))
13034       (save-excursion
13035         (while pslist
13036           (setq after-article (or (cdr (assq 'article (car pslist)))
13037                                   (gnus-summary-article-number)))
13038           (gnus-summary-goto-subject after-article)
13039           (forward-line 1)
13040           (setq b (point))
13041           (insert "    " (file-name-nondirectory
13042                                 (cdr (assq 'name (car pslist))))
13043                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
13044           (setq e (point))
13045           (forward-line -1)             ; back to `b'
13046           (add-text-properties
13047            b e (list 'gnus-number gnus-reffed-article-number
13048                      gnus-mouse-face-prop gnus-mouse-face))
13049           (gnus-data-enter
13050            after-article gnus-reffed-article-number
13051            gnus-unread-mark b (car pslist) 0 (- e b))
13052           (push gnus-reffed-article-number gnus-newsgroup-unreads)
13053           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
13054           (setq pslist (cdr pslist)))))))
13055
13056 (defun gnus-pseudos< (p1 p2)
13057   (let ((c1 (cdr (assq 'action p1)))
13058         (c2 (cdr (assq 'action p2))))
13059     (and c1 c2 (string< c1 c2))))
13060
13061 (defun gnus-request-pseudo-article (props)
13062   (cond ((assq 'execute props)
13063          (gnus-execute-command (cdr (assq 'execute props)))))
13064   (let ((gnus-current-article (gnus-summary-article-number)))
13065     (run-hooks 'gnus-mark-article-hook)))
13066
13067 (defun gnus-execute-command (command &optional automatic)
13068   (save-excursion
13069     (gnus-article-setup-buffer)
13070     (set-buffer gnus-article-buffer)
13071     (let ((command (if automatic command (read-string "Command: " command)))
13072           (buffer-read-only nil))
13073       (erase-buffer)
13074       (insert "$ " command "\n\n")
13075       (if gnus-view-pseudo-asynchronously
13076           (start-process "gnus-execute" nil "sh" "-c" command)
13077         (call-process "sh" nil t nil "-c" command)))))
13078
13079 (defun gnus-copy-file (file &optional to)
13080   "Copy FILE to TO."
13081   (interactive
13082    (list (read-file-name "Copy file: " default-directory)
13083          (read-file-name "Copy file to: " default-directory)))
13084   (gnus-set-global-variables)
13085   (or to (setq to (read-file-name "Copy file to: " default-directory)))
13086   (and (file-directory-p to)
13087        (setq to (concat (file-name-as-directory to)
13088                         (file-name-nondirectory file))))
13089   (copy-file file to))
13090
13091 ;; Summary kill commands.
13092
13093 (defun gnus-summary-edit-global-kill (article)
13094   "Edit the \"global\" kill file."
13095   (interactive (list (gnus-summary-article-number)))
13096   (gnus-set-global-variables)
13097   (gnus-group-edit-global-kill article))
13098
13099 (defun gnus-summary-edit-local-kill ()
13100   "Edit a local kill file applied to the current newsgroup."
13101   (interactive)
13102   (gnus-set-global-variables)
13103   (setq gnus-current-headers (gnus-summary-article-header))
13104   (gnus-set-global-variables)
13105   (gnus-group-edit-local-kill
13106    (gnus-summary-article-number) gnus-newsgroup-name))
13107
13108 \f
13109 ;;;
13110 ;;; Gnus article mode
13111 ;;;
13112
13113 (put 'gnus-article-mode 'mode-class 'special)
13114
13115 (if gnus-article-mode-map
13116     nil
13117   (setq gnus-article-mode-map (make-keymap))
13118   (suppress-keymap gnus-article-mode-map)
13119
13120   (gnus-define-keys gnus-article-mode-map
13121     " " gnus-article-goto-next-page
13122     "\177" gnus-article-goto-prev-page
13123     [delete] gnus-article-goto-prev-page
13124     "\C-c^" gnus-article-refer-article
13125     "h" gnus-article-show-summary
13126     "s" gnus-article-show-summary
13127     "\C-c\C-m" gnus-article-mail
13128     "?" gnus-article-describe-briefly
13129     gnus-mouse-2 gnus-article-push-button
13130     "\r" gnus-article-press-button
13131     "\t" gnus-article-next-button
13132     "\M-\t" gnus-article-prev-button
13133     "\C-c\C-b" gnus-bug)
13134
13135   (substitute-key-definition
13136    'undefined 'gnus-article-read-summary-keys gnus-article-mode-map))
13137
13138 (defun gnus-article-mode ()
13139   "Major mode for displaying an article.
13140
13141 All normal editing commands are switched off.
13142
13143 The following commands are available:
13144
13145 \\<gnus-article-mode-map>
13146 \\[gnus-article-next-page]\t Scroll the article one page forwards
13147 \\[gnus-article-prev-page]\t Scroll the article one page backwards
13148 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
13149 \\[gnus-article-show-summary]\t Display the summary buffer
13150 \\[gnus-article-mail]\t Send a reply to the address near point
13151 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
13152 \\[gnus-info-find-node]\t Go to the Gnus info node"
13153   (interactive)
13154   (when (and menu-bar-mode
13155              (gnus-visual-p 'article-menu 'menu))
13156     (gnus-article-make-menu-bar))
13157   (kill-all-local-variables)
13158   (gnus-simplify-mode-line)
13159   (setq mode-name "Article")
13160   (setq major-mode 'gnus-article-mode)
13161   (make-local-variable 'minor-mode-alist)
13162   (or (assq 'gnus-show-mime minor-mode-alist)
13163       (setq minor-mode-alist
13164             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
13165   (use-local-map gnus-article-mode-map)
13166   (make-local-variable 'page-delimiter)
13167   (setq page-delimiter gnus-page-delimiter)
13168   (buffer-disable-undo (current-buffer))
13169   (setq buffer-read-only t)             ;Disable modification
13170   (run-hooks 'gnus-article-mode-hook))
13171
13172 (defun gnus-article-setup-buffer ()
13173   "Initialize the article buffer."
13174   (let* ((name (if gnus-single-article-buffer "*Article*"
13175                  (concat "*Article " gnus-newsgroup-name "*")))
13176          (original
13177           (progn (string-match "\\*Article" name)
13178                  (concat " *Original Article"
13179                          (substring name (match-end 0))))))
13180     (setq gnus-article-buffer name)
13181     (setq gnus-original-article-buffer original)
13182     ;; This might be a variable local to the summary buffer.
13183     (unless gnus-single-article-buffer
13184       (save-excursion
13185         (set-buffer gnus-summary-buffer)
13186         (setq gnus-article-buffer name)
13187         (setq gnus-original-article-buffer original)
13188         (gnus-set-global-variables))
13189       (make-local-variable 'gnus-summary-buffer))
13190     ;; Init original article buffer.
13191     (save-excursion
13192       (set-buffer (get-buffer-create gnus-original-article-buffer))
13193       (buffer-disable-undo (current-buffer))
13194       (setq major-mode 'gnus-original-article-mode)
13195       (make-local-variable 'gnus-original-article))
13196     (if (get-buffer name)
13197         (save-excursion
13198           (set-buffer name)
13199           (buffer-disable-undo (current-buffer))
13200           (setq buffer-read-only t)
13201           (gnus-add-current-to-buffer-list)
13202           (or (eq major-mode 'gnus-article-mode)
13203               (gnus-article-mode))
13204           (current-buffer))
13205       (save-excursion
13206         (set-buffer (get-buffer-create name))
13207         (gnus-add-current-to-buffer-list)
13208         (gnus-article-mode)
13209         (current-buffer)))))
13210
13211 ;; Set article window start at LINE, where LINE is the number of lines
13212 ;; from the head of the article.
13213 (defun gnus-article-set-window-start (&optional line)
13214   (set-window-start
13215    (get-buffer-window gnus-article-buffer)
13216    (save-excursion
13217      (set-buffer gnus-article-buffer)
13218      (goto-char (point-min))
13219      (if (not line)
13220          (point-min)
13221        (gnus-message 6 "Moved to bookmark")
13222        (search-forward "\n\n" nil t)
13223        (forward-line line)
13224        (point)))))
13225
13226 (defun gnus-kill-all-overlays ()
13227   "Delete all overlays in the current buffer."
13228   (when (fboundp 'overlay-lists)
13229     (let* ((overlayss (overlay-lists))
13230            (buffer-read-only nil)
13231            (overlays (nconc (car overlayss) (cdr overlayss))))
13232       (while overlays
13233         (delete-overlay (pop overlays))))))
13234
13235 (defun gnus-request-article-this-buffer (article group)
13236   "Get an article and insert it into this buffer."
13237   (let (do-update-line)
13238     (prog1
13239         (save-excursion
13240           (erase-buffer)
13241           (gnus-kill-all-overlays)
13242           (setq group (or group gnus-newsgroup-name))
13243
13244           ;; Open server if it has closed.
13245           (gnus-check-server (gnus-find-method-for-group group))
13246
13247           ;; Using `gnus-request-article' directly will insert the article into
13248           ;; `nntp-server-buffer' - so we'll save some time by not having to
13249           ;; copy it from the server buffer into the article buffer.
13250
13251           ;; We only request an article by message-id when we do not have the
13252           ;; headers for it, so we'll have to get those.
13253           (when (stringp article)
13254             (let ((gnus-override-method gnus-refer-article-method))
13255               (gnus-read-header article)))
13256
13257           ;; If the article number is negative, that means that this article
13258           ;; doesn't belong in this newsgroup (possibly), so we find its
13259           ;; message-id and request it by id instead of number.
13260           (when (and (numberp article)
13261                      gnus-summary-buffer
13262                      (get-buffer gnus-summary-buffer)
13263                      (buffer-name (get-buffer gnus-summary-buffer)))
13264             (save-excursion
13265               (set-buffer gnus-summary-buffer)
13266               (let ((header (gnus-summary-article-header article)))
13267                 (if (< article 0)
13268                     (cond 
13269                      ((memq article gnus-newsgroup-sparse)
13270                       ;; This is a sparse gap article.
13271                       (setq do-update-line article)
13272                       (setq article (mail-header-id header))
13273                       (let ((gnus-override-method gnus-refer-article-method))
13274                         (gnus-read-header article)))
13275                      ((vectorp header)
13276                       ;; It's a real article.
13277                       (setq article (mail-header-id header)))
13278                      (t
13279                       ;; It is an extracted pseudo-article.
13280                       (setq article 'pseudo)
13281                       (gnus-request-pseudo-article header))))
13282                 
13283                 (let ((method (gnus-find-method-for-group 
13284                                gnus-newsgroup-name)))
13285                   (if (not (eq (car method) 'nneething))
13286                       ()
13287                     (let ((dir (concat (file-name-as-directory (nth 1 method))
13288                                        (mail-header-subject header))))
13289                       (if (file-directory-p dir)
13290                           (progn
13291                             (setq article 'nneething)
13292                             (gnus-group-enter-directory dir)))))))))
13293
13294           (cond
13295            ;; We first check `gnus-original-article-buffer'.
13296            ((and (get-buffer gnus-original-article-buffer)
13297                  (save-excursion
13298                    (set-buffer gnus-original-article-buffer)
13299                    (and (equal (car gnus-original-article) group)
13300                         (eq (cdr gnus-original-article) article))))
13301             (insert-buffer-substring gnus-original-article-buffer)
13302             'article)
13303            ;; Check the backlog.
13304            ((and gnus-keep-backlog
13305                  (gnus-backlog-request-article group article (current-buffer)))
13306             'article)
13307            ;; Check the cache.
13308            ((and gnus-use-cache
13309                  (numberp article)
13310                  (gnus-cache-request-article article group))
13311             'article)
13312            ;; Get the article and put into the article buffer.
13313            ((or (stringp article) (numberp article))
13314             (let ((gnus-override-method
13315                    (and (stringp article) gnus-refer-article-method))
13316                   (buffer-read-only nil))
13317               (erase-buffer)
13318               (gnus-kill-all-overlays)
13319               (if (gnus-request-article article group (current-buffer))
13320                   (progn
13321                     (and gnus-keep-backlog
13322                          (gnus-backlog-enter-article
13323                           group article (current-buffer)))
13324                     'article))))
13325            ;; It was a pseudo.
13326            (t article)))
13327
13328       ;; Take the article from the original article buffer
13329       ;; and place it in the buffer it's supposed to be in.
13330       (when (and (get-buffer gnus-article-buffer)
13331                  (equal (buffer-name (current-buffer))
13332                         (buffer-name (get-buffer gnus-article-buffer))))
13333         (save-excursion
13334           (if (get-buffer gnus-original-article-buffer)
13335               (set-buffer (get-buffer gnus-original-article-buffer))
13336             (set-buffer (get-buffer-create gnus-original-article-buffer))
13337             (buffer-disable-undo (current-buffer))
13338             (setq major-mode 'gnus-original-article-mode)
13339             (setq buffer-read-only t)
13340             (gnus-add-current-to-buffer-list))
13341           (let (buffer-read-only)
13342             (erase-buffer)
13343             (insert-buffer-substring gnus-article-buffer))
13344           (setq gnus-original-article (cons group article))))
13345     
13346       ;; Update sparse articles.
13347       (when do-update-line
13348         (save-excursion
13349           (set-buffer gnus-summary-buffer)
13350           (gnus-summary-update-article do-update-line)
13351           (gnus-summary-goto-subject do-update-line)
13352           (set-window-point (get-buffer-window (current-buffer) t)
13353                             (point)))))))
13354
13355 (defun gnus-read-header (id &optional header)
13356   "Read the headers of article ID and enter them into the Gnus system."
13357   (let ((group gnus-newsgroup-name)
13358         where)
13359     ;; First we check to see whether the header in question is already
13360     ;; fetched.
13361     (if (stringp id)
13362         ;; This is a Message-ID.
13363         (setq header (or header (gnus-id-to-header id)))
13364       ;; This is an article number.
13365       (setq header (or header (gnus-summary-article-header id))))
13366     (if (and header
13367              (not (memq (mail-header-number header) gnus-newsgroup-sparse)))
13368         ;; We have found the header.
13369         header
13370       ;; We have to really fetch the header to this article.
13371       (when (setq where
13372                   (if (gnus-check-backend-function 'request-head group)
13373                       (gnus-request-head id group)
13374                     (gnus-request-article id group)))
13375         (save-excursion
13376           (set-buffer nntp-server-buffer)
13377           (and (search-forward "\n\n" nil t)
13378                (delete-region (1- (point)) (point-max)))
13379           (goto-char (point-max))
13380           (insert ".\n")
13381           (goto-char (point-min))
13382           (insert "211 ")
13383           (princ (cond
13384                   ((numberp id) id)
13385                   ((cdr where) (cdr where))
13386                   (header (mail-header-number header))
13387                   (t gnus-reffed-article-number))
13388                  (current-buffer))
13389           (insert " Article retrieved.\n"))
13390         ;(when (and header
13391         ;          (memq (mail-header-number header) gnus-newsgroup-sparse))
13392         ;  (setcar (gnus-id-to-thread id) nil))
13393         (if (not (setq header (car (gnus-get-newsgroup-headers))))
13394             ()                          ; Malformed head.
13395           (unless (memq (mail-header-number header) gnus-newsgroup-sparse)
13396             (if (and (stringp id)
13397                      (not (string= (gnus-group-real-name group)
13398                                    (car where))))
13399                 ;; If we fetched by Message-ID and the article came
13400                 ;; from a different group, we fudge some bogus article
13401                 ;; numbers for this article.
13402                 (mail-header-set-number header gnus-reffed-article-number))
13403             (decf gnus-reffed-article-number)
13404             (push header gnus-newsgroup-headers)
13405             (setq gnus-current-headers header)
13406             (push (mail-header-number header) gnus-newsgroup-limit))
13407           header)))))
13408
13409 (defun gnus-article-prepare (article &optional all-headers header)
13410   "Prepare ARTICLE in article mode buffer.
13411 ARTICLE should either be an article number or a Message-ID.
13412 If ARTICLE is an id, HEADER should be the article headers.
13413 If ALL-HEADERS is non-nil, no headers are hidden."
13414   (save-excursion
13415     ;; Make sure we start in a summary buffer.
13416     (unless (eq major-mode 'gnus-summary-mode)
13417       (set-buffer gnus-summary-buffer))
13418     (setq gnus-summary-buffer (current-buffer))
13419     ;; Make sure the connection to the server is alive.
13420     (unless (gnus-server-opened
13421              (gnus-find-method-for-group gnus-newsgroup-name))
13422       (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
13423       (gnus-request-group gnus-newsgroup-name t))
13424     (let* ((article (if header (mail-header-number header) article))
13425            (summary-buffer (current-buffer))
13426            (internal-hook gnus-article-internal-prepare-hook)
13427            (group gnus-newsgroup-name)
13428            result)
13429       (save-excursion
13430         (gnus-article-setup-buffer)
13431         (set-buffer gnus-article-buffer)
13432         ;; Deactivate active regions.
13433         (when (and (boundp 'transient-mark-mode)
13434                    transient-mark-mode)
13435           (setq mark-active nil))
13436         (if (not (setq result (let ((buffer-read-only nil))
13437                                 (gnus-request-article-this-buffer
13438                                  article group))))
13439             ;; There is no such article.
13440             (save-excursion
13441               (when (and (numberp article)
13442                          (not (memq article gnus-newsgroup-sparse)))
13443                 (setq gnus-article-current
13444                       (cons gnus-newsgroup-name article))
13445                 (set-buffer gnus-summary-buffer)
13446                 (setq gnus-current-article article)
13447                 (gnus-summary-mark-article article gnus-canceled-mark))
13448               (unless (memq article gnus-newsgroup-sparse)
13449                 (gnus-message
13450                  1 "No such article (may have expired or been canceled)")
13451                 (ding)
13452                 nil))
13453           (if (or (eq result 'pseudo) (eq result 'nneething))
13454               (progn
13455                 (save-excursion
13456                   (set-buffer summary-buffer)
13457                   (setq gnus-last-article gnus-current-article
13458                         gnus-newsgroup-history (cons gnus-current-article
13459                                                      gnus-newsgroup-history)
13460                         gnus-current-article 0
13461                         gnus-current-headers nil
13462                         gnus-article-current nil)
13463                   (if (eq result 'nneething)
13464                       (gnus-configure-windows 'summary)
13465                     (gnus-configure-windows 'article))
13466                   (gnus-set-global-variables))
13467                 (gnus-set-mode-line 'article))
13468             ;; The result from the `request' was an actual article -
13469             ;; or at least some text that is now displayed in the
13470             ;; article buffer.
13471             (if (and (numberp article)
13472                      (not (eq article gnus-current-article)))
13473                 ;; Seems like a new article has been selected.
13474                 ;; `gnus-current-article' must be an article number.
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 article
13481                         gnus-current-headers
13482                         (gnus-summary-article-header gnus-current-article)
13483                         gnus-article-current
13484                         (cons gnus-newsgroup-name gnus-current-article))
13485                   (unless (vectorp gnus-current-headers)
13486                     (setq gnus-current-headers nil))
13487                   (gnus-summary-show-thread)
13488                   (run-hooks 'gnus-mark-article-hook)
13489                   (gnus-set-mode-line 'summary)
13490                   (and (gnus-visual-p 'article-highlight 'highlight)
13491                        (run-hooks 'gnus-visual-mark-article-hook))
13492                   ;; Set the global newsgroup variables here.
13493                   ;; Suggested by Jim Sisolak
13494                   ;; <sisolak@trans4.neep.wisc.edu>.
13495                   (gnus-set-global-variables)
13496                   (setq gnus-have-all-headers
13497                         (or all-headers gnus-show-all-headers))
13498                   (and gnus-use-cache
13499                        (vectorp (gnus-summary-article-header article))
13500                        (gnus-cache-possibly-enter-article
13501                         group article
13502                         (gnus-summary-article-header article)
13503                         (memq article gnus-newsgroup-marked)
13504                         (memq article gnus-newsgroup-dormant)
13505                         (memq article gnus-newsgroup-unreads)))))
13506             ;; Hooks for getting information from the article.
13507             ;; This hook must be called before being narrowed.
13508             (let (buffer-read-only)
13509               (run-hooks 'internal-hook)
13510               (run-hooks 'gnus-article-prepare-hook)
13511               ;; Decode MIME message.
13512               (if gnus-show-mime
13513                   (if (or (not gnus-strict-mime)
13514                           (gnus-fetch-field "Mime-Version"))
13515                       (funcall gnus-show-mime-method)
13516                     (funcall gnus-decode-encoded-word-method)))
13517               ;; Perform the article display hooks.
13518               (run-hooks 'gnus-article-display-hook))
13519             ;; Do page break.
13520             (goto-char (point-min))
13521             (and gnus-break-pages (gnus-narrow-to-page))
13522             (gnus-set-mode-line 'article)
13523             (gnus-configure-windows 'article)
13524             (goto-char (point-min))
13525             t))))))
13526
13527 (defun gnus-article-show-all-headers ()
13528   "Show all article headers in article mode buffer."
13529   (save-excursion
13530     (gnus-article-setup-buffer)
13531     (set-buffer gnus-article-buffer)
13532     (let ((buffer-read-only nil))
13533       (gnus-unhide-text (point-min) (point-max)))))
13534
13535 (defun gnus-article-hide-headers-if-wanted ()
13536   "Hide unwanted headers if `gnus-have-all-headers' is nil.
13537 Provided for backwards compatibility."
13538   (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
13539       gnus-inhibit-hiding
13540       (gnus-article-hide-headers)))
13541
13542 (defun gnus-article-hide-headers (&optional arg delete)
13543   "Toggle whether to hide unwanted headers and possibly sort them as well.
13544 If given a negative prefix, always show; if given a positive prefix,
13545 always hide."
13546   (interactive "P")
13547   (unless (gnus-article-check-hidden-text 'headers arg)
13548     ;; This function might be inhibited.
13549     (unless gnus-inhibit-hiding
13550       (save-excursion
13551         (set-buffer gnus-article-buffer)
13552         (save-restriction
13553           (let ((buffer-read-only nil)
13554                 (props (nconc (list 'gnus-type 'headers)
13555                               gnus-hidden-properties))
13556                 (ignored (when (not (stringp gnus-visible-headers))
13557                            (cond ((stringp gnus-ignored-headers)
13558                                   gnus-ignored-headers)
13559                                  ((listp gnus-ignored-headers)
13560                                   (mapconcat 'identity gnus-ignored-headers
13561                                              "\\|")))))
13562                 (visible
13563                  (cond ((stringp gnus-visible-headers)
13564                         gnus-visible-headers)
13565                        ((and gnus-visible-headers
13566                              (listp gnus-visible-headers))
13567                         (mapconcat 'identity gnus-visible-headers "\\|"))))
13568                 want-list beg)
13569             ;; First we narrow to just the headers.
13570             (widen)
13571             (goto-char (point-min))
13572             ;; Hide any "From " lines at the beginning of (mail) articles.
13573             (while (looking-at "From ")
13574               (forward-line 1))
13575             (unless (bobp)
13576               (gnus-hide-text (point-min) (point) props))
13577             ;; Then treat the rest of the header lines.
13578             (narrow-to-region
13579              (point)
13580              (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
13581             ;; Then we use the two regular expressions
13582             ;; `gnus-ignored-headers' and `gnus-visible-headers' to
13583             ;; select which header lines is to remain visible in the
13584             ;; article buffer.
13585             (goto-char (point-min))
13586             (while (re-search-forward "^[^ \t]*:" nil t)
13587               (beginning-of-line)
13588               ;; We add the headers we want to keep to a list and delete
13589               ;; them from the buffer.
13590               (if (or (and visible (looking-at visible))
13591                       (and ignored (not (looking-at ignored))))
13592                   (progn
13593                     (push (buffer-substring
13594                            (setq beg (point))
13595                            (progn
13596                              (forward-line 1)
13597                              ;; Be sure to get multi-line headers...
13598                              (re-search-forward "^[^ \t]*:" nil t)
13599                              (beginning-of-line)
13600                              (point)))
13601                           want-list)
13602                     (delete-region beg (point)))
13603                 (forward-line 1)))
13604             ;; Sort the headers that we want to display.
13605             (setq want-list (sort want-list 'gnus-article-header-less))
13606             (goto-char (point-min))
13607             (while want-list
13608               (insert (pop want-list)))
13609             ;; We make the unwanted headers invisible.
13610             (if delete
13611                 (delete-region (point-min) (point-max))
13612               ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
13613               (gnus-hide-text-type (point) (point-max) 'headers))))))))
13614
13615 (defsubst gnus-article-header-rank (header)
13616   "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
13617   (let ((list gnus-sorted-header-list)
13618         (i 0))
13619     (while list
13620       (when (string-match (car list) header)
13621         (setq list nil))
13622       (setq list (cdr list))
13623       (incf i))
13624     i))
13625
13626 (defun gnus-article-header-less (h1 h2)
13627   "Say whether string H1 is \"less\" than string H2."
13628   (< (gnus-article-header-rank h1)
13629      (gnus-article-header-rank h2)))
13630
13631 (defun gnus-article-hide-boring-headers (&optional arg)
13632   "Toggle hiding of headers that aren't very interesting.
13633 If given a negative prefix, always show; if given a positive prefix,
13634 always hide."
13635   (interactive "P")
13636   (unless (gnus-article-check-hidden-text 'boring-headers arg)
13637     (save-excursion
13638       (set-buffer gnus-article-buffer)
13639       (save-restriction
13640         (let ((buffer-read-only nil)
13641               (list gnus-boring-article-headers)
13642               (inhibit-point-motion-hooks t)
13643               elem)
13644           (nnheader-narrow-to-headers)
13645           (while list
13646             (setq elem (pop list))
13647             (goto-char (point-min))
13648             (cond
13649              ;; Hide empty headers.
13650              ((eq elem 'empty)
13651               (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t)
13652                 (forward-line -1)
13653                 (gnus-hide-text-type
13654                  (progn (beginning-of-line) (point))
13655                  (progn 
13656                    (end-of-line)
13657                    (if (re-search-forward "^[^ \t]" nil t)
13658                        (match-beginning 0)
13659                      (point-max)))
13660                  'boring-headers)))
13661              ;; Hide boring Newsgroups header.
13662              ((eq elem 'newsgroups)
13663               (when (equal (mail-fetch-field "newsgroups")
13664                            (gnus-group-real-name gnus-newsgroup-name))
13665                 (gnus-article-hide-header "newsgroups")))
13666              ((eq elem 'followup-to)
13667               (when (equal (mail-fetch-field "followup-to")
13668                            (mail-fetch-field "newsgroups"))
13669                 (gnus-article-hide-header "followup-to")))
13670              ((eq elem 'reply-to)
13671               (let ((from (mail-fetch-field "from"))
13672                     (reply-to (mail-fetch-field "reply-to")))
13673                 (when (and
13674                        from reply-to
13675                        (equal 
13676                         (nth 1 (funcall gnus-extract-address-components from))
13677                         (nth 1 (funcall gnus-extract-address-components
13678                                         reply-to))))
13679                   (gnus-article-hide-header "reply-to"))))
13680              ((eq elem 'date)
13681               (let ((date (mail-fetch-field "date")))
13682                 (when (and date
13683                            (< (gnus-days-between date (current-time-string))
13684                               4))
13685                   (gnus-article-hide-header "date")))))))))))
13686
13687 (defun gnus-article-hide-header (header)
13688   (save-excursion
13689     (goto-char (point-min))
13690     (when (re-search-forward (concat "^" header ":") nil t)
13691       (gnus-hide-text-type
13692        (progn (beginning-of-line) (point))
13693        (progn 
13694          (end-of-line)
13695          (if (re-search-forward "^[^ \t]" nil t)
13696              (match-beginning 0)
13697            (point-max)))
13698        'boring-headers))))
13699
13700 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
13701 (defun gnus-article-treat-overstrike ()
13702   "Translate overstrikes into bold text."
13703   (interactive)
13704   (save-excursion
13705     (set-buffer gnus-article-buffer)
13706     (let ((buffer-read-only nil))
13707       (while (search-forward "\b" nil t)
13708         (let ((next (following-char))
13709               (previous (char-after (- (point) 2))))
13710           (cond ((eq next previous)
13711                  (put-text-property (- (point) 2) (point) 'invisible t)
13712                  (put-text-property (point) (1+ (point)) 'face 'bold))
13713                 ((eq next ?_)
13714                  (put-text-property (1- (point)) (1+ (point)) 'invisible t)
13715                  (put-text-property
13716                   (- (point) 2) (1- (point)) 'face 'underline))
13717                 ((eq previous ?_)
13718                  (put-text-property (- (point) 2) (point) 'invisible t)
13719                  (put-text-property
13720                   (point) (1+ (point))  'face 'underline))))))))
13721
13722 (defun gnus-article-word-wrap ()
13723   "Format too long lines."
13724   (interactive)
13725   (save-excursion
13726     (set-buffer gnus-article-buffer)
13727     (let ((buffer-read-only nil))
13728       (widen)
13729       (goto-char (point-min))
13730       (search-forward "\n\n" nil t)
13731       (end-of-line 1)
13732       (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
13733             (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
13734             (adaptive-fill-mode t))
13735         (while (not (eobp))
13736           (and (>= (current-column) (min fill-column (window-width)))
13737                (/= (preceding-char) ?:)
13738                (fill-paragraph nil))
13739           (end-of-line 2))))))
13740
13741 (defun gnus-article-remove-cr ()
13742   "Remove carriage returns from an article."
13743   (interactive)
13744   (save-excursion
13745     (set-buffer gnus-article-buffer)
13746     (let ((buffer-read-only nil))
13747       (goto-char (point-min))
13748       (while (search-forward "\r" nil t)
13749         (replace-match "" t t)))))
13750
13751 (defun gnus-article-remove-trailing-blank-lines ()
13752   "Remove all trailing blank lines from the article."
13753   (interactive)
13754   (save-excursion
13755     (set-buffer gnus-article-buffer)
13756     (let ((buffer-read-only nil))
13757       (goto-char (point-max))
13758       (delete-region
13759        (point)
13760        (progn
13761          (while (looking-at "^[ \t]*$")
13762            (forward-line -1))
13763          (forward-line 1)
13764          (point))))))
13765
13766 (defun gnus-article-display-x-face (&optional force)
13767   "Look for an X-Face header and display it if present."
13768   (interactive (list 'force))
13769   (save-excursion
13770     (set-buffer gnus-article-buffer)
13771     ;; Delete the old process, if any.
13772     (when (process-status "gnus-x-face")
13773       (delete-process "gnus-x-face"))
13774     (let ((inhibit-point-motion-hooks t)
13775           (case-fold-search nil)
13776           from)
13777       (save-restriction
13778         (nnheader-narrow-to-headers)
13779         (setq from (mail-fetch-field "from"))
13780         (goto-char (point-min))
13781         (when (and gnus-article-x-face-command
13782                    (or force
13783                        ;; Check whether this face is censored.
13784                        (not gnus-article-x-face-too-ugly)
13785                        (and gnus-article-x-face-too-ugly from
13786                             (not (string-match gnus-article-x-face-too-ugly
13787                                                from))))
13788                    ;; Has to be present.
13789                    (re-search-forward "^X-Face: " nil t))
13790           ;; We now have the area of the buffer where the X-Face is stored.
13791           (let ((beg (point))
13792                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
13793             ;; We display the face.
13794             (if (symbolp gnus-article-x-face-command)
13795                 ;; The command is a lisp function, so we call it.
13796                 (if (gnus-functionp gnus-article-x-face-command)
13797                     (funcall gnus-article-x-face-command beg end)
13798                   (error "%s is not a function" gnus-article-x-face-command))
13799               ;; The command is a string, so we interpret the command
13800               ;; as a, well, command, and fork it off.
13801               (let ((process-connection-type nil))
13802                 (process-kill-without-query
13803                  (start-process
13804                   "gnus-x-face" nil "sh" "-c" gnus-article-x-face-command))
13805                 (process-send-region "gnus-x-face" beg end)
13806                 (process-send-eof "gnus-x-face")))))))))
13807
13808 (defun gnus-headers-decode-quoted-printable ()
13809   "Hack to remove QP encoding from headers."
13810   (let ((case-fold-search t)
13811         (inhibit-point-motion-hooks t)
13812         string)
13813     (goto-char (point-min))
13814     (while (re-search-forward "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
13815       (setq string (match-string 1))
13816       (narrow-to-region (match-beginning 0) (match-end 0))
13817       (delete-region (point-min) (point-max))
13818       (insert string)
13819       (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
13820       (subst-char-in-region (point-min) (point-max) ?_ ? )
13821       (widen)
13822       (goto-char (point-min)))))
13823
13824 (defun gnus-article-de-quoted-unreadable (&optional force)
13825   "Do a naive translation of a quoted-printable-encoded article.
13826 This is in no way, shape or form meant as a replacement for real MIME
13827 processing, but is simply a stop-gap measure until MIME support is
13828 written.
13829 If FORCE, decode the article whether it is marked as quoted-printable
13830 or not."
13831   (interactive (list 'force))
13832   (save-excursion
13833     (set-buffer gnus-article-buffer)
13834     (let ((case-fold-search t)
13835           (buffer-read-only nil)
13836           (type (gnus-fetch-field "content-transfer-encoding")))
13837       (when (or force
13838                 (and type (string-match "quoted-printable" type)))
13839         (gnus-headers-decode-quoted-printable)
13840         (goto-char (point-min))
13841         (search-forward "\n\n" nil 'move)
13842         (gnus-mime-decode-quoted-printable (point) (point-max))))))
13843
13844 (defun gnus-mime-decode-quoted-printable (from to)
13845   "Decode Quoted-Printable in the region between FROM and TO."
13846   (goto-char from)
13847   (while (search-forward "=" to t)
13848     (cond ((eq (following-char) ?\n)
13849            (delete-char -1)
13850            (delete-char 1))
13851           ((looking-at "[0-9A-F][0-9A-F]")
13852            (delete-char -1)
13853            (insert (hexl-hex-string-to-integer
13854                     (buffer-substring (point) (+ 2 (point)))))
13855            (delete-char 2))
13856           ((looking-at "=")
13857            (delete-char 1))
13858           ((gnus-message 3 "Malformed MIME quoted-printable message")))))
13859
13860 (defun gnus-article-hide-pgp (&optional arg)
13861   "Toggle hiding of any PGP headers and signatures in the current article.
13862 If given a negative prefix, always show; if given a positive prefix,
13863 always hide."
13864   (interactive "P")
13865   (unless (gnus-article-check-hidden-text 'pgp arg)
13866     (save-excursion
13867       (set-buffer gnus-article-buffer)
13868       (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties))
13869             buffer-read-only beg end)
13870         (widen)
13871         (goto-char (point-min))
13872         ;; Hide the "header".
13873         (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
13874              (gnus-hide-text (match-beginning 0) (match-end 0) props))
13875         (setq beg (point))
13876         ;; Hide the actual signature.
13877         (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
13878              (setq end (1+ (match-beginning 0)))
13879              (gnus-hide-text
13880               end
13881               (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
13882                   (match-end 0)
13883                 ;; Perhaps we shouldn't hide to the end of the buffer
13884                 ;; if there is no end to the signature?
13885                 (point-max))
13886               props))
13887         ;; Hide "- " PGP quotation markers.
13888         (when (and beg end)
13889           (narrow-to-region beg end)
13890           (goto-char (point-min))
13891           (while (re-search-forward "^- " nil t)
13892             (gnus-hide-text (match-beginning 0) (match-end 0) props))
13893           (widen))))))
13894
13895 (defun gnus-article-hide-signature (&optional arg)
13896   "Hide the signature in the current article.
13897 If given a negative prefix, always show; if given a positive prefix,
13898 always hide."
13899   (interactive "P")
13900   (unless (gnus-article-check-hidden-text 'signature arg)
13901     (save-excursion
13902       (set-buffer gnus-article-buffer)
13903       (save-restriction
13904         (let ((buffer-read-only nil))
13905           (when (gnus-narrow-to-signature)
13906             (gnus-hide-text-type (point-min) (point-max) 'signature)))))))
13907
13908 (defun gnus-article-strip-leading-blank-lines ()
13909   "Remove all blank lines from the beginning of the article."
13910   (interactive)
13911   (save-excursion
13912     (set-buffer gnus-article-buffer)
13913     (let (buffer-read-only)
13914       (goto-char (point-min))
13915       (when (search-forward "\n\n" nil t)
13916         (while (looking-at "[ \t]$")
13917           (gnus-delete-line))))))
13918
13919 (defun gnus-narrow-to-signature ()
13920   "Narrow to the signature."
13921   (widen)
13922   (goto-char (point-max))
13923   (when (re-search-backward gnus-signature-separator nil t)
13924     (forward-line 1)
13925     (when (or (null gnus-signature-limit)
13926               (and (numberp gnus-signature-limit)
13927                    (< (- (point-max) (point)) gnus-signature-limit))
13928               (and (gnus-functionp gnus-signature-limit)
13929                    (funcall gnus-signature-limit))
13930               (and (stringp gnus-signature-limit)
13931                    (not (re-search-forward gnus-signature-limit nil t))))
13932       (narrow-to-region (point) (point-max))
13933       t)))
13934
13935 (defun gnus-article-check-hidden-text (type arg)
13936   "Return nil if hiding is necessary."
13937   (save-excursion
13938     (set-buffer gnus-article-buffer)
13939     (let ((hide (gnus-article-hidden-text-p type)))
13940       (cond ((or (and (null arg) (eq hide 'hidden))
13941                  (and arg (< 0 (prefix-numeric-value arg))))
13942              (gnus-article-show-hidden-text type))
13943             ((eq hide 'shown)
13944              (gnus-article-show-hidden-text type t))
13945             (t nil)))))
13946
13947 (defun gnus-article-hidden-text-p (type)
13948   "Say whether the current buffer contains hidden text of type TYPE."
13949   (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type)))
13950     (when pos
13951       (if (get-text-property pos 'invisible)
13952           'hidden
13953         'shown))))
13954
13955 (defun gnus-article-hide (&optional arg force)
13956   "Hide all the gruft in the current article.
13957 This means that PGP stuff, signatures, cited text and (some)
13958 headers will be hidden.
13959 If given a prefix, show the hidden text instead."
13960   (interactive (list current-prefix-arg 'force))
13961   (gnus-article-hide-headers arg)
13962   (gnus-article-hide-pgp arg)
13963   (gnus-article-hide-citation-maybe arg force)
13964   (gnus-article-hide-signature arg))
13965
13966 (defun gnus-article-show-hidden-text (type &optional hide)
13967   "Show all hidden text of type TYPE.
13968 If HIDE, hide the text instead."
13969   (save-excursion
13970     (set-buffer gnus-article-buffer)
13971     (let ((buffer-read-only nil)
13972           (inhibit-point-motion-hooks t)
13973           (beg (point-min)))
13974       (while (gnus-goto-char (text-property-any
13975                               beg (point-max) 'gnus-type type))
13976         (setq beg (point))
13977         (forward-char)
13978         (if hide
13979             (gnus-hide-text beg (point) gnus-hidden-properties)
13980           (gnus-unhide-text beg (point)))
13981         (setq beg (point)))
13982       t)))
13983
13984 (defvar gnus-article-time-units
13985   `((year . ,(* 365.25 24 60 60))
13986     (week . ,(* 7 24 60 60))
13987     (day . ,(* 24 60 60))
13988     (hour . ,(* 60 60))
13989     (minute . 60)
13990     (second . 1))
13991   "Mapping from time units to seconds.")
13992
13993 (defun gnus-article-date-ut (&optional type highlight)
13994   "Convert DATE date to universal time in the current article.
13995 If TYPE is `local', convert to local time; if it is `lapsed', output
13996 how much time has lapsed since DATE."
13997   (interactive (list 'ut t))
13998   (let* ((header (or gnus-current-headers
13999                      (gnus-summary-article-header) ""))
14000          (date (and (vectorp header) (mail-header-date header)))
14001          (date-regexp "^Date: \\|^X-Sent: ")
14002          (now (current-time))
14003          (inhibit-point-motion-hooks t))
14004     (when (and date (not (string= date "")))
14005       (save-excursion
14006         (set-buffer gnus-article-buffer)
14007         (save-restriction
14008           (nnheader-narrow-to-headers)
14009           (let ((buffer-read-only nil))
14010             ;; Delete any old Date headers.
14011             (if (zerop (message-remove-header date-regexp t))
14012                 (beginning-of-line)
14013               (goto-char (point-max)))
14014             (insert
14015              (cond
14016               ;; Convert to the local timezone.  We have to slap a
14017               ;; `condition-case' round the calls to the timezone
14018               ;; functions since they aren't particularly resistant to
14019               ;; buggy dates.
14020               ((eq type 'local)
14021                (concat "Date: " (condition-case ()
14022                                     (timezone-make-date-arpa-standard date)
14023                                   (error date))
14024                        "\n"))
14025               ;; Convert to Universal Time.
14026               ((eq type 'ut)
14027                (concat "Date: "
14028                        (condition-case ()
14029                            (timezone-make-date-arpa-standard date nil "UT")
14030                          (error date))
14031                        "\n"))
14032               ;; Get the original date from the article.
14033               ((eq type 'original)
14034                (concat "Date: " date "\n"))
14035               ;; Do an X-Sent lapsed format.
14036               ((eq type 'lapsed)
14037                ;; If the date is seriously mangled, the timezone
14038                ;; functions are liable to bug out, so we condition-case
14039                ;; the entire thing.
14040                (let* ((real-time
14041                        (condition-case ()
14042                            (gnus-time-minus
14043                             (gnus-encode-date
14044                              (timezone-make-date-arpa-standard
14045                               (current-time-string now)
14046                               (current-time-zone now) "UT"))
14047                             (gnus-encode-date
14048                              (timezone-make-date-arpa-standard
14049                               date nil "UT")))
14050                          (error '(0 0))))
14051                       (real-sec (+ (* (float (car real-time)) 65536)
14052                                    (cadr real-time)))
14053                       (sec (abs real-sec))
14054                       num prev)
14055                  (if (zerop sec)
14056                      "X-Sent: Now\n"
14057                    (concat
14058                     "X-Sent: "
14059                     ;; This is a bit convoluted, but basically we go
14060                     ;; through the time units for years, weeks, etc,
14061                     ;; and divide things to see whether that results
14062                     ;; in positive answers.
14063                     (mapconcat
14064                      (lambda (unit)
14065                        (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
14066                            ;; The (remaining) seconds are too few to
14067                            ;; be divided into this time unit.
14068                            ""
14069                          ;; It's big enough, so we output it.
14070                          (setq sec (- sec (* num (cdr unit))))
14071                          (prog1
14072                              (concat (if prev ", " "") (int-to-string
14073                                                         (floor num))
14074                                      " " (symbol-name (car unit))
14075                                      (if (> num 1) "s" ""))
14076                            (setq prev t))))
14077                      gnus-article-time-units "")
14078                     ;; If dates are odd, then it might appear like the
14079                     ;; article was sent in the future.
14080                     (if (> real-sec 0)
14081                         " ago\n"
14082                       " in the future\n")))))
14083               (t
14084                (error "Unknown conversion type: %s" type)))))
14085           ;; Do highlighting.
14086           (when (and highlight (gnus-visual-p 'article-highlight 'highlight))
14087             (gnus-article-highlight-headers)))))))
14088
14089 (defun gnus-article-date-local (&optional highlight)
14090   "Convert the current article date to the local timezone."
14091   (interactive (list t))
14092   (gnus-article-date-ut 'local highlight))
14093
14094 (defun gnus-article-date-original (&optional highlight)
14095   "Convert the current article date to what it was originally.
14096 This is only useful if you have used some other date conversion
14097 function and want to see what the date was before converting."
14098   (interactive (list t))
14099   (gnus-article-date-ut 'original highlight))
14100
14101 (defun gnus-article-date-lapsed (&optional highlight)
14102   "Convert the current article date to time lapsed since it was sent."
14103   (interactive (list t))
14104   (gnus-article-date-ut 'lapsed highlight))
14105
14106 (defun gnus-article-maybe-highlight ()
14107   "Do some article highlighting if `gnus-visual' is non-nil."
14108   (if (gnus-visual-p 'article-highlight 'highlight)
14109       (gnus-article-highlight-some)))
14110
14111 ;; Article savers.
14112
14113 (defun gnus-output-to-rmail (file-name)
14114   "Append the current article to an Rmail file named FILE-NAME."
14115   (require 'rmail)
14116   ;; Most of these codes are borrowed from rmailout.el.
14117   (setq file-name (expand-file-name file-name))
14118   (setq rmail-default-rmail-file file-name)
14119   (let ((artbuf (current-buffer))
14120         (tmpbuf (get-buffer-create " *Gnus-output*")))
14121     (save-excursion
14122       (or (get-file-buffer file-name)
14123           (file-exists-p file-name)
14124           (if (gnus-yes-or-no-p
14125                (concat "\"" file-name "\" does not exist, create it? "))
14126               (let ((file-buffer (create-file-buffer file-name)))
14127                 (save-excursion
14128                   (set-buffer file-buffer)
14129                   (rmail-insert-rmail-file-header)
14130                   (let ((require-final-newline nil))
14131                     (write-region (point-min) (point-max) file-name t 1)))
14132                 (kill-buffer file-buffer))
14133             (error "Output file does not exist")))
14134       (set-buffer tmpbuf)
14135       (buffer-disable-undo (current-buffer))
14136       (erase-buffer)
14137       (insert-buffer-substring artbuf)
14138       (gnus-convert-article-to-rmail)
14139       ;; Decide whether to append to a file or to an Emacs buffer.
14140       (let ((outbuf (get-file-buffer file-name)))
14141         (if (not outbuf)
14142             (append-to-file (point-min) (point-max) file-name)
14143           ;; File has been visited, in buffer OUTBUF.
14144           (set-buffer outbuf)
14145           (let ((buffer-read-only nil)
14146                 (msg (and (boundp 'rmail-current-message)
14147                           (symbol-value 'rmail-current-message))))
14148             ;; If MSG is non-nil, buffer is in RMAIL mode.
14149             (if msg
14150                 (progn (widen)
14151                        (narrow-to-region (point-max) (point-max))))
14152             (insert-buffer-substring tmpbuf)
14153             (if msg
14154                 (progn
14155                   (goto-char (point-min))
14156                   (widen)
14157                   (search-backward "\^_")
14158                   (narrow-to-region (point) (point-max))
14159                   (goto-char (1+ (point-min)))
14160                   (rmail-count-new-messages t)
14161                   (rmail-show-message msg)))))))
14162     (kill-buffer tmpbuf)))
14163
14164 (defun gnus-output-to-file (file-name)
14165   "Append the current article to a file named FILE-NAME."
14166   (setq file-name (expand-file-name file-name))
14167   (let ((artbuf (current-buffer))
14168         (tmpbuf (get-buffer-create " *Gnus-output*")))
14169     (save-excursion
14170       (set-buffer tmpbuf)
14171       (buffer-disable-undo (current-buffer))
14172       (erase-buffer)
14173       (insert-buffer-substring artbuf)
14174       ;; Append newline at end of the buffer as separator, and then
14175       ;; save it to file.
14176       (goto-char (point-max))
14177       (insert "\n")
14178       (append-to-file (point-min) (point-max) file-name))
14179     (kill-buffer tmpbuf)))
14180
14181 (defun gnus-convert-article-to-rmail ()
14182   "Convert article in current buffer to Rmail message format."
14183   (let ((buffer-read-only nil))
14184     ;; Convert article directly into Babyl format.
14185     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
14186     (goto-char (point-min))
14187     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
14188     (while (search-forward "\n\^_" nil t) ;single char
14189       (replace-match "\n^_" t t))       ;2 chars: "^" and "_"
14190     (goto-char (point-max))
14191     (insert "\^_")))
14192
14193 (defun gnus-narrow-to-page (&optional arg)
14194   "Narrow the article buffer to a page.
14195 If given a numerical ARG, move forward ARG pages."
14196   (interactive "P")
14197   (setq arg (if arg (prefix-numeric-value arg) 0))
14198   (save-excursion
14199     (set-buffer gnus-article-buffer)
14200     (goto-char (point-min))
14201     (widen)
14202     (when (gnus-visual-p 'page-marker)
14203       (let ((buffer-read-only nil))
14204         (gnus-remove-text-with-property 'gnus-prev)
14205         (gnus-remove-text-with-property 'gnus-next)))
14206     (when
14207         (cond ((< arg 0)
14208                (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
14209               ((> arg 0)
14210                (re-search-forward page-delimiter nil 'move arg)))
14211       (goto-char (match-end 0)))
14212     (narrow-to-region
14213      (point)
14214      (if (re-search-forward page-delimiter nil 'move)
14215          (match-beginning 0)
14216        (point)))
14217     (when (and (gnus-visual-p 'page-marker)
14218                (not (= (point-min) 1)))
14219       (save-excursion
14220         (goto-char (point-min))
14221         (gnus-insert-prev-page-button)))
14222     (when (and (gnus-visual-p 'page-marker)
14223                (not (= (1- (point-max)) (buffer-size))))
14224       (save-excursion
14225         (goto-char (point-max))
14226         (gnus-insert-next-page-button)))))
14227
14228 ;; Article mode commands
14229
14230 (defun gnus-article-goto-next-page ()
14231   "Show the next page of the article."
14232   (interactive)
14233   (when (gnus-article-next-page)
14234     (gnus-article-read-summary-keys nil ?n)))
14235
14236 (defun gnus-article-goto-prev-page ()
14237   "Show the next page of the article."
14238   (interactive)
14239   (if (bobp) (gnus-article-read-summary-keys nil ?n)
14240     (gnus-article-prev-page nil)))
14241
14242 (defun gnus-article-next-page (&optional lines)
14243   "Show the next page of the current article.
14244 If end of article, return non-nil.  Otherwise return nil.
14245 Argument LINES specifies lines to be scrolled up."
14246   (interactive "p")
14247   (move-to-window-line -1)
14248   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
14249   (if (save-excursion
14250         (end-of-line)
14251         (and (pos-visible-in-window-p)  ;Not continuation line.
14252              (eobp)))
14253       ;; Nothing in this page.
14254       (if (or (not gnus-break-pages)
14255               (save-excursion
14256                 (save-restriction
14257                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
14258           t                             ;Nothing more.
14259         (gnus-narrow-to-page 1)         ;Go to next page.
14260         nil)
14261     ;; More in this page.
14262     (condition-case ()
14263         (scroll-up lines)
14264       (end-of-buffer
14265        ;; Long lines may cause an end-of-buffer error.
14266        (goto-char (point-max))))
14267     (move-to-window-line 0)
14268     nil))
14269
14270 (defun gnus-article-prev-page (&optional lines)
14271   "Show previous page of current article.
14272 Argument LINES specifies lines to be scrolled down."
14273   (interactive "p")
14274   (move-to-window-line 0)
14275   (if (and gnus-break-pages
14276            (bobp)
14277            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
14278       (progn
14279         (gnus-narrow-to-page -1)        ;Go to previous page.
14280         (goto-char (point-max))
14281         (recenter -1))
14282     (prog1
14283         (condition-case ()
14284             (scroll-down lines)
14285           (error nil))
14286       (move-to-window-line 0))))
14287
14288 (defun gnus-article-refer-article ()
14289   "Read article specified by message-id around point."
14290   (interactive)
14291   (let ((point (point)))
14292     (search-forward ">" nil t)          ;Move point to end of "<....>".
14293     (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
14294         (let ((message-id (match-string 1)))
14295           (goto-char point)
14296           (set-buffer gnus-summary-buffer)
14297           (gnus-summary-refer-article message-id))
14298       (goto-char (point))
14299       (error "No references around point"))))
14300
14301 (defun gnus-article-show-summary ()
14302   "Reconfigure windows to show summary buffer."
14303   (interactive)
14304   (gnus-configure-windows 'article)
14305   (gnus-summary-goto-subject gnus-current-article))
14306
14307 (defun gnus-article-describe-briefly ()
14308   "Describe article mode commands briefly."
14309   (interactive)
14310   (gnus-message 6
14311                 (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")))
14312
14313 (defun gnus-article-summary-command ()
14314   "Execute the last keystroke in the summary buffer."
14315   (interactive)
14316   (let ((obuf (current-buffer))
14317         (owin (current-window-configuration))
14318         func)
14319     (switch-to-buffer gnus-summary-buffer 'norecord)
14320     (setq func (lookup-key (current-local-map) (this-command-keys)))
14321     (call-interactively func)
14322     (set-buffer obuf)
14323     (set-window-configuration owin)
14324     (set-window-point (get-buffer-window (current-buffer)) (point))))
14325
14326 (defun gnus-article-summary-command-nosave ()
14327   "Execute the last keystroke in the summary buffer."
14328   (interactive)
14329   (let (func)
14330     (pop-to-buffer gnus-summary-buffer 'norecord)
14331     (setq func (lookup-key (current-local-map) (this-command-keys)))
14332     (call-interactively func)))
14333
14334 (defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
14335   "Read a summary buffer key sequence and execute it from the article buffer."
14336   (interactive "P")
14337   (let ((nosaves
14338          '("q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F"
14339            "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
14340            "=" "^" "\M-^"))
14341         keys)
14342     (save-excursion
14343       (set-buffer gnus-summary-buffer)
14344       (push (or key last-command-event) unread-command-events)
14345       (setq keys (read-key-sequence nil)))
14346     (message "")
14347
14348     (if (member keys nosaves)
14349         (let (func)
14350           (pop-to-buffer gnus-summary-buffer 'norecord)
14351           (if (setq func (lookup-key (current-local-map) keys))
14352               (call-interactively func)
14353             (ding)))
14354       (let ((obuf (current-buffer))
14355             (owin (current-window-configuration))
14356             (opoint (point))
14357             func in-buffer)
14358         (if not-restore-window
14359             (pop-to-buffer gnus-summary-buffer 'norecord)
14360           (switch-to-buffer gnus-summary-buffer 'norecord))
14361         (setq in-buffer (current-buffer))
14362         (if (setq func (lookup-key (current-local-map) keys))
14363             (call-interactively func)
14364           (ding))
14365         (when (eq in-buffer (current-buffer))
14366           (set-buffer obuf)
14367           (unless not-restore-window
14368             (set-window-configuration owin))
14369           (set-window-point (get-buffer-window (current-buffer)) opoint))))))
14370
14371 \f
14372 ;;;
14373 ;;; Kill file handling.
14374 ;;;
14375
14376 ;;;###autoload
14377 (defalias 'gnus-batch-kill 'gnus-batch-score)
14378 ;;;###autoload
14379 (defun gnus-batch-score ()
14380   "Run batched scoring.
14381 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
14382 Newsgroups is a list of strings in Bnews format.  If you want to score
14383 the comp hierarchy, you'd say \"comp.all\".  If you would not like to
14384 score the alt hierarchy, you'd say \"!alt.all\"."
14385   (interactive)
14386   (let* ((yes-and-no
14387           (gnus-newsrc-parse-options
14388            (apply (function concat)
14389                   (mapcar (lambda (g) (concat g " "))
14390                           command-line-args-left))))
14391          (gnus-expert-user t)
14392          (nnmail-spool-file nil)
14393          (gnus-use-dribble-file nil)
14394          (yes (car yes-and-no))
14395          (no (cdr yes-and-no))
14396          group newsrc entry
14397          ;; Disable verbose message.
14398          gnus-novice-user gnus-large-newsgroup)
14399     ;; Eat all arguments.
14400     (setq command-line-args-left nil)
14401     ;; Start Gnus.
14402     (gnus)
14403     ;; Apply kills to specified newsgroups in command line arguments.
14404     (setq newsrc (cdr gnus-newsrc-alist))
14405     (while newsrc
14406       (setq group (caar newsrc))
14407       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
14408       (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
14409                (and (car entry)
14410                     (or (eq (car entry) t)
14411                         (not (zerop (car entry)))))
14412                (if yes (string-match yes group) t)
14413                (or (null no) (not (string-match no group))))
14414           (progn
14415             (gnus-summary-read-group group nil t nil t)
14416             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
14417                  (gnus-summary-exit))))
14418       (setq newsrc (cdr newsrc)))
14419     ;; Exit Emacs.
14420     (switch-to-buffer gnus-group-buffer)
14421     (gnus-group-save-newsrc)))
14422
14423 (defun gnus-apply-kill-file ()
14424   "Apply a kill file to the current newsgroup.
14425 Returns the number of articles marked as read."
14426   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
14427           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
14428       (gnus-apply-kill-file-internal)
14429     0))
14430
14431 (defun gnus-kill-save-kill-buffer ()
14432   (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
14433     (when (get-file-buffer file)
14434       (save-excursion
14435         (set-buffer (get-file-buffer file))
14436         (and (buffer-modified-p) (save-buffer))
14437         (kill-buffer (current-buffer))))))
14438
14439 (defvar gnus-kill-file-name "KILL"
14440   "Suffix of the kill files.")
14441
14442 (defun gnus-newsgroup-kill-file (newsgroup)
14443   "Return the name of a kill file name for NEWSGROUP.
14444 If NEWSGROUP is nil, return the global kill file name instead."
14445   (cond 
14446    ;; The global KILL file is placed at top of the directory.
14447    ((or (null newsgroup)
14448         (string-equal newsgroup ""))
14449     (expand-file-name gnus-kill-file-name
14450                       (or gnus-kill-files-directory "~/News")))
14451    ;; Append ".KILL" to newsgroup name.
14452    ((gnus-use-long-file-name 'not-kill)
14453     (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
14454                               "." gnus-kill-file-name)
14455                       (or gnus-kill-files-directory "~/News")))
14456    ;; Place "KILL" under the hierarchical directory.
14457    (t
14458     (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
14459                               "/" gnus-kill-file-name)
14460                       (or gnus-kill-files-directory "~/News")))))
14461
14462 \f
14463 ;;;
14464 ;;; Dribble file
14465 ;;;
14466
14467 (defvar gnus-dribble-ignore nil)
14468 (defvar gnus-dribble-eval-file nil)
14469
14470 (defun gnus-dribble-file-name ()
14471   "Return the dribble file for the current .newsrc."
14472   (concat
14473    (if gnus-dribble-directory
14474        (concat (file-name-as-directory gnus-dribble-directory)
14475                (file-name-nondirectory gnus-current-startup-file))
14476      gnus-current-startup-file)
14477    "-dribble"))
14478
14479 (defun gnus-dribble-enter (string)
14480   "Enter STRING into the dribble buffer."
14481   (if (and (not gnus-dribble-ignore)
14482            gnus-dribble-buffer
14483            (buffer-name gnus-dribble-buffer))
14484       (let ((obuf (current-buffer)))
14485         (set-buffer gnus-dribble-buffer)
14486         (insert string "\n")
14487         (set-window-point (get-buffer-window (current-buffer)) (point-max))
14488         (set-buffer obuf))))
14489
14490 (defun gnus-dribble-read-file ()
14491   "Read the dribble file from disk."
14492   (let ((dribble-file (gnus-dribble-file-name)))
14493     (save-excursion
14494       (set-buffer (setq gnus-dribble-buffer
14495                         (get-buffer-create
14496                          (file-name-nondirectory dribble-file))))
14497       (gnus-add-current-to-buffer-list)
14498       (erase-buffer)
14499       (setq buffer-file-name dribble-file)
14500       (auto-save-mode t)
14501       (buffer-disable-undo (current-buffer))
14502       (bury-buffer (current-buffer))
14503       (set-buffer-modified-p nil)
14504       (let ((auto (make-auto-save-file-name))
14505             (gnus-dribble-ignore t))
14506         (when (or (file-exists-p auto) (file-exists-p dribble-file))
14507           ;; Load whichever file is newest -- the auto save file
14508           ;; or the "real" file.
14509           (if (file-newer-than-file-p auto dribble-file)
14510               (insert-file-contents auto)
14511             (insert-file-contents dribble-file))
14512           (unless (zerop (buffer-size))
14513             (set-buffer-modified-p t))
14514           ;; Set the file modes to reflect the .newsrc file modes.
14515           (save-buffer)
14516           (when (file-exists-p gnus-current-startup-file)
14517             (set-file-modes dribble-file
14518                             (file-modes gnus-current-startup-file)))
14519           ;; Possibly eval the file later.
14520           (when (gnus-y-or-n-p
14521                  "Auto-save file exists.  Do you want to read it? ")
14522             (setq gnus-dribble-eval-file t)))))))
14523
14524 (defun gnus-dribble-eval-file ()
14525   (if (not gnus-dribble-eval-file)
14526       ()
14527     (setq gnus-dribble-eval-file nil)
14528     (save-excursion
14529       (let ((gnus-dribble-ignore t))
14530         (set-buffer gnus-dribble-buffer)
14531         (eval-buffer (current-buffer))))))
14532
14533 (defun gnus-dribble-delete-file ()
14534   (if (file-exists-p (gnus-dribble-file-name))
14535       (delete-file (gnus-dribble-file-name)))
14536   (if gnus-dribble-buffer
14537       (save-excursion
14538         (set-buffer gnus-dribble-buffer)
14539         (let ((auto (make-auto-save-file-name)))
14540           (if (file-exists-p auto)
14541               (delete-file auto))
14542           (erase-buffer)
14543           (set-buffer-modified-p nil)))))
14544
14545 (defun gnus-dribble-save ()
14546   (if (and gnus-dribble-buffer
14547            (buffer-name gnus-dribble-buffer))
14548       (save-excursion
14549         (set-buffer gnus-dribble-buffer)
14550         (save-buffer))))
14551
14552 (defun gnus-dribble-clear ()
14553   (save-excursion
14554     (if (gnus-buffer-exists-p gnus-dribble-buffer)
14555         (progn
14556           (set-buffer gnus-dribble-buffer)
14557           (erase-buffer)
14558           (set-buffer-modified-p nil)
14559           (setq buffer-saved-size (buffer-size))))))
14560
14561 \f
14562 ;;;
14563 ;;; Server Communication
14564 ;;;
14565
14566 (defun gnus-start-news-server (&optional confirm)
14567   "Open a method for getting news.
14568 If CONFIRM is non-nil, the user will be asked for an NNTP server."
14569   (let (how)
14570     (if gnus-current-select-method
14571         ;; Stream is already opened.
14572         nil
14573       ;; Open NNTP server.
14574       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
14575       (if confirm
14576           (progn
14577             ;; Read server name with completion.
14578             (setq gnus-nntp-server
14579                   (completing-read "NNTP server: "
14580                                    (mapcar (lambda (server) (list server))
14581                                            (cons (list gnus-nntp-server)
14582                                                  gnus-secondary-servers))
14583                                    nil nil gnus-nntp-server))))
14584
14585       (if (and gnus-nntp-server
14586                (stringp gnus-nntp-server)
14587                (not (string= gnus-nntp-server "")))
14588           (setq gnus-select-method
14589                 (cond ((or (string= gnus-nntp-server "")
14590                            (string= gnus-nntp-server "::"))
14591                        (list 'nnspool (system-name)))
14592                       ((string-match "^:" gnus-nntp-server)
14593                        (list 'nnmh gnus-nntp-server
14594                              (list 'nnmh-directory
14595                                    (file-name-as-directory
14596                                     (expand-file-name
14597                                      (concat "~/" (substring
14598                                                    gnus-nntp-server 1)))))
14599                              (list 'nnmh-get-new-mail nil)))
14600                       (t
14601                        (list 'nntp gnus-nntp-server)))))
14602
14603       (setq how (car gnus-select-method))
14604       (cond ((eq how 'nnspool)
14605              (require 'nnspool)
14606              (gnus-message 5 "Looking up local news spool..."))
14607             ((eq how 'nnmh)
14608              (require 'nnmh)
14609              (gnus-message 5 "Looking up mh spool..."))
14610             (t
14611              (require 'nntp)))
14612       (setq gnus-current-select-method gnus-select-method)
14613       (run-hooks 'gnus-open-server-hook)
14614       (or
14615        ;; gnus-open-server-hook might have opened it
14616        (gnus-server-opened gnus-select-method)
14617        (gnus-open-server gnus-select-method)
14618        (gnus-y-or-n-p
14619         (format
14620          "%s (%s) open error: '%s'.     Continue? "
14621          (car gnus-select-method) (cadr gnus-select-method)
14622          (gnus-status-message gnus-select-method)))
14623        (progn
14624          (gnus-message 1 "Couldn't open server on %s"
14625                        (nth 1 gnus-select-method))
14626          (ding)
14627          nil)))))
14628
14629 (defun gnus-check-group (group)
14630   "Try to make sure that the server where GROUP exists is alive."
14631   (let ((method (gnus-find-method-for-group group)))
14632     (or (gnus-server-opened method)
14633         (gnus-open-server method))))
14634
14635 (defun gnus-check-server (&optional method silent)
14636   "Check whether the connection to METHOD is down.
14637 If METHOD is nil, use `gnus-select-method'.
14638 If it is down, start it up (again)."
14639   (let ((method (or method gnus-select-method)))
14640     ;; Transform virtual server names into select methods.
14641     (when (stringp method)
14642       (setq method (gnus-server-to-method method)))
14643     (if (gnus-server-opened method)
14644         ;; The stream is already opened.
14645         t
14646       ;; Open the server.
14647       (unless silent
14648         (gnus-message 5 "Opening %s server%s..." (car method)
14649                       (if (equal (nth 1 method) "") ""
14650                         (format " on %s" (nth 1 method)))))
14651       (run-hooks 'gnus-open-server-hook)
14652       (prog1
14653           (gnus-open-server method)
14654         (unless silent
14655           (message ""))))))
14656
14657 (defun gnus-get-function (method function)
14658   "Return a function symbol based on METHOD and FUNCTION."
14659   ;; Translate server names into methods.
14660   (unless method
14661     (error "Attempted use of a nil select method"))
14662   (when (stringp method)
14663     (setq method (gnus-server-to-method method)))
14664   (let ((func (intern (format "%s-%s" (car method) function))))
14665     ;; If the functions isn't bound, we require the backend in
14666     ;; question.
14667     (unless (fboundp func)
14668       (require (car method))
14669       (unless (fboundp func)
14670         ;; This backend doesn't implement this function.
14671         (error "No such function: %s" func)))
14672     func))
14673
14674 \f
14675 ;;;
14676 ;;; Interface functions to the backends.
14677 ;;;
14678
14679 (defun gnus-open-server (method)
14680   "Open a connection to METHOD."
14681   (when (stringp method)
14682     (setq method (gnus-server-to-method method)))
14683   (let ((elem (assoc method gnus-opened-servers)))
14684     ;; If this method was previously denied, we just return nil.
14685     (if (eq (nth 1 elem) 'denied)
14686         (progn
14687           (gnus-message 1 "Denied server")
14688           nil)
14689       ;; Open the server.
14690       (let ((result
14691              (funcall (gnus-get-function method 'open-server)
14692                       (nth 1 method) (nthcdr 2 method))))
14693         ;; If this hasn't been opened before, we add it to the list.
14694         (unless elem
14695           (setq elem (list method nil)
14696                 gnus-opened-servers (cons elem gnus-opened-servers)))
14697         ;; Set the status of this server.
14698         (setcar (cdr elem) (if result 'ok 'denied))
14699         ;; Return the result from the "open" call.
14700         result))))
14701
14702 (defun gnus-close-server (method)
14703   "Close the connection to METHOD."
14704   (when (stringp method)
14705     (setq method (gnus-server-to-method method)))
14706   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
14707
14708 (defun gnus-request-list (method)
14709   "Request the active file from METHOD."
14710   (when (stringp method)
14711     (setq method (gnus-server-to-method method)))
14712   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
14713
14714 (defun gnus-request-list-newsgroups (method)
14715   "Request the newsgroups file from METHOD."
14716   (when (stringp method)
14717     (setq method (gnus-server-to-method method)))
14718   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
14719
14720 (defun gnus-request-newgroups (date method)
14721   "Request all new groups since DATE from METHOD."
14722   (when (stringp method)
14723     (setq method (gnus-server-to-method method)))
14724   (funcall (gnus-get-function method 'request-newgroups)
14725            date (nth 1 method)))
14726
14727 (defun gnus-server-opened (method)
14728   "Check whether a connection to METHOD has been opened."
14729   (when (stringp method)
14730     (setq method (gnus-server-to-method method)))
14731   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
14732
14733 (defun gnus-status-message (method)
14734   "Return the status message from METHOD.
14735 If METHOD is a string, it is interpreted as a group name.   The method
14736 this group uses will be queried."
14737   (let ((method (if (stringp method) (gnus-find-method-for-group method)
14738                   method)))
14739     (funcall (gnus-get-function method 'status-message) (nth 1 method))))
14740
14741 (defun gnus-request-group (group &optional dont-check method)
14742   "Request GROUP.  If DONT-CHECK, no information is required."
14743   (let ((method (or method (gnus-find-method-for-group group))))
14744     (when (stringp method)
14745       (setq method (gnus-server-to-method method)))
14746     (funcall (gnus-get-function method 'request-group)
14747              (gnus-group-real-name group) (nth 1 method) dont-check)))
14748
14749 (defun gnus-request-asynchronous (group &optional articles)
14750   "Request that GROUP behave asynchronously.
14751 ARTICLES is the `data' of the group."
14752   (let ((method (gnus-find-method-for-group group)))
14753     (funcall (gnus-get-function method 'request-asynchronous)
14754              (gnus-group-real-name group) (nth 1 method) articles)))
14755
14756 (defun gnus-list-active-group (group)
14757   "Request active information on GROUP."
14758   (let ((method (gnus-find-method-for-group group))
14759         (func 'list-active-group))
14760     (when (gnus-check-backend-function func group)
14761       (funcall (gnus-get-function method func)
14762                (gnus-group-real-name group) (nth 1 method)))))
14763
14764 (defun gnus-request-group-description (group)
14765   "Request a description of GROUP."
14766   (let ((method (gnus-find-method-for-group group))
14767         (func 'request-group-description))
14768     (when (gnus-check-backend-function func group)
14769       (funcall (gnus-get-function method func)
14770                (gnus-group-real-name group) (nth 1 method)))))
14771
14772 (defun gnus-close-group (group)
14773   "Request the GROUP be closed."
14774   (let ((method (gnus-find-method-for-group group)))
14775     (funcall (gnus-get-function method 'close-group)
14776              (gnus-group-real-name group) (nth 1 method))))
14777
14778 (defun gnus-retrieve-headers (articles group &optional fetch-old)
14779   "Request headers for ARTICLES in GROUP.
14780 If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
14781   (let ((method (gnus-find-method-for-group group)))
14782     (if (and gnus-use-cache (numberp (car articles)))
14783         (gnus-cache-retrieve-headers articles group fetch-old)
14784       (funcall (gnus-get-function method 'retrieve-headers)
14785                articles (gnus-group-real-name group) (nth 1 method)
14786                fetch-old))))
14787
14788 (defun gnus-retrieve-groups (groups method)
14789   "Request active information on GROUPS from METHOD."
14790   (when (stringp method)
14791     (setq method (gnus-server-to-method method)))
14792   (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
14793
14794 (defun gnus-request-type (group &optional article)
14795   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
14796   (let ((method (gnus-find-method-for-group group)))
14797     (if (not (gnus-check-backend-function 'request-type (car method)))
14798         'unknown
14799       (funcall (gnus-get-function method 'request-type)
14800                (gnus-group-real-name group) article))))
14801
14802 (defun gnus-request-update-mark (group article mark)
14803   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
14804   (let ((method (gnus-find-method-for-group group)))
14805     (if (not (gnus-check-backend-function 'request-update-mark (car method)))
14806         mark
14807       (funcall (gnus-get-function method 'request-update-mark)
14808                (gnus-group-real-name group) article mark))))
14809
14810 (defun gnus-request-article (article group &optional buffer)
14811   "Request the ARTICLE in GROUP.
14812 ARTICLE can either be an article number or an article Message-ID.
14813 If BUFFER, insert the article in that group."
14814   (let ((method (gnus-find-method-for-group group)))
14815     (funcall (gnus-get-function method 'request-article)
14816              article (gnus-group-real-name group) (nth 1 method) buffer)))
14817
14818 (defun gnus-request-head (article group)
14819   "Request the head of ARTICLE in GROUP."
14820   (let ((method (gnus-find-method-for-group group)))
14821     (funcall (gnus-get-function method 'request-head)
14822              article (gnus-group-real-name group) (nth 1 method))))
14823
14824 (defun gnus-request-body (article group)
14825   "Request the body of ARTICLE in GROUP."
14826   (let ((method (gnus-find-method-for-group group)))
14827     (funcall (gnus-get-function method 'request-body)
14828              article (gnus-group-real-name group) (nth 1 method))))
14829
14830 (defun gnus-request-post (method)
14831   "Post the current buffer using METHOD."
14832   (when (stringp method)
14833     (setq method (gnus-server-to-method method)))
14834   (funcall (gnus-get-function method 'request-post) (nth 1 method)))
14835
14836 (defun gnus-request-scan (group method)
14837   "Request a SCAN being performed in GROUP from METHOD.
14838 If GROUP is nil, all groups on METHOD are scanned."
14839   (let ((method (if group (gnus-find-method-for-group group) method)))
14840     (funcall (gnus-get-function method 'request-scan)
14841              (and group (gnus-group-real-name group)) (nth 1 method))))
14842
14843 (defsubst gnus-request-update-info (info method)
14844   "Request that METHOD update INFO."
14845   (when (stringp method)
14846     (setq method (gnus-server-to-method method)))
14847   (when (gnus-check-backend-function 'request-update-info (car method))
14848     (funcall (gnus-get-function method 'request-update-info)
14849              (gnus-group-real-name (gnus-info-group info))
14850              info (nth 1 method))))
14851
14852 (defun gnus-request-expire-articles (articles group &optional force)
14853   (let ((method (gnus-find-method-for-group group)))
14854     (funcall (gnus-get-function method 'request-expire-articles)
14855              articles (gnus-group-real-name group) (nth 1 method)
14856              force)))
14857
14858 (defun gnus-request-move-article
14859   (article group server accept-function &optional last)
14860   (let ((method (gnus-find-method-for-group group)))
14861     (funcall (gnus-get-function method 'request-move-article)
14862              article (gnus-group-real-name group)
14863              (nth 1 method) accept-function last)))
14864
14865 (defun gnus-request-accept-article (group &optional last method)
14866   ;; Make sure there's a newline at the end of the article.
14867   (when (stringp method)
14868     (setq method (gnus-server-to-method method)))
14869   (goto-char (point-max))
14870   (unless (bolp)
14871     (insert "\n"))
14872   (let ((func (if (symbolp group) group
14873                 (car (or method (gnus-find-method-for-group group))))))
14874     (funcall (intern (format "%s-request-accept-article" func))
14875              (if (stringp group) (gnus-group-real-name group) group)
14876              last)))
14877
14878 (defun gnus-request-replace-article (article group buffer)
14879   (let ((func (car (gnus-find-method-for-group group))))
14880     (funcall (intern (format "%s-request-replace-article" func))
14881              article (gnus-group-real-name group) buffer)))
14882
14883 (defun gnus-request-associate-buffer (group)
14884   (let ((method (gnus-find-method-for-group group)))
14885     (funcall (gnus-get-function method 'request-associate-buffer)
14886              (gnus-group-real-name group))))
14887
14888 (defun gnus-request-restore-buffer (article group)
14889   "Request a new buffer restored to the state of ARTICLE."
14890   (let ((method (gnus-find-method-for-group group)))
14891     (funcall (gnus-get-function method 'request-restore-buffer)
14892              article (gnus-group-real-name group) (nth 1 method))))
14893
14894 (defun gnus-request-create-group (group &optional method)
14895   (when (stringp method)
14896     (setq method (gnus-server-to-method method)))
14897   (let ((method (or method (gnus-find-method-for-group group))))
14898     (funcall (gnus-get-function method 'request-create-group)
14899              (gnus-group-real-name group) (nth 1 method))))
14900
14901 (defun gnus-request-delete-group (group &optional force)
14902   (let ((method (gnus-find-method-for-group group)))
14903     (funcall (gnus-get-function method 'request-delete-group)
14904              (gnus-group-real-name group) force (nth 1 method))))
14905
14906 (defun gnus-request-rename-group (group new-name)
14907   (let ((method (gnus-find-method-for-group group)))
14908     (funcall (gnus-get-function method 'request-rename-group)
14909              (gnus-group-real-name group)
14910              (gnus-group-real-name new-name) (nth 1 method))))
14911
14912 (defun gnus-member-of-valid (symbol group)
14913   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
14914   (memq symbol (assoc
14915                 (symbol-name (car (gnus-find-method-for-group group)))
14916                 gnus-valid-select-methods)))
14917
14918 (defun gnus-method-option-p (method option)
14919   "Return non-nil if select METHOD has OPTION as a parameter."
14920   (when (stringp method)
14921     (setq method (gnus-server-to-method method)))
14922   (memq option (assoc (format "%s" (car method))
14923                       gnus-valid-select-methods)))
14924
14925 (defun gnus-server-extend-method (group method)
14926   ;; This function "extends" a virtual server.  If the server is
14927   ;; "hello", and the select method is ("hello" (my-var "something"))
14928   ;; in the group "alt.alt", this will result in a new virtual server
14929   ;; called "hello+alt.alt".
14930   (let ((entry
14931          (gnus-copy-sequence
14932           (if (equal (car method) "native") gnus-select-method
14933             (cdr (assoc (car method) gnus-server-alist))))))
14934     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
14935     (nconc entry (cdr method))))
14936
14937 (defun gnus-find-method-for-group (group &optional info)
14938   "Find the select method that GROUP uses."
14939   (or gnus-override-method
14940       (and (not group)
14941            gnus-select-method)
14942       (let ((info (or info (gnus-get-info group)))
14943             method)
14944         (if (or (not info)
14945                 (not (setq method (gnus-info-method info)))
14946                 (equal method "native"))
14947             gnus-select-method
14948           (setq method
14949                 (cond ((stringp method)
14950                        (gnus-server-to-method method))
14951                       ((stringp (car method))
14952                        (gnus-server-extend-method group method))
14953                       (t
14954                        method)))
14955           (if (equal (cadr method) "")
14956               method
14957             (gnus-server-add-address method))))))
14958
14959 (defun gnus-check-backend-function (func group)
14960   "Check whether GROUP supports function FUNC."
14961   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
14962                   group)))
14963     (fboundp (intern (format "%s-%s" method func)))))
14964
14965 (defun gnus-methods-using (feature)
14966   "Find all methods that have FEATURE."
14967   (let ((valids gnus-valid-select-methods)
14968         outs)
14969     (while valids
14970       (if (memq feature (car valids))
14971           (setq outs (cons (car valids) outs)))
14972       (setq valids (cdr valids)))
14973     outs))
14974
14975 \f
14976 ;;;
14977 ;;; Active & Newsrc File Handling
14978 ;;;
14979
14980 (defun gnus-setup-news (&optional rawfile level dont-connect)
14981   "Setup news information.
14982 If RAWFILE is non-nil, the .newsrc file will also be read.
14983 If LEVEL is non-nil, the news will be set up at level LEVEL."
14984   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
14985
14986     (when init 
14987       ;; Clear some variables to re-initialize news information.
14988       (setq gnus-newsrc-alist nil
14989             gnus-active-hashtb nil)
14990       ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
14991       (gnus-read-newsrc-file rawfile))
14992
14993     (when (and (not (assoc "archive" gnus-server-alist))
14994                gnus-message-archive-method)
14995       (push (cons "archive" gnus-message-archive-method)
14996             gnus-server-alist))
14997
14998     ;; If we don't read the complete active file, we fill in the
14999     ;; hashtb here.
15000     (if (or (null gnus-read-active-file)
15001             (eq gnus-read-active-file 'some))
15002         (gnus-update-active-hashtb-from-killed))
15003
15004     ;; Read the active file and create `gnus-active-hashtb'.
15005     ;; If `gnus-read-active-file' is nil, then we just create an empty
15006     ;; hash table.  The partial filling out of the hash table will be
15007     ;; done in `gnus-get-unread-articles'.
15008     (and gnus-read-active-file
15009          (not level)
15010          (gnus-read-active-file))
15011
15012     (or gnus-active-hashtb
15013         (setq gnus-active-hashtb (make-vector 4095 0)))
15014
15015     ;; Initialize the cache.
15016     (when gnus-use-cache
15017       (gnus-cache-open))
15018
15019     ;; Possibly eval the dribble file.
15020     (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
15021
15022     (gnus-update-format-specifications)
15023
15024     ;; See whether we need to read the description file.
15025     (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
15026              (not gnus-description-hashtb)
15027              (not dont-connect)
15028              gnus-read-active-file)
15029         (gnus-read-all-descriptions-files))
15030
15031     ;; Find new newsgroups and treat them.
15032     (if (and init gnus-check-new-newsgroups (not level)
15033              (gnus-check-server gnus-select-method))
15034         (gnus-find-new-newsgroups))
15035
15036     ;; We might read in new NoCeM messages here.
15037     (when gnus-use-nocem 
15038       (gnus-nocem-scan-groups))
15039
15040     ;; Find the number of unread articles in each non-dead group.
15041     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
15042       (gnus-get-unread-articles level))
15043
15044     (if (and init gnus-check-bogus-newsgroups
15045              gnus-read-active-file (not level)
15046              (gnus-server-opened gnus-select-method))
15047         (gnus-check-bogus-newsgroups))))
15048
15049 (defun gnus-find-new-newsgroups (&optional arg)
15050   "Search for new newsgroups and add them.
15051 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
15052 The `-n' option line from .newsrc is respected.
15053 If ARG (the prefix), use the `ask-server' method to query
15054 the server for new groups."
15055   (interactive "P")
15056   (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups)))
15057                        (null gnus-read-active-file)
15058                        (eq gnus-read-active-file 'some))
15059                    'ask-server gnus-check-new-newsgroups)))
15060     (unless (gnus-check-first-time-used)
15061       (if (or (consp check)
15062               (eq check 'ask-server))
15063           ;; Ask the server for new groups.
15064           (gnus-ask-server-for-new-groups)
15065         ;; Go through the active hashtb and look for new groups.
15066         (let ((groups 0)
15067               group new-newsgroups)
15068           (gnus-message 5 "Looking for new newsgroups...")
15069           (unless gnus-have-read-active-file
15070             (gnus-read-active-file))
15071           (setq gnus-newsrc-last-checked-date (current-time-string))
15072           (unless gnus-killed-hashtb
15073             (gnus-make-hashtable-from-killed))
15074           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
15075           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
15076           (mapatoms
15077            (lambda (sym)
15078              (if (or (null (setq group (symbol-name sym)))
15079                      (not (boundp sym))
15080                      (null (symbol-value sym))
15081                      (gnus-gethash group gnus-killed-hashtb)
15082                      (gnus-gethash group gnus-newsrc-hashtb))
15083                  ()
15084                (let ((do-sub (gnus-matches-options-n group)))
15085                  (cond
15086                   ((eq do-sub 'subscribe)
15087                    (setq groups (1+ groups))
15088                    (gnus-sethash group group gnus-killed-hashtb)
15089                    (funcall gnus-subscribe-options-newsgroup-method group))
15090                   ((eq do-sub 'ignore)
15091                    nil)
15092                   (t
15093                    (setq groups (1+ groups))
15094                    (gnus-sethash group group gnus-killed-hashtb)
15095                    (if gnus-subscribe-hierarchical-interactive
15096                        (setq new-newsgroups (cons group new-newsgroups))
15097                      (funcall gnus-subscribe-newsgroup-method group)))))))
15098            gnus-active-hashtb)
15099           (when new-newsgroups
15100             (gnus-subscribe-hierarchical-interactive new-newsgroups))
15101           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
15102           (if (> groups 0)
15103               (gnus-message 6 "%d new newsgroup%s arrived."
15104                             groups (if (> groups 1) "s have" " has"))
15105             (gnus-message 6 "No new newsgroups.")))))))
15106
15107 (defun gnus-matches-options-n (group)
15108   ;; Returns `subscribe' if the group is to be unconditionally
15109   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
15110   ;; no match for the group.
15111
15112   ;; First we check the two user variables.
15113   (cond
15114    ((and gnus-options-subscribe
15115          (string-match gnus-options-subscribe group))
15116     'subscribe)
15117    ((and gnus-auto-subscribed-groups
15118          (string-match gnus-auto-subscribed-groups group))
15119     'subscribe)
15120    ((and gnus-options-not-subscribe
15121          (string-match gnus-options-not-subscribe group))
15122     'ignore)
15123    ;; Then we go through the list that was retrieved from the .newsrc
15124    ;; file.  This list has elements on the form
15125    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
15126    ;; is in the reverse order of the options line) is returned.
15127    (t
15128     (let ((regs gnus-newsrc-options-n))
15129       (while (and regs
15130                   (not (string-match (caar regs) group)))
15131         (setq regs (cdr regs)))
15132       (and regs (cdar regs))))))
15133
15134 (defun gnus-ask-server-for-new-groups ()
15135   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
15136          (methods (cons gnus-select-method
15137                         (nconc
15138                          (when gnus-message-archive-method
15139                            (list "archive"))
15140                          (append
15141                           (and (consp gnus-check-new-newsgroups)
15142                                gnus-check-new-newsgroups)
15143                           gnus-secondary-select-methods))))
15144          (groups 0)
15145          (new-date (current-time-string))
15146          group new-newsgroups got-new method hashtb
15147          gnus-override-subscribe-method)
15148     ;; Go through both primary and secondary select methods and
15149     ;; request new newsgroups.
15150     (while (setq method (gnus-server-get-method nil (pop methods)))
15151       (setq new-newsgroups nil)
15152       (setq gnus-override-subscribe-method method)
15153       (when (and (gnus-check-server method)
15154                  (gnus-request-newgroups date method))
15155         (save-excursion
15156           (setq got-new t)
15157           (setq hashtb (gnus-make-hashtable 100))
15158           (set-buffer nntp-server-buffer)
15159           ;; Enter all the new groups into a hashtable.
15160           (gnus-active-to-gnus-format method hashtb 'ignore)))
15161       ;; Now all new groups from `method' are in `hashtb'.
15162       (mapatoms
15163        (lambda (group-sym)
15164          (if (or (null (setq group (symbol-name group-sym)))
15165                  (null (symbol-value group-sym))
15166                  (gnus-gethash group gnus-newsrc-hashtb)
15167                  (member group gnus-zombie-list)
15168                  (member group gnus-killed-list))
15169              ;; The group is already known.
15170              ()
15171            ;; Make this group active.
15172            (when (symbol-value group-sym)
15173              (gnus-set-active group (symbol-value group-sym)))
15174            ;; Check whether we want it or not.
15175            (let ((do-sub (gnus-matches-options-n group)))
15176              (cond
15177               ((eq do-sub 'subscribe)
15178                (incf groups)
15179                (gnus-sethash group group gnus-killed-hashtb)
15180                (funcall gnus-subscribe-options-newsgroup-method group))
15181               ((eq do-sub 'ignore)
15182                nil)
15183               (t
15184                (incf groups)
15185                (gnus-sethash group group gnus-killed-hashtb)
15186                (if gnus-subscribe-hierarchical-interactive
15187                    (push group new-newsgroups)
15188                  (funcall gnus-subscribe-newsgroup-method group)))))))
15189        hashtb)
15190       (when new-newsgroups
15191         (gnus-subscribe-hierarchical-interactive new-newsgroups)))
15192     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
15193     (when (> groups 0)
15194       (gnus-message 6 "%d new newsgroup%s arrived."
15195                     groups (if (> groups 1) "s have" " has")))
15196     (and got-new (setq gnus-newsrc-last-checked-date new-date))
15197     got-new))
15198
15199 (defun gnus-check-first-time-used ()
15200   (if (or (> (length gnus-newsrc-alist) 1)
15201           (file-exists-p gnus-startup-file)
15202           (file-exists-p (concat gnus-startup-file ".el"))
15203           (file-exists-p (concat gnus-startup-file ".eld")))
15204       nil
15205     (gnus-message 6 "First time user; subscribing you to default groups")
15206     (unless gnus-have-read-active-file
15207       (gnus-read-active-file))
15208     (setq gnus-newsrc-last-checked-date (current-time-string))
15209     (let ((groups gnus-default-subscribed-newsgroups)
15210           group)
15211       (if (eq groups t)
15212           nil
15213         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
15214         (mapatoms
15215          (lambda (sym)
15216            (if (null (setq group (symbol-name sym)))
15217                ()
15218              (let ((do-sub (gnus-matches-options-n group)))
15219                (cond
15220                 ((eq do-sub 'subscribe)
15221                  (gnus-sethash group group gnus-killed-hashtb)
15222                  (funcall gnus-subscribe-options-newsgroup-method group))
15223                 ((eq do-sub 'ignore)
15224                  nil)
15225                 (t
15226                  (setq gnus-killed-list (cons group gnus-killed-list)))))))
15227          gnus-active-hashtb)
15228         (while groups
15229           (if (gnus-active (car groups))
15230               (gnus-group-change-level
15231                (car groups) gnus-level-default-subscribed gnus-level-killed))
15232           (setq groups (cdr groups)))
15233         (gnus-group-make-help-group)
15234         (and gnus-novice-user
15235              (gnus-message 7 "`A k' to list killed groups"))))))
15236
15237 (defun gnus-subscribe-group (group previous &optional method)
15238   (gnus-group-change-level
15239    (if method
15240        (list t group gnus-level-default-subscribed nil nil method)
15241      group)
15242    gnus-level-default-subscribed gnus-level-killed previous t))
15243
15244 ;; `gnus-group-change-level' is the fundamental function for changing
15245 ;; subscription levels of newsgroups.  This might mean just changing
15246 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
15247 ;; again, which subscribes/unsubscribes a group, which is equally
15248 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
15249 ;; from 8-9 to 1-7 means that you remove the group from the list of
15250 ;; killed (or zombie) groups and add them to the (kinda) subscribed
15251 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
15252 ;; which is trivial.
15253 ;; ENTRY can either be a string (newsgroup name) or a list (if
15254 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
15255 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
15256 ;; entries.
15257 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
15258 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
15259 ;; after.
15260 (defun gnus-group-change-level (entry level &optional oldlevel
15261                                       previous fromkilled)
15262   (let (group info active num)
15263     ;; Glean what info we can from the arguments
15264     (if (consp entry)
15265         (if fromkilled (setq group (nth 1 entry))
15266           (setq group (car (nth 2 entry))))
15267       (setq group entry))
15268     (if (and (stringp entry)
15269              oldlevel
15270              (< oldlevel gnus-level-zombie))
15271         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
15272     (if (and (not oldlevel)
15273              (consp entry))
15274         (setq oldlevel (gnus-info-level (nth 2 entry)))
15275       (setq oldlevel (or oldlevel 9)))
15276     (if (stringp previous)
15277         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
15278
15279     (if (and (>= oldlevel gnus-level-zombie)
15280              (gnus-gethash group gnus-newsrc-hashtb))
15281         ;; We are trying to subscribe a group that is already
15282         ;; subscribed.
15283         ()                              ; Do nothing.
15284
15285       (or (gnus-ephemeral-group-p group)
15286           (gnus-dribble-enter
15287            (format "(gnus-group-change-level %S %S %S %S %S)"
15288                    group level oldlevel (car (nth 2 previous)) fromkilled)))
15289
15290       ;; Then we remove the newgroup from any old structures, if needed.
15291       ;; If the group was killed, we remove it from the killed or zombie
15292       ;; list.  If not, and it is in fact going to be killed, we remove
15293       ;; it from the newsrc hash table and assoc.
15294       (cond
15295        ((>= oldlevel gnus-level-zombie)
15296         (if (= oldlevel gnus-level-zombie)
15297             (setq gnus-zombie-list (delete group gnus-zombie-list))
15298           (setq gnus-killed-list (delete group gnus-killed-list))))
15299        (t
15300         (if (and (>= level gnus-level-zombie)
15301                  entry)
15302             (progn
15303               (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
15304               (if (nth 3 entry)
15305                   (setcdr (gnus-gethash (car (nth 3 entry))
15306                                         gnus-newsrc-hashtb)
15307                           (cdr entry)))
15308               (setcdr (cdr entry) (cdddr entry))))))
15309
15310       ;; Finally we enter (if needed) the list where it is supposed to
15311       ;; go, and change the subscription level.  If it is to be killed,
15312       ;; we enter it into the killed or zombie list.
15313       (cond 
15314        ((>= level gnus-level-zombie)
15315         ;; Remove from the hash table.
15316         (gnus-sethash group nil gnus-newsrc-hashtb)
15317         ;; We do not enter foreign groups into the list of dead
15318         ;; groups.
15319         (unless (gnus-group-foreign-p group)
15320           (if (= level gnus-level-zombie)
15321               (setq gnus-zombie-list (cons group gnus-zombie-list))
15322             (setq gnus-killed-list (cons group gnus-killed-list)))))
15323        (t
15324         ;; If the list is to be entered into the newsrc assoc, and
15325         ;; it was killed, we have to create an entry in the newsrc
15326         ;; hashtb format and fix the pointers in the newsrc assoc.
15327         (if (< oldlevel gnus-level-zombie)
15328             ;; It was alive, and it is going to stay alive, so we
15329             ;; just change the level and don't change any pointers or
15330             ;; hash table entries.
15331             (setcar (cdaddr entry) level)
15332           (if (listp entry)
15333               (setq info (cdr entry)
15334                     num (car entry))
15335             (setq active (gnus-active group))
15336             (setq num
15337                   (if active (- (1+ (cdr active)) (car active)) t))
15338             ;; Check whether the group is foreign.  If so, the
15339             ;; foreign select method has to be entered into the
15340             ;; info.
15341             (let ((method (or gnus-override-subscribe-method
15342                               (gnus-group-method group))))
15343               (if (eq method gnus-select-method)
15344                   (setq info (list group level nil))
15345                 (setq info (list group level nil nil method)))))
15346           (unless previous
15347             (setq previous
15348                   (let ((p gnus-newsrc-alist))
15349                     (while (cddr p)
15350                       (setq p (cdr p)))
15351                     p)))
15352           (setq entry (cons info (cddr previous)))
15353           (if (cdr previous)
15354               (progn
15355                 (setcdr (cdr previous) entry)
15356                 (gnus-sethash group (cons num (cdr previous))
15357                               gnus-newsrc-hashtb))
15358             (setcdr previous entry)
15359             (gnus-sethash group (cons num previous)
15360                           gnus-newsrc-hashtb))
15361           (when (cdr entry)
15362             (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)))))
15363       (when gnus-group-change-level-function
15364         (funcall gnus-group-change-level-function group level oldlevel)))))
15365
15366 (defun gnus-kill-newsgroup (newsgroup)
15367   "Obsolete function.  Kills a newsgroup."
15368   (gnus-group-change-level
15369    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
15370
15371 (defun gnus-check-bogus-newsgroups (&optional confirm)
15372   "Remove bogus newsgroups.
15373 If CONFIRM is non-nil, the user has to confirm the deletion of every
15374 newsgroup."
15375   (let ((newsrc (cdr gnus-newsrc-alist))
15376         bogus group entry info)
15377     (gnus-message 5 "Checking bogus newsgroups...")
15378     (unless gnus-have-read-active-file
15379       (gnus-read-active-file))
15380     (when (member gnus-select-method gnus-have-read-active-file)
15381       ;; Find all bogus newsgroup that are subscribed.
15382       (while newsrc
15383         (setq info (pop newsrc)
15384               group (gnus-info-group info))
15385         (unless (or (gnus-active group) ; Active
15386                     (gnus-info-method info) ; Foreign
15387                     (and confirm
15388                          (not (gnus-y-or-n-p
15389                                (format "Remove bogus newsgroup: %s " group)))))
15390           ;; Found a bogus newsgroup.
15391           (push group bogus)))
15392       ;; Remove all bogus subscribed groups by first killing them, and
15393       ;; then removing them from the list of killed groups.
15394       (while bogus
15395         (when (setq entry (gnus-gethash (setq group (pop bogus))
15396                                         gnus-newsrc-hashtb))
15397           (gnus-group-change-level entry gnus-level-killed)
15398           (setq gnus-killed-list (delete group gnus-killed-list))))
15399       ;; Then we remove all bogus groups from the list of killed and
15400       ;; zombie groups.  They are are removed without confirmation.
15401       (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
15402             killed)
15403         (while dead-lists
15404           (setq killed (symbol-value (car dead-lists)))
15405           (while killed
15406             (unless (gnus-active (setq group (pop killed)))
15407               ;; The group is bogus.
15408               ;; !!!Slow as hell.
15409               (set (car dead-lists)
15410                    (delete group (symbol-value (car dead-lists))))))
15411           (setq dead-lists (cdr dead-lists))))
15412       (gnus-message 5 "Checking bogus newsgroups...done"))))
15413
15414 (defun gnus-check-duplicate-killed-groups ()
15415   "Remove duplicates from the list of killed groups."
15416   (interactive)
15417   (let ((killed gnus-killed-list))
15418     (while killed
15419       (gnus-message 9 "%d" (length killed))
15420       (setcdr killed (delete (car killed) (cdr killed)))
15421       (setq killed (cdr killed)))))
15422
15423 ;; We want to inline a function from gnus-cache, so we cheat here:
15424 (eval-when-compile
15425   (provide 'gnus)
15426   (require 'gnus-cache))
15427
15428 (defun gnus-get-unread-articles-in-group (info active &optional update)
15429   (when active
15430     ;; Allow the backend to update the info in the group.
15431     (when (and update 
15432                (gnus-request-update-info
15433                 info (gnus-find-method-for-group (gnus-info-group info))))
15434       (gnus-activate-group (gnus-info-group info)))
15435     (let* ((range (gnus-info-read info))
15436            (num 0))
15437       ;; If a cache is present, we may have to alter the active info.
15438       (when (and gnus-use-cache info)
15439         (inline (gnus-cache-possibly-alter-active 
15440                  (gnus-info-group info) active)))
15441       ;; Modify the list of read articles according to what articles
15442       ;; are available; then tally the unread articles and add the
15443       ;; number to the group hash table entry.
15444       (cond
15445        ((zerop (cdr active))
15446         (setq num 0))
15447        ((not range)
15448         (setq num (- (1+ (cdr active)) (car active))))
15449        ((not (listp (cdr range)))
15450         ;; Fix a single (num . num) range according to the
15451         ;; active hash table.
15452         ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
15453         (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
15454         (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
15455         ;; Compute number of unread articles.
15456         (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
15457        (t
15458         ;; The read list is a list of ranges.  Fix them according to
15459         ;; the active hash table.
15460         ;; First peel off any elements that are below the lower
15461         ;; active limit.
15462         (while (and (cdr range)
15463                     (>= (car active)
15464                         (or (and (atom (cadr range)) (cadr range))
15465                             (caadr range))))
15466           (if (numberp (car range))
15467               (setcar range
15468                       (cons (car range)
15469                             (or (and (numberp (cadr range))
15470                                      (cadr range))
15471                                 (cdadr range))))
15472             (setcdr (car range)
15473                     (or (and (numberp (nth 1 range)) (nth 1 range))
15474                         (cdadr range))))
15475           (setcdr range (cddr range)))
15476         ;; Adjust the first element to be the same as the lower limit.
15477         (if (and (not (atom (car range)))
15478                  (< (cdar range) (car active)))
15479             (setcdr (car range) (1- (car active))))
15480         ;; Then we want to peel off any elements that are higher
15481         ;; than the upper active limit.
15482         (let ((srange range))
15483           ;; Go past all legal elements.
15484           (while (and (cdr srange)
15485                       (<= (or (and (atom (cadr srange))
15486                                    (cadr srange))
15487                               (caadr srange)) (cdr active)))
15488             (setq srange (cdr srange)))
15489           (if (cdr srange)
15490               ;; Nuke all remaining illegal elements.
15491               (setcdr srange nil))
15492
15493           ;; Adjust the final element.
15494           (if (and (not (atom (car srange)))
15495                    (> (cdar srange) (cdr active)))
15496               (setcdr (car srange) (cdr active))))
15497         ;; Compute the number of unread articles.
15498         (while range
15499           (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
15500                                       (cdar range)))
15501                               (or (and (atom (car range)) (car range))
15502                                   (caar range)))))
15503           (setq range (cdr range)))
15504         (setq num (max 0 (- (cdr active) num)))))
15505       ;; Set the number of unread articles.
15506       (when info
15507         (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
15508       num)))
15509
15510 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
15511 ;; and compute how many unread articles there are in each group.
15512 (defun gnus-get-unread-articles (&optional level)
15513   (let* ((newsrc (cdr gnus-newsrc-alist))
15514          (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
15515          (foreign-level
15516           (min
15517            (cond ((and gnus-activate-foreign-newsgroups
15518                        (not (numberp gnus-activate-foreign-newsgroups)))
15519                   (1+ gnus-level-subscribed))
15520                  ((numberp gnus-activate-foreign-newsgroups)
15521                   gnus-activate-foreign-newsgroups)
15522                  (t 0))
15523            level))
15524          info group active method)
15525     (gnus-message 5 "Checking new news...")
15526
15527     (while newsrc
15528       (setq active (gnus-active (setq group (gnus-info-group
15529                                              (setq info (pop newsrc))))))
15530
15531       ;; Check newsgroups.  If the user doesn't want to check them, or
15532       ;; they can't be checked (for instance, if the news server can't
15533       ;; be reached) we just set the number of unread articles in this
15534       ;; newsgroup to t.  This means that Gnus thinks that there are
15535       ;; unread articles, but it has no idea how many.
15536       (if (and (setq method (gnus-info-method info))
15537                (not (gnus-server-equal
15538                      gnus-select-method
15539                      (setq method (gnus-server-get-method nil method))))
15540                (not (gnus-secondary-method-p method)))
15541           ;; These groups are foreign.  Check the level.
15542           (when (<= (gnus-info-level info) foreign-level)
15543             (setq active (gnus-activate-group group 'scan))
15544             (gnus-close-group group))
15545
15546         ;; These groups are native or secondary.
15547         (when (and (<= (gnus-info-level info) level)
15548                    (not gnus-read-active-file))
15549           (setq active (gnus-activate-group group 'scan))
15550           (gnus-close-group group)))
15551
15552       (if active
15553           (inline (gnus-get-unread-articles-in-group 
15554                    info active
15555                    (and method
15556                         (fboundp (intern (concat (symbol-name (car method))
15557                                                  "-request-scan"))))))
15558         ;; The group couldn't be reached, so we nix out the number of
15559         ;; unread articles and stuff.
15560         (gnus-set-active group nil)
15561         (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
15562
15563     (gnus-message 5 "Checking new news...done")))
15564
15565 ;; Create a hash table out of the newsrc alist.  The `car's of the
15566 ;; alist elements are used as keys.
15567 (defun gnus-make-hashtable-from-newsrc-alist ()
15568   (let ((alist gnus-newsrc-alist)
15569         (ohashtb gnus-newsrc-hashtb)
15570         prev)
15571     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
15572     (setq alist
15573           (setq prev (setq gnus-newsrc-alist
15574                            (if (equal (caar gnus-newsrc-alist)
15575                                       "dummy.group")
15576                                gnus-newsrc-alist
15577                              (cons (list "dummy.group" 0 nil) alist)))))
15578     (while alist
15579       (gnus-sethash
15580        (caar alist)
15581        (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
15582              prev)
15583        gnus-newsrc-hashtb)
15584       (setq prev alist
15585             alist (cdr alist)))))
15586
15587 (defun gnus-make-hashtable-from-killed ()
15588   "Create a hash table from the killed and zombie lists."
15589   (let ((lists '(gnus-killed-list gnus-zombie-list))
15590         list)
15591     (setq gnus-killed-hashtb
15592           (gnus-make-hashtable
15593            (+ (length gnus-killed-list) (length gnus-zombie-list))))
15594     (while (setq list (symbol-value (pop lists)))
15595       (while list
15596         (gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
15597
15598 (defun gnus-activate-group (group &optional scan)
15599   ;; Check whether a group has been activated or not.
15600   ;; If SCAN, request a scan of that group as well.
15601   (let ((method (gnus-find-method-for-group group))
15602         active)
15603     (and (gnus-check-server method)
15604          ;; We escape all bugs and quit here to make it possible to
15605          ;; continue if a group is so out-there that it reports bugs
15606          ;; and stuff.
15607          (progn
15608            (and scan
15609                 (gnus-check-backend-function 'request-scan (car method))
15610                 (gnus-request-scan group method))
15611            t)
15612          (condition-case ()
15613              (gnus-request-group group)
15614         ;   (error nil)
15615            (quit nil))
15616          (save-excursion
15617            (set-buffer nntp-server-buffer)
15618            (goto-char (point-min))
15619            ;; Parse the result we got from `gnus-request-group'.
15620            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
15621                 (progn
15622                   (goto-char (match-beginning 1))
15623                   (gnus-set-active
15624                    group (setq active (cons (read (current-buffer))
15625                                             (read (current-buffer)))))
15626                   ;; Return the new active info.
15627                   active))))))
15628
15629 (defun gnus-update-read-articles (group unread)
15630   "Update the list of read and ticked articles in GROUP using the
15631 UNREAD and TICKED lists.
15632 Note: UNSELECTED has to be sorted over `<'.
15633 Returns whether the updating was successful."
15634   (let* ((active (or gnus-newsgroup-active (gnus-active group)))
15635          (entry (gnus-gethash group gnus-newsrc-hashtb))
15636          (info (nth 2 entry))
15637          (prev 1)
15638          (unread (sort (copy-sequence unread) '<))
15639          read)
15640     (if (or (not info) (not active))
15641         ;; There is no info on this group if it was, in fact,
15642         ;; killed.  Gnus stores no information on killed groups, so
15643         ;; there's nothing to be done.
15644         ;; One could store the information somewhere temporarily,
15645         ;; perhaps...  Hmmm...
15646         ()
15647       ;; Remove any negative articles numbers.
15648       (while (and unread (< (car unread) 0))
15649         (setq unread (cdr unread)))
15650       ;; Remove any expired article numbers
15651       (while (and unread (< (car unread) (car active)))
15652         (setq unread (cdr unread)))
15653       ;; Compute the ranges of read articles by looking at the list of
15654       ;; unread articles.
15655       (while unread
15656         (if (/= (car unread) prev)
15657             (setq read (cons (if (= prev (1- (car unread))) prev
15658                                (cons prev (1- (car unread)))) read)))
15659         (setq prev (1+ (car unread)))
15660         (setq unread (cdr unread)))
15661       (when (<= prev (cdr active))
15662         (setq read (cons (cons prev (cdr active)) read)))
15663       ;; Enter this list into the group info.
15664       (gnus-info-set-read
15665        info (if (> (length read) 1) (nreverse read) read))
15666       ;; Set the number of unread articles in gnus-newsrc-hashtb.
15667       (gnus-get-unread-articles-in-group info (gnus-active group))
15668       t)))
15669
15670 (defun gnus-make-articles-unread (group articles)
15671   "Mark ARTICLES in GROUP as unread."
15672   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
15673                           (gnus-gethash (gnus-group-real-name group)
15674                                         gnus-newsrc-hashtb))))
15675          (ranges (gnus-info-read info))
15676          news article)
15677     (while articles
15678       (when (gnus-member-of-range
15679              (setq article (pop articles)) ranges)
15680         (setq news (cons article news))))
15681     (when news
15682       (gnus-info-set-read
15683        info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
15684       (gnus-group-update-group group t))))
15685
15686 ;; Enter all dead groups into the hashtb.
15687 (defun gnus-update-active-hashtb-from-killed ()
15688   (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
15689         (lists (list gnus-killed-list gnus-zombie-list))
15690         killed)
15691     (while lists
15692       (setq killed (car lists))
15693       (while killed
15694         (gnus-sethash (car killed) nil hashtb)
15695         (setq killed (cdr killed)))
15696       (setq lists (cdr lists)))))
15697
15698 ;; Get the active file(s) from the backend(s).
15699 (defun gnus-read-active-file ()
15700   (gnus-group-set-mode-line)
15701   (let ((methods 
15702          (append
15703           (if (gnus-check-server gnus-select-method)
15704               ;; The native server is available.
15705               (cons gnus-select-method gnus-secondary-select-methods)
15706             ;; The native server is down, so we just do the
15707             ;; secondary ones.
15708             gnus-secondary-select-methods)
15709           ;; Also read from the archive server.
15710           (when gnus-message-archive-method
15711             (list "archive"))))
15712         list-type)
15713     (setq gnus-have-read-active-file nil)
15714     (save-excursion
15715       (set-buffer nntp-server-buffer)
15716       (while methods
15717         (let* ((method (if (stringp (car methods))
15718                            (gnus-server-get-method nil (car methods))
15719                          (car methods)))
15720                (where (nth 1 method))
15721                (mesg (format "Reading active file%s via %s..."
15722                              (if (and where (not (zerop (length where))))
15723                                  (concat " from " where) "")
15724                              (car method))))
15725           (gnus-message 5 mesg)
15726           (when (gnus-check-server method)
15727             ;; Request that the backend scan its incoming messages.
15728             (and (gnus-check-backend-function 'request-scan (car method))
15729                  (gnus-request-scan nil method))
15730             (cond
15731              ((and (eq gnus-read-active-file 'some)
15732                    (gnus-check-backend-function 'retrieve-groups (car method)))
15733               (let ((newsrc (cdr gnus-newsrc-alist))
15734                     (gmethod (if (stringp method)
15735                                  (gnus-server-get-method nil method)
15736                                method))
15737                     groups info)
15738                 (while (setq info (pop newsrc))
15739                   (when (gnus-server-equal
15740                          (gnus-find-method-for-group 
15741                           (gnus-info-group info) info)
15742                          gmethod)
15743                     (push (gnus-group-real-name (gnus-info-group info)) 
15744                           groups)))
15745                 (when groups
15746                   (gnus-check-server method)
15747                   (setq list-type (gnus-retrieve-groups groups method))
15748                   (cond
15749                    ((not list-type)
15750                     (gnus-message
15751                      1 "Cannot read partial active file from %s server."
15752                      (car method))
15753                     (ding)
15754                     (sit-for 2))
15755                    ((eq list-type 'active)
15756                     (gnus-active-to-gnus-format method gnus-active-hashtb))
15757                    (t
15758                     (gnus-groups-to-gnus-format method gnus-active-hashtb))))))
15759              (t
15760               (if (not (gnus-request-list method))
15761                   (progn
15762                     (unless (equal method gnus-message-archive-method)
15763                       (gnus-message 1 "Cannot read active file from %s server."
15764                                     (car method))
15765                       (ding)))
15766                 (gnus-active-to-gnus-format method)
15767                 ;; We mark this active file as read.
15768                 (push method gnus-have-read-active-file)
15769                 (gnus-message 5 "%sdone" mesg))))))
15770         (setq methods (cdr methods))))))
15771
15772 ;; Read an active file and place the results in `gnus-active-hashtb'.
15773 (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors)
15774   (unless method
15775     (setq method gnus-select-method))
15776   (let ((cur (current-buffer))
15777         (hashtb (or hashtb
15778                     (if (and gnus-active-hashtb
15779                              (not (equal method gnus-select-method)))
15780                         gnus-active-hashtb
15781                       (setq gnus-active-hashtb
15782                             (if (equal method gnus-select-method)
15783                                 (gnus-make-hashtable
15784                                  (count-lines (point-min) (point-max)))
15785                               (gnus-make-hashtable 4096)))))))
15786     ;; Delete unnecessary lines.
15787     (goto-char (point-min))
15788     (while (search-forward "\nto." nil t)
15789       (delete-region (1+ (match-beginning 0))
15790                      (progn (forward-line 1) (point))))
15791     (or (string= gnus-ignored-newsgroups "")
15792         (progn
15793           (goto-char (point-min))
15794           (delete-matching-lines gnus-ignored-newsgroups)))
15795     ;; Make the group names readable as a lisp expression even if they
15796     ;; contain special characters.
15797     ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
15798     (goto-char (point-max))
15799     (while (re-search-backward "[][';?()#]" nil t)
15800       (insert ?\\))
15801     ;; If these are groups from a foreign select method, we insert the
15802     ;; group prefix in front of the group names.
15803     (and method (not (gnus-server-equal
15804                       (gnus-server-get-method nil method)
15805                       (gnus-server-get-method nil gnus-select-method)))
15806          (let ((prefix (gnus-group-prefixed-name "" method)))
15807            (goto-char (point-min))
15808            (while (and (not (eobp))
15809                        (progn (insert prefix)
15810                               (zerop (forward-line 1)))))))
15811     ;; Store the active file in a hash table.
15812     (goto-char (point-min))
15813     (if (string-match "%[oO]" gnus-group-line-format)
15814         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
15815         ;; If we want information on moderated groups, we use this
15816         ;; loop...
15817         (let* ((mod-hashtb (make-vector 7 0))
15818                (m (intern "m" mod-hashtb))
15819                group max min)
15820           (while (not (eobp))
15821             (condition-case nil
15822                 (progn
15823                   (narrow-to-region (point) (gnus-point-at-eol))
15824                   (setq group (let ((obarray hashtb)) (read cur)))
15825                   (if (and (numberp (setq max (read cur)))
15826                            (numberp (setq min (read cur)))
15827                            (progn
15828                              (skip-chars-forward " \t")
15829                              (not
15830                               (or (= (following-char) ?=)
15831                                   (= (following-char) ?x)
15832                                   (= (following-char) ?j)))))
15833                       (set group (cons min max))
15834                     (set group nil))
15835                   ;; Enter moderated groups into a list.
15836                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
15837                       (setq gnus-moderated-list
15838                             (cons (symbol-name group) gnus-moderated-list))))
15839               (error
15840                (and group
15841                     (symbolp group)
15842                     (set group nil))))
15843             (widen)
15844             (forward-line 1)))
15845       ;; And if we do not care about moderation, we use this loop,
15846       ;; which is faster.
15847       (let (group max min)
15848         (while (not (eobp))
15849           (condition-case ()
15850               (progn
15851                 (narrow-to-region (point) (gnus-point-at-eol))
15852                 ;; group gets set to a symbol interned in the hash table
15853                 ;; (what a hack!!) - jwz
15854                 (setq group (let ((obarray hashtb)) (read cur)))
15855                 (if (and (numberp (setq max (read cur)))
15856                          (numberp (setq min (read cur)))
15857                          (progn
15858                            (skip-chars-forward " \t")
15859                            (not
15860                             (or (= (following-char) ?=)
15861                                 (= (following-char) ?x)
15862                                 (= (following-char) ?j)))))
15863                     (set group (cons min max))
15864                   (set group nil)))
15865             (error
15866              (progn
15867                (and group
15868                     (symbolp group)
15869                     (set group nil))
15870                (or ignore-errors
15871                    (gnus-message 3 "Warning - illegal active: %s"
15872                                  (buffer-substring
15873                                   (gnus-point-at-bol) (gnus-point-at-eol)))))))
15874           (widen)
15875           (forward-line 1))))))
15876
15877 (defun gnus-groups-to-gnus-format (method &optional hashtb)
15878   ;; Parse a "groups" active file.
15879   (let ((cur (current-buffer))
15880         (hashtb (or hashtb
15881                     (if (and method gnus-active-hashtb)
15882                         gnus-active-hashtb
15883                       (setq gnus-active-hashtb
15884                             (gnus-make-hashtable
15885                              (count-lines (point-min) (point-max)))))))
15886         (prefix (and method
15887                      (not (gnus-server-equal
15888                            (gnus-server-get-method nil method)
15889                            (gnus-server-get-method nil gnus-select-method)))
15890                      (gnus-group-prefixed-name "" method))))
15891
15892     (goto-char (point-min))
15893     ;; We split this into to separate loops, one with the prefix
15894     ;; and one without to speed the reading up somewhat.
15895     (if prefix
15896         (let (min max opoint group)
15897           (while (not (eobp))
15898             (condition-case ()
15899                 (progn
15900                   (read cur) (read cur)
15901                   (setq min (read cur)
15902                         max (read cur)
15903                         opoint (point))
15904                   (skip-chars-forward " \t")
15905                   (insert prefix)
15906                   (goto-char opoint)
15907                   (set (let ((obarray hashtb)) (read cur))
15908                        (cons min max)))
15909               (error (and group (symbolp group) (set group nil))))
15910             (forward-line 1)))
15911       (let (min max group)
15912         (while (not (eobp))
15913           (condition-case ()
15914               (if (= (following-char) ?2)
15915                   (progn
15916                     (read cur) (read cur)
15917                     (setq min (read cur)
15918                           max (read cur))
15919                     (set (setq group (let ((obarray hashtb)) (read cur)))
15920                          (cons min max))))
15921             (error (and group (symbolp group) (set group nil))))
15922           (forward-line 1))))))
15923
15924 (defun gnus-read-newsrc-file (&optional force)
15925   "Read startup file.
15926 If FORCE is non-nil, the .newsrc file is read."
15927   ;; Reset variables that might be defined in the .newsrc.eld file.
15928   (let ((variables gnus-variable-list))
15929     (while variables
15930       (set (car variables) nil)
15931       (setq variables (cdr variables))))
15932   (let* ((newsrc-file gnus-current-startup-file)
15933          (quick-file (concat newsrc-file ".el")))
15934     (save-excursion
15935       ;; We always load the .newsrc.eld file.  If always contains
15936       ;; much information that can not be gotten from the .newsrc
15937       ;; file (ticked articles, killed groups, foreign methods, etc.)
15938       (gnus-read-newsrc-el-file quick-file)
15939
15940       (if (and (file-exists-p gnus-current-startup-file)
15941                (or force
15942                    (and (file-newer-than-file-p newsrc-file quick-file)
15943                         (file-newer-than-file-p newsrc-file
15944                                                 (concat quick-file "d")))
15945                    (not gnus-newsrc-alist)))
15946           ;; We read the .newsrc file.  Note that if there if a
15947           ;; .newsrc.eld file exists, it has already been read, and
15948           ;; the `gnus-newsrc-hashtb' has been created.  While reading
15949           ;; the .newsrc file, Gnus will only use the information it
15950           ;; can find there for changing the data already read -
15951           ;; ie. reading the .newsrc file will not trash the data
15952           ;; already read (except for read articles).
15953           (save-excursion
15954             (gnus-message 5 "Reading %s..." newsrc-file)
15955             (set-buffer (find-file-noselect newsrc-file))
15956             (buffer-disable-undo (current-buffer))
15957             (gnus-newsrc-to-gnus-format)
15958             (kill-buffer (current-buffer))
15959             (gnus-message 5 "Reading %s...done" newsrc-file)))
15960
15961       ;; Read any slave files.
15962       (or gnus-slave
15963           (gnus-master-read-slave-newsrc)))))
15964
15965 (defun gnus-read-newsrc-el-file (file)
15966   (let ((ding-file (concat file "d")))
15967     ;; We always, always read the .eld file.
15968     (gnus-message 5 "Reading %s..." ding-file)
15969     (let (gnus-newsrc-assoc)
15970       (condition-case nil
15971           (load ding-file t t t)
15972         (error
15973          (gnus-message 1 "Error in %s" ding-file)
15974          (ding)))
15975       (when gnus-newsrc-assoc
15976         (setq gnus-newsrc-alist gnus-newsrc-assoc)))
15977     (gnus-make-hashtable-from-newsrc-alist)
15978     (when (file-newer-than-file-p file ding-file)
15979       ;; Old format quick file
15980       (gnus-message 5 "Reading %s..." file)
15981       ;; The .el file is newer than the .eld file, so we read that one
15982       ;; as well.
15983       (gnus-read-old-newsrc-el-file file))))
15984
15985 ;; Parse the old-style quick startup file
15986 (defun gnus-read-old-newsrc-el-file (file)
15987   (let (newsrc killed marked group m info)
15988     (prog1
15989         (let ((gnus-killed-assoc nil)
15990               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
15991           (prog1
15992               (condition-case nil
15993                   (load file t t t)
15994                 (error nil))
15995             (setq newsrc gnus-newsrc-assoc
15996                   killed gnus-killed-assoc
15997                   marked gnus-marked-assoc)))
15998       (setq gnus-newsrc-alist nil)
15999       (while (setq info (gnus-get-info (setq group (pop newsrc))))
16000         (if info
16001             (progn
16002               (gnus-info-set-read info (cddr group))
16003               (gnus-info-set-level
16004                info (if (nth 1 group) gnus-level-default-subscribed
16005                       gnus-level-default-unsubscribed))
16006               (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
16007           (push (setq info
16008                       (list (car group)
16009                             (if (nth 1 group) gnus-level-default-subscribed
16010                               gnus-level-default-unsubscribed)
16011                             (cddr group)))
16012                 gnus-newsrc-alist))
16013         ;; Copy marks into info.
16014         (when (setq m (assoc (car group) marked))
16015           (unless (nthcdr 3 info)
16016             (nconc info (list nil)))
16017           (gnus-info-set-marks
16018            info (list (cons 'tick (gnus-compress-sequence 
16019                                    (sort (cdr m) '<) t))))))
16020       (setq newsrc killed)
16021       (while newsrc
16022         (setcar newsrc (caar newsrc))
16023         (setq newsrc (cdr newsrc)))
16024       (setq gnus-killed-list killed))
16025     ;; The .el file version of this variable does not begin with
16026     ;; "options", while the .eld version does, so we just add it if it
16027     ;; isn't there.
16028     (and
16029      gnus-newsrc-options
16030      (progn
16031        (and (not (string-match "^ *options" gnus-newsrc-options))
16032             (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
16033        (and (not (string-match "\n$" gnus-newsrc-options))
16034             (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
16035        ;; Finally, if we read some options lines, we parse them.
16036        (or (string= gnus-newsrc-options "")
16037            (gnus-newsrc-parse-options gnus-newsrc-options))))
16038
16039     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
16040     (gnus-make-hashtable-from-newsrc-alist)))
16041
16042 (defun gnus-make-newsrc-file (file)
16043   "Make server dependent file name by catenating FILE and server host name."
16044   (let* ((file (expand-file-name file nil))
16045          (real-file (concat file "-" (nth 1 gnus-select-method))))
16046     (if (or (file-exists-p real-file)
16047             (file-exists-p (concat real-file ".el"))
16048             (file-exists-p (concat real-file ".eld")))
16049         real-file file)))
16050
16051 (defun gnus-newsrc-to-gnus-format ()
16052   (setq gnus-newsrc-options "")
16053   (setq gnus-newsrc-options-n nil)
16054
16055   (or gnus-active-hashtb
16056       (setq gnus-active-hashtb (make-vector 4095 0)))
16057   (let ((buf (current-buffer))
16058         (already-read (> (length gnus-newsrc-alist) 1))
16059         group subscribed options-symbol newsrc Options-symbol
16060         symbol reads num1)
16061     (goto-char (point-min))
16062     ;; We intern the symbol `options' in the active hashtb so that we
16063     ;; can `eq' against it later.
16064     (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
16065     (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
16066
16067     (while (not (eobp))
16068       ;; We first read the first word on the line by narrowing and
16069       ;; then reading into `gnus-active-hashtb'.  Most groups will
16070       ;; already exist in that hashtb, so this will save some string
16071       ;; space.
16072       (narrow-to-region
16073        (point)
16074        (progn (skip-chars-forward "^ \t!:\n") (point)))
16075       (goto-char (point-min))
16076       (setq symbol
16077             (and (/= (point-min) (point-max))
16078                  (let ((obarray gnus-active-hashtb)) (read buf))))
16079       (widen)
16080       ;; Now, the symbol we have read is either `options' or a group
16081       ;; name.  If it is an options line, we just add it to a string.
16082       (cond
16083        ((or (eq symbol options-symbol)
16084             (eq symbol Options-symbol))
16085         (setq gnus-newsrc-options
16086               ;; This concating is quite inefficient, but since our
16087               ;; thorough studies show that approx 99.37% of all
16088               ;; .newsrc files only contain a single options line, we
16089               ;; don't give a damn, frankly, my dear.
16090               (concat gnus-newsrc-options
16091                       (buffer-substring
16092                        (gnus-point-at-bol)
16093                        ;; Options may continue on the next line.
16094                        (or (and (re-search-forward "^[^ \t]" nil 'move)
16095                                 (progn (beginning-of-line) (point)))
16096                            (point)))))
16097         (forward-line -1))
16098        (symbol
16099         ;; Group names can be just numbers.  
16100         (when (numberp symbol) 
16101           (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
16102         (or (boundp symbol) (set symbol nil))
16103         ;; It was a group name.
16104         (setq subscribed (= (following-char) ?:)
16105               group (symbol-name symbol)
16106               reads nil)
16107         (if (eolp)
16108             ;; If the line ends here, this is clearly a buggy line, so
16109             ;; we put point a the beginning of line and let the cond
16110             ;; below do the error handling.
16111             (beginning-of-line)
16112           ;; We skip to the beginning of the ranges.
16113           (skip-chars-forward "!: \t"))
16114         ;; We are now at the beginning of the list of read articles.
16115         ;; We read them range by range.
16116         (while
16117             (cond
16118              ((looking-at "[0-9]+")
16119               ;; We narrow and read a number instead of buffer-substring/
16120               ;; string-to-int because it's faster.  narrow/widen is
16121               ;; faster than save-restriction/narrow, and save-restriction
16122               ;; produces a garbage object.
16123               (setq num1 (progn
16124                            (narrow-to-region (match-beginning 0) (match-end 0))
16125                            (read buf)))
16126               (widen)
16127               ;; If the next character is a dash, then this is a range.
16128               (if (= (following-char) ?-)
16129                   (progn
16130                     ;; We read the upper bound of the range.
16131                     (forward-char 1)
16132                     (if (not (looking-at "[0-9]+"))
16133                         ;; This is a buggy line, by we pretend that
16134                         ;; it's kinda OK.  Perhaps the user should be
16135                         ;; dinged?
16136                         (setq reads (cons num1 reads))
16137                       (setq reads
16138                             (cons
16139                              (cons num1
16140                                    (progn
16141                                      (narrow-to-region (match-beginning 0)
16142                                                        (match-end 0))
16143                                      (read buf)))
16144                              reads))
16145                       (widen)))
16146                 ;; It was just a simple number, so we add it to the
16147                 ;; list of ranges.
16148                 (setq reads (cons num1 reads)))
16149               ;; If the next char in ?\n, then we have reached the end
16150               ;; of the line and return nil.
16151               (/= (following-char) ?\n))
16152              ((= (following-char) ?\n)
16153               ;; End of line, so we end.
16154               nil)
16155              (t
16156               ;; Not numbers and not eol, so this might be a buggy
16157               ;; line...
16158               (or (eobp)
16159                   ;; If it was eob instead of ?\n, we allow it.
16160                   (progn
16161                     ;; The line was buggy.
16162                     (setq group nil)
16163                     (gnus-message 3 "Mangled line: %s"
16164                                   (buffer-substring (gnus-point-at-bol)
16165                                                     (gnus-point-at-eol)))
16166                     (ding)
16167                     (sit-for 1)))
16168               nil))
16169           ;; Skip past ", ".  Spaces are illegal in these ranges, but
16170           ;; we allow them, because it's a common mistake to put a
16171           ;; space after the comma.
16172           (skip-chars-forward ", "))
16173
16174         ;; We have already read .newsrc.eld, so we gently update the
16175         ;; data in the hash table with the information we have just
16176         ;; read.
16177         (when group
16178           (let ((info (gnus-get-info group))
16179                 level)
16180             (if info
16181                 ;; There is an entry for this file in the alist.
16182                 (progn
16183                   (gnus-info-set-read info (nreverse reads))
16184                   ;; We update the level very gently.  In fact, we
16185                   ;; only change it if there's been a status change
16186                   ;; from subscribed to unsubscribed, or vice versa.
16187                   (setq level (gnus-info-level info))
16188                   (cond ((and (<= level gnus-level-subscribed)
16189                               (not subscribed))
16190                          (setq level (if reads
16191                                          gnus-level-default-unsubscribed
16192                                        (1+ gnus-level-default-unsubscribed))))
16193                         ((and (> level gnus-level-subscribed) subscribed)
16194                          (setq level gnus-level-default-subscribed)))
16195                   (gnus-info-set-level info level))
16196               ;; This is a new group.
16197               (setq info (list group
16198                                (if subscribed
16199                                    gnus-level-default-subscribed
16200                                  (if reads
16201                                      (1+ gnus-level-subscribed)
16202                                    gnus-level-default-unsubscribed))
16203                                (nreverse reads))))
16204             (setq newsrc (cons info newsrc))))))
16205       (forward-line 1))
16206
16207     (setq newsrc (nreverse newsrc))
16208
16209     (if (not already-read)
16210         ()
16211       ;; We now have two newsrc lists - `newsrc', which is what we
16212       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
16213       ;; what we've read from .newsrc.eld.  We have to merge these
16214       ;; lists.  We do this by "attaching" any (foreign) groups in the
16215       ;; gnus-newsrc-alist to the (native) group that precedes them.
16216       (let ((rc (cdr gnus-newsrc-alist))
16217             (prev gnus-newsrc-alist)
16218             entry mentry)
16219         (while rc
16220           (or (null (nth 4 (car rc)))   ; It's a native group.
16221               (assoc (caar rc) newsrc) ; It's already in the alist.
16222               (if (setq entry (assoc (caar prev) newsrc))
16223                   (setcdr (setq mentry (memq entry newsrc))
16224                           (cons (car rc) (cdr mentry)))
16225                 (setq newsrc (cons (car rc) newsrc))))
16226           (setq prev rc
16227                 rc (cdr rc)))))
16228
16229     (setq gnus-newsrc-alist newsrc)
16230     ;; We make the newsrc hashtb.
16231     (gnus-make-hashtable-from-newsrc-alist)
16232
16233     ;; Finally, if we read some options lines, we parse them.
16234     (or (string= gnus-newsrc-options "")
16235         (gnus-newsrc-parse-options gnus-newsrc-options))))
16236
16237 ;; Parse options lines to find "options -n !all rec.all" and stuff.
16238 ;; The return value will be a list on the form
16239 ;; ((regexp1 . ignore)
16240 ;;  (regexp2 . subscribe)...)
16241 ;; When handling new newsgroups, groups that match a `ignore' regexp
16242 ;; will be ignored, and groups that match a `subscribe' regexp will be
16243 ;; subscribed.  A line like
16244 ;; options -n !all rec.all
16245 ;; will lead to a list that looks like
16246 ;; (("^rec\\..+" . subscribe)
16247 ;;  ("^.+" . ignore))
16248 ;; So all "rec.*" groups will be subscribed, while all the other
16249 ;; groups will be ignored.  Note that "options -n !all rec.all" is very
16250 ;; different from "options -n rec.all !all".
16251 (defun gnus-newsrc-parse-options (options)
16252   (let (out eol)
16253     (save-excursion
16254       (gnus-set-work-buffer)
16255       (insert (regexp-quote options))
16256       ;; First we treat all continuation lines.
16257       (goto-char (point-min))
16258       (while (re-search-forward "\n[ \t]+" nil t)
16259         (replace-match " " t t))
16260       ;; Then we transform all "all"s into ".+"s.
16261       (goto-char (point-min))
16262       (while (re-search-forward "\\ball\\b" nil t)
16263         (replace-match ".+" t t))
16264       (goto-char (point-min))
16265       ;; We remove all other options than the "-n" ones.
16266       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
16267         (replace-match " ")
16268         (forward-char -1))
16269       (goto-char (point-min))
16270
16271       ;; We are only interested in "options -n" lines - we
16272       ;; ignore the other option lines.
16273       (while (re-search-forward "[ \t]-n" nil t)
16274         (setq eol
16275               (or (save-excursion
16276                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
16277                          (- (point) 2)))
16278                   (gnus-point-at-eol)))
16279         ;; Search for all "words"...
16280         (while (re-search-forward "[^ \t,\n]+" eol t)
16281           (if (= (char-after (match-beginning 0)) ?!)
16282               ;; If the word begins with a bang (!), this is a "not"
16283               ;; spec.  We put this spec (minus the bang) and the
16284               ;; symbol `ignore' into the list.
16285               (setq out (cons (cons (concat
16286                                      "^" (buffer-substring
16287                                           (1+ (match-beginning 0))
16288                                           (match-end 0)))
16289                                     'ignore) out))
16290             ;; There was no bang, so this is a "yes" spec.
16291             (setq out (cons (cons (concat "^" (match-string 0))
16292                                   'subscribe) out)))))
16293
16294       (setq gnus-newsrc-options-n out))))
16295
16296 (defun gnus-save-newsrc-file (&optional force)
16297   "Save .newsrc file."
16298   ;; Note: We cannot save .newsrc file if all newsgroups are removed
16299   ;; from the variable gnus-newsrc-alist.
16300   (when (and (or gnus-newsrc-alist gnus-killed-list)
16301              gnus-current-startup-file)
16302     (save-excursion
16303       (if (and (or gnus-use-dribble-file gnus-slave)
16304                (not force)
16305                (or (not gnus-dribble-buffer)
16306                    (not (buffer-name gnus-dribble-buffer))
16307                    (zerop (save-excursion
16308                             (set-buffer gnus-dribble-buffer)
16309                             (buffer-size)))))
16310           (gnus-message 4 "(No changes need to be saved)")
16311         (run-hooks 'gnus-save-newsrc-hook)
16312         (if gnus-slave
16313             (gnus-slave-save-newsrc)
16314           ;; Save .newsrc.
16315           (when gnus-save-newsrc-file
16316             (gnus-message 5 "Saving %s..." gnus-current-startup-file)
16317             (gnus-gnus-to-newsrc-format)
16318             (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
16319           ;; Save .newsrc.eld.
16320           (set-buffer (get-buffer-create " *Gnus-newsrc*"))
16321           (make-local-variable 'version-control)
16322           (setq version-control 'never)
16323           (setq buffer-file-name
16324                 (concat gnus-current-startup-file ".eld"))
16325           (gnus-add-current-to-buffer-list)
16326           (buffer-disable-undo (current-buffer))
16327           (erase-buffer)
16328           (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
16329           (gnus-gnus-to-quick-newsrc-format)
16330           (run-hooks 'gnus-save-quick-newsrc-hook)
16331           (save-buffer)
16332           (kill-buffer (current-buffer))
16333           (gnus-message
16334            5 "Saving %s.eld...done" gnus-current-startup-file))
16335         (gnus-dribble-delete-file)))))
16336
16337 (defun gnus-gnus-to-quick-newsrc-format ()
16338   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
16339   (insert ";; Gnus startup file.\n")
16340   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
16341   (insert ";; to read .newsrc.\n")
16342   (insert "(setq gnus-newsrc-file-version "
16343           (prin1-to-string gnus-version) ")\n")
16344   (let ((variables
16345          (if gnus-save-killed-list gnus-variable-list
16346            ;; Remove the `gnus-killed-list' from the list of variables
16347            ;; to be saved, if required.
16348            (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
16349         ;; Peel off the "dummy" group.
16350         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
16351         variable)
16352     ;; Insert the variables into the file.
16353     (while variables
16354       (when (and (boundp (setq variable (pop variables)))
16355                  (symbol-value variable))
16356         (insert "(setq " (symbol-name variable) " '")
16357         (prin1 (symbol-value variable) (current-buffer))
16358         (insert ")\n")))))
16359
16360 (defun gnus-gnus-to-newsrc-format ()
16361   ;; Generate and save the .newsrc file.
16362   (save-excursion
16363     (set-buffer (create-file-buffer gnus-current-startup-file))
16364     (let ((newsrc (cdr gnus-newsrc-alist))
16365           (standard-output (current-buffer))
16366           info ranges range method)
16367       (setq buffer-file-name gnus-current-startup-file)
16368       (buffer-disable-undo (current-buffer))
16369       (erase-buffer)
16370       ;; Write options.
16371       (if gnus-newsrc-options (insert gnus-newsrc-options))
16372       ;; Write subscribed and unsubscribed.
16373       (while (setq info (pop newsrc))
16374         ;; Don't write foreign groups to .newsrc.
16375         (when (or (null (setq method (gnus-info-method info)))
16376                   (equal method "native")
16377                   (gnus-server-equal method gnus-select-method))
16378           (insert (gnus-info-group info)
16379                   (if (> (gnus-info-level info) gnus-level-subscribed)
16380                       "!" ":"))
16381           (when (setq ranges (gnus-info-read info))
16382             (insert " ")
16383             (if (not (listp (cdr ranges)))
16384                 (if (= (car ranges) (cdr ranges))
16385                     (princ (car ranges))
16386                   (princ (car ranges))
16387                   (insert "-")
16388                   (princ (cdr ranges)))
16389               (while (setq range (pop ranges))
16390                 (if (or (atom range) (= (car range) (cdr range)))
16391                     (princ (or (and (atom range) range) (car range)))
16392                   (princ (car range))
16393                   (insert "-")
16394                   (princ (cdr range)))
16395                 (if ranges (insert ",")))))
16396           (insert "\n")))
16397       (make-local-variable 'version-control)
16398       (setq version-control 'never)
16399       ;; It has been reported that sometime the modtime on the .newsrc
16400       ;; file seems to be off.  We really do want to overwrite it, so
16401       ;; we clear the modtime here before saving.  It's a bit odd,
16402       ;; though...
16403       ;; sometimes the modtime clear isn't sufficient.  most brute force:
16404       ;; delete the silly thing entirely first.  but this fails to provide
16405       ;; such niceties as .newsrc~ creation.
16406       (if gnus-modtime-botch
16407           (delete-file gnus-startup-file)
16408         (clear-visited-file-modtime))
16409       (run-hooks 'gnus-save-standard-newsrc-hook)
16410       (save-buffer)
16411       (kill-buffer (current-buffer)))))
16412
16413 \f
16414 ;;;
16415 ;;; Slave functions.
16416 ;;;
16417
16418 (defun gnus-slave-save-newsrc ()
16419   (save-excursion
16420     (set-buffer gnus-dribble-buffer)
16421     (let ((slave-name
16422            (make-temp-name (concat gnus-current-startup-file "-slave-"))))
16423       (write-region (point-min) (point-max) slave-name nil 'nomesg))))
16424
16425 (defun gnus-master-read-slave-newsrc ()
16426   (let ((slave-files
16427          (directory-files
16428           (file-name-directory gnus-current-startup-file)
16429           t (concat
16430              "^" (regexp-quote
16431                   (concat
16432                    (file-name-nondirectory gnus-current-startup-file)
16433                    "-slave-")))
16434           t))
16435         file)
16436     (if (not slave-files)
16437         ()                              ; There are no slave files to read.
16438       (gnus-message 7 "Reading slave newsrcs...")
16439       (save-excursion
16440         (set-buffer (get-buffer-create " *gnus slave*"))
16441         (buffer-disable-undo (current-buffer))
16442         (setq slave-files
16443               (sort (mapcar (lambda (file)
16444                               (list (nth 5 (file-attributes file)) file))
16445                             slave-files)
16446                     (lambda (f1 f2)
16447                       (or (< (caar f1) (caar f2))
16448                           (< (nth 1 (car f1)) (nth 1 (car f2)))))))
16449         (while slave-files
16450           (erase-buffer)
16451           (setq file (nth 1 (car slave-files)))
16452           (insert-file-contents file)
16453           (if (condition-case ()
16454                   (progn
16455                     (eval-buffer (current-buffer))
16456                     t)
16457                 (error
16458                  (gnus-message 3 "Possible error in %s" file)
16459                  (ding)
16460                  (sit-for 2)
16461                  nil))
16462               (or gnus-slave ; Slaves shouldn't delete these files.
16463                   (condition-case ()
16464                       (delete-file file)
16465                     (error nil))))
16466           (setq slave-files (cdr slave-files))))
16467       (gnus-message 7 "Reading slave newsrcs...done"))))
16468
16469 \f
16470 ;;;
16471 ;;; Group description.
16472 ;;;
16473
16474 (defun gnus-read-all-descriptions-files ()
16475   (let ((methods (cons gnus-select-method 
16476                        (nconc
16477                         (when gnus-message-archive-method
16478                           (list "archive"))
16479                         gnus-secondary-select-methods))))
16480     (while methods
16481       (gnus-read-descriptions-file (car methods))
16482       (setq methods (cdr methods)))
16483     t))
16484
16485 (defun gnus-read-descriptions-file (&optional method)
16486   (let ((method (or method gnus-select-method)))
16487     (when (stringp method)
16488       (setq method (gnus-server-to-method method)))
16489     ;; We create the hashtable whether we manage to read the desc file
16490     ;; to avoid trying to re-read after a failed read.
16491     (or gnus-description-hashtb
16492         (setq gnus-description-hashtb
16493               (gnus-make-hashtable (length gnus-active-hashtb))))
16494     ;; Mark this method's desc file as read.
16495     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
16496                   gnus-description-hashtb)
16497
16498     (gnus-message 5 "Reading descriptions file via %s..." (car method))
16499     (cond
16500      ((not (gnus-check-server method))
16501       (gnus-message 1 "Couldn't open server")
16502       nil)
16503      ((not (gnus-request-list-newsgroups method))
16504       (gnus-message 1 "Couldn't read newsgroups descriptions")
16505       nil)
16506      (t
16507       (let (group)
16508         (save-excursion
16509           (save-restriction
16510             (set-buffer nntp-server-buffer)
16511             (goto-char (point-min))
16512             (if (or (search-forward "\n.\n" nil t)
16513                     (goto-char (point-max)))
16514                 (progn
16515                   (beginning-of-line)
16516                   (narrow-to-region (point-min) (point))))
16517             (goto-char (point-min))
16518             (while (not (eobp))
16519               ;; If we get an error, we set group to 0, which is not a
16520               ;; symbol...
16521               (setq group
16522                     (condition-case ()
16523                         (let ((obarray gnus-description-hashtb))
16524                           ;; Group is set to a symbol interned in this
16525                           ;; hash table.
16526                           (read nntp-server-buffer))
16527                       (error 0)))
16528               (skip-chars-forward " \t")
16529               ;; ...  which leads to this line being effectively ignored.
16530               (and (symbolp group)
16531                    (set group (buffer-substring
16532                                (point) (progn (end-of-line) (point)))))
16533               (forward-line 1))))
16534         (gnus-message 5 "Reading descriptions file...done")
16535         t)))))
16536
16537 (defun gnus-group-get-description (group)
16538   "Get the description of a group by sending XGTITLE to the server."
16539   (when (gnus-request-group-description group)
16540     (save-excursion
16541       (set-buffer nntp-server-buffer)
16542       (goto-char (point-min))
16543       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
16544         (match-string 1)))))
16545
16546 \f
16547 ;;;
16548 ;;; Buffering of read articles.
16549 ;;;
16550
16551 (defvar gnus-backlog-buffer " *Gnus Backlog*")
16552 (defvar gnus-backlog-articles nil)
16553 (defvar gnus-backlog-hashtb nil)
16554
16555 (defun gnus-backlog-buffer ()
16556   "Return the backlog buffer."
16557   (or (get-buffer gnus-backlog-buffer)
16558       (save-excursion
16559         (set-buffer (get-buffer-create gnus-backlog-buffer))
16560         (buffer-disable-undo (current-buffer))
16561         (setq buffer-read-only t)
16562         (gnus-add-current-to-buffer-list)
16563         (get-buffer gnus-backlog-buffer))))
16564
16565 (defun gnus-backlog-setup ()
16566   "Initialize backlog variables."
16567   (unless gnus-backlog-hashtb
16568     (setq gnus-backlog-hashtb (make-vector 1023 0))))
16569
16570 (gnus-add-shutdown 'gnus-backlog-shutdown 'gnus)
16571
16572 (defun gnus-backlog-shutdown ()
16573   "Clear all backlog variables and buffers."
16574   (when (get-buffer gnus-backlog-buffer)
16575     (kill-buffer gnus-backlog-buffer))
16576   (setq gnus-backlog-hashtb nil
16577         gnus-backlog-articles nil))
16578
16579 (defun gnus-backlog-enter-article (group number buffer)
16580   (gnus-backlog-setup)
16581   (let ((ident (intern (concat group ":" (int-to-string number))
16582                        gnus-backlog-hashtb))
16583         b)
16584     (if (memq ident gnus-backlog-articles)
16585         () ; It's already kept.
16586       ;; Remove the oldest article, if necessary.
16587       (and (numberp gnus-keep-backlog)
16588            (>= (length gnus-backlog-articles) gnus-keep-backlog)
16589            (gnus-backlog-remove-oldest-article))
16590       (setq gnus-backlog-articles (cons ident gnus-backlog-articles))
16591       ;; Insert the new article.
16592       (save-excursion
16593         (set-buffer (gnus-backlog-buffer))
16594         (let (buffer-read-only)
16595           (goto-char (point-max))
16596           (or (bolp) (insert "\n"))
16597           (setq b (point))
16598           (insert-buffer-substring buffer)
16599           ;; Tag the beginning of the article with the ident.
16600           (put-text-property b (1+ b) 'gnus-backlog ident))))))
16601
16602 (defun gnus-backlog-remove-oldest-article ()
16603   (save-excursion
16604     (set-buffer (gnus-backlog-buffer))
16605     (goto-char (point-min))
16606     (if (zerop (buffer-size))
16607         () ; The buffer is empty.
16608       (let ((ident (get-text-property (point) 'gnus-backlog))
16609             buffer-read-only)
16610         ;; Remove the ident from the list of articles.
16611         (when ident
16612           (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
16613         ;; Delete the article itself.
16614         (delete-region
16615          (point) (next-single-property-change
16616                   (1+ (point)) 'gnus-backlog nil (point-max)))))))
16617
16618 (defun gnus-backlog-request-article (group number buffer)
16619   (when (numberp number)
16620     (gnus-backlog-setup)
16621     (let ((ident (intern (concat group ":" (int-to-string number))
16622                          gnus-backlog-hashtb))
16623           beg end)
16624       (when (memq ident gnus-backlog-articles)
16625         ;; It was in the backlog.
16626         (save-excursion
16627           (set-buffer (gnus-backlog-buffer))
16628           (if (not (setq beg (text-property-any
16629                               (point-min) (point-max) 'gnus-backlog
16630                               ident)))
16631               ;; It wasn't in the backlog after all.
16632               (ignore
16633                (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
16634             ;; Find the end (i. e., the beginning of the next article).
16635             (setq end
16636                   (next-single-property-change
16637                    (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
16638         (let ((buffer-read-only nil))
16639           (erase-buffer)
16640           (insert-buffer-substring gnus-backlog-buffer beg end)
16641           t)))))
16642
16643 ;; Allow redefinition of Gnus functions.
16644
16645 (gnus-ems-redefine)
16646
16647 (provide 'gnus)
16648
16649 ;;; gnus.el ends here