*** empty log message ***
[gnus] / lisp / gnus.el
1 ;;; gnus.el --- a newsreader for GNU Emacs
2 ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
3
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Keywords: news
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24 ;;; Commentary:
25
26 ;;; Code:
27
28 (eval '(run-hooks 'gnus-load-hook))
29
30 (require 'mail-utils)
31 (require 'timezone)
32 (require 'nnheader)
33
34 (eval-when-compile (require 'cl))
35
36 ;; Site dependent variables.  These variables should be defined in
37 ;; paths.el.
38
39 (defvar gnus-default-nntp-server nil
40   "Specify a default NNTP server.
41 This variable should be defined in paths.el, and should never be set
42 by the user.
43 If you want to change servers, you should use `gnus-select-method'.
44 See the documentation to that variable.")
45
46 (defvar gnus-backup-default-subscribed-newsgroups
47   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
48   "Default default new newsgroups the first time Gnus is run.
49 Should be set in paths.el, and shouldn't be touched by the user.")
50
51 (defvar gnus-local-domain nil
52   "Local domain name without a host name.
53 The DOMAINNAME environment variable is used instead if it is defined.
54 If the `system-name' function returns the full Internet name, there is
55 no need to set this variable.")
56
57 (defvar gnus-local-organization nil
58   "String with a description of what organization (if any) the user belongs to.
59 The ORGANIZATION environment variable is used instead if it is defined.
60 If this variable contains a function, this function will be called
61 with the current newsgroup name as the argument.  The function should
62 return a string.
63
64 In any case, if the string (either in the variable, in the environment
65 variable, or returned by the function) is a file name, the contents of
66 this file will be used as the organization.")
67
68 (defvar gnus-use-generic-from nil
69   "If nil, the full host name will be the system name prepended to the domain name.
70 If this is a string, the full host name will be this string.
71 If this is non-nil, non-string, the domain name will be used as the
72 full host name.")
73
74 (defvar gnus-use-generic-path nil
75   "If nil, use the NNTP server name in the Path header.
76 If stringp, use this; if non-nil, use no host name (user name only).")
77
78
79 ;; Customization variables
80
81 ;; Don't touch this variable.
82 (defvar gnus-nntp-service "nntp"
83   "*NNTP service name (\"nntp\" or 119).
84 This is an obsolete variable, which is scarcely used.  If you use an
85 nntp server for your newsgroup and want to change the port number
86 used to 899, you would say something along these lines:
87
88  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
89
90 (defvar gnus-nntpserver-file "/etc/nntpserver"
91   "*A file with only the name of the nntp server in it.")
92
93 ;; This function is used to check both the environment variable
94 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
95 ;; an nntp server name default.
96 (defun gnus-getenv-nntpserver ()
97   (or (getenv "NNTPSERVER")
98       (and (file-readable-p gnus-nntpserver-file)
99            (save-excursion
100              (set-buffer (get-buffer-create " *gnus nntp*"))
101              (buffer-disable-undo (current-buffer))
102              (insert-file-contents gnus-nntpserver-file)
103              (let ((name (buffer-string)))
104                (prog1
105                    (if (string-match "^[ \t\n]*$" name)
106                        nil
107                      name)
108                  (kill-buffer (current-buffer))))))))
109
110 (defvar gnus-select-method
111   (nconc
112    (list 'nntp (or (condition-case ()
113                        (gnus-getenv-nntpserver)
114                      (error nil))
115                    (if (and gnus-default-nntp-server
116                             (not (string= gnus-default-nntp-server "")))
117                        gnus-default-nntp-server)
118                    (system-name)))
119    (if (or (null gnus-nntp-service)
120            (equal gnus-nntp-service "nntp"))
121        nil
122      (list gnus-nntp-service)))
123   "*Default method for selecting a newsgroup.
124 This variable should be a list, where the first element is how the
125 news is to be fetched, the second is the address.
126
127 For instance, if you want to get your news via NNTP from
128 \"flab.flab.edu\", you could say:
129
130 (setq gnus-select-method '(nntp \"flab.flab.edu\"))
131
132 If you want to use your local spool, say:
133
134 (setq gnus-select-method (list 'nnspool (system-name)))
135
136 If you use this variable, you must set `gnus-nntp-server' to nil.
137
138 There is a lot more to know about select methods and virtual servers -
139 see the manual for details.")
140
141 (defvar gnus-message-archive-method 
142   '(nnfolder "archive" (nnfolder-directory "~/Mail/archive/")
143              (nnfolder-active-file "~/Mail/archive/active")
144              (nnfolder-get-new-mail nil)
145              (nnfolder-inhibit-expiry t))
146   "*Method used for archiving messages you've sent.
147 This should be a mail method.")
148
149 (defvar gnus-refer-article-method nil
150   "*Preferred method for fetching an article by Message-ID.
151 If you are reading news from the local spool (with nnspool), fetching
152 articles by Message-ID is painfully slow.  By setting this method to an
153 nntp method, you might get acceptable results.
154
155 The value of this variable must be a valid select method as discussed
156 in the documentation of `gnus-select-method'")
157
158 (defvar gnus-secondary-select-methods nil
159   "*A list of secondary methods that will be used for reading news.
160 This is a list where each element is a complete select method (see
161 `gnus-select-method').
162
163 If, for instance, you want to read your mail with the nnml backend,
164 you could set this variable:
165
166 (setq gnus-secondary-select-methods '((nnml \"\")))")
167
168 (defvar gnus-secondary-servers nil
169   "*List of NNTP servers that the user can choose between interactively.
170 To make Gnus query you for a server, you have to give `gnus' a
171 non-numeric prefix - `C-u M-x gnus', in short.")
172
173 (defvar gnus-nntp-server nil
174   "*The name of the host running the NNTP server.
175 This variable is semi-obsolete.  Use the `gnus-select-method'
176 variable instead.")
177
178 (defvar gnus-startup-file "~/.newsrc"
179   "*Your `.newsrc' file.
180 `.newsrc-SERVER' will be used instead if that exists.")
181
182 (defvar gnus-init-file "~/.gnus"
183   "*Your Gnus elisp startup file.
184 If a file with the .el or .elc suffixes exist, it will be read
185 instead.")
186
187 (defvar gnus-group-faq-directory
188   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
189 ;    "/ftp@ftp.uu.net:/usenet/news.answers/"
190     "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
191     "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
192     "/ftp@rtfm.mit.edu:/pub/usenet/news.answers/"
193     "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
194 ;    "/ftp@ftp.Germany.EU.net:/pub/newsarchive/news.answers/"
195     "/ftp@ftp.sunet.se:/pub/usenet/"
196     "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
197     "/ftp@hwarang.postech.ac.kr:/pub/usenet/news.answers/"
198     "/ftp@ftp.hk.super.net:/mirror/faqs/")
199   "*Directory where the group FAQs are stored.
200 This will most commonly be on a remote machine, and the file will be
201 fetched by ange-ftp.
202
203 This variable can also be a list of directories.  In that case, the
204 first element in the list will be used by default, and the others will
205 be used as backup sites.
206
207 Note that Gnus uses an aol machine as the default directory.  If this
208 feels fundamentally unclean, just think of it as a way to finally get
209 something of value back from them.
210
211 If the default site is too slow, try one of these:
212
213    North America: mirrors.aol.com                /pub/rtfm/usenet
214                   ftp.seas.gwu.edu               /pub/rtfm
215                   rtfm.mit.edu                   /pub/usenet/news.answers
216    Europe:        ftp.uni-paderborn.de           /pub/FAQ
217                   src.doc.ic.ac.uk               /usenet/news-FAQS
218                   ftp.sunet.se                   /pub/usenet
219    Asia:          nctuccca.edu.tw                /USENET/FAQ
220                   hwarang.postech.ac.kr          /pub/usenet/news.answers
221                   ftp.hk.super.net               /mirror/faqs")
222
223 (defvar gnus-group-archive-directory
224   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
225   "*The address of the (ding) archives.")
226
227 (defvar gnus-group-recent-archive-directory
228   "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
229   "*The address of the most recent (ding) articles.")
230
231 (defvar gnus-default-subscribed-newsgroups nil
232   "*This variable lists what newsgroups should be subscribed the first time Gnus is used.
233 It should be a list of strings.
234 If it is `t', Gnus will not do anything special the first time it is
235 started; it'll just use the normal newsgroups subscription methods.")
236
237 (defvar gnus-use-cross-reference t
238   "*Non-nil means that cross referenced articles will be marked as read.
239 If nil, ignore cross references.  If t, mark articles as read in
240 subscribed newsgroups.  If neither t nor nil, mark as read in all
241 newsgroups.")
242
243 (defvar gnus-single-article-buffer t
244   "*If non-nil, display all articles in the same buffer.
245 If nil, each group will get its own article buffer.")
246
247 (defvar gnus-use-dribble-file t
248   "*Non-nil means that Gnus will use a dribble file to store user updates.
249 If Emacs should crash without saving the .newsrc files, complete
250 information can be restored from the dribble file.")
251
252 (defvar gnus-dribble-directory nil
253   "*The directory where dribble files will be saved.
254 If this variable is nil, the directory where the .newsrc files are
255 saved will be used.")
256
257 (defvar gnus-asynchronous nil
258   "*If non-nil, Gnus will supply backends with data needed for async article fetching.")
259
260 (defvar gnus-kill-summary-on-exit t
261   "*If non-nil, kill the summary buffer when you exit from it.
262 If nil, the summary will become a \"*Dead Summary*\" buffer, and
263 it will be killed sometime later.")
264
265 (defvar gnus-large-newsgroup 200
266   "*The number of articles which indicates a large newsgroup.
267 If the number of articles in a newsgroup is greater than this value,
268 confirmation is required for selecting the newsgroup.")
269
270 ;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
271 (defvar gnus-no-groups-message "No news is horrible news"
272   "*Message displayed by Gnus when no groups are available.")
273
274 (defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
275   "*Non-nil means that the default name of a file to save articles in is the group name.
276 If it's nil, the directory form of the group name is used instead.
277
278 If this variable is a list, and the list contains the element
279 `not-score', long file names will not be used for score files; if it
280 contains the element `not-save', long file names will not be used for
281 saving; and if it contains the element `not-kill', long file names
282 will not be used for kill files.")
283
284 (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
285   "*Name of the directory articles will be saved in (default \"~/News\").
286 Initialized from the SAVEDIR environment variable.")
287
288 (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
289   "*Name of the directory where kill files will be stored (default \"~/News\").
290 Initialized from the SAVEDIR environment variable.")
291
292 (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
293   "*A function to save articles in your favorite format.
294 The function must be interactively callable (in other words, it must
295 be an Emacs command).
296
297 Gnus provides the following functions:
298
299 * gnus-summary-save-in-rmail (Rmail format)
300 * gnus-summary-save-in-mail (Unix mail format)
301 * gnus-summary-save-in-folder (MH folder)
302 * gnus-summary-save-in-file (article format).
303 * gnus-summary-save-in-vm (use VM's folder format).")
304
305 (defvar gnus-prompt-before-saving 'always
306   "*This variable says how much prompting is to be done when saving articles.
307 If it is nil, no prompting will be done, and the articles will be
308 saved to the default files.  If this variable is `always', each and
309 every article that is saved will be preceded by a prompt, even when
310 saving large batches of articles.  If this variable is neither nil not
311 `always', there the user will be prompted once for a file name for
312 each invocation of the saving commands.")
313
314 (defvar gnus-rmail-save-name (function gnus-plain-save-name)
315   "*A function generating a file name to save articles in Rmail format.
316 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
317
318 (defvar gnus-mail-save-name (function gnus-plain-save-name)
319   "*A function generating a file name to save articles in Unix mail format.
320 The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
321
322 (defvar gnus-folder-save-name (function gnus-folder-save-name)
323   "*A function generating a file name to save articles in MH folder.
324 The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
325
326 (defvar gnus-file-save-name (function gnus-numeric-save-name)
327   "*A function generating a file name to save articles in article format.
328 The function is called with NEWSGROUP, HEADERS, and optional
329 LAST-FILE.")
330
331 (defvar gnus-split-methods
332   '((gnus-article-archive-name))
333   "*Variable used to suggest where articles are to be saved.
334 For instance, if you would like to save articles related to Gnus in
335 the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
336 you could set this variable to something like:
337
338  '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
339    (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
340
341 This variable is an alist where the where the key is the match and the
342 value is a list of possible files to save in if the match is non-nil.
343
344 If the match is a string, it is used as a regexp match on the
345 article.  If the match is a symbol, that symbol will be funcalled
346 from the buffer of the article to be saved with the newsgroup as the
347 parameter.  If it is a list, it will be evaled in the same buffer.
348
349 If this form or function returns a string, this string will be used as
350 a possible file name; and if it returns a non-nil list, that list will
351 be used as possible file names.")
352
353 (defvar gnus-move-split-methods nil
354   "*Variable used to suggest where articles are to be moved to.
355 It uses the same syntax as the `gnus-split-methods' variable.")
356
357 (defvar gnus-save-score nil
358   "*If non-nil, save group scoring info.")
359
360 (defvar gnus-use-adaptive-scoring nil
361   "*If non-nil, use some adaptive scoring scheme.")
362
363 (defvar gnus-use-cache nil
364   "*If nil, Gnus will ignore the article cache.
365 If `passive', it will allow entering (and reading) articles
366 explicitly entered into the cache.  If anything else, use the
367 cache to the full extent of the law.")
368
369 (defvar gnus-use-trees nil
370   "*If non-nil, display a thread tree buffer.")
371
372 (defvar gnus-keep-backlog nil
373   "*If non-nil, Gnus will keep read articles for later re-retrieval.
374 If it is a number N, then Gnus will only keep the last N articles
375 read.  If it is neither nil nor a number, Gnus will keep all read
376 articles.  This is not a good idea.")
377
378 (defvar gnus-use-nocem nil
379   "*If non-nil, Gnus will read NoCeM cancel messages.")
380
381 (defvar gnus-use-demon nil
382   "If non-nil, Gnus might use some demons.")
383
384 (defvar gnus-use-scoring t
385   "*If non-nil, enable scoring.")
386
387 (defvar gnus-use-picons nil
388   "*If non-nil, display picons.")
389
390 (defvar gnus-fetch-old-headers nil
391   "*Non-nil means that Gnus will try to build threads by grabbing old headers.
392 If an unread article in the group refers to an older, already read (or
393 just marked as read) article, the old article will not normally be
394 displayed in the Summary buffer.  If this variable is non-nil, Gnus
395 will attempt to grab the headers to the old articles, and thereby
396 build complete threads.  If it has the value `some', only enough
397 headers to connect otherwise loose threads will be displayed.
398 This variable can also be a number.  In that case, no more than that
399 number of old headers will be fetched.
400
401 The server has to support NOV for any of this to work.")
402
403 ;see gnus-cus.el
404 ;(defvar gnus-visual t
405 ;  "*If non-nil, will do various highlighting.
406 ;If nil, no mouse highlights (or any other highlights) will be
407 ;performed.  This might speed up Gnus some when generating large group
408 ;and summary buffers.")
409
410 (defvar gnus-novice-user t
411   "*Non-nil means that you are a usenet novice.
412 If non-nil, verbose messages may be displayed and confirmations may be
413 required.")
414
415 (defvar gnus-expert-user nil
416   "*Non-nil means that you will never be asked for confirmation about anything.
417 And that means *anything*.")
418
419 (defvar gnus-verbose 7
420   "*Integer that says how verbose Gnus should be.
421 The higher the number, the more messages Gnus will flash to say what
422 it's doing.  At zero, Gnus will be totally mute; at five, Gnus will
423 display most important messages; and at ten, Gnus will keep on
424 jabbering all the time.")
425
426 (defvar gnus-keep-same-level nil
427   "*Non-nil means that the next newsgroup after the current will be on the same level.
428 When you type, for instance, `n' after reading the last article in the
429 current newsgroup, you will go to the next newsgroup.  If this variable
430 is nil, the next newsgroup will be the next from the group
431 buffer.
432 If this variable is non-nil, Gnus will either put you in the
433 next newsgroup with the same level, or, if no such newsgroup is
434 available, the next newsgroup with the lowest possible level higher
435 than the current level.
436 If this variable is `best', Gnus will make the next newsgroup the one
437 with the best level.")
438
439 (defvar gnus-summary-make-false-root 'adopt
440   "*nil means that Gnus won't gather loose threads.
441 If the root of a thread has expired or been read in a previous
442 session, the information necessary to build a complete thread has been
443 lost.  Instead of having many small sub-threads from this original thread
444 scattered all over the summary buffer, Gnus can gather them.
445
446 If non-nil, Gnus will try to gather all loose sub-threads from an
447 original thread into one large thread.
448
449 If this variable is non-nil, it should be one of `none', `adopt',
450 `dummy' or `empty'.
451
452 If this variable is `none', Gnus will not make a false root, but just
453 present the sub-threads after another.
454 If this variable is `dummy', Gnus will create a dummy root that will
455 have all the sub-threads as children.
456 If this variable is `adopt', Gnus will make one of the \"children\"
457 the parent and mark all the step-children as such.
458 If this variable is `empty', the \"children\" are printed with empty
459 subject fields.  (Or rather, they will be printed with a string
460 given by the `gnus-summary-same-subject' variable.)")
461
462 (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
463   "*A regexp to match subjects to be excluded from loose thread gathering.
464 As loose thread gathering is done on subjects only, that means that
465 there can be many false gatherings performed.  By rooting out certain
466 common subjects, gathering might become saner.")
467
468 (defvar gnus-summary-gather-subject-limit nil
469   "*Maximum length of subject comparisons when gathering loose threads.
470 Use nil to compare full subjects.  Setting this variable to a low
471 number will help gather threads that have been corrupted by
472 newsreaders chopping off subject lines, but it might also mean that
473 unrelated articles that have subject that happen to begin with the
474 same few characters will be incorrectly gathered.
475
476 If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
477 comparing subjects.")
478
479 (defvar gnus-simplify-ignored-prefixes nil
480   "*Regexp, matches for which are removed from subject lines when simplifying.")
481
482 (defvar gnus-build-sparse-threads nil
483   "*If non-nil, fill in the gaps in threads.
484 If `some', only fill in the gaps that are needed to tie loose threads
485 together.  If `more', fill in all leaf nodes that Gnus can find.  If
486 non-nil and non-`some', fill in all gaps that Gnus manages to guess.")
487
488 (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
489   "Function used for gathering loose threads.
490 There are two pre-defined functions: `gnus-gather-threads-by-subject',
491 which only takes Subjects into consideration; and
492 `gnus-gather-threads-by-references', which compared the References
493 headers of the articles to find matches.")
494
495 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
496 (defvar gnus-summary-same-subject ""
497   "*String indicating that the current article has the same subject as the previous.
498 This variable will only be used if the value of
499 `gnus-summary-make-false-root' is `empty'.")
500
501 (defvar gnus-summary-goto-unread t
502   "*If non-nil, marking commands will go to the next unread article.
503 If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article,
504 whether it is read or not.")
505
506 (defvar gnus-group-goto-unread t
507   "*If non-nil, movement commands will go to the next unread and subscribed group.")
508
509 (defvar gnus-goto-next-group-when-activating t
510   "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.")
511
512 (defvar gnus-check-new-newsgroups t
513   "*Non-nil means that Gnus will add new newsgroups at startup.
514 If this variable is `ask-server', Gnus will ask the server for new
515 groups since the last time it checked.  This means that the killed list
516 is no longer necessary, so you could set `gnus-save-killed-list' to
517 nil.
518
519 A variant is to have this variable be a list of select methods.  Gnus
520 will then use the `ask-server' method on all these select methods to
521 query for new groups from all those servers.
522
523 Eg.
524   (setq gnus-check-new-newsgroups
525         '((nntp \"some.server\") (nntp \"other.server\")))
526
527 If this variable is nil, then you have to tell Gnus explicitly to
528 check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
529
530 (defvar gnus-check-bogus-newsgroups nil
531   "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
532 If this variable is nil, then you have to tell Gnus explicitly to
533 check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
534
535 (defvar gnus-read-active-file t
536   "*Non-nil means that Gnus will read the entire active file at startup.
537 If this variable is nil, Gnus will only know about the groups in your
538 `.newsrc' file.
539
540 If this variable is `some', Gnus will try to only read the relevant
541 parts of the active file from the server.  Not all servers support
542 this, and it might be quite slow with other servers, but this should
543 generally be faster than both the t and nil value.
544
545 If you set this variable to nil or `some', you probably still want to
546 be told about new newsgroups that arrive.  To do that, set
547 `gnus-check-new-newsgroups' to `ask-server'.  This may not work
548 properly with all servers.")
549
550 (defvar gnus-level-subscribed 5
551   "*Groups with levels less than or equal to this variable are subscribed.")
552
553 (defvar gnus-level-unsubscribed 7
554   "*Groups with levels less than or equal to this variable are unsubscribed.
555 Groups with levels less than `gnus-level-subscribed', which should be
556 less than this variable, are subscribed.")
557
558 (defvar gnus-level-zombie 8
559   "*Groups with this level are zombie groups.")
560
561 (defvar gnus-level-killed 9
562   "*Groups with this level are killed.")
563
564 (defvar gnus-level-default-subscribed 3
565   "*New subscribed groups will be subscribed at this level.")
566
567 (defvar gnus-level-default-unsubscribed 6
568   "*New unsubscribed groups will be unsubscribed at this level.")
569
570 (defvar gnus-activate-level (1+ gnus-level-subscribed)
571   "*Groups higher than this level won't be activated on startup.
572 Setting this variable to something log might save lots of time when
573 you have many groups that you aren't interested in.")
574
575 (defvar gnus-activate-foreign-newsgroups 4
576   "*If nil, Gnus will not check foreign newsgroups at startup.
577 If it is non-nil, it should be a number between one and nine.  Foreign
578 newsgroups that have a level lower or equal to this number will be
579 activated on startup.  For instance, if you want to active all
580 subscribed newsgroups, but not the rest, you'd set this variable to
581 `gnus-level-subscribed'.
582
583 If you subscribe to lots of newsgroups from different servers, startup
584 might take a while.  By setting this variable to nil, you'll save time,
585 but you won't be told how many unread articles there are in the
586 groups.")
587
588 (defvar gnus-save-newsrc-file t
589   "*Non-nil means that Gnus will save the `.newsrc' file.
590 Gnus always saves its own startup file, which is called
591 \".newsrc.eld\".  The file called \".newsrc\" is in a format that can
592 be readily understood by other newsreaders.  If you don't plan on
593 using other newsreaders, set this variable to nil to save some time on
594 exit.")
595
596 (defvar gnus-save-killed-list t
597   "*If non-nil, save the list of killed groups to the startup file.
598 If you set this variable to nil, you'll save both time (when starting
599 and quitting) and space (both memory and disk), but it will also mean
600 that Gnus has no record of which groups are new and which are old, so
601 the automatic new newsgroups subscription methods become meaningless.
602
603 You should always set `gnus-check-new-newsgroups' to `ask-server' or
604 nil if you set this variable to nil.")
605
606 (defvar gnus-interactive-catchup t
607   "*If non-nil, require your confirmation when catching up a group.")
608
609 (defvar gnus-interactive-post t
610   "*If non-nil, group name will be asked for when posting.")
611
612 (defvar gnus-interactive-exit t
613   "*If non-nil, require your confirmation when exiting Gnus.")
614
615 (defvar gnus-kill-killed t
616   "*If non-nil, Gnus will apply kill files to already killed articles.
617 If it is nil, Gnus will never apply kill files to articles that have
618 already been through the scoring process, which might very well save lots
619 of time.")
620
621 (defvar gnus-extract-address-components 'gnus-extract-address-components
622   "*Function for extracting address components from a From header.
623 Two pre-defined function exist: `gnus-extract-address-components',
624 which is the default, quite fast, and too simplistic solution, and
625 `mail-extract-address-components', which works much better, but is
626 slower.")
627
628 (defvar gnus-summary-default-score 0
629   "*Default article score level.
630 If this variable is nil, scoring will be disabled.")
631
632 (defvar gnus-summary-zcore-fuzz 0
633   "*Fuzziness factor for the zcore in the summary buffer.
634 Articles with scores closer than this to `gnus-summary-default-score'
635 will not be marked.")
636
637 (defvar gnus-simplify-subject-fuzzy-regexp nil
638   "*Strings to be removed when doing fuzzy matches.
639 This can either be a regular expression or list of regular expressions
640 that will be removed from subject strings if fuzzy subject
641 simplification is selected.")
642
643 (defvar gnus-permanently-visible-groups nil
644   "*Regexp to match groups that should always be listed in the group buffer.
645 This means that they will still be listed when there are no unread
646 articles in the groups.")
647
648 (defvar gnus-list-groups-with-ticked-articles t
649   "*If non-nil, list groups that have only ticked articles.
650 If nil, only list groups that have unread articles.")
651
652 (defvar gnus-group-default-list-level gnus-level-subscribed
653   "*Default listing level.
654 Ignored if `gnus-group-use-permanent-levels' is non-nil.")
655
656 (defvar gnus-group-use-permanent-levels nil
657   "*If non-nil, once you set a level, Gnus will use this level.")
658
659 (defvar gnus-group-list-inactive-groups t
660   "*If non-nil, inactive groups will be listed.")
661
662 (defvar gnus-show-mime nil
663   "*If non-nil, do mime processing of articles.
664 The articles will simply be fed to the function given by
665 `gnus-show-mime-method'.")
666
667 (defvar gnus-strict-mime t
668   "*If nil, MIME-decode even if there is no Mime-Version header in the article.")
669
670 (defvar gnus-show-mime-method 'metamail-buffer
671   "*Function to process a MIME message.
672 The function is called from the article buffer.")
673
674 (defvar gnus-decode-encoded-word-method (lambda ())
675   "*Function to decode a MIME encoded-words.
676 The function is called from the article buffer.")
677
678 (defvar gnus-show-threads t
679   "*If non-nil, display threads in summary mode.")
680
681 (defvar gnus-thread-hide-subtree nil
682   "*If non-nil, hide all threads initially.
683 If threads are hidden, you have to run the command
684 `gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
685 to expose hidden threads.")
686
687 (defvar gnus-thread-hide-killed t
688   "*If non-nil, hide killed threads automatically.")
689
690 (defvar gnus-thread-ignore-subject nil
691   "*If non-nil, ignore subjects and do all threading based on the Reference header.
692 If nil, which is the default, articles that have different subjects
693 from their parents will start separate threads.")
694
695 (defvar gnus-thread-operation-ignore-subject t
696   "*If non-nil, subjects will be ignored when doing thread commands.
697 This affects commands like `gnus-summary-kill-thread' and
698 `gnus-summary-lower-thread'.
699
700 If this variable is nil, articles in the same thread with different
701 subjects will not be included in the operation in question.  If this
702 variable is `fuzzy', only articles that have subjects that are fuzzily
703 equal will be included.")
704
705 (defvar gnus-thread-indent-level 4
706   "*Number that says how much each sub-thread should be indented.")
707
708 (defvar gnus-ignored-newsgroups
709   (purecopy (mapconcat 'identity
710                        '("^to\\."       ; not "real" groups
711                          "^[0-9. \t]+ " ; all digits in name
712                          "[][\"#'()]"   ; bogus characters
713                          )
714                        "\\|"))
715   "*A regexp to match uninteresting newsgroups in the active file.
716 Any lines in the active file matching this regular expression are
717 removed from the newsgroup list before anything else is done to it,
718 thus making them effectively non-existent.")
719
720 (defvar gnus-ignored-headers
721   "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:"
722   "*All headers that match this regexp will be hidden.
723 This variable can also be a list of regexps of headers to be ignored.
724 If `gnus-visible-headers' is non-nil, this variable will be ignored.")
725
726 (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-"
727   "*All headers that do not match this regexp will be hidden.
728 This variable can also be a list of regexp of headers to remain visible.
729 If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
730
731 (defvar gnus-sorted-header-list
732   '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
733     "^Cc:" "^Date:" "^Organization:")
734   "*This variable is a list of regular expressions.
735 If it is non-nil, headers that match the regular expressions will
736 be placed first in the article buffer in the sequence specified by
737 this list.")
738
739 (defvar gnus-boring-article-headers
740   '(empty followup-to reply-to)
741   "*Headers that are only to be displayed if they have interesting data.
742 Possible values in this list are `empty', `newsgroups', `followup-to',
743 `reply-to', and `date'.")
744
745 (defvar gnus-show-all-headers nil
746   "*If non-nil, don't hide any headers.")
747
748 (defvar gnus-save-all-headers t
749   "*If non-nil, don't remove any headers before saving.")
750
751 (defvar gnus-saved-headers gnus-visible-headers
752   "*Headers to keep if `gnus-save-all-headers' is nil.
753 If `gnus-save-all-headers' is non-nil, this variable will be ignored.
754 If that variable is nil, however, all headers that match this regexp
755 will be kept while the rest will be deleted before saving.")
756
757 (defvar gnus-inhibit-startup-message nil
758   "*If non-nil, the startup message will not be displayed.")
759
760 (defvar gnus-signature-separator "^-- *$"
761   "Regexp matching signature separator.")
762
763 (defvar gnus-auto-extend-newsgroup t
764   "*If non-nil, extend newsgroup forward and backward when requested.")
765
766 (defvar gnus-auto-select-first t
767   "*If nil, don't select the first unread article when entering a group.
768 If this variable is `best', select the highest-scored unread article
769 in the group.  If neither nil nor `best', select the first unread
770 article.
771
772 If you want to prevent automatic selection of the first unread article
773 in some newsgroups, set the variable to nil in
774 `gnus-select-group-hook'.")
775
776 (defvar gnus-auto-select-next t
777   "*If non-nil, offer to go to the next group from the end of the previous.
778 If the value is t and the next newsgroup is empty, Gnus will exit
779 summary mode and go back to group mode.  If the value is neither nil
780 nor t, Gnus will select the following unread newsgroup.  In
781 particular, if the value is the symbol `quietly', the next unread
782 newsgroup will be selected without any confirmation, and if it is
783 `almost-quietly', the next group will be selected without any
784 confirmation if you are located on the last article in the group.
785 Finally, if this variable is `slightly-quietly', the `Z n' command
786 will go to the next group without confirmation.")
787
788 (defvar gnus-auto-select-same nil
789   "*If non-nil, select the next article with the same subject.")
790
791 (defvar gnus-summary-check-current nil
792   "*If non-nil, consider the current article when moving.
793 The \"unread\" movement commands will stay on the same line if the
794 current article is unread.")
795
796 (defvar gnus-auto-center-summary t
797   "*If non-nil, always center the current summary buffer.")
798
799 (defvar gnus-break-pages t
800   "*If non-nil, do page breaking on articles.
801 The page delimiter is specified by the `gnus-page-delimiter'
802 variable.")
803
804 (defvar gnus-page-delimiter "^\^L"
805   "*Regexp describing what to use as article page delimiters.
806 The default value is \"^\^L\", which is a form linefeed at the
807 beginning of a line.")
808
809 (defvar gnus-use-full-window t
810   "*If non-nil, use the entire Emacs screen.")
811
812 (defvar gnus-window-configuration nil
813   "Obsolete variable.  See `gnus-buffer-configuration'.")
814
815 (defvar gnus-window-min-width 2
816   "*Minimum width of Gnus buffers.")
817
818 (defvar gnus-window-min-height 1
819   "*Minimum height of Gnus buffers.")
820
821 (defvar gnus-buffer-configuration
822   '((group
823      (vertical 1.0
824                (group 1.0 point)
825                (if gnus-carpal '(group-carpal 4))))
826     (summary
827      (vertical 1.0
828                (summary 1.0 point)
829                (if gnus-carpal '(summary-carpal 4))))
830     (article
831      (cond 
832       (gnus-use-picons
833        '(frame 1.0
834                (vertical 1.0
835                          (summary 0.25 point)
836                          (if gnus-carpal '(summary-carpal 4))
837                          (article 1.0))
838                (vertical '((height . 5) (width . 15)
839                            (user-position . t)
840                            (left . -1) (top . 1))
841                          (picons 1.0))))
842       (gnus-use-trees
843        '(vertical 1.0
844                   (summary 0.25 point)
845                   (tree 0.25)
846                   (article 1.0)))
847       (t
848        '(vertical 1.0
849                  (summary 0.25 point)
850                  (if gnus-carpal '(summary-carpal 4))
851                  (if gnus-use-trees '(tree 0.25))
852                  (article 1.0)))))
853     (server
854      (vertical 1.0
855                (server 1.0 point)
856                (if gnus-carpal '(server-carpal 2))))
857     (browse
858      (vertical 1.0
859                (browse 1.0 point)
860                (if gnus-carpal '(browse-carpal 2))))
861     (group-mail
862      (vertical 1.0
863                (mail 1.0 point)))
864     (summary-mail
865      (vertical 1.0
866                (mail 1.0 point)))
867     (summary-reply
868      (vertical 1.0
869                (article 0.5)
870                (mail 1.0 point)))
871     (pick
872      (vertical 1.0
873                (article 1.0 point)))
874     (info
875      (vertical 1.0
876                (info 1.0 point)))
877     (summary-faq
878      (vertical 1.0
879                (summary 0.25)
880                (faq 1.0 point)))
881     (edit-group
882      (vertical 1.0
883                (group 0.5)
884                (edit-group 1.0 point)))
885     (edit-server
886      (vertical 1.0
887                (server 0.5)
888                (edit-server 1.0 point)))
889     (edit-score
890      (vertical 1.0
891                (summary 0.25)
892                (edit-score 1.0 point)))
893     (post
894      (vertical 1.0
895                (post 1.0 point)))
896     (reply
897      (vertical 1.0
898                (article 0.5)
899                (mail 1.0 point)))
900     (mail-forward
901      (vertical 1.0
902                (mail 1.0 point)))
903     (post-forward
904      (vertical 1.0
905                (post 1.0 point)))
906     (reply-yank
907      (vertical 1.0
908                (mail 1.0 point)))
909     (mail-bounce
910      (vertical 1.0
911                (article 0.5)
912                (mail 1.0 point)))
913     (draft
914      (vertical 1.0
915                (draft 1.0 point)))
916     (pipe
917      (vertical 1.0
918                (summary 0.25 point)
919                (if gnus-carpal '(summary-carpal 4))
920                ("*Shell Command Output*" 1.0)))
921     (followup
922      (vertical 1.0
923                (article 0.5)
924                (post 1.0 point)))
925     (followup-yank
926      (vertical 1.0
927                (post 1.0 point))))
928   "Window configuration for all possible Gnus buffers.
929 This variable is a list of lists.  Each of these lists has a NAME and
930 a RULE.  The NAMEs are commonsense names like `group', which names a
931 rule used when displaying the group buffer; `summary', which names a
932 rule for what happens when you enter a group and do not display an
933 article buffer; and so on.  See the value of this variable for a
934 complete list of NAMEs.
935
936 Each RULE is a list of vectors.  The first element in this vector is
937 the name of the buffer to be displayed; the second element is the
938 percentage of the screen this buffer is to occupy (a number in the
939 0.0-0.99 range); the optional third element is `point', which should
940 be present to denote which buffer point is to go to after making this
941 buffer configuration.")
942
943 (defvar gnus-window-to-buffer
944   '((group . gnus-group-buffer)
945     (summary . gnus-summary-buffer)
946     (article . gnus-article-buffer)
947     (server . gnus-server-buffer)
948     (browse . "*Gnus Browse Server*")
949     (edit-group . gnus-group-edit-buffer)
950     (edit-server . gnus-server-edit-buffer)
951     (group-carpal . gnus-carpal-group-buffer)
952     (summary-carpal . gnus-carpal-summary-buffer)
953     (server-carpal . gnus-carpal-server-buffer)
954     (browse-carpal . gnus-carpal-browse-buffer)
955     (edit-score . gnus-score-edit-buffer)
956     (mail . gnus-mail-buffer)
957     (post . gnus-post-news-buffer)
958     (faq . gnus-faq-buffer)
959     (picons . "*Picons*")
960     (tree . gnus-tree-buffer)
961     (info . gnus-info-buffer)
962     (draft . gnus-draft-buffer))
963   "Mapping from short symbols to buffer names or buffer variables.")
964
965 (defvar gnus-carpal nil
966   "*If non-nil, display clickable icons.")
967
968 (defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
969   "*Function called with a group name when new group is detected.
970 A few pre-made functions are supplied: `gnus-subscribe-randomly'
971 inserts new groups at the beginning of the list of groups;
972 `gnus-subscribe-alphabetically' inserts new groups in strict
973 alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
974 in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
975 for your decision; `gnus-subscribe-killed' kills all new groups.")
976
977 ;; Suggested by a bug report by Hallvard B Furuseth.
978 ;; <h.b.furuseth@usit.uio.no>.
979 (defvar gnus-subscribe-options-newsgroup-method
980   (function gnus-subscribe-alphabetically)
981   "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
982 If, for instance, you want to subscribe to all newsgroups in the
983 \"no\" and \"alt\" hierarchies, you'd put the following in your
984 .newsrc file:
985
986 options -n no.all alt.all
987
988 Gnus will the subscribe all new newsgroups in these hierarchies with
989 the subscription method in this variable.")
990
991 (defvar gnus-subscribe-hierarchical-interactive nil
992   "*If non-nil, Gnus will offer to subscribe hierarchically.
993 When a new hierarchy appears, Gnus will ask the user:
994
995 'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
996
997 If the user pressed `d', Gnus will descend the hierarchy, `y' will
998 subscribe to all newsgroups in the hierarchy and `s' will skip this
999 hierarchy in its entirety.")
1000
1001 (defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
1002   "*Function used for sorting the group buffer.
1003 This function will be called with group info entries as the arguments
1004 for the groups to be sorted.  Pre-made functions include
1005 `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
1006 `gnus-group-sort-by-level', `gnus-group-sort-by-score', and
1007 `gnus-group-sort-by-rank'.
1008
1009 This variable can also be a list of sorting functions.  In that case,
1010 the most significant sort function should be the last function in the
1011 list.")
1012
1013 ;; Mark variables suggested by Thomas Michanek
1014 ;; <Thomas.Michanek@telelogic.se>.
1015 (defvar gnus-unread-mark ? 
1016   "*Mark used for unread articles.")
1017 (defvar gnus-ticked-mark ?!
1018   "*Mark used for ticked articles.")
1019 (defvar gnus-dormant-mark ??
1020   "*Mark used for dormant articles.")
1021 (defvar gnus-del-mark ?r
1022   "*Mark used for del'd articles.")
1023 (defvar gnus-read-mark ?R
1024   "*Mark used for read articles.")
1025 (defvar gnus-expirable-mark ?E
1026   "*Mark used for expirable articles.")
1027 (defvar gnus-killed-mark ?K
1028   "*Mark used for killed articles.")
1029 (defvar gnus-souped-mark ?F
1030   "*Mark used for killed articles.")
1031 (defvar gnus-kill-file-mark ?X
1032   "*Mark used for articles killed by kill files.")
1033 (defvar gnus-low-score-mark ?Y
1034   "*Mark used for articles with a low score.")
1035 (defvar gnus-catchup-mark ?C
1036   "*Mark used for articles that are caught up.")
1037 (defvar gnus-replied-mark ?A
1038   "*Mark used for articles that have been replied to.")
1039 (defvar gnus-cached-mark ?*
1040   "*Mark used for articles that are in the cache.")
1041 (defvar gnus-saved-mark ?S
1042   "*Mark used for articles that have been saved to.")
1043 (defvar gnus-process-mark ?#
1044   "*Process mark.")
1045 (defvar gnus-ancient-mark ?O
1046   "*Mark used for ancient articles.")
1047 (defvar gnus-sparse-mark ?Q
1048   "*Mark used for sparsely reffed articles.")
1049 (defvar gnus-canceled-mark ?G
1050   "*Mark used for canceled articles.")
1051 (defvar gnus-score-over-mark ?+
1052   "*Score mark used for articles with high scores.")
1053 (defvar gnus-score-below-mark ?-
1054   "*Score mark used for articles with low scores.")
1055 (defvar gnus-empty-thread-mark ? 
1056   "*There is no thread under the article.")
1057 (defvar gnus-not-empty-thread-mark ?=
1058   "*There is a thread under the article.")
1059
1060 (defvar gnus-view-pseudo-asynchronously nil
1061   "*If non-nil, Gnus will view pseudo-articles asynchronously.")
1062
1063 (defvar gnus-view-pseudos nil
1064   "*If `automatic', pseudo-articles will be viewed automatically.
1065 If `not-confirm', pseudos will be viewed automatically, and the user
1066 will not be asked to confirm the command.")
1067
1068 (defvar gnus-view-pseudos-separately t
1069   "*If non-nil, one pseudo-article will be created for each file to be viewed.
1070 If nil, all files that use the same viewing command will be given as a
1071 list of parameters to that command.")
1072
1073 (defvar gnus-insert-pseudo-articles t
1074   "*If non-nil, insert pseudo-articles when decoding articles.")
1075
1076 (defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)\n"
1077   "*Format of group lines.
1078 It works along the same lines as a normal formatting string,
1079 with some simple extensions.
1080
1081 %M    Only marked articles (character, \"*\" or \" \")
1082 %S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
1083 %L    Level of subscribedness (integer)
1084 %N    Number of unread articles (integer)
1085 %I    Number of dormant articles (integer)
1086 %i    Number of ticked and dormant (integer)
1087 %T    Number of ticked articles (integer)
1088 %R    Number of read articles (integer)
1089 %t    Total number of articles (integer)
1090 %y    Number of unread, unticked articles (integer)
1091 %G    Group name (string)
1092 %g    Qualified group name (string)
1093 %D    Group description (string)
1094 %s    Select method (string)
1095 %o    Moderated group (char, \"m\")
1096 %p    Process mark (char)
1097 %O    Moderated group (string, \"(m)\" or \"\")
1098 %P    Topic indentation (string)
1099 %n    Select from where (string)
1100 %z    A string that look like `<%s:%n>' if a foreign select method is used
1101 %u    User defined specifier.  The next character in the format string should
1102       be a letter.  Gnus will call the function gnus-user-format-function-X,
1103       where X is the letter following %u.  The function will be passed the
1104       current header as argument.  The function should return a string, which
1105       will be inserted into the buffer just like information from any other
1106       group specifier.
1107
1108 Text between %( and %) will be highlighted with `gnus-mouse-face' when
1109 the mouse point move inside the area.  There can only be one such area.
1110
1111 Note that this format specification is not always respected.  For
1112 reasons of efficiency, when listing killed groups, this specification
1113 is ignored altogether.  If the spec is changed considerably, your
1114 output may end up looking strange when listing both alive and killed
1115 groups.
1116
1117 If you use %o or %O, reading the active file will be slower and quite
1118 a bit of extra memory will be used. %D will also worsen performance.
1119 Also note that if you change the format specification to include any
1120 of these specs, you must probably re-start Gnus to see them go into
1121 effect.")
1122
1123 (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
1124   "*The format specification of the lines in the summary buffer.
1125
1126 It works along the same lines as a normal formatting string,
1127 with some simple extensions.
1128
1129 %N   Article number, left padded with spaces (string)
1130 %S   Subject (string)
1131 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
1132 %n   Name of the poster (string)
1133 %a   Extracted name of the poster (string)
1134 %A   Extracted address of the poster (string)
1135 %F   Contents of the From: header (string)
1136 %x   Contents of the Xref: header (string)
1137 %D   Date of the article (string)
1138 %d   Date of the article (string) in DD-MMM format
1139 %M   Message-id of the article (string)
1140 %r   References of the article (string)
1141 %c   Number of characters in the article (integer)
1142 %L   Number of lines in the article (integer)
1143 %I   Indentation based on thread level (a string of spaces)
1144 %T   A string with two possible values: 80 spaces if the article
1145      is on thread level two or larger and 0 spaces on level one
1146 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
1147 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
1148 %[   Opening bracket (character, \"[\" or \"<\")
1149 %]   Closing bracket (character, \"]\" or \">\")
1150 %>   Spaces of length thread-level (string)
1151 %<   Spaces of length (- 20 thread-level) (string)
1152 %i   Article score (number)
1153 %z   Article zcore (character)
1154 %t   Number of articles under the current thread (number).
1155 %e   Whether the thread is empty or not (character).
1156 %u   User defined specifier.  The next character in the format string should
1157      be a letter.  Gnus will call the function gnus-user-format-function-X,
1158      where X is the letter following %u.  The function will be passed the
1159      current header as argument.  The function should return a string, which
1160      will be inserted into the summary just like information from any other
1161      summary specifier.
1162
1163 Text between %( and %) will be highlighted with `gnus-mouse-face'
1164 when the mouse point is placed inside the area.  There can only be one
1165 such area.
1166
1167 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1168 with care.  For reasons of efficiency, Gnus will compute what column
1169 these characters will end up in, and \"hard-code\" that.  This means that
1170 it is illegal to have these specs after a variable-length spec.  Well,
1171 you might not be arrested, but your summary buffer will look strange,
1172 which is bad enough.
1173
1174 The smart choice is to have these specs as for to the left as
1175 possible.
1176
1177 This restriction may disappear in later versions of Gnus.")
1178
1179 (defvar gnus-summary-dummy-line-format
1180   "*  %(:                          :%) %S\n"
1181   "*The format specification for the dummy roots in the summary buffer.
1182 It works along the same lines as a normal formatting string,
1183 with some simple extensions.
1184
1185 %S  The subject")
1186
1187 (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
1188   "*The format specification for the summary mode line.
1189 It works along the same lines as a normal formatting string,
1190 with some simple extensions:
1191
1192 %G  Group name
1193 %p  Unprefixed group name
1194 %A  Current article number
1195 %V  Gnus version
1196 %U  Number of unread articles in the group
1197 %e  Number of unselected articles in the group
1198 %Z  A string with unread/unselected article counts
1199 %g  Shortish group name
1200 %S  Subject of the current article
1201 %u  User-defined spec
1202 %s  Current score file name
1203 %d  Number of dormant articles
1204 %r  Number of articles that have been marked as read in this session
1205 %E  Number of articles expunged by the score files")
1206
1207 (defvar gnus-article-mode-line-format "Gnus: %%b %S"
1208   "*The format specification for the article mode line.
1209 See `gnus-summary-mode-line-format' for a closer description.")
1210
1211 (defvar gnus-group-mode-line-format "Gnus: %%b {%M:%S}"
1212   "*The format specification for the group mode line.
1213 It works along the same lines as a normal formatting string,
1214 with some simple extensions:
1215
1216 %S   The native news server.
1217 %M   The native select method.")
1218
1219 (defvar gnus-valid-select-methods
1220   '(("nntp" post address prompt-address)
1221     ("nnspool" post)
1222     ("nnvirtual" post-mail virtual prompt-address)
1223     ("nnmbox" mail respool)
1224     ("nnml" mail respool)
1225     ("nnmh" mail respool)
1226     ("nndir" post-mail prompt-address address)
1227     ("nneething" none prompt-address)
1228     ("nndoc" none prompt-address)
1229     ("nnbabyl" mail respool)
1230     ("nnkiboze" post virtual)
1231     ("nnsoup" post-mail)
1232     ("nnfolder" mail respool))
1233   "An alist of valid select methods.
1234 The first element of each list lists should be a string with the name
1235 of the select method.  The other elements may be be the category of
1236 this method (ie. `post', `mail', `none' or whatever) or other
1237 properties that this method has (like being respoolable).
1238 If you implement a new select method, all you should have to change is
1239 this variable.  I think.")
1240
1241 (defvar gnus-updated-mode-lines '(group article summary tree)
1242   "*List of buffers that should update their mode lines.
1243 The list may contain the symbols `group', `article' and `summary'.  If
1244 the corresponding symbol is present, Gnus will keep that mode line
1245 updated with information that may be pertinent.
1246 If this variable is nil, screen refresh may be quicker.")
1247
1248 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1249 (defvar gnus-mode-non-string-length nil
1250   "*Max length of mode-line non-string contents.
1251 If this is nil, Gnus will take space as is needed, leaving the rest
1252 of the modeline intact.")
1253
1254 ;see gnus-cus.el
1255 ;(defvar gnus-mouse-face 'highlight
1256 ;  "*Face used for mouse highlighting in Gnus.
1257 ;No mouse highlights will be done if `gnus-visual' is nil.")
1258
1259 (defvar gnus-summary-mark-below nil
1260   "*Mark all articles with a score below this variable as read.
1261 This variable is local to each summary buffer and usually set by the
1262 score file.")
1263
1264 (defvar gnus-article-sort-functions '(gnus-article-sort-by-number)
1265   "*List of functions used for sorting articles in the summary buffer.
1266 This variable is only used when not using a threaded display.")
1267
1268 (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
1269   "*List of functions used for sorting threads in the summary buffer.
1270 By default, threads are sorted by article number.
1271
1272 Each function takes two threads and return non-nil if the first thread
1273 should be sorted before the other.  If you use more than one function,
1274 the primary sort function should be the last.  You should probably
1275 always include `gnus-thread-sort-by-number' in the list of sorting
1276 functions -- preferably first.
1277
1278 Ready-mady functions include `gnus-thread-sort-by-number',
1279 `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
1280 `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
1281 `gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
1282
1283 (defvar gnus-thread-score-function '+
1284   "*Function used for calculating the total score of a thread.
1285
1286 The function is called with the scores of the article and each
1287 subthread and should then return the score of the thread.
1288
1289 Some functions you can use are `+', `max', or `min'.")
1290
1291 (defvar gnus-summary-expunge-below nil
1292   "All articles that have a score less than this variable will be expunged.")
1293
1294 (defvar gnus-thread-expunge-below nil
1295   "All threads that have a total score less than this variable will be expunged.
1296 See `gnus-thread-score-function' for en explanation of what a
1297 \"thread score\" is.")
1298
1299 (defvar gnus-auto-subscribed-groups
1300   "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
1301   "*All new groups that match this regexp will be subscribed automatically.
1302 Note that this variable only deals with new groups.  It has no effect
1303 whatsoever on old groups.")
1304
1305 (defvar gnus-options-subscribe nil
1306   "*All new groups matching this regexp will be subscribed unconditionally.
1307 Note that this variable deals only with new newsgroups.  This variable
1308 does not affect old newsgroups.")
1309
1310 (defvar gnus-options-not-subscribe nil
1311   "*All new groups matching this regexp will be ignored.
1312 Note that this variable deals only with new newsgroups.  This variable
1313 does not affect old (already subscribed) newsgroups.")
1314
1315 (defvar gnus-auto-expirable-newsgroups nil
1316   "*Groups in which to automatically mark read articles as expirable.
1317 If non-nil, this should be a regexp that should match all groups in
1318 which to perform auto-expiry.  This only makes sense for mail groups.")
1319
1320 (defvar gnus-total-expirable-newsgroups nil
1321   "*Groups in which to perform expiry of all read articles.
1322 Use with extreme caution.  All groups that match this regexp will be
1323 expiring - which means that all read articles will be deleted after
1324 (say) one week.  (This only goes for mail groups and the like, of
1325 course.)")
1326
1327 (defvar gnus-group-uncollapsed-levels 1
1328   "Number of group name elements to leave alone when making a short group name.")
1329
1330 (defvar gnus-hidden-properties '(invisible t intangible t)
1331   "Property list to use for hiding text.")
1332
1333 (defvar gnus-modtime-botch nil
1334   "*Non-nil means .newsrc should be deleted prior to save.  Its use is
1335 due to the bogus appearance that .newsrc was modified on disc.")
1336
1337 ;; Hooks.
1338
1339 (defvar gnus-group-mode-hook nil
1340   "*A hook for Gnus group mode.")
1341
1342 (defvar gnus-summary-mode-hook nil
1343   "*A hook for Gnus summary mode.
1344 This hook is run before any variables are set in the summary buffer.")
1345
1346 (defvar gnus-article-mode-hook nil
1347   "*A hook for Gnus article mode.")
1348
1349 (defvar gnus-summary-prepare-exit-hook nil
1350   "*A hook called when preparing to exit from the summary buffer.
1351 It calls `gnus-summary-expire-articles' by default.")
1352 (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
1353
1354 (defvar gnus-summary-exit-hook nil
1355   "*A hook called on exit from the summary buffer.")
1356
1357 (defvar gnus-group-catchup-group-hook nil
1358   "*A hook run when catching up a group from the group buffer.")
1359
1360 (defvar gnus-open-server-hook nil
1361   "*A hook called just before opening connection to the news server.")
1362
1363 (defvar gnus-load-hook nil
1364   "*A hook run while Gnus is loaded.")
1365
1366 (defvar gnus-startup-hook nil
1367   "*A hook called at startup.
1368 This hook is called after Gnus is connected to the NNTP server.")
1369
1370 (defvar gnus-get-new-news-hook nil
1371   "*A hook run just before Gnus checks for new news.")
1372
1373 (defvar gnus-group-prepare-function 'gnus-group-prepare-flat
1374   "*A function that is called to generate the group buffer.
1375 The function is called with three arguments: The first is a number;
1376 all group with a level less or equal to that number should be listed,
1377 if the second is non-nil, empty groups should also be displayed.  If
1378 the third is non-nil, it is a number.  No groups with a level lower
1379 than this number should be displayed.
1380
1381 The only current function implemented is `gnus-group-prepare-flat'.")
1382
1383 (defvar gnus-group-prepare-hook nil
1384   "*A hook called after the group buffer has been generated.
1385 If you want to modify the group buffer, you can use this hook.")
1386
1387 (defvar gnus-summary-prepare-hook nil
1388   "*A hook called after the summary buffer has been generated.
1389 If you want to modify the summary buffer, you can use this hook.")
1390
1391 (defvar gnus-summary-generate-hook nil
1392   "*A hook run just before generating the summary buffer.
1393 This hook is commonly used to customize threading variables and the
1394 like.")
1395
1396 (defvar gnus-article-prepare-hook nil
1397   "*A hook called after an article has been prepared in the article buffer.
1398 If you want to run a special decoding program like nkf, use this hook.")
1399
1400 ;(defvar gnus-article-display-hook nil
1401 ;  "*A hook called after the article is displayed in the article buffer.
1402 ;The hook is designed to change the contents of the article
1403 ;buffer.  Typical functions that this hook may contain are
1404 ;`gnus-article-hide-headers' (hide selected headers),
1405 ;`gnus-article-maybe-highlight' (perform fancy article highlighting),
1406 ;`gnus-article-hide-signature' (hide signature) and
1407 ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
1408 ;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
1409 ;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
1410 ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight)
1411
1412 (defvar gnus-article-x-face-command
1413   "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
1414   "String or function to be executed to display an X-Face header.
1415 If it is a string, the command will be executed in a sub-shell
1416 asynchronously.  The compressed face will be piped to this command.")
1417
1418 (defvar gnus-article-x-face-too-ugly nil
1419   "Regexp matching posters whose face shouldn't be shown automatically.")
1420
1421 (defvar gnus-select-group-hook nil
1422   "*A hook called when a newsgroup is selected.
1423
1424 If you'd like to simplify subjects like the
1425 `gnus-summary-next-same-subject' command does, you can use the
1426 following hook:
1427
1428  (setq gnus-select-group-hook
1429       (list
1430         (lambda ()
1431           (mapcar (lambda (header)
1432                      (mail-header-set-subject
1433                       header
1434                       (gnus-simplify-subject
1435                        (mail-header-subject header) 're-only)))
1436                   gnus-newsgroup-headers))))")
1437
1438 (defvar gnus-select-article-hook nil
1439   "*A hook called when an article is selected.")
1440
1441 (defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
1442   "*A hook called to apply kill files to a group.
1443 This hook is intended to apply a kill file to the selected newsgroup.
1444 The function `gnus-apply-kill-file' is called by default.
1445
1446 Since a general kill file is too heavy to use only for a few
1447 newsgroups, I recommend you to use a lighter hook function.  For
1448 example, if you'd like to apply a kill file to articles which contains
1449 a string `rmgroup' in subject in newsgroup `control', you can use the
1450 following hook:
1451
1452  (setq gnus-apply-kill-hook
1453       (list
1454         (lambda ()
1455           (cond ((string-match \"control\" gnus-newsgroup-name)
1456                  (gnus-kill \"Subject\" \"rmgroup\")
1457                  (gnus-expunge \"X\"))))))")
1458
1459 (defvar gnus-visual-mark-article-hook
1460   (list 'gnus-highlight-selected-summary)
1461   "*Hook run after selecting an article in the summary buffer.
1462 It is meant to be used for highlighting the article in some way.  It
1463 is not run if `gnus-visual' is nil.")
1464
1465 (defvar gnus-parse-headers-hook nil
1466   "*A hook called before parsing the headers.")
1467
1468 (defvar gnus-exit-group-hook nil
1469   "*A hook called when exiting (not quitting) summary mode.")
1470
1471 (defvar gnus-suspend-gnus-hook nil
1472   "*A hook called when suspending (not exiting) Gnus.")
1473
1474 (defvar gnus-exit-gnus-hook nil
1475   "*A hook called when exiting Gnus.")
1476
1477 (defvar gnus-save-newsrc-hook nil
1478   "*A hook called before saving any of the newsrc files.")
1479
1480 (defvar gnus-save-quick-newsrc-hook nil
1481   "*A hook called just before saving the quick newsrc file.
1482 Can be used to turn version control on or off.")
1483
1484 (defvar gnus-save-standard-newsrc-hook nil
1485   "*A hook called just before saving the standard newsrc file.
1486 Can be used to turn version control on or off.")
1487
1488 (defvar gnus-summary-update-hook
1489   (list 'gnus-summary-highlight-line)
1490   "*A hook called when a summary line is changed.
1491 The hook will not be called if `gnus-visual' is nil.
1492
1493 The default function `gnus-summary-highlight-line' will
1494 highlight the line according to the `gnus-summary-highlight'
1495 variable.")
1496
1497 (defvar gnus-group-update-hook '(gnus-group-highlight-line)
1498   "*A hook called when a group line is changed.
1499 The hook will not be called if `gnus-visual' is nil.
1500
1501 The default function `gnus-group-highlight-line' will
1502 highlight the line according to the `gnus-group-highlight'
1503 variable.")
1504
1505 (defvar gnus-mark-article-hook (list 'gnus-summary-mark-unread-as-read)
1506   "*A hook called when an article is selected for the first time.
1507 The hook is intended to mark an article as read (or unread)
1508 automatically when it is selected.")
1509
1510 (defvar gnus-group-change-level-function nil
1511   "Function run when a group level is changed.
1512 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.")
1513
1514 ;; Remove any hilit infestation.
1515 (add-hook 'gnus-startup-hook
1516           (lambda ()
1517             (remove-hook 'gnus-summary-prepare-hook
1518                          'hilit-rehighlight-buffer-quietly)
1519             (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
1520             (setq gnus-mark-article-hook '(gnus-summary-mark-unread-as-read))
1521             (remove-hook 'gnus-article-prepare-hook
1522                          'hilit-rehighlight-buffer-quietly)))
1523
1524
1525 \f
1526 ;; Internal variables
1527
1528 (defvar gnus-topic-indentation "") ;; Obsolete variable.
1529
1530 (defvar gnus-override-subscribe-method nil)
1531
1532 (defvar gnus-group-goto-next-group-function nil
1533   "Function to override finding the next group after listing groups.")
1534
1535 (defconst gnus-article-mark-lists
1536   '((marked . tick) (replied . reply)
1537     (expirable . expire) (killed . killed)
1538     (bookmarks . bookmark) (dormant . dormant)
1539     (scored . score) (saved . save)
1540     (cached . cache)))
1541
1542 ;; Avoid highlighting in kill files.
1543 (defvar gnus-summary-inhibit-highlight nil)
1544 (defvar gnus-newsgroup-selected-overlay nil)
1545
1546 (defvar gnus-inhibit-hiding nil)
1547 (defvar gnus-group-indentation "")
1548 (defvar gnus-inhibit-limiting nil)
1549
1550 (defvar gnus-article-mode-map nil)
1551 (defvar gnus-dribble-buffer nil)
1552 (defvar gnus-headers-retrieved-by nil)
1553 (defvar gnus-article-reply nil)
1554 (defvar gnus-override-method nil)
1555 (defvar gnus-article-check-size nil)
1556
1557 (defvar gnus-nocem-hashtb nil)
1558
1559 (defvar gnus-current-score-file nil)
1560 (defvar gnus-newsgroup-adaptive-score-file nil)
1561 (defvar gnus-scores-exclude-files nil)
1562
1563 (defvar gnus-opened-servers nil)
1564
1565 (defvar gnus-current-move-group nil)
1566
1567 (defvar gnus-newsgroup-dependencies nil)
1568 (defvar gnus-newsgroup-async nil)
1569 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1570
1571 (defvar gnus-newsgroup-adaptive nil)
1572
1573 (defvar gnus-summary-display-table nil)
1574 (defvar gnus-summary-display-article-function nil)
1575
1576 (defvar gnus-summary-highlight-line-function nil
1577   "Function called after highlighting a summary line.")
1578
1579 (defvar gnus-group-line-format-alist
1580   `((?M gnus-tmp-marked-mark ?c)
1581     (?S gnus-tmp-subscribed ?c)
1582     (?L gnus-tmp-level ?d)
1583     (?N (cond ((eq number t) "*" )
1584               ((numberp number) 
1585                (int-to-string
1586                 (+ number
1587                    (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1588                    (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
1589               (t number)) ?s)
1590     (?R gnus-tmp-number-of-read ?s)
1591     (?t gnus-tmp-number-total ?d)
1592     (?y gnus-tmp-number-of-unread ?s)
1593     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
1594     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
1595     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1596            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
1597     (?g gnus-tmp-group ?s)
1598     (?G gnus-tmp-qualified-group ?s)
1599     (?c (gnus-short-group-name gnus-tmp-group) ?s)
1600     (?D gnus-tmp-newsgroup-description ?s)
1601     (?o gnus-tmp-moderated ?c)
1602     (?O gnus-tmp-moderated-string ?s)
1603     (?p gnus-tmp-process-marked ?c)
1604     (?s gnus-tmp-news-server ?s)
1605     (?n gnus-tmp-news-method ?s)
1606     (?P gnus-group-indentation ?s)
1607     (?z gnus-tmp-news-method-string ?s)
1608     (?u gnus-tmp-user-defined ?s)))
1609
1610 (defvar gnus-summary-line-format-alist
1611   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1612     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1613     (?s gnus-tmp-subject-or-nil ?s)
1614     (?n gnus-tmp-name ?s)
1615     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1616         ?s)
1617     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
1618             gnus-tmp-from) ?s)
1619     (?F gnus-tmp-from ?s)
1620     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1621     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1622     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1623     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1624     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1625     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1626     (?L gnus-tmp-lines ?d)
1627     (?I gnus-tmp-indentation ?s)
1628     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1629     (?R gnus-tmp-replied ?c)
1630     (?\[ gnus-tmp-opening-bracket ?c)
1631     (?\] gnus-tmp-closing-bracket ?c)
1632     (?\> (make-string gnus-tmp-level ? ) ?s)
1633     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1634     (?i gnus-tmp-score ?d)
1635     (?z gnus-tmp-score-char ?c)
1636     (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
1637     (?U gnus-tmp-unread ?c)
1638     (?t (gnus-summary-number-of-articles-in-thread
1639          (and (boundp 'thread) (car thread)) gnus-tmp-level)
1640         ?d)
1641     (?e (gnus-summary-number-of-articles-in-thread
1642          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1643         ?c)
1644     (?u gnus-tmp-user-defined ?s))
1645   "An alist of format specifications that can appear in summary lines,
1646 and what variables they correspond with, along with the type of the
1647 variable (string, integer, character, etc).")
1648
1649 (defvar gnus-summary-dummy-line-format-alist
1650   (` ((?S gnus-tmp-subject ?s)
1651       (?N gnus-tmp-number ?d)
1652       (?u gnus-tmp-user-defined ?s))))
1653
1654 (defvar gnus-summary-mode-line-format-alist
1655   (` ((?G gnus-tmp-group-name ?s)
1656       (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1657       (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1658       (?A gnus-tmp-article-number ?d)
1659       (?Z gnus-tmp-unread-and-unselected ?s)
1660       (?V gnus-version ?s)
1661       (?U gnus-tmp-unread ?d)
1662       (?S gnus-tmp-subject ?s)
1663       (?e gnus-tmp-unselected ?d)
1664       (?u gnus-tmp-user-defined ?s)
1665       (?d (length gnus-newsgroup-dormant) ?d)
1666       (?t (length gnus-newsgroup-marked) ?d)
1667       (?r (length gnus-newsgroup-reads) ?d)
1668       (?E gnus-newsgroup-expunged-tally ?d)
1669       (?s (gnus-current-score-file-nondirectory) ?s))))
1670
1671 (defvar gnus-article-mode-line-format-alist
1672   gnus-summary-mode-line-format-alist)
1673
1674 (defvar gnus-group-mode-line-format-alist
1675   (` ((?S gnus-tmp-news-server ?s)
1676       (?M gnus-tmp-news-method ?s)
1677       (?u gnus-tmp-user-defined ?s))))
1678
1679 (defvar gnus-have-read-active-file nil)
1680
1681 (defconst gnus-maintainer
1682   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1683   "The mail address of the Gnus maintainers.")
1684
1685 (defconst gnus-version "September Gnus v0.35"
1686   "Version number for this version of Gnus.")
1687
1688 (defvar gnus-info-nodes
1689   '((gnus-group-mode            "(gnus)The Group Buffer")
1690     (gnus-summary-mode          "(gnus)The Summary Buffer")
1691     (gnus-article-mode          "(gnus)The Article Buffer"))
1692   "Assoc list of major modes and related Info nodes.")
1693
1694 (defvar gnus-group-buffer "*Group*")
1695 (defvar gnus-summary-buffer "*Summary*")
1696 (defvar gnus-article-buffer "*Article*")
1697 (defvar gnus-server-buffer "*Server*")
1698
1699 (defvar gnus-work-buffer " *gnus work*")
1700
1701 (defvar gnus-original-article-buffer " *Original Article*")
1702 (defvar gnus-original-article nil)
1703
1704 (defvar gnus-buffer-list nil
1705   "Gnus buffers that should be killed on exit.")
1706
1707 (defvar gnus-server-alist nil
1708   "List of available servers.")
1709
1710 (defvar gnus-slave nil
1711   "Whether this Gnus is a slave or not.")
1712
1713 (defvar gnus-variable-list
1714   '(gnus-newsrc-options gnus-newsrc-options-n
1715     gnus-newsrc-last-checked-date
1716     gnus-newsrc-alist gnus-server-alist
1717     gnus-killed-list gnus-zombie-list
1718     gnus-topic-topology gnus-topic-alist
1719     gnus-format-specs)
1720   "Gnus variables saved in the quick startup file.")
1721
1722 (defvar gnus-newsrc-options nil
1723   "Options line in the .newsrc file.")
1724
1725 (defvar gnus-newsrc-options-n nil
1726   "List of regexps representing groups to be subscribed/ignored unconditionally.")
1727
1728 (defvar gnus-newsrc-last-checked-date nil
1729   "Date Gnus last asked server for new newsgroups.")
1730
1731 (defvar gnus-topic-topology nil
1732   "The complete topic hierarchy.")
1733
1734 (defvar gnus-topic-alist nil
1735   "The complete topic-group alist.")
1736
1737 (defvar gnus-newsrc-alist nil
1738   "Assoc list of read articles.
1739 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1740
1741 (defvar gnus-newsrc-hashtb nil
1742   "Hashtable of gnus-newsrc-alist.")
1743
1744 (defvar gnus-killed-list nil
1745   "List of killed newsgroups.")
1746
1747 (defvar gnus-killed-hashtb nil
1748   "Hash table equivalent of gnus-killed-list.")
1749
1750 (defvar gnus-zombie-list nil
1751   "List of almost dead newsgroups.")
1752
1753 (defvar gnus-description-hashtb nil
1754   "Descriptions of newsgroups.")
1755
1756 (defvar gnus-list-of-killed-groups nil
1757   "List of newsgroups that have recently been killed by the user.")
1758
1759 (defvar gnus-active-hashtb nil
1760   "Hashtable of active articles.")
1761
1762 (defvar gnus-moderated-list nil
1763   "List of moderated newsgroups.")
1764
1765 (defvar gnus-group-marked nil)
1766
1767 (defvar gnus-current-startup-file nil
1768   "Startup file for the current host.")
1769
1770 (defvar gnus-last-search-regexp nil
1771   "Default regexp for article search command.")
1772
1773 (defvar gnus-last-shell-command nil
1774   "Default shell command on article.")
1775
1776 (defvar gnus-current-select-method nil
1777   "The current method for selecting a newsgroup.")
1778
1779 (defvar gnus-group-list-mode nil)
1780
1781 (defvar gnus-article-internal-prepare-hook nil)
1782
1783 (defvar gnus-newsgroup-name nil)
1784 (defvar gnus-newsgroup-begin nil)
1785 (defvar gnus-newsgroup-end nil)
1786 (defvar gnus-newsgroup-last-rmail nil)
1787 (defvar gnus-newsgroup-last-mail nil)
1788 (defvar gnus-newsgroup-last-folder nil)
1789 (defvar gnus-newsgroup-last-file nil)
1790 (defvar gnus-newsgroup-auto-expire nil)
1791 (defvar gnus-newsgroup-active nil)
1792
1793 (defvar gnus-newsgroup-data nil)
1794 (defvar gnus-newsgroup-data-reverse nil)
1795 (defvar gnus-newsgroup-limit nil)
1796 (defvar gnus-newsgroup-limits nil)
1797
1798 (defvar gnus-newsgroup-unreads nil
1799   "List of unread articles in the current newsgroup.")
1800
1801 (defvar gnus-newsgroup-unselected nil
1802   "List of unselected unread articles in the current newsgroup.")
1803
1804 (defvar gnus-newsgroup-reads nil
1805   "Alist of read articles and article marks in the current newsgroup.")
1806
1807 (defvar gnus-newsgroup-expunged-tally nil)
1808
1809 (defvar gnus-newsgroup-marked nil
1810   "List of ticked articles in the current newsgroup (a subset of unread art).")
1811
1812 (defvar gnus-newsgroup-killed nil
1813   "List of ranges of articles that have been through the scoring process.")
1814
1815 (defvar gnus-newsgroup-cached nil
1816   "List of articles that come from the article cache.")
1817
1818 (defvar gnus-newsgroup-saved nil
1819   "List of articles that have been saved.")
1820
1821 (defvar gnus-newsgroup-kill-headers nil)
1822
1823 (defvar gnus-newsgroup-replied nil
1824   "List of articles that have been replied to in the current newsgroup.")
1825
1826 (defvar gnus-newsgroup-expirable nil
1827   "List of articles in the current newsgroup that can be expired.")
1828
1829 (defvar gnus-newsgroup-processable nil
1830   "List of articles in the current newsgroup that can be processed.")
1831
1832 (defvar gnus-newsgroup-bookmarks nil
1833   "List of articles in the current newsgroup that have bookmarks.")
1834
1835 (defvar gnus-newsgroup-dormant nil
1836   "List of dormant articles in the current newsgroup.")
1837
1838 (defvar gnus-newsgroup-scored nil
1839   "List of scored articles in the current newsgroup.")
1840
1841 (defvar gnus-newsgroup-headers nil
1842   "List of article headers in the current newsgroup.")
1843
1844 (defvar gnus-newsgroup-threads nil)
1845
1846 (defvar gnus-newsgroup-prepared nil
1847   "Whether the current group has been prepared properly.")
1848
1849 (defvar gnus-newsgroup-ancient nil
1850   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1851
1852 (defvar gnus-newsgroup-sparse nil)
1853
1854 (defvar gnus-current-article nil)
1855 (defvar gnus-article-current nil)
1856 (defvar gnus-current-headers nil)
1857 (defvar gnus-have-all-headers nil)
1858 (defvar gnus-last-article nil)
1859 (defvar gnus-newsgroup-history nil)
1860 (defvar gnus-current-kill-article nil)
1861
1862 ;; Save window configuration.
1863 (defvar gnus-prev-winconf nil)
1864
1865 (defvar gnus-summary-mark-positions nil)
1866 (defvar gnus-group-mark-positions nil)
1867
1868 (defvar gnus-reffed-article-number nil)
1869
1870 ;;; Let the byte-compiler know that we know about this variable.
1871 (defvar rmail-default-rmail-file)
1872
1873 (defvar gnus-cache-removable-articles nil)
1874
1875 (defvar gnus-dead-summary nil)
1876
1877 (defconst gnus-summary-local-variables
1878   '(gnus-newsgroup-name
1879     gnus-newsgroup-begin gnus-newsgroup-end
1880     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1881     gnus-newsgroup-last-folder gnus-newsgroup-last-file
1882     gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1883     gnus-newsgroup-unselected gnus-newsgroup-marked
1884     gnus-newsgroup-reads gnus-newsgroup-saved
1885     gnus-newsgroup-replied gnus-newsgroup-expirable
1886     gnus-newsgroup-processable gnus-newsgroup-killed
1887     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1888     gnus-newsgroup-headers gnus-newsgroup-threads
1889     gnus-newsgroup-prepared gnus-summary-highlight-line-function
1890     gnus-current-article gnus-current-headers gnus-have-all-headers
1891     gnus-last-article gnus-article-internal-prepare-hook
1892     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1893     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1894     gnus-newsgroup-async 
1895     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
1896     gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
1897     gnus-newsgroup-history gnus-newsgroup-ancient
1898     gnus-newsgroup-sparse
1899     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1900     gnus-newsgroup-adaptive-score-file
1901     (gnus-newsgroup-expunged-tally . 0)
1902     gnus-cache-removeable-articles gnus-newsgroup-cached
1903     gnus-newsgroup-data gnus-newsgroup-data-reverse
1904     gnus-newsgroup-limit gnus-newsgroup-limits)
1905   "Variables that are buffer-local to the summary buffers.")
1906
1907 (defconst gnus-bug-message
1908   "Sending a bug report to the Gnus Towers.
1909 ========================================
1910
1911 The buffer below is a mail buffer.  When you press `C-c C-c', it will
1912 be sent to the Gnus Bug Exterminators.
1913
1914 At the bottom of the buffer you'll see lots of variable settings.
1915 Please do not delete those.  They will tell the Bug People what your
1916 environment is, so that it will be easier to locate the bugs.
1917
1918 If you have found a bug that makes Emacs go \"beep\", set
1919 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
1920 and include the backtrace in your bug report.
1921
1922 Please describe the bug in annoying, painstaking detail.
1923
1924 Thank you for your help in stamping out bugs.
1925 ")
1926
1927 ;;; End of variables.
1928
1929 ;; Define some autoload functions Gnus might use.
1930 (eval-and-compile
1931
1932   ;; This little mapcar goes through the list below and marks the
1933   ;; symbols in question as autoloaded functions.
1934   (mapcar
1935    (lambda (package)
1936      (let ((interactive (nth 1 (memq ':interactive package))))
1937        (mapcar
1938         (lambda (function)
1939           (let (keymap)
1940             (when (consp function)
1941               (setq keymap (car (memq 'keymap function)))
1942               (setq function (car function)))
1943             (autoload function (car package) nil interactive keymap)))
1944         (if (eq (nth 1 package) ':interactive)
1945             (cdddr package)
1946           (cdr package)))))
1947    '(("metamail" metamail-buffer)
1948      ("info" Info-goto-node)
1949      ("hexl" hexl-hex-string-to-integer)
1950      ("pp" pp pp-to-string pp-eval-expression)
1951      ("mail-extr" mail-extract-address-components)
1952      ("nnmail" nnmail-split-fancy nnmail-article-group)
1953      ("nnvirtual" nnvirtual-catchup-group)
1954      ("timezone" timezone-make-date-arpa-standard timezone-fix-time
1955       timezone-make-sortable-date timezone-make-time-string)
1956      ("sendmail" mail-position-on-field mail-setup)
1957      ("rmailout" rmail-output)
1958      ("rnewspost" news-mail-other-window news-reply-yank-original
1959       news-caesar-buffer-body)
1960      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
1961       rmail-show-message)
1962      ("gnus-soup" :interactive t
1963       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
1964       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1965      ("nnsoup" nnsoup-pack-replies)
1966      ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
1967       gnus-Folder-save-name gnus-folder-save-name)
1968      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
1969      ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
1970       gnus-server-make-menu-bar gnus-article-make-menu-bar
1971       gnus-browse-make-menu-bar gnus-highlight-selected-summary
1972       gnus-summary-highlight-line gnus-carpal-setup-buffer
1973       gnus-group-highlight-line
1974       gnus-article-add-button gnus-insert-next-page-button
1975       gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu)
1976      ("gnus-vis" :interactive t
1977       gnus-article-push-button gnus-article-press-button
1978       gnus-article-highlight gnus-article-highlight-some
1979       gnus-article-highlight-headers gnus-article-highlight-signature
1980       gnus-article-add-buttons gnus-article-add-buttons-to-head
1981       gnus-article-next-button gnus-article-prev-button)
1982      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
1983       gnus-demon-add-disconnection gnus-demon-add-handler
1984       gnus-demon-remove-handler)
1985      ("gnus-demon" :interactive t
1986       gnus-demon-init gnus-demon-cancel)
1987      ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
1988       gnus-tree-open gnus-tree-close)
1989      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close)
1990      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
1991      ("gnus-srvr" gnus-browse-foreign-server)
1992      ("gnus-cite" :interactive t
1993       gnus-article-highlight-citation gnus-article-hide-citation-maybe
1994       gnus-article-hide-citation gnus-article-fill-cited-article)
1995      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
1996       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
1997       gnus-execute gnus-expunge)
1998      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
1999       gnus-cache-possibly-remove-articles gnus-cache-request-article
2000       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
2001       gnus-cache-enter-remove-article gnus-cached-article-p
2002       gnus-cache-open gnus-cache-close)
2003      ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
2004       gnus-cache-remove-article)
2005      ("gnus-score" :interactive t
2006       gnus-summary-increase-score gnus-summary-lower-score
2007       gnus-score-flush-cache gnus-score-close
2008       gnus-score-raise-same-subject-and-select
2009       gnus-score-raise-same-subject gnus-score-default
2010       gnus-score-raise-thread gnus-score-lower-same-subject-and-select
2011       gnus-score-lower-same-subject gnus-score-lower-thread
2012       gnus-possibly-score-headers)
2013      ("gnus-score"
2014       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
2015       gnus-current-score-file-nondirectory gnus-score-adaptive
2016       gnus-score-find-trace gnus-score-file-name)
2017      ("gnus-edit" :interactive t gnus-score-customize)
2018      ("gnus-topic" :interactive t gnus-topic-mode)
2019      ("gnus-topic" gnus-topic-remove-group)
2020      ("gnus-salt" :interactive t gnus-pick-mode)
2021      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
2022      ("gnus-uu" :interactive t
2023       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
2024       gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
2025       gnus-uu-mark-by-regexp gnus-uu-mark-all
2026       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
2027       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
2028       gnus-uu-decode-unshar-and-save gnus-uu-decode-save
2029       gnus-uu-decode-binhex gnus-uu-decode-uu-view
2030       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
2031       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
2032       gnus-uu-decode-binhex-view)
2033      ("gnus-msg" (gnus-summary-send-map keymap)
2034       gnus-mail-yank-original gnus-mail-send-and-exit
2035       gnus-sendmail-setup-mail gnus-article-mail
2036       gnus-inews-message-id gnus-new-mail gnus-mail-reply)
2037      ("gnus-msg" :interactive t
2038       gnus-group-post-news gnus-group-mail gnus-summary-post-news
2039       gnus-summary-followup gnus-summary-followup-with-original
2040       gnus-summary-followup-and-reply
2041       gnus-summary-followup-and-reply-with-original
2042       gnus-summary-cancel-article gnus-summary-supersede-article
2043       gnus-post-news gnus-inews-news gnus-cancel-news
2044       gnus-summary-reply gnus-summary-reply-with-original
2045       gnus-summary-mail-forward gnus-summary-mail-other-window
2046       gnus-bug)
2047      ("gnus-picon" :interactive t gnus-article-display-picons
2048       gnus-group-display-picons)
2049      ("gnus-vm" gnus-vm-mail-setup)
2050      ("gnus-vm" :interactive t gnus-summary-save-in-vm
2051       gnus-summary-save-article-vm gnus-yank-article))))
2052
2053 \f
2054
2055 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2056 ;; If you want the cursor to go somewhere else, set these two
2057 ;; functions in some startup hook to whatever you want.
2058 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
2059 (defalias 'gnus-group-position-point 'gnus-goto-colon)
2060
2061 ;;; Various macros and substs.
2062
2063 (defun gnus-header-from (header)
2064   (mail-header-from header))
2065
2066 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
2067   "Pop to BUFFER, evaluate FORMS, and then return to the original window."
2068   `(let ((GnusStartBufferWindow (selected-window)))
2069      (unwind-protect
2070          (progn
2071            (pop-to-buffer ,buffer)
2072            ,@forms)
2073        (select-window GnusStartBufferWindow))))
2074
2075 (defmacro gnus-gethash (string hashtable)
2076   "Get hash value of STRING in HASHTABLE."
2077   `(symbol-value (intern-soft ,string ,hashtable)))
2078
2079 (defmacro gnus-sethash (string value hashtable)
2080   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2081   `(set (intern ,string ,hashtable) ,value))
2082
2083 (defmacro gnus-intern-safe (string hashtable)
2084   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2085   `(let ((symbol (intern ,string ,hashtable)))
2086      (or (boundp symbol)
2087          (set symbol nil))
2088      symbol))
2089
2090 (defmacro gnus-group-unread (group)
2091   "Get the currently computed number of unread articles in GROUP."
2092   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
2093
2094 (defmacro gnus-group-entry (group)
2095   "Get the newsrc entry for GROUP."
2096   `(gnus-gethash ,group gnus-newsrc-hashtb))
2097
2098 (defmacro gnus-active (group)
2099   "Get active info on GROUP."
2100   `(gnus-gethash ,group gnus-active-hashtb))
2101
2102 (defmacro gnus-set-active (group active)
2103   "Set GROUP's active info."
2104   `(gnus-sethash ,group ,active gnus-active-hashtb))
2105
2106 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2107 ;;   function `substring' might cut on a middle of multi-octet
2108 ;;   character.
2109 (defun gnus-truncate-string (str width)
2110   (substring str 0 width))
2111
2112 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
2113 ;; to limit the length of a string.  This function is necessary since
2114 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
2115 (defsubst gnus-limit-string (str width)
2116   (if (> (length str) width)
2117       (substring str 0 width)
2118     str))
2119
2120 (defsubst gnus-simplify-subject-re (subject)
2121   "Remove \"Re:\" from subject lines."
2122   (if (string-match "^[Rr][Ee]: *" subject)
2123       (substring subject (match-end 0))
2124     subject))
2125
2126 (defsubst gnus-goto-char (point)
2127   (and point (goto-char point)))
2128
2129 (defmacro gnus-buffer-exists-p (buffer)
2130   `(and ,buffer
2131         (funcall (if (stringp ,buffer) 'get-buffer 'buffer-name)
2132                  ,buffer)))
2133
2134 (defmacro gnus-kill-buffer (buffer)
2135   `(let ((buf ,buffer))
2136      (if (gnus-buffer-exists-p buf)
2137          (kill-buffer buf))))
2138
2139 (defsubst gnus-point-at-bol ()
2140   "Return point at the beginning of the line."
2141   (let ((p (point)))
2142     (beginning-of-line)
2143     (prog1
2144         (point)
2145       (goto-char p))))
2146
2147 (defsubst gnus-point-at-eol ()
2148   "Return point at the end of the line."
2149   (let ((p (point)))
2150     (end-of-line)
2151     (prog1
2152         (point)
2153       (goto-char p))))
2154
2155 ;; Delete the current line (and the next N lines.);
2156 (defmacro gnus-delete-line (&optional n)
2157   `(delete-region (progn (beginning-of-line) (point))
2158                   (progn (forward-line ,(or n 1)) (point))))
2159
2160 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
2161 (defvar gnus-init-inhibit nil)
2162 (defun gnus-read-init-file (&optional inhibit-next)
2163   (if gnus-init-inhibit
2164       (setq gnus-init-inhibit nil)
2165     (setq gnus-init-inhibit inhibit-next)
2166     (and gnus-init-file
2167          (or (and (file-exists-p gnus-init-file)
2168                   ;; Don't try to load a directory.
2169                   (not (file-directory-p gnus-init-file)))
2170              (file-exists-p (concat gnus-init-file ".el"))
2171              (file-exists-p (concat gnus-init-file ".elc")))
2172          (condition-case var
2173              (load gnus-init-file nil t)
2174            (error
2175             (error "Error in %s: %s" gnus-init-file var))))))
2176
2177 ;; Info access macros.
2178
2179 (defmacro gnus-info-group (info)
2180   `(nth 0 ,info))
2181 (defmacro gnus-info-rank (info)
2182   `(nth 1 ,info))
2183 (defmacro gnus-info-read (info)
2184   `(nth 2 ,info))
2185 (defmacro gnus-info-marks (info)
2186   `(nth 3 ,info))
2187 (defmacro gnus-info-method (info)
2188   `(nth 4 ,info))
2189 (defmacro gnus-info-params (info)
2190   `(nth 5 ,info))
2191
2192 (defmacro gnus-info-level (info)
2193   `(let ((rank (gnus-info-rank ,info)))
2194      (if (consp rank)
2195          (car rank)
2196        rank)))
2197 (defmacro gnus-info-score (info)
2198   `(let ((rank (gnus-info-rank ,info)))
2199      (or (and (consp rank) (cdr rank)) 0)))
2200
2201 (defmacro gnus-info-set-group (info group)
2202   `(setcar ,info ,group))
2203 (defmacro gnus-info-set-rank (info rank)
2204   `(setcar (nthcdr 1 ,info) ,rank))
2205 (defmacro gnus-info-set-read (info read)
2206   `(setcar (nthcdr 2 ,info) ,read))
2207 (defmacro gnus-info-set-marks (info marks)
2208   `(setcar (nthcdr 3 ,info) ,marks))
2209 (defmacro gnus-info-set-method (info method)
2210   `(setcar (nthcdr 4 ,info) ,method))
2211 (defmacro gnus-info-set-params (info params)
2212   `(setcar (nthcdr 5 ,info) ,params))
2213
2214 (defmacro gnus-info-set-level (info level)
2215   `(let ((rank (cdr ,info)))
2216      (if (consp (car rank))
2217          (setcar (car rank) ,level)
2218        (setcar rank ,level))))
2219 (defmacro gnus-info-set-score (info score)
2220   `(let ((rank (cdr ,info)))
2221      (if (consp (car rank))
2222          (setcdr (car rank) ,score)
2223        (setcar rank (cons (car rank) ,score)))))
2224
2225 (defmacro gnus-get-info (group)
2226   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2227
2228 (defun gnus-byte-code (func)
2229   "Return a form that can be `eval'ed based on FUNC."
2230   (let ((fval (symbol-function func)))
2231     (if (byte-code-function-p fval)
2232         (let ((flist (append fval nil)))
2233           (setcar flist 'byte-code)
2234           flist)
2235       (cons 'progn (cdr (cdr fval))))))
2236
2237 ;;; Load the compatability functions.
2238
2239 (require 'gnus-cus)
2240 (require 'gnus-ems)
2241
2242 \f
2243
2244 ;; Format specs.  The chunks below are the machine-generated forms
2245 ;; that are to be evaled as the result of the default format strings.
2246 ;; We write them in here to get them byte-compiled.  That way the
2247 ;; default actions will be quite fast, while still retaining the full
2248 ;; flexibility of the user-defined format specs.
2249
2250 ;; First we have lots of dummy defvars to let the compiler know these
2251 ;; are really dynamic variables.
2252
2253 (defvar gnus-tmp-unread)
2254 (defvar gnus-tmp-replied)
2255 (defvar gnus-tmp-score-char)
2256 (defvar gnus-tmp-indentation)
2257 (defvar gnus-tmp-opening-bracket)
2258 (defvar gnus-tmp-lines)
2259 (defvar gnus-tmp-name)
2260 (defvar gnus-tmp-closing-bracket)
2261 (defvar gnus-tmp-subject-or-nil)
2262 (defvar gnus-tmp-subject)
2263 (defvar gnus-tmp-marked)
2264 (defvar gnus-tmp-marked-mark)
2265 (defvar gnus-tmp-subscribed)
2266 (defvar gnus-tmp-process-marked)
2267 (defvar gnus-tmp-number-of-unread)
2268 (defvar gnus-tmp-group-name)
2269 (defvar gnus-tmp-group)
2270 (defvar gnus-tmp-article-number)
2271 (defvar gnus-tmp-unread-and-unselected)
2272 (defvar gnus-tmp-news-method)
2273 (defvar gnus-tmp-news-server)
2274 (defvar gnus-tmp-article-number)
2275 (defvar gnus-mouse-face)
2276 (defvar gnus-mouse-face-prop)
2277
2278 (defun gnus-summary-line-format-spec ()
2279   (insert gnus-tmp-unread gnus-tmp-replied
2280           gnus-tmp-score-char gnus-tmp-indentation)
2281   (put-text-property
2282    (point)
2283    (progn
2284      (insert
2285       gnus-tmp-opening-bracket
2286       (format "%4d: %-20s"
2287               gnus-tmp-lines
2288               (if (> (length gnus-tmp-name) 20)
2289                   (substring gnus-tmp-name 0 20)
2290                 gnus-tmp-name))
2291       gnus-tmp-closing-bracket)
2292      (point))
2293    gnus-mouse-face-prop gnus-mouse-face)
2294   (insert " " gnus-tmp-subject-or-nil "\n"))
2295
2296 (defvar gnus-summary-line-format-spec
2297   (gnus-byte-code 'gnus-summary-line-format-spec))
2298
2299 (defun gnus-summary-dummy-line-format-spec ()
2300   (insert "*  ")
2301   (put-text-property
2302    (point)
2303    (progn
2304      (insert ":                          :")
2305      (point))
2306    gnus-mouse-face-prop gnus-mouse-face)
2307   (insert " " gnus-tmp-subject "\n"))
2308
2309 (defvar gnus-summary-dummy-line-format-spec
2310   (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
2311
2312 (defun gnus-group-line-format-spec ()
2313   (insert gnus-tmp-marked-mark gnus-tmp-subscribed
2314           gnus-tmp-process-marked
2315           gnus-group-indentation
2316           (format "%5s: " gnus-tmp-number-of-unread))
2317   (put-text-property
2318    (point)
2319    (progn
2320      (insert gnus-tmp-group "\n")
2321      (1- (point)))
2322    gnus-mouse-face-prop gnus-mouse-face))
2323 (defvar gnus-group-line-format-spec
2324   (gnus-byte-code 'gnus-group-line-format-spec))
2325
2326 (defvar gnus-format-specs
2327   `((version . ,emacs-version)
2328     (group ,gnus-group-line-format ,gnus-group-line-format-spec)
2329     (summary-dummy ,gnus-summary-dummy-line-format
2330                    ,gnus-summary-dummy-line-format-spec)
2331     (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec)))
2332
2333 (defvar gnus-article-mode-line-format-spec nil)
2334 (defvar gnus-summary-mode-line-format-spec nil)
2335 (defvar gnus-group-mode-line-format-spec nil)
2336
2337 ;;; Phew.  All that gruft is over, fortunately.
2338
2339 \f
2340 ;;;
2341 ;;; Gnus Utility Functions
2342 ;;;
2343
2344 (defun gnus-extract-address-components (from)
2345   (let (name address)
2346     ;; First find the address - the thing with the @ in it.  This may
2347     ;; not be accurate in mail addresses, but does the trick most of
2348     ;; the time in news messages.
2349     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
2350         (setq address (substring from (match-beginning 0) (match-end 0))))
2351     ;; Then we check whether the "name <address>" format is used.
2352     (and address
2353          ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2354          ;; Linear white space is not required.
2355          (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
2356          (and (setq name (substring from 0 (match-beginning 0)))
2357               ;; Strip any quotes from the name.
2358               (string-match "\".*\"" name)
2359               (setq name (substring name 1 (1- (match-end 0))))))
2360     ;; If not, then "address (name)" is used.
2361     (or name
2362         (and (string-match "(.+)" from)
2363              (setq name (substring from (1+ (match-beginning 0))
2364                                    (1- (match-end 0)))))
2365         (and (string-match "()" from)
2366              (setq name address))
2367         ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
2368         ;; XOVER might not support folded From headers.
2369         (and (string-match "(.*" from)
2370              (setq name (substring from (1+ (match-beginning 0))
2371                                    (match-end 0)))))
2372     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2373     (list (or name from) (or address from))))
2374
2375 (defun gnus-fetch-field (field)
2376   "Return the value of the header FIELD of current article."
2377   (save-excursion
2378     (save-restriction
2379       (let ((case-fold-search t))
2380         (nnheader-narrow-to-headers)
2381         (mail-fetch-field field)))))
2382
2383 (defun gnus-goto-colon ()
2384   (beginning-of-line)
2385   (search-forward ":" (gnus-point-at-eol) t))
2386
2387 ;;;###autoload
2388 (defun gnus-update-format (var)
2389   "Update the format specification near point."
2390   (interactive
2391    (list
2392     (save-excursion
2393       (eval-defun nil)
2394       ;; Find the end of the current word.
2395       (re-search-forward "[ \t\n]" nil t)
2396       ;; Search backward.
2397       (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
2398         (match-string 1)))))
2399   (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
2400                               (match-string 1 var))))
2401          (entry (assq type gnus-format-specs))
2402          value spec)
2403     (when entry
2404       (setq gnus-format-specs (delq entry gnus-format-specs)))
2405     (set
2406      (intern (format "%s-spec" var))
2407      (gnus-parse-format (setq value (symbol-value (intern var)))
2408                         (symbol-value (intern (format "%s-alist" var)))
2409                         (not (string-match "mode" var))))
2410     (setq spec (symbol-value (intern (format "%s-spec" var))))
2411     (push (list type value spec) gnus-format-specs)
2412
2413     (pop-to-buffer "*Gnus Format*")
2414     (erase-buffer)
2415     (lisp-interaction-mode)
2416     (insert (pp-to-string spec))))
2417
2418
2419 (defun gnus-update-format-specifications (&optional force)
2420   "Update all (necessary) format specifications."
2421   ;; Make the indentation array.
2422   (gnus-make-thread-indent-array)
2423
2424   (when (or force
2425             (and (assq 'version gnus-format-specs)
2426                  (not (equal emacs-version
2427                              (cdr (assq 'version gnus-format-specs))))))
2428     (setq gnus-format-specs nil))
2429
2430   (let ((types '(summary summary-dummy group
2431                            summary-mode group-mode article-mode))
2432         old-format new-format entry type val)
2433     (while types
2434       (setq type (pop types))
2435       (setq new-format (symbol-value
2436                         (intern (format "gnus-%s-line-format" type))))
2437       (setq entry (cdr (assq type gnus-format-specs)))
2438       (if (and entry
2439                (equal (car entry) new-format))
2440           (set (intern (format "gnus-%s-line-format-spec" type))
2441                (car (cdr entry)))
2442         (setq val
2443               (if (not (stringp new-format))
2444                   ;; This is a function call or something.
2445                   new-format
2446                 ;; This is a "real" format.
2447                 (gnus-parse-format
2448                  new-format
2449                  (symbol-value
2450                   (intern (format "gnus-%s-line-format-alist"
2451                                   (if (eq type 'article-mode)
2452                                       'summary-mode type))))
2453                  (not (string-match "mode$" (symbol-name type))))))
2454         (set (intern (format "gnus-%s-line-format-spec" type)) val)
2455         (if entry
2456             (setcar (cdr entry) val)
2457           (push (list type new-format val) gnus-format-specs)))))
2458
2459   (gnus-update-group-mark-positions)
2460   (gnus-update-summary-mark-positions)
2461
2462   (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
2463            (not gnus-description-hashtb)
2464            gnus-read-active-file)
2465       (gnus-read-all-descriptions-files)))
2466
2467 (defun gnus-update-summary-mark-positions ()
2468   (save-excursion
2469     (let ((gnus-replied-mark 129)
2470           (gnus-score-below-mark 130)
2471           (gnus-score-over-mark 130)
2472           (thread nil)
2473           (gnus-visual nil)
2474           pos)
2475       (gnus-set-work-buffer)
2476       (gnus-summary-insert-line
2477        [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
2478       (goto-char (point-min))
2479       (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
2480                                          (- (point) 2)))))
2481       (goto-char (point-min))
2482       (setq pos (cons (cons 'replied (and (search-forward "\201" nil t)
2483                                           (- (point) 2))) pos))
2484       (goto-char (point-min))
2485       (setq pos (cons (cons 'score (and (search-forward "\202" nil t)
2486                                         (- (point) 2))) pos))
2487       (setq gnus-summary-mark-positions pos))))
2488
2489 (defun gnus-update-group-mark-positions ()
2490   (save-excursion
2491     (let ((gnus-process-mark 128)
2492           (gnus-group-marked '("dummy.group")))
2493       (gnus-set-active "dummy.group" '(0 . 0))
2494       (gnus-set-work-buffer)
2495       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
2496       (goto-char (point-min))
2497       (setq gnus-group-mark-positions
2498             (list (cons 'process (and (search-forward "\200" nil t)
2499                                       (- (point) 2))))))))
2500
2501 (defvar gnus-mouse-face-0 'highlight)
2502 (defvar gnus-mouse-face-1 'highlight)
2503 (defvar gnus-mouse-face-2 'highlight)
2504 (defvar gnus-mouse-face-3 'highlight)
2505 (defvar gnus-mouse-face-4 'highlight)
2506
2507 (defun gnus-mouse-face-function (form type)
2508   `(put-text-property
2509     (point) (progn ,@form (point))
2510     gnus-mouse-face-prop
2511     ,(if (equal type 0)
2512          'gnus-mouse-face
2513        `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
2514
2515 (defvar gnus-face-0 'bold)
2516 (defvar gnus-face-1 'italic)
2517 (defvar gnus-face-2 'bold-italic)
2518 (defvar gnus-face-3 'bold)
2519 (defvar gnus-face-4 'bold)
2520
2521 (defun gnus-face-face-function (form type)
2522   `(put-text-property
2523     (point) (progn ,@form (point))
2524     'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
2525
2526 (defun gnus-max-width-function (el max-width)
2527   (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
2528   (if (symbolp el)
2529       `(if (> (length ,el) ,max-width)
2530            (substring ,el 0 ,max-width)
2531          ,el)
2532     `(let ((val (eval ,el)))
2533        (if (numberp val)
2534            (setq val (int-to-string val)))
2535        (if (> (length val) ,max-width)
2536            (substring val 0 ,max-width)
2537          val))))
2538
2539 (defun gnus-parse-format (format spec-alist &optional insert)
2540   ;; This function parses the FORMAT string with the help of the
2541   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
2542   ;; string.  If the FORMAT string contains the specifiers %( and %)
2543   ;; the text between them will have the mouse-face text property.
2544   (if (string-match
2545        "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
2546        format)
2547       (gnus-parse-complex-format format spec-alist)
2548     ;; This is a simple format.
2549     (gnus-parse-simple-format format spec-alist insert)))
2550
2551 (defun gnus-parse-complex-format (format spec-alist)
2552   (save-excursion
2553     (gnus-set-work-buffer)
2554     (insert format)
2555     (goto-char (point-min))
2556     (while (re-search-forward "\"" nil t)
2557       (replace-match "\\\"" nil t))
2558     (goto-char (point-min))
2559     (insert "(\"")
2560     (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
2561       (let ((number (if (match-beginning 1)
2562                         (match-string 1) "0"))
2563             (delim (aref (match-string 2) 0)))
2564         (if (or (= delim ?\() (= delim ?\{))
2565             (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
2566                                    " " number " \""))
2567           (replace-match "\")\""))))
2568     (goto-char (point-max))
2569     (insert "\")")
2570     (goto-char (point-min))
2571     (let ((form (read (current-buffer))))
2572       (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
2573
2574 (defun gnus-complex-form-to-spec (form spec-alist)
2575   (delq nil
2576         (mapcar
2577          (lambda (sform)
2578            (if (stringp sform)
2579                (gnus-parse-simple-format sform spec-alist t)
2580              (funcall (intern (format "gnus-%s-face-function"
2581                                       (car sform)))
2582                       (gnus-complex-form-to-spec
2583                        (cdr (cdr sform)) spec-alist)
2584                       (nth 1 sform))))
2585          form)))
2586
2587 (defun gnus-parse-simple-format (format spec-alist &optional insert)
2588   ;; This function parses the FORMAT string with the help of the
2589   ;; SPEC-ALIST and returns a list that can be eval'ed to return a
2590   ;; string.
2591   (let ((max-width 0)
2592         spec flist fstring newspec elem beg result dontinsert)
2593     (save-excursion
2594       (gnus-set-work-buffer)
2595       (insert format)
2596       (goto-char (point-min))
2597       (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
2598                                 nil t)
2599         (if (= (setq spec (string-to-char (match-string 2))) ?%)
2600               (setq newspec "%"
2601                     beg (1+ (match-beginning 0)))
2602           ;; First check if there are any specs that look anything like
2603           ;; "%12,12A", ie. with a "max width specification".  These have
2604           ;; to be treated specially.
2605           (if (setq beg (match-beginning 1))
2606               (setq max-width
2607                     (string-to-int
2608                      (buffer-substring
2609                       (1+ (match-beginning 1)) (match-end 1))))
2610             (setq max-width 0)
2611             (setq beg (match-beginning 2)))
2612           ;; Find the specification from `spec-alist'.
2613           (unless (setq elem (cdr (assq spec spec-alist)))
2614             (setq elem '("*" ?s)))
2615           ;; Treat user defined format specifiers specially.
2616           (when (eq (car elem) 'gnus-tmp-user-defined)
2617             (setq elem
2618                   (list
2619                    (list (intern (concat "gnus-user-format-function-"
2620                                          (match-string 3)))
2621                          'gnus-tmp-header) ?s))
2622             (delete-region (match-beginning 3) (match-end 3)))
2623           (if (not (zerop max-width))
2624               (let ((el (car elem)))
2625                 (cond ((= (car (cdr elem)) ?c)
2626                        (setq el (list 'char-to-string el)))
2627                       ((= (car (cdr elem)) ?d)
2628                        (setq el (list 'int-to-string el))))
2629                 (setq flist (cons (gnus-max-width-function el max-width)
2630                                   flist))
2631                 (setq newspec ?s))
2632             (progn
2633               (setq flist (cons (car elem) flist))
2634               (setq newspec (car (cdr elem))))))
2635         ;; Remove the old specification (and possibly a ",12" string).
2636         (delete-region beg (match-end 2))
2637         ;; Insert the new specification.
2638         (goto-char beg)
2639         (insert newspec))
2640       (setq fstring (buffer-substring 1 (point-max))))
2641     ;; Do some postprocessing to increase efficiency.
2642     (setq
2643      result
2644      (cond
2645       ;; Emptyness.
2646       ((string= fstring "")
2647        nil)
2648       ;; Not a format string.
2649       ((not (string-match "%" fstring))
2650        (list fstring))
2651       ;; A format string with just a single string spec.
2652       ((string= fstring "%s")
2653        (list (car flist)))
2654       ;; A single character.
2655       ((string= fstring "%c")
2656        (list (car flist)))
2657       ;; A single number.
2658       ((string= fstring "%d")
2659        (setq dontinsert)
2660        (if insert
2661            (list `(princ ,(car flist)))
2662          (list `(int-to-string ,(car flist)))))
2663       ;; Just lots of chars and strings.
2664       ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
2665        (nreverse flist))
2666       ;; A single string spec at the beginning of the spec.
2667       ((string-match "\\`%[sc][^%]+\\'" fstring)
2668        (list (car flist) (substring fstring 2)))
2669       ;; A single string spec in the middle of the spec.
2670       ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
2671        (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
2672       ;; A single string spec in the end of the spec.
2673       ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
2674        (list (match-string 1 fstring) (car flist)))
2675       ;; A more complex spec.
2676       (t
2677        (list (cons 'format (cons fstring (nreverse flist)))))))
2678
2679     (if insert
2680         (when result
2681           (if dontinsert
2682               result
2683             (cons 'insert result)))
2684       (cond ((stringp result)
2685              result)
2686             ((consp result)
2687              (cons 'concat result))
2688             (t "")))))
2689
2690 (defun gnus-eval-format (format &optional alist props)
2691   "Eval the format variable FORMAT, using ALIST.
2692 If PROPS, insert the result."
2693   (let ((form (gnus-parse-format format alist props)))
2694     (if props
2695         (add-text-properties (point) (progn (eval form) (point)) props)
2696       (eval form))))
2697
2698 (defun gnus-remove-text-with-property (prop)
2699   "Delete all text in the current buffer with text property PROP."
2700   (save-excursion
2701     (goto-char (point-min))
2702     (while (not (eobp))
2703       (while (get-text-property (point) prop)
2704         (delete-char 1))
2705       (goto-char (next-single-property-change (point) prop nil (point-max))))))
2706
2707 (defun gnus-set-work-buffer ()
2708   (if (get-buffer gnus-work-buffer)
2709       (progn
2710         (set-buffer gnus-work-buffer)
2711         (erase-buffer))
2712     (set-buffer (get-buffer-create gnus-work-buffer))
2713     (kill-all-local-variables)
2714     (buffer-disable-undo (current-buffer))
2715     (gnus-add-current-to-buffer-list)))
2716
2717 ;; Article file names when saving.
2718
2719 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
2720   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2721 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
2722 Otherwise, it is like ~/News/news/group/num."
2723   (let ((default
2724           (expand-file-name
2725            (concat (if (gnus-use-long-file-name 'not-save)
2726                        (gnus-capitalize-newsgroup newsgroup)
2727                      (gnus-newsgroup-directory-form newsgroup))
2728                    "/" (int-to-string (mail-header-number headers)))
2729            (or gnus-article-save-directory "~/News"))))
2730     (if (and last-file
2731              (string-equal (file-name-directory default)
2732                            (file-name-directory last-file))
2733              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2734         default
2735       (or last-file default))))
2736
2737 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
2738   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2739 If variable `gnus-use-long-file-name' is non-nil, it is
2740 ~/News/news.group/num.  Otherwise, it is like ~/News/news/group/num."
2741   (let ((default
2742           (expand-file-name
2743            (concat (if (gnus-use-long-file-name 'not-save)
2744                        newsgroup
2745                      (gnus-newsgroup-directory-form newsgroup))
2746                    "/" (int-to-string (mail-header-number headers)))
2747            (or gnus-article-save-directory "~/News"))))
2748     (if (and last-file
2749              (string-equal (file-name-directory default)
2750                            (file-name-directory last-file))
2751              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2752         default
2753       (or last-file default))))
2754
2755 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
2756   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2757 If variable `gnus-use-long-file-name' is non-nil, it is
2758 ~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
2759   (or last-file
2760       (expand-file-name
2761        (if (gnus-use-long-file-name 'not-save)
2762            (gnus-capitalize-newsgroup newsgroup)
2763          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2764        (or gnus-article-save-directory "~/News"))))
2765
2766 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2767   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2768 If variable `gnus-use-long-file-name' is non-nil, it is
2769 ~/News/news.group.  Otherwise, it is like ~/News/news/group/news."
2770   (or last-file
2771       (expand-file-name
2772        (if (gnus-use-long-file-name 'not-save)
2773            newsgroup
2774          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2775        (or gnus-article-save-directory "~/News"))))
2776
2777 ;; For subscribing new newsgroup
2778
2779 (defun gnus-subscribe-hierarchical-interactive (groups)
2780   (let ((groups (sort groups 'string<))
2781         prefixes prefix start ans group starts)
2782     (while groups
2783       (setq prefixes (list "^"))
2784       (while (and groups prefixes)
2785         (while (not (string-match (car prefixes) (car groups)))
2786           (setq prefixes (cdr prefixes)))
2787         (setq prefix (car prefixes))
2788         (setq start (1- (length prefix)))
2789         (if (and (string-match "[^\\.]\\." (car groups) start)
2790                  (cdr groups)
2791                  (setq prefix
2792                        (concat "^" (substring (car groups) 0 (match-end 0))))
2793                  (string-match prefix (car (cdr groups))))
2794             (progn
2795               (setq prefixes (cons prefix prefixes))
2796               (message "Descend hierarchy %s? ([y]nsq): "
2797                        (substring prefix 1 (1- (length prefix))))
2798               (setq ans (read-char))
2799               (cond ((= ans ?n)
2800                      (while (and groups
2801                                  (string-match prefix
2802                                                (setq group (car groups))))
2803                        (setq gnus-killed-list
2804                              (cons group gnus-killed-list))
2805                        (gnus-sethash group group gnus-killed-hashtb)
2806                        (setq groups (cdr groups)))
2807                      (setq starts (cdr starts)))
2808                     ((= ans ?s)
2809                      (while (and groups
2810                                  (string-match prefix
2811                                                (setq group (car groups))))
2812                        (gnus-sethash group group gnus-killed-hashtb)
2813                        (gnus-subscribe-alphabetically (car groups))
2814                        (setq groups (cdr groups)))
2815                      (setq starts (cdr starts)))
2816                     ((= ans ?q)
2817                      (while groups
2818                        (setq group (car groups))
2819                        (setq gnus-killed-list (cons group gnus-killed-list))
2820                        (gnus-sethash group group gnus-killed-hashtb)
2821                        (setq groups (cdr groups))))
2822                     (t nil)))
2823           (message "Subscribe %s? ([n]yq)" (car groups))
2824           (setq ans (read-char))
2825           (setq group (car groups))
2826           (cond ((= ans ?y)
2827                  (gnus-subscribe-alphabetically (car groups))
2828                  (gnus-sethash group group gnus-killed-hashtb))
2829                 ((= ans ?q)
2830                  (while groups
2831                    (setq group (car groups))
2832                    (setq gnus-killed-list (cons group gnus-killed-list))
2833                    (gnus-sethash group group gnus-killed-hashtb)
2834                    (setq groups (cdr groups))))
2835                 (t
2836                  (setq gnus-killed-list (cons group gnus-killed-list))
2837                  (gnus-sethash group group gnus-killed-hashtb)))
2838           (setq groups (cdr groups)))))))
2839
2840 (defun gnus-subscribe-randomly (newsgroup)
2841   "Subscribe new NEWSGROUP by making it the first newsgroup."
2842   (gnus-subscribe-newsgroup newsgroup))
2843
2844 (defun gnus-subscribe-alphabetically (newgroup)
2845   "Subscribe new NEWSGROUP and insert it in alphabetical order."
2846   (let ((groups (cdr gnus-newsrc-alist))
2847         before)
2848     (while (and (not before) groups)
2849       (if (string< newgroup (car (car groups)))
2850           (setq before (car (car groups)))
2851         (setq groups (cdr groups))))
2852     (gnus-subscribe-newsgroup newgroup before)))
2853
2854 (defun gnus-subscribe-hierarchically (newgroup)
2855   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
2856   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2857   (save-excursion
2858     (set-buffer (find-file-noselect gnus-current-startup-file))
2859     (let ((groupkey newgroup)
2860           before)
2861       (while (and (not before) groupkey)
2862         (goto-char (point-min))
2863         (let ((groupkey-re
2864                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
2865           (while (and (re-search-forward groupkey-re nil t)
2866                       (progn
2867                         (setq before (match-string 1))
2868                         (string< before newgroup)))))
2869         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
2870         (setq groupkey
2871               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
2872                   (substring groupkey (match-beginning 1) (match-end 1)))))
2873       (gnus-subscribe-newsgroup newgroup before))))
2874
2875 (defun gnus-subscribe-interactively (group)
2876   "Subscribe the new GROUP interactively.
2877 It is inserted in hierarchical newsgroup order if subscribed.  If not,
2878 it is killed."
2879   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
2880       (gnus-subscribe-hierarchically group)
2881     (push group gnus-killed-list)))
2882
2883 (defun gnus-subscribe-zombies (group)
2884   "Make the new GROUP into a zombie group."
2885   (push group gnus-zombie-list))
2886
2887 (defun gnus-subscribe-killed (group)
2888   "Make the new GROUP a killed group."
2889   (push group gnus-killed-list))
2890
2891 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
2892   "Subscribe new NEWSGROUP.
2893 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
2894 the first newsgroup."
2895   ;; We subscribe the group by changing its level to `subscribed'.
2896   (gnus-group-change-level
2897    newsgroup gnus-level-default-subscribed
2898    gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
2899   (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
2900
2901 ;; For directories
2902
2903 (defun gnus-newsgroup-directory-form (newsgroup)
2904   "Make hierarchical directory name from NEWSGROUP name."
2905   (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
2906         (len (length newsgroup))
2907         idx)
2908     ;; If this is a foreign group, we don't want to translate the
2909     ;; entire name.
2910     (if (setq idx (string-match ":" newsgroup))
2911         (aset newsgroup idx ?/)
2912       (setq idx 0))
2913     ;; Replace all occurrences of `.' with `/'.
2914     (while (< idx len)
2915       (if (= (aref newsgroup idx) ?.)
2916           (aset newsgroup idx ?/))
2917       (setq idx (1+ idx)))
2918     newsgroup))
2919
2920 (defun gnus-newsgroup-savable-name (group)
2921   ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
2922   ;; with dots.
2923   (nnheader-replace-chars-in-string group ?/ ?.))
2924
2925 (defun gnus-make-directory (dir)
2926   "Make DIRECTORY recursively."
2927   ;; Why don't we use `(make-directory dir 'parents)'?  That's just one
2928   ;; of the many mysteries of the universe.
2929   (let* ((dir (expand-file-name dir default-directory))
2930          dirs err)
2931     (if (string-match "/$" dir)
2932         (setq dir (substring dir 0 (match-beginning 0))))
2933     ;; First go down the path until we find a directory that exists.
2934     (while (not (file-exists-p dir))
2935       (setq dirs (cons dir dirs))
2936       (string-match "/[^/]+$" dir)
2937       (setq dir (substring dir 0 (match-beginning 0))))
2938     ;; Then create all the subdirs.
2939     (while (and dirs (not err))
2940       (condition-case ()
2941           (make-directory (car dirs))
2942         (error (setq err t)))
2943       (setq dirs (cdr dirs)))
2944     ;; We return whether we were successful or not.
2945     (not dirs)))
2946
2947 (defun gnus-capitalize-newsgroup (newsgroup)
2948   "Capitalize NEWSGROUP name."
2949   (and (not (zerop (length newsgroup)))
2950        (concat (char-to-string (upcase (aref newsgroup 0)))
2951                (substring newsgroup 1))))
2952
2953 ;; Various... things.
2954
2955 (defun gnus-simplify-subject (subject &optional re-only)
2956   "Remove `Re:' and words in parentheses.
2957 If RE-ONLY is non-nil, strip leading `Re:'s only."
2958   (let ((case-fold-search t))           ;Ignore case.
2959     ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
2960     (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
2961       (setq subject (substring subject (match-end 0))))
2962     ;; Remove uninteresting prefixes.
2963     (if (and (not re-only)
2964              gnus-simplify-ignored-prefixes
2965              (string-match gnus-simplify-ignored-prefixes subject))
2966         (setq subject (substring subject (match-end 0))))
2967     ;; Remove words in parentheses from end.
2968     (unless re-only
2969       (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
2970         (setq subject (substring subject 0 (match-beginning 0)))))
2971     ;; Return subject string.
2972     subject))
2973
2974 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
2975 ;; all whitespace.
2976 ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
2977 (defun gnus-simplify-buffer-fuzzy ()
2978   (goto-char (point-min))
2979   (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*" nil t)
2980   (goto-char (match-beginning 0))
2981   (while (or
2982           (looking-at "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*")
2983           (looking-at "^[[].*:[ \t].*[]]$"))
2984     (goto-char (point-min))
2985     (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
2986                               nil t)
2987       (replace-match "" t t))
2988     (goto-char (point-min))
2989     (while (re-search-forward "^[[].*:[ \t].*[]]$" nil t)
2990       (goto-char (match-end 0))
2991       (delete-char -1)
2992       (delete-region
2993        (progn (goto-char (match-beginning 0)))
2994        (re-search-forward ":"))))
2995   (goto-char (point-min))
2996   (while (re-search-forward "[ \t\n]*[[{(][^()]*[]})][ \t]*$" nil t)
2997     (replace-match "" t t))
2998   (goto-char (point-min))
2999   (while (re-search-forward "[ \t]+" nil t)
3000     (replace-match " " t t))
3001   (goto-char (point-min))
3002   (while (re-search-forward "[ \t]+$" nil t)
3003     (replace-match "" t t))
3004   (goto-char (point-min))
3005   (while (re-search-forward "^[ \t]+" nil t)
3006     (replace-match "" t t))
3007   (goto-char (point-min))
3008   (if gnus-simplify-subject-fuzzy-regexp
3009       (if (listp gnus-simplify-subject-fuzzy-regexp)
3010           (let ((list gnus-simplify-subject-fuzzy-regexp))
3011             (while list
3012               (goto-char (point-min))
3013               (while (re-search-forward (car list) nil t)
3014                 (replace-match "" t t))
3015               (setq list (cdr list))))
3016         (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
3017           (replace-match "" t t)))))
3018
3019 (defun gnus-simplify-subject-fuzzy (subject)
3020   "Siplify a subject string fuzzily."
3021   (save-excursion
3022     (gnus-set-work-buffer)
3023     (let ((case-fold-search t))
3024       (insert subject)
3025       (inline (gnus-simplify-buffer-fuzzy))
3026       (buffer-string))))
3027
3028 ;; Add the current buffer to the list of buffers to be killed on exit.
3029 (defun gnus-add-current-to-buffer-list ()
3030   (or (memq (current-buffer) gnus-buffer-list)
3031       (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
3032
3033 (defun gnus-string> (s1 s2)
3034   (not (or (string< s1 s2)
3035            (string= s1 s2))))
3036
3037 ;;; General various misc type functions.
3038
3039 (defun gnus-clear-system ()
3040   "Clear all variables and buffers."
3041   ;; Clear Gnus variables.
3042   (let ((variables gnus-variable-list))
3043     (while variables
3044       (set (car variables) nil)
3045       (setq variables (cdr variables))))
3046   ;; Clear other internal variables.
3047   (setq gnus-list-of-killed-groups nil
3048         gnus-have-read-active-file nil
3049         gnus-newsrc-alist nil
3050         gnus-newsrc-hashtb nil
3051         gnus-killed-list nil
3052         gnus-zombie-list nil
3053         gnus-killed-hashtb nil
3054         gnus-active-hashtb nil
3055         gnus-moderated-list nil
3056         gnus-description-hashtb nil
3057         gnus-newsgroup-headers nil
3058         gnus-newsgroup-name nil
3059         gnus-server-alist nil
3060         gnus-opened-servers nil
3061         gnus-current-select-method nil)
3062   ;; Reset any score variables.
3063   (and gnus-use-scoring (gnus-score-close))
3064   ;; Kill the startup file.
3065   (and gnus-current-startup-file
3066        (get-file-buffer gnus-current-startup-file)
3067        (kill-buffer (get-file-buffer gnus-current-startup-file)))
3068   ;; Save any cache buffers.
3069   (and gnus-use-cache (gnus-cache-save-buffers))
3070   ;; Clear the dribble buffer.
3071   (gnus-dribble-clear)
3072   ;; Close down NoCeM.
3073   (and gnus-use-nocem (gnus-nocem-close))
3074   ;; Shut down the demons.
3075   (and gnus-use-demon (gnus-demon-cancel))
3076   ;; Kill global KILL file buffer.
3077   (if (get-file-buffer (gnus-newsgroup-kill-file nil))
3078       (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
3079   (gnus-kill-buffer nntp-server-buffer)
3080   ;; Backlog.
3081   (and gnus-keep-backlog (gnus-backlog-shutdown))
3082   ;; Kill Gnus buffers.
3083   (while gnus-buffer-list
3084     (gnus-kill-buffer (car gnus-buffer-list))
3085     (setq gnus-buffer-list (cdr gnus-buffer-list))))
3086
3087 (defun gnus-windows-old-to-new (setting)
3088   ;; First we take care of the really, really old Gnus 3 actions.
3089   (if (symbolp setting)
3090       (setq setting
3091             (cond ((memq setting '(SelectArticle))
3092                    'article)
3093                   ((memq setting '(SelectSubject ExpandSubject))
3094                    'summary)
3095                   ((memq setting '(SelectNewsgroup ExitNewsgroup))
3096                    'group)
3097                   (t setting))))
3098   (if (or (listp setting)
3099           (not (and gnus-window-configuration
3100                     (memq setting '(group summary article)))))
3101       setting
3102     (let* ((setting (if (eq setting 'group)
3103                         (if (assq 'newsgroup gnus-window-configuration)
3104                             'newsgroup
3105                           'newsgroups) setting))
3106            (elem (car (cdr (assq setting gnus-window-configuration))))
3107            (total (apply '+ elem))
3108            (types '(group summary article))
3109            (pbuf (if (eq setting 'newsgroups) 'group 'summary))
3110            (i 0)
3111            perc
3112            out)
3113       (while (< i 3)
3114         (or (not (numberp (nth i elem)))
3115             (zerop (nth i elem))
3116             (progn
3117               (setq perc  (/ (float (nth 0 elem)) total))
3118               (setq out (cons (if (eq pbuf (nth i types))
3119                                   (vector (nth i types) perc 'point)
3120                                 (vector (nth i types) perc))
3121                               out))))
3122         (setq i (1+ i)))
3123       (list (nreverse out)))))
3124
3125 (defun gnus-add-configuration (conf)
3126   "Add the window configuration CONF to `gnus-buffer-configuration'."
3127   (setq gnus-buffer-configuration
3128         (cons conf (delq (assq (car conf) gnus-buffer-configuration)
3129                          gnus-buffer-configuration))))
3130
3131 (defvar gnus-frame-list nil)
3132
3133 (defun gnus-configure-frame (split &optional window)
3134   "Split WINDOW according to SPLIT."
3135   (unless window
3136     (setq window (get-buffer-window (current-buffer))))
3137   (select-window window)
3138   ;; This might be an old-stylee buffer config.
3139   (when (vectorp split)
3140     (setq split (append split nil)))
3141   (when (or (consp (car split))
3142             (vectorp (car split)))
3143     (push 1.0 split)
3144     (push 'vertical split))
3145   ;; The SPLIT might be something that is to be evaled to
3146   ;; return a new SPLIT.
3147   (while (and (not (assq (car split) gnus-window-to-buffer))
3148               (gnus-functionp (car split)))
3149     (setq split (eval split)))
3150   (let* ((type (car split))
3151          (subs (cddr split))
3152          (len (if (eq type 'horizontal) (window-width) (window-height)))
3153          (total 0)
3154          (window-min-width (or gnus-window-min-width window-min-width))
3155          (window-min-height (or gnus-window-min-height window-min-height))
3156          s result new-win rest comp-subs size sub)
3157     (cond
3158      ;; Nothing to do here.
3159      ((null split))
3160      ;; Don't switch buffers.
3161      ((null type)
3162       (and (memq 'point split) window))
3163      ;; This is a buffer to be selected.
3164      ((not (memq type '(frame horizontal vertical)))
3165       (let ((buffer (cond ((stringp type) type)
3166                           (t (cdr (assq type gnus-window-to-buffer)))))
3167             buf)
3168         (unless buffer
3169           (error "Illegal buffer type: %s" type))
3170         (unless (setq buf (get-buffer (if (symbolp buffer)
3171                                           (symbol-value buffer) buffer)))
3172           (setq buf (get-buffer-create (if (symbolp buffer)
3173                                            (symbol-value buffer) buffer))))
3174         (switch-to-buffer buf)
3175         ;; We return the window if it has the `point' spec.
3176         (and (memq 'point split) window)))
3177      ;; This is a frame split.
3178      ((eq type 'frame)
3179       (unless gnus-frame-list
3180         (setq gnus-frame-list (list (window-frame
3181                                      (get-buffer-window (current-buffer))))))
3182       (let ((i 0)
3183             params frame fresult)
3184         (while (< i (length subs))
3185           ;; Frame parameter is gotten from the sub-split.
3186           (setq params (cadr (elt subs i)))
3187           ;; It should be a list.
3188           (unless (listp params)
3189             (setq params nil))
3190           ;; Create a new frame?
3191           (unless (setq frame (elt gnus-frame-list i))
3192             (nconc gnus-frame-list (list (setq frame (make-frame params)))))
3193           ;; Is the old frame still alive?
3194           (unless (frame-live-p frame)
3195             (setcar (nthcdr i gnus-frame-list)
3196                     (setq frame (make-frame params))))
3197           ;; Select the frame in question and do more splits there.
3198           (select-frame frame)
3199           (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
3200           (incf i))
3201         ;; Select the frame that has the selected buffer.
3202         (when fresult
3203           (select-frame (window-frame fresult)))))
3204      ;; This is a normal split.
3205      (t
3206       (when (> (length subs) 0)
3207         ;; First we have to compute the sizes of all new windows.
3208         (while subs
3209           (setq sub (append (pop subs) nil))
3210           (while (and (not (assq (car sub) gnus-window-to-buffer))
3211                       (gnus-functionp (car sub)))
3212             (setq sub (eval sub)))
3213           (when sub
3214             (push sub comp-subs)
3215             (setq size (cadar comp-subs))
3216             (cond ((equal size 1.0)
3217                    (setq rest (car comp-subs))
3218                    (setq s 0))
3219                   ((floatp size)
3220                    (setq s (floor (* size len))))
3221                   ((integerp size)
3222                    (setq s size))
3223                   (t
3224                    (error "Illegal size: %s" size)))
3225             ;; Try to make sure that we are inside the safe limits.
3226             (cond ((zerop s))
3227                   ((eq type 'horizontal)
3228                    (setq s (max s window-min-width)))
3229                   ((eq type 'vertical)
3230                    (setq s (max s window-min-height))))
3231             (setcar (cdar comp-subs) s)
3232             (incf total s)))
3233         ;; Take care of the "1.0" spec.
3234         (if rest
3235             (setcar (cdr rest) (- len total))
3236           (error "No 1.0 specs in %s" split))
3237         ;; The we do the actual splitting in a nice recursive
3238         ;; fashion.
3239         (setq comp-subs (nreverse comp-subs))
3240         (while comp-subs
3241           (if (null (cdr comp-subs))
3242               (setq new-win window)
3243             (setq new-win
3244                   (split-window window (cadar comp-subs)
3245                                 (eq type 'horizontal))))
3246           (setq result (or (gnus-configure-frame
3247                             (car comp-subs) window) result))
3248           (select-window new-win)
3249           (setq window new-win)
3250           (setq comp-subs (cdr comp-subs))))
3251       ;; Return the proper window, if any.
3252       (when result
3253         (select-window result))))))
3254
3255 (defun gnus-configure-windows (setting &optional force)
3256   (setq setting (gnus-windows-old-to-new setting))
3257   (let ((split (if (symbolp setting)
3258                    (car (cdr (assq setting gnus-buffer-configuration)))
3259                  setting))
3260         (in-buf (current-buffer))
3261         rule val w height hor ohor heights sub jump-buffer
3262         rel total to-buf all-visible)
3263
3264     (unless split
3265       (error "No such setting: %s" setting))
3266
3267     (if (and (not force) (setq all-visible (gnus-all-windows-visible-p split)))
3268         ;; All the windows mentioned are already visible, so we just
3269         ;; put point in the assigned buffer, and do not touch the
3270         ;; winconf.
3271         (select-window all-visible)
3272
3273       ;; Either remove all windows or just remove all Gnus windows.
3274       (if gnus-use-full-window
3275           (mapcar (lambda (frame)
3276                     (select-frame frame)
3277                     (delete-other-windows)) 
3278                   (frame-list))
3279         (gnus-remove-some-windows)
3280         (switch-to-buffer nntp-server-buffer))
3281
3282       (switch-to-buffer nntp-server-buffer)
3283       (gnus-configure-frame split (get-buffer-window (current-buffer))))))
3284
3285 (defun gnus-all-windows-visible-p (split)
3286   (when (vectorp split)
3287     (setq split (append split nil)))
3288   (when (or (consp (car split))
3289             (vectorp (car split)))
3290     (push 1.0 split)
3291     (push 'vertical split))
3292   ;; The SPLIT might be something that is to be evaled to
3293   ;; return a new SPLIT.
3294   (while (and (not (assq (car split) gnus-window-to-buffer))
3295               (gnus-functionp (car split)))
3296     (setq split (eval split)))
3297   (let* ((type (elt split 0)))
3298     (cond
3299      ((null split)
3300       t)
3301      ((not (or (eq type 'horizontal) (eq type 'vertical) (eq type 'frame)))
3302       (let ((buffer (cond ((stringp type) type)
3303                           (t (cdr (assq type gnus-window-to-buffer)))))
3304             win buf)
3305         (unless buffer
3306           (error "Illegal buffer type: %s" type))
3307         (when (setq buf (get-buffer (if (symbolp buffer) (symbol-value buffer)
3308                                       buffer)))
3309           (setq win (get-buffer-window buf t)))
3310         (when win
3311           (if (memq 'point split)
3312               win
3313             t))))
3314      (t
3315       (let ((n (mapcar 'gnus-all-windows-visible-p
3316                        (cdr (cdr split))))
3317             (win t))
3318         (while n
3319           (cond ((windowp (car n))
3320                  (setq win (car n)))
3321                 ((null (car n))
3322                  (setq win nil)))
3323           (setq n (cdr n)))
3324         win)))))
3325
3326 (defun gnus-window-top-edge (&optional window)
3327   (nth 1 (window-edges window)))
3328
3329 (defun gnus-remove-some-windows ()
3330   (let ((buffers gnus-window-to-buffer)
3331         buf bufs lowest-buf lowest)
3332     (save-excursion
3333       ;; Remove windows on all known Gnus buffers.
3334       (while buffers
3335         (setq buf (cdr (car buffers)))
3336         (if (symbolp buf)
3337             (setq buf (and (boundp buf) (symbol-value buf))))
3338         (and buf
3339              (get-buffer-window buf)
3340              (progn
3341                (setq bufs (cons buf bufs))
3342                (pop-to-buffer buf)
3343                (if (or (not lowest)
3344                        (< (gnus-window-top-edge) lowest))
3345                    (progn
3346                      (setq lowest (gnus-window-top-edge))
3347                      (setq lowest-buf buf)))))
3348         (setq buffers (cdr buffers)))
3349       ;; Remove windows on *all* summary buffers.
3350       (let (wins)
3351         (walk-windows
3352          (lambda (win)
3353            (let ((buf (window-buffer win)))
3354              (if (string-match  "^\\*Summary" (buffer-name buf))
3355                  (progn
3356                    (setq bufs (cons buf bufs))
3357                    (pop-to-buffer buf)
3358                    (if (or (not lowest)
3359                            (< (gnus-window-top-edge) lowest))
3360                        (progn
3361                          (setq lowest-buf buf)
3362                          (setq lowest (gnus-window-top-edge))))))))))
3363       (and lowest-buf
3364            (progn
3365              (pop-to-buffer lowest-buf)
3366              (switch-to-buffer nntp-server-buffer)))
3367       (while bufs
3368         (and (not (eq (car bufs) lowest-buf))
3369              (delete-windows-on (car bufs)))
3370         (setq bufs (cdr bufs))))))
3371
3372 (defun gnus-version ()
3373   "Version numbers of this version of Gnus."
3374   (interactive)
3375   (let ((methods gnus-valid-select-methods)
3376         (mess gnus-version)
3377         meth)
3378     ;; Go through all the legal select methods and add their version
3379     ;; numbers to the total version string.  Only the backends that are
3380     ;; currently in use will have their message numbers taken into
3381     ;; consideration.
3382     (while methods
3383       (setq meth (intern (concat (car (car methods)) "-version")))
3384       (and (boundp meth)
3385            (stringp (symbol-value meth))
3386            (setq mess (concat mess "; " (symbol-value meth))))
3387       (setq methods (cdr methods)))
3388     (gnus-message 2 mess)))
3389
3390 (defun gnus-info-find-node ()
3391   "Find Info documentation of Gnus."
3392   (interactive)
3393   ;; Enlarge info window if needed.
3394   (let ((mode major-mode)
3395         gnus-info-buffer)
3396     (Info-goto-node (car (cdr (assq mode gnus-info-nodes))))
3397     (setq gnus-info-buffer (current-buffer))
3398     (gnus-configure-windows 'info)))
3399
3400 (defun gnus-days-between (date1 date2)
3401   ;; Return the number of days between date1 and date2.
3402   (- (gnus-day-number date1) (gnus-day-number date2)))
3403
3404 (defun gnus-day-number (date)
3405   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
3406                      (timezone-parse-date date))))
3407     (timezone-absolute-from-gregorian
3408      (nth 1 dat) (nth 2 dat) (car dat))))
3409
3410 (defun gnus-encode-date (date)
3411   "Convert DATE to internal time."
3412   (let* ((parse (timezone-parse-date date))
3413          (date (mapcar (lambda (d) (and d (string-to-int d))) parse))
3414          (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
3415     (encode-time (caddr time) (cadr time) (car time)
3416                  (caddr date) (cadr date) (car date) (nth 4 date))))
3417
3418 (defun gnus-time-minus (t1 t2)
3419   "Subtract two internal times."
3420   (let ((borrow (< (cadr t1) (cadr t2))))
3421     (list (- (car t1) (car t2) (if borrow 1 0))
3422           (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
3423
3424 (defun gnus-file-newer-than (file date)
3425   (let ((fdate (nth 5 (file-attributes file))))
3426     (or (> (car fdate) (car date))
3427         (and (= (car fdate) (car date))
3428              (> (nth 1 fdate) (nth 1 date))))))
3429
3430 (defmacro gnus-define-keys (keymap &rest plist)
3431   "Define all keys in PLIST in KEYMAP."
3432   `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
3433
3434 (defun gnus-define-keys-1 (keymap plist)
3435   (when (null keymap)
3436     (error "Can't set keys in a null keymap"))
3437   (cond ((symbolp keymap)
3438          (setq keymap (symbol-value keymap)))
3439         ((listp keymap)
3440          (set (car keymap) nil)
3441          (define-prefix-command (car keymap))
3442          (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
3443          (setq keymap (symbol-value (car keymap)))))
3444   (let (key)
3445     (while plist
3446       (when (symbolp (setq key (pop plist)))
3447         (setq key (symbol-value key)))
3448       (define-key keymap key (pop plist)))))
3449
3450 (defun gnus-group-read-only-p (&optional group)
3451   "Check whether GROUP supports editing or not.
3452 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
3453 that that variable is buffer-local to the summary buffers."
3454   (let ((group (or group gnus-newsgroup-name)))
3455     (not (gnus-check-backend-function 'request-replace-article group))))
3456
3457 (defun gnus-group-total-expirable-p (group)
3458   "Check whether GROUP is total-expirable or not."
3459   (let ((params (gnus-info-params (gnus-get-info group))))
3460     (or (memq 'total-expire params)
3461         (cdr (assq 'total-expire params)) ; (total-expire . t)
3462         (and gnus-total-expirable-newsgroups ; Check var.
3463              (string-match gnus-total-expirable-newsgroups group)))))
3464
3465 (defun gnus-group-auto-expirable-p (group)
3466   "Check whether GROUP is total-expirable or not."
3467   (let ((params (gnus-info-params (gnus-get-info group))))
3468     (or (memq 'auto-expire params)
3469         (cdr (assq 'auto-expire params)) ; (auto-expire . t)
3470         (and gnus-auto-expirable-newsgroups ; Check var.
3471              (string-match gnus-auto-expirable-newsgroups group)))))
3472
3473 (defun gnus-virtual-group-p (group)
3474   "Say whether GROUP is virtual or not."
3475   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
3476                         gnus-valid-select-methods)))
3477
3478 (defsubst gnus-simplify-subject-fully (subject)
3479   "Simplify a subject string according to the user's wishes."
3480   (cond
3481    ((null gnus-summary-gather-subject-limit)
3482     (gnus-simplify-subject-re subject))
3483    ((eq gnus-summary-gather-subject-limit 'fuzzy)
3484     (gnus-simplify-subject-fuzzy subject))
3485    ((numberp gnus-summary-gather-subject-limit)
3486     (gnus-limit-string (gnus-simplify-subject-re subject)
3487                        gnus-summary-gather-subject-limit))
3488    (t
3489     subject)))
3490
3491 (defsubst gnus-subject-equal (s1 s2 &optional simple-first)
3492   "Check whether two subjects are equal.  If optional argument
3493 simple-first is t, first argument is already simplified."
3494   (cond
3495    ((null simple-first)
3496     (equal (gnus-simplify-subject-fully s1)
3497            (gnus-simplify-subject-fully s2)))
3498    (t
3499     (equal s1
3500            (gnus-simplify-subject-fully s2)))))
3501
3502 ;; Returns a list of writable groups.
3503 (defun gnus-writable-groups ()
3504   (let ((alist gnus-newsrc-alist)
3505         groups)
3506     (while alist
3507       (or (gnus-group-read-only-p (car (car alist)))
3508           (setq groups (cons (car (car alist)) groups)))
3509       (setq alist (cdr alist)))
3510     (nreverse groups)))
3511
3512 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
3513 ;; the echo area.
3514 (defun gnus-y-or-n-p (prompt)
3515   (prog1
3516       (y-or-n-p prompt)
3517     (message "")))
3518
3519 (defun gnus-yes-or-no-p (prompt)
3520   (prog1
3521       (yes-or-no-p prompt)
3522     (message "")))
3523
3524 ;; Check whether to use long file names.
3525 (defun gnus-use-long-file-name (symbol)
3526   ;; The variable has to be set...
3527   (and gnus-use-long-file-name
3528        ;; If it isn't a list, then we return t.
3529        (or (not (listp gnus-use-long-file-name))
3530            ;; If it is a list, and the list contains `symbol', we
3531            ;; return nil.
3532            (not (memq symbol gnus-use-long-file-name)))))
3533
3534 ;; I suspect there's a better way, but I haven't taken the time to do
3535 ;; it yet. -erik selberg@cs.washington.edu
3536 (defun gnus-dd-mmm (messy-date)
3537   "Return a string like DD-MMM from a big messy string"
3538   (let ((datevec (timezone-parse-date messy-date)))
3539     (format "%2s-%s"
3540             (or (aref datevec 2) "??")
3541             (capitalize
3542              (or (car
3543                   (nth (1- (string-to-number (aref datevec 1)))
3544                        timezone-months-assoc))
3545                  "???")))))
3546
3547 ;; Make a hash table (default and minimum size is 255).
3548 ;; Optional argument HASHSIZE specifies the table size.
3549 (defun gnus-make-hashtable (&optional hashsize)
3550   (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
3551
3552 ;; Make a number that is suitable for hashing; bigger than MIN and one
3553 ;; less than 2^x.
3554 (defun gnus-create-hash-size (min)
3555   (let ((i 1))
3556     (while (< i min)
3557       (setq i (* 2 i)))
3558     (1- i)))
3559
3560 ;; Show message if message has a lower level than `gnus-verbose'.
3561 ;; Guideline for numbers:
3562 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
3563 ;; for things that take a long time, 7 - not very important messages
3564 ;; on stuff, 9 - messages inside loops.
3565 (defun gnus-message (level &rest args)
3566   (if (<= level gnus-verbose)
3567       (apply 'message args)
3568     ;; We have to do this format thingy here even if the result isn't
3569     ;; shown - the return value has to be the same as the return value
3570     ;; from `message'.
3571     (apply 'format args)))
3572
3573 (defun gnus-functionp (form)
3574   "Return non-nil if FORM is funcallable."
3575   (or (and (symbolp form) (fboundp form))
3576       (and (listp form) (eq (car form) 'lambda))))
3577
3578 ;; Generate a unique new group name.
3579 (defun gnus-generate-new-group-name (leaf)
3580   (let ((name leaf)
3581         (num 0))
3582     (while (gnus-gethash name gnus-newsrc-hashtb)
3583       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3584     name))
3585
3586 ;; Find out whether the gnus-visual TYPE is wanted.
3587 (defun gnus-visual-p (&optional type class)
3588   (and gnus-visual                      ; Has to be non-nil, at least.
3589        (if (not type)                   ; We don't care about type.
3590            gnus-visual
3591          (if (listp gnus-visual)        ; It's a list, so we check it.
3592              (or (memq type gnus-visual)
3593                  (memq class gnus-visual))
3594            t))))
3595
3596 (defun gnus-parent-id (references)
3597   "Return the last Message-ID in REFERENCES."
3598   (when (and references
3599              (string-match "\\(<[^<>]+>\\)[ \t\n]*\\'" references))
3600     (substring references (match-beginning 1) (match-end 1))))
3601
3602 (defun gnus-split-references (references)
3603   "Return a list of Message-IDs in REFERENCES."
3604   (let ((beg 0)
3605         ids)
3606     (while (string-match "<[^>]+>" references beg)
3607       (push (substring references (match-beginning 0) (setq beg (match-end 0)))
3608             ids))
3609     (nreverse ids)))
3610
3611 (defun gnus-ephemeral-group-p (group)
3612   "Say whether GROUP is ephemeral or not."
3613   (assoc 'quit-config (gnus-find-method-for-group group)))
3614
3615 (defun gnus-group-quit-config (group)
3616   "Return the quit-config of GROUP."
3617   (nth 1 (assoc 'quit-config (gnus-find-method-for-group group))))
3618
3619 (defun gnus-simplify-mode-line ()
3620   "Make mode lines a bit simpler."
3621   (setq mode-line-modified "-- ")
3622   (when (listp mode-line-format)
3623     (make-local-variable 'mode-line-format)
3624     (setq mode-line-format (copy-sequence mode-line-format))
3625     (when (equal (nth 3 mode-line-format) "   ")
3626       (setcar (nthcdr 3 mode-line-format) " "))))
3627
3628 ;;; List and range functions
3629
3630 (defun gnus-last-element (list)
3631   "Return last element of LIST."
3632   (while (cdr list)
3633     (setq list (cdr list)))
3634   (car list))
3635
3636 (defun gnus-copy-sequence (list)
3637   "Do a complete, total copy of a list."
3638   (if (and (consp list) (not (consp (cdr list))))
3639       (cons (car list) (cdr list))
3640     (mapcar (lambda (elem) (if (consp elem)
3641                                (if (consp (cdr elem))
3642                                    (gnus-copy-sequence elem)
3643                                  (cons (car elem) (cdr elem)))
3644                              elem))
3645             list)))
3646
3647 (defun gnus-set-difference (list1 list2)
3648   "Return a list of elements of LIST1 that do not appear in LIST2."
3649   (let ((list1 (copy-sequence list1)))
3650     (while list2
3651       (setq list1 (delq (car list2) list1))
3652       (setq list2 (cdr list2)))
3653     list1))
3654
3655 (defun gnus-sorted-complement (list1 list2)
3656   "Return a list of elements of LIST1 that do not appear in LIST2.
3657 Both lists have to be sorted over <."
3658   (let (out)
3659     (if (or (null list1) (null list2))
3660         (or list1 list2)
3661       (while (and list1 list2)
3662         (cond ((= (car list1) (car list2))
3663                (setq list1 (cdr list1)
3664                      list2 (cdr list2)))
3665               ((< (car list1) (car list2))
3666                (setq out (cons (car list1) out))
3667                (setq list1 (cdr list1)))
3668               (t
3669                (setq out (cons (car list2) out))
3670                (setq list2 (cdr list2)))))
3671       (nconc (nreverse out) (or list1 list2)))))
3672
3673 (defun gnus-intersection (list1 list2)
3674   (let ((result nil))
3675     (while list2
3676       (if (memq (car list2) list1)
3677           (setq result (cons (car list2) result)))
3678       (setq list2 (cdr list2)))
3679     result))
3680
3681 (defun gnus-sorted-intersection (list1 list2)
3682   ;; LIST1 and LIST2 have to be sorted over <.
3683   (let (out)
3684     (while (and list1 list2)
3685       (cond ((= (car list1) (car list2))
3686              (setq out (cons (car list1) out)
3687                    list1 (cdr list1)
3688                    list2 (cdr list2)))
3689             ((< (car list1) (car list2))
3690              (setq list1 (cdr list1)))
3691             (t
3692              (setq list2 (cdr list2)))))
3693     (nreverse out)))
3694
3695 (defun gnus-set-sorted-intersection (list1 list2)
3696   ;; LIST1 and LIST2 have to be sorted over <.
3697   ;; This function modifies LIST1.
3698   (let* ((top (cons nil list1))
3699          (prev top))
3700     (while (and list1 list2)
3701       (cond ((= (car list1) (car list2))
3702              (setq prev list1
3703                    list1 (cdr list1)
3704                    list2 (cdr list2)))
3705             ((< (car list1) (car list2))
3706              (setcdr prev (cdr list1))
3707              (setq list1 (cdr list1)))
3708             (t
3709              (setq list2 (cdr list2)))))
3710     (setcdr prev nil)
3711     (cdr top)))
3712
3713 (defun gnus-compress-sequence (numbers &optional always-list)
3714   "Convert list of numbers to a list of ranges or a single range.
3715 If ALWAYS-LIST is non-nil, this function will always release a list of
3716 ranges."
3717   (let* ((first (car numbers))
3718          (last (car numbers))
3719          result)
3720     (if (null numbers)
3721         nil
3722       (if (not (listp (cdr numbers)))
3723           numbers
3724         (while numbers
3725           (cond ((= last (car numbers)) nil) ;Omit duplicated number
3726                 ((= (1+ last) (car numbers)) ;Still in sequence
3727                  (setq last (car numbers)))
3728                 (t                      ;End of one sequence
3729                  (setq result
3730                        (cons (if (= first last) first
3731                                (cons first last)) result))
3732                  (setq first (car numbers))
3733                  (setq last  (car numbers))))
3734           (setq numbers (cdr numbers)))
3735         (if (and (not always-list) (null result))
3736             (if (= first last) (list first) (cons first last))
3737           (nreverse (cons (if (= first last) first (cons first last))
3738                           result)))))))
3739
3740 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
3741 (defun gnus-uncompress-range (ranges)
3742   "Expand a list of ranges into a list of numbers.
3743 RANGES is either a single range on the form `(num . num)' or a list of
3744 these ranges."
3745   (let (first last result)
3746     (cond
3747      ((null ranges)
3748       nil)
3749      ((not (listp (cdr ranges)))
3750       (setq first (car ranges))
3751       (setq last (cdr ranges))
3752       (while (<= first last)
3753         (setq result (cons first result))
3754         (setq first (1+ first)))
3755       (nreverse result))
3756      (t
3757       (while ranges
3758         (if (atom (car ranges))
3759             (if (numberp (car ranges))
3760                 (setq result (cons (car ranges) result)))
3761           (setq first (car (car ranges)))
3762           (setq last  (cdr (car ranges)))
3763           (while (<= first last)
3764             (setq result (cons first result))
3765             (setq first (1+ first))))
3766         (setq ranges (cdr ranges)))
3767       (nreverse result)))))
3768
3769 (defun gnus-add-to-range (ranges list)
3770   "Return a list of ranges that has all articles from both RANGES and LIST.
3771 Note: LIST has to be sorted over `<'."
3772   (if (not ranges)
3773       (gnus-compress-sequence list t)
3774     (setq list (copy-sequence list))
3775     (or (listp (cdr ranges))
3776         (setq ranges (list ranges)))
3777     (let ((out ranges)
3778           ilist lowest highest temp)
3779       (while (and ranges list)
3780         (setq ilist list)
3781         (setq lowest (or (and (atom (car ranges)) (car ranges))
3782                          (car (car ranges))))
3783         (while (and list (cdr list) (< (car (cdr list)) lowest))
3784           (setq list (cdr list)))
3785         (if (< (car ilist) lowest)
3786             (progn
3787               (setq temp list)
3788               (setq list (cdr list))
3789               (setcdr temp nil)
3790               (setq out (nconc (gnus-compress-sequence ilist t) out))))
3791         (setq highest (or (and (atom (car ranges)) (car ranges))
3792                           (cdr (car ranges))))
3793         (while (and list (<= (car list) highest))
3794           (setq list (cdr list)))
3795         (setq ranges (cdr ranges)))
3796       (if list
3797           (setq out (nconc (gnus-compress-sequence list t) out)))
3798       (setq out (sort out (lambda (r1 r2)
3799                             (< (or (and (atom r1) r1) (car r1))
3800                                (or (and (atom r2) r2) (car r2))))))
3801       (setq ranges out)
3802       (while ranges
3803         (if (atom (car ranges))
3804             (if (cdr ranges)
3805                 (if (atom (car (cdr ranges)))
3806                     (if (= (1+ (car ranges)) (car (cdr ranges)))
3807                         (progn
3808                           (setcar ranges (cons (car ranges)
3809                                                (car (cdr ranges))))
3810                           (setcdr ranges (cdr (cdr ranges)))))
3811                   (if (= (1+ (car ranges)) (car (car (cdr ranges))))
3812                       (progn
3813                         (setcar (car (cdr ranges)) (car ranges))
3814                         (setcar ranges (car (cdr ranges)))
3815                         (setcdr ranges (cdr (cdr ranges)))))))
3816           (if (cdr ranges)
3817               (if (atom (car (cdr ranges)))
3818                   (if (= (1+ (cdr (car ranges))) (car (cdr ranges)))
3819                       (progn
3820                         (setcdr (car ranges) (car (cdr ranges)))
3821                         (setcdr ranges (cdr (cdr ranges)))))
3822                 (if (= (1+ (cdr (car ranges))) (car (car (cdr ranges))))
3823                     (progn
3824                       (setcdr (car ranges) (cdr (car (cdr ranges))))
3825                       (setcdr ranges (cdr (cdr ranges))))))))
3826         (setq ranges (cdr ranges)))
3827       out)))
3828
3829 (defun gnus-remove-from-range (ranges list)
3830   "Return a list of ranges that has all articles from LIST removed from RANGES.
3831 Note: LIST has to be sorted over `<'."
3832   ;; !!! This function shouldn't look like this, but I've got a headache.
3833   (gnus-compress-sequence
3834    (gnus-sorted-complement
3835     (gnus-uncompress-range ranges) list)))
3836
3837 (defun gnus-member-of-range (number ranges)
3838   (if (not (listp (cdr ranges)))
3839       (and (>= number (car ranges))
3840            (<= number (cdr ranges)))
3841     (let ((not-stop t))
3842       (while (and ranges
3843                   (if (numberp (car ranges))
3844                       (>= number (car ranges))
3845                     (>= number (car (car ranges))))
3846                   not-stop)
3847         (if (if (numberp (car ranges))
3848                 (= number (car ranges))
3849               (and (>= number (car (car ranges)))
3850                    (<= number (cdr (car ranges)))))
3851             (setq not-stop nil))
3852         (setq ranges (cdr ranges)))
3853       (not not-stop))))
3854
3855 (defun gnus-range-length (range)
3856   "Return the length RANGE would have if uncompressed."
3857   (length (gnus-uncompress-range range)))
3858
3859 (defun gnus-sublist-p (list sublist)
3860   "Test whether all elements in SUBLIST are members of LIST."
3861   (let ((sublistp t))
3862     (while sublist
3863       (unless (memq (pop sublist) list)
3864         (setq sublistp nil
3865               sublist nil)))
3866     sublistp))
3867
3868 \f
3869 ;;;
3870 ;;; Gnus group mode
3871 ;;;
3872
3873 (defvar gnus-group-mode-map nil)
3874 (put 'gnus-group-mode 'mode-class 'special)
3875
3876 (unless gnus-group-mode-map
3877   (setq gnus-group-mode-map (make-keymap))
3878   (suppress-keymap gnus-group-mode-map)
3879
3880   (gnus-define-keys
3881    gnus-group-mode-map
3882    " " gnus-group-read-group
3883    "=" gnus-group-select-group
3884    "\M- " gnus-group-unhidden-select-group
3885    "\r" gnus-group-select-group
3886    "\M-\r" gnus-group-quick-select-group
3887    "j" gnus-group-jump-to-group
3888    "n" gnus-group-next-unread-group
3889    "p" gnus-group-prev-unread-group
3890    "\177" gnus-group-prev-unread-group
3891    "N" gnus-group-next-group
3892    "P" gnus-group-prev-group
3893    "\M-n" gnus-group-next-unread-group-same-level
3894    "\M-p" gnus-group-prev-unread-group-same-level
3895    "," gnus-group-best-unread-group
3896    "." gnus-group-first-unread-group
3897    "u" gnus-group-unsubscribe-current-group
3898    "U" gnus-group-unsubscribe-group
3899    "c" gnus-group-catchup-current
3900    "C" gnus-group-catchup-current-all
3901    "l" gnus-group-list-groups
3902    "L" gnus-group-list-all-groups
3903    "m" gnus-group-mail
3904    "g" gnus-group-get-new-news
3905    "\M-g" gnus-group-get-new-news-this-group
3906    "R" gnus-group-restart
3907    "r" gnus-group-read-init-file
3908    "B" gnus-group-browse-foreign-server
3909    "b" gnus-group-check-bogus-groups
3910    "F" gnus-find-new-newsgroups
3911    "\C-c\C-d" gnus-group-describe-group
3912    "\M-d" gnus-group-describe-all-groups
3913    "\C-c\C-a" gnus-group-apropos
3914    "\C-c\M-\C-a" gnus-group-description-apropos
3915    "a" gnus-group-post-news
3916    "\ek" gnus-group-edit-local-kill
3917    "\eK" gnus-group-edit-global-kill
3918    "\C-k" gnus-group-kill-group
3919    "\C-y" gnus-group-yank-group
3920    "\C-w" gnus-group-kill-region
3921    "\C-x\C-t" gnus-group-transpose-groups
3922    "\C-c\C-l" gnus-group-list-killed
3923    "\C-c\C-x" gnus-group-expire-articles
3924    "\C-c\M-\C-x" gnus-group-expire-all-groups
3925    "V" gnus-version
3926    "s" gnus-group-save-newsrc
3927    "z" gnus-group-suspend
3928    "Z" gnus-group-clear-dribble
3929    "q" gnus-group-exit
3930    "Q" gnus-group-quit
3931    "?" gnus-group-describe-briefly
3932    "\C-c\C-i" gnus-info-find-node
3933    "\M-e" gnus-group-edit-group-method
3934    "^" gnus-group-enter-server-mode
3935    gnus-mouse-2 gnus-mouse-pick-group
3936    "<" beginning-of-buffer
3937    ">" end-of-buffer
3938    "\C-c\C-b" gnus-bug
3939    "\C-c\C-s" gnus-group-sort-groups
3940    "t" gnus-topic-mode
3941    "\C-c\M-g" gnus-activate-all-groups
3942    "\M-&" gnus-group-universal-argument
3943    "#" gnus-group-mark-group
3944    "\M-#" gnus-group-unmark-group)
3945
3946   (gnus-define-keys
3947    (gnus-group-mark-map "M" gnus-group-mode-map)
3948    "m" gnus-group-mark-group
3949    "u" gnus-group-unmark-group
3950    "w" gnus-group-mark-region
3951    "m" gnus-group-mark-buffer
3952    "r" gnus-group-mark-regexp
3953    "U" gnus-group-unmark-all-groups)
3954
3955   (gnus-define-keys
3956    (gnus-group-group-map "G" gnus-group-mode-map)
3957    "d" gnus-group-make-directory-group
3958    "h" gnus-group-make-help-group
3959    "a" gnus-group-make-archive-group
3960    "k" gnus-group-make-kiboze-group
3961    "m" gnus-group-make-group
3962    "E" gnus-group-edit-group
3963    "e" gnus-group-edit-group-method
3964    "p" gnus-group-edit-group-parameters
3965    "v" gnus-group-add-to-virtual
3966    "V" gnus-group-make-empty-virtual
3967    "D" gnus-group-enter-directory
3968    "f" gnus-group-make-doc-group
3969    "r" gnus-group-rename-group
3970    "\177" gnus-group-delete-group)
3971
3972    (gnus-define-keys
3973     (gnus-group-soup-map "s" gnus-group-group-map)
3974     "b" gnus-group-brew-soup
3975     "w" gnus-soup-save-areas
3976     "s" gnus-soup-send-replies
3977     "p" gnus-soup-pack-packet
3978     "r" nnsoup-pack-replies)
3979
3980    (gnus-define-keys
3981     (gnus-group-sort-map "S" gnus-group-group-map)
3982     "s" gnus-group-sort-groups
3983     "a" gnus-group-sort-groups-by-alphabet
3984     "u" gnus-group-sort-groups-by-unread
3985     "l" gnus-group-sort-groups-by-level
3986     "v" gnus-group-sort-groups-by-score
3987     "r" gnus-group-sort-groups-by-rank
3988     "m" gnus-group-sort-groups-by-method)
3989
3990    (gnus-define-keys
3991     (gnus-group-list-map "A" gnus-group-mode-map)
3992     "k" gnus-group-list-killed
3993     "z" gnus-group-list-zombies
3994     "s" gnus-group-list-groups
3995     "u" gnus-group-list-all-groups
3996     "A" gnus-group-list-active
3997     "a" gnus-group-apropos
3998     "d" gnus-group-description-apropos
3999     "m" gnus-group-list-matching
4000     "M" gnus-group-list-all-matching
4001     "l" gnus-group-list-level)
4002
4003    (gnus-define-keys
4004     (gnus-group-score-map "W" gnus-group-mode-map)
4005     "f" gnus-score-flush-cache)
4006
4007    (gnus-define-keys
4008     (gnus-group-help-map "H" gnus-group-mode-map)
4009     "f" gnus-group-fetch-faq)
4010
4011    (gnus-define-keys
4012     (gnus-group-sub-map "S" gnus-group-mode-map)
4013     "l" gnus-group-set-current-level
4014     "t" gnus-group-unsubscribe-current-group
4015     "s" gnus-group-unsubscribe-group
4016     "k" gnus-group-kill-group
4017     "y" gnus-group-yank-group
4018     "w" gnus-group-kill-region
4019     "\C-k" gnus-group-kill-level
4020     "z" gnus-group-kill-all-zombies))
4021
4022 (defun gnus-group-mode ()
4023   "Major mode for reading news.
4024
4025 All normal editing commands are switched off.
4026 \\<gnus-group-mode-map>
4027 The group buffer lists (some of) the groups available.  For instance,
4028 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
4029 lists all zombie groups.
4030
4031 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
4032 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
4033
4034 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
4035
4036 The following commands are available:
4037
4038 \\{gnus-group-mode-map}"
4039   (interactive)
4040   (when (and menu-bar-mode
4041              (gnus-visual-p 'group-menu 'menu))
4042     (gnus-group-make-menu-bar))
4043   (kill-all-local-variables)
4044   (gnus-simplify-mode-line)
4045   (setq major-mode 'gnus-group-mode)
4046   (setq mode-name "Group")
4047   (gnus-group-set-mode-line)
4048   (setq mode-line-process nil)
4049   (use-local-map gnus-group-mode-map)
4050   (buffer-disable-undo (current-buffer))
4051   (setq truncate-lines t)
4052   (setq buffer-read-only t)
4053   (run-hooks 'gnus-group-mode-hook))
4054
4055 (defun gnus-mouse-pick-group (e)
4056   "Enter the group under the mouse pointer."
4057   (interactive "e")
4058   (mouse-set-point e)
4059   (gnus-group-read-group nil))
4060
4061 ;; Look at LEVEL and find out what the level is really supposed to be.
4062 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
4063 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
4064 (defun gnus-group-default-level (&optional level number-or-nil)
4065   (cond
4066    (gnus-group-use-permanent-levels
4067     (setq gnus-group-default-list-level
4068           (or level gnus-group-default-list-level))
4069     (or gnus-group-default-list-level gnus-level-subscribed))
4070    (number-or-nil
4071     level)
4072    (t
4073     (or level gnus-group-default-list-level gnus-level-subscribed))))
4074
4075 ;;;###autoload
4076 (defun gnus-slave-no-server (&optional arg)
4077   "Read network news as a slave, without connecting to local server"
4078   (interactive "P")
4079   (gnus-no-server arg t))
4080
4081 ;;;###autoload
4082 (defun gnus-no-server (&optional arg slave)
4083   "Read network news.
4084 If ARG is a positive number, Gnus will use that as the
4085 startup level.  If ARG is nil, Gnus will be started at level 2.
4086 If ARG is non-nil and not a positive number, Gnus will
4087 prompt the user for the name of an NNTP server to use.
4088 As opposed to `gnus', this command will not connect to the local server."
4089   (interactive "P")
4090   (make-local-variable 'gnus-group-use-permanent-levels)
4091   (setq gnus-group-use-permanent-levels t)
4092   (gnus (or arg (1- gnus-level-default-subscribed)) t slave))
4093
4094 ;;;###autoload
4095 (defun gnus-slave (&optional arg)
4096   "Read news as a slave."
4097   (interactive "P")
4098   (gnus arg nil 'slave))
4099
4100 ;;;###autoload
4101 (defun gnus-other-frame (&optional arg)
4102   "Pop up a frame to read news."
4103   (interactive "P")
4104   (if (get-buffer gnus-group-buffer)
4105       (let ((pop-up-frames t))
4106         (gnus arg))
4107     (select-frame (make-frame))
4108     (gnus arg)))
4109
4110 ;;;###autoload
4111 (defun gnus (&optional arg dont-connect slave)
4112   "Read network news.
4113 If ARG is non-nil and a positive number, Gnus will use that as the
4114 startup level.  If ARG is non-nil and not a positive number, Gnus will
4115 prompt the user for the name of an NNTP server to use."
4116   (interactive "P")
4117
4118   (if (get-buffer gnus-group-buffer)
4119       (progn
4120         (switch-to-buffer gnus-group-buffer)
4121         (gnus-group-get-new-news))
4122
4123     (gnus-clear-system)
4124     (nnheader-init-server-buffer)
4125     (gnus-read-init-file)
4126     (setq gnus-slave slave)
4127
4128     (gnus-group-setup-buffer)
4129     (let ((buffer-read-only nil))
4130       (erase-buffer)
4131       (if (not gnus-inhibit-startup-message)
4132           (progn
4133             (gnus-group-startup-message)
4134             (sit-for 0))))
4135
4136     (let ((level (and (numberp arg) (> arg 0) arg))
4137           did-connect)
4138       (unwind-protect
4139           (progn
4140             (or dont-connect
4141                 (setq did-connect
4142                       (gnus-start-news-server (and arg (not level))))))
4143         (if (and (not dont-connect)
4144                  (not did-connect))
4145             (gnus-group-quit)
4146           (run-hooks 'gnus-startup-hook)
4147           ;; NNTP server is successfully open.
4148
4149           ;; Find the current startup file name.
4150           (setq gnus-current-startup-file
4151                 (gnus-make-newsrc-file gnus-startup-file))
4152
4153           ;; Read the dribble file.
4154           (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
4155
4156           (gnus-summary-make-display-table)
4157           ;; Do the actual startup.
4158           (gnus-setup-news nil level)
4159           ;; Generate the group buffer.
4160           (gnus-group-list-groups level)
4161           (gnus-group-first-unread-group)
4162           (gnus-configure-windows 'group)
4163           (gnus-group-set-mode-line))))))
4164
4165 (defun gnus-unload ()
4166   "Unload all Gnus features."
4167   (interactive)
4168   (or (boundp 'load-history)
4169       (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
4170   (let ((history load-history)
4171         feature)
4172     (while history
4173       (and (string-match "^\\(gnus\\|nn\\)" (caar history))
4174            (setq feature (cdr (assq 'provide (car history))))
4175            (unload-feature feature 'force))
4176       (setq history (cdr history)))))
4177
4178 (defun gnus-compile ()
4179   "Byte-compile the user-defined format specs."
4180   (interactive)
4181   (let ((entries gnus-format-specs)
4182         entry gnus-tmp-func)
4183     (save-excursion
4184       (gnus-message 7 "Compiling format specs...")
4185
4186       (while entries
4187         (setq entry (pop entries))
4188         (if (eq (car entry) 'version)
4189             (setq gnus-format-specs (delq entry gnus-format-specs))
4190           (when (and (listp (caddr entry))
4191                      (not (eq 'byte-code (caaddr entry))))
4192             (fset 'gnus-tmp-func
4193                   `(lambda () ,(caddr entry)))
4194             (byte-compile 'gnus-tmp-func)
4195             (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
4196
4197       (push (cons 'version emacs-version) gnus-format-specs)
4198
4199       (gnus-message 7 "Compiling user specs...done"))))
4200
4201 (defun gnus-indent-rigidly (start end arg)
4202   "Indent rigidly using only spaces and no tabs."
4203   (save-excursion
4204     (save-restriction
4205       (narrow-to-region start end)
4206       (indent-rigidly start end arg)
4207       (goto-char (point-min))
4208       (while (search-forward "\t" nil t)
4209         (replace-match "        " t t)))))
4210
4211 (defun gnus-group-startup-message (&optional x y)
4212   "Insert startup message in current buffer."
4213   ;; Insert the message.
4214   (erase-buffer)
4215   (insert
4216    (format "              %s
4217           _    ___ _             _
4218           _ ___ __ ___  __    _ ___
4219           __   _     ___    __  ___
4220               _           ___     _
4221              _  _ __             _
4222              ___   __            _
4223                    __           _
4224                     _      _   _
4225                    _      _    _
4226                       _  _    _
4227                   __  ___
4228                  _   _ _     _
4229                 _   _
4230               _    _
4231              _    _
4232             _
4233           __
4234
4235 "
4236            ""))
4237   ;; And then hack it.
4238   (gnus-indent-rigidly (point-min) (point-max)
4239                        (/ (max (- (window-width) (or x 46)) 0) 2))
4240   (goto-char (point-min))
4241   (forward-line 1)
4242   (let* ((pheight (count-lines (point-min) (point-max)))
4243          (wheight (window-height))
4244          (rest (- wheight pheight)))
4245     (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
4246   ;; Fontify some.
4247   (goto-char (point-min))
4248   (and (search-forward "Praxis" nil t)
4249        (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
4250   (goto-char (point-min))
4251   (let* ((mode-string (gnus-group-set-mode-line)))
4252     (setq mode-line-buffer-identification
4253           (list (concat gnus-version (substring (car mode-string) 4))))
4254     (set-buffer-modified-p t)))
4255
4256 (defun gnus-group-setup-buffer ()
4257   (or (get-buffer gnus-group-buffer)
4258       (progn
4259         (switch-to-buffer gnus-group-buffer)
4260         (gnus-add-current-to-buffer-list)
4261         (gnus-group-mode)
4262         (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
4263
4264 (defun gnus-group-list-groups (&optional level unread lowest)
4265   "List newsgroups with level LEVEL or lower that have unread articles.
4266 Default is all subscribed groups.
4267 If argument UNREAD is non-nil, groups with no unread articles are also
4268 listed."
4269   (interactive (list (if current-prefix-arg
4270                          (prefix-numeric-value current-prefix-arg)
4271                        (or
4272                         (gnus-group-default-level nil t)
4273                         gnus-group-default-list-level
4274                         gnus-level-subscribed))))
4275   (or level
4276       (setq level (car gnus-group-list-mode)
4277             unread (cdr gnus-group-list-mode)))
4278   (setq level (gnus-group-default-level level))
4279   (gnus-group-setup-buffer)             ;May call from out of group buffer
4280   (gnus-update-format-specifications)
4281   (let ((case-fold-search nil)
4282         (props (text-properties-at (gnus-point-at-bol)))
4283         (group (gnus-group-group-name)))
4284     (funcall gnus-group-prepare-function level unread lowest)
4285     (if (zerop (buffer-size))
4286         (gnus-message 5 gnus-no-groups-message)
4287       (goto-char (point-max))
4288       (when (or (not gnus-group-goto-next-group-function)
4289                 (not (funcall gnus-group-goto-next-group-function 
4290                               group props)))
4291         (if (not group)
4292             ;; Go to the first group with unread articles.
4293             (gnus-group-search-forward t)
4294           ;; Find the right group to put point on.  If the current group
4295           ;; has disappeared in the new listing, try to find the next
4296           ;; one.        If no next one can be found, just leave point at the
4297           ;; first newsgroup in the buffer.
4298           (if (not (gnus-goto-char
4299                     (text-property-any
4300                      (point-min) (point-max)
4301                      'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
4302               (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
4303                 (while (and newsrc
4304                             (not (gnus-goto-char
4305                                   (text-property-any
4306                                    (point-min) (point-max) 'gnus-group
4307                                    (gnus-intern-safe
4308                                     (car (car newsrc)) gnus-active-hashtb)))))
4309                   (setq newsrc (cdr newsrc)))
4310                 (or newsrc (progn (goto-char (point-max))
4311                                   (forward-line -1)))))))
4312       ;; Adjust cursor point.
4313       (gnus-group-position-point))))
4314
4315 (defun gnus-group-list-level (level &optional all)
4316   "List groups on LEVEL.
4317 If ALL (the prefix), also list groups that have no unread articles."
4318   (interactive "nList groups on level: \nP")
4319   (gnus-group-list-groups level all level))
4320
4321 (defun gnus-group-prepare-flat (level &optional all lowest regexp)
4322   "List all newsgroups with unread articles of level LEVEL or lower.
4323 If ALL is non-nil, list groups that have no unread articles.
4324 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
4325 If REGEXP, only list groups matching REGEXP."
4326   (set-buffer gnus-group-buffer)
4327   (let ((buffer-read-only nil)
4328         (newsrc (cdr gnus-newsrc-alist))
4329         (lowest (or lowest 1))
4330         info clevel unread group params)
4331     (erase-buffer)
4332     (if (< lowest gnus-level-zombie)
4333         ;; List living groups.
4334         (while newsrc
4335           (setq info (car newsrc)
4336                 group (gnus-info-group info)
4337                 params (gnus-info-params info)
4338                 newsrc (cdr newsrc)
4339                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
4340           (and unread                   ; This group might be bogus
4341                (or (not regexp)
4342                    (string-match regexp group))
4343                (<= (setq clevel (gnus-info-level info)) level)
4344                (>= clevel lowest)
4345                (or all                  ; We list all groups?
4346                    (and gnus-group-list-inactive-groups
4347                         (eq unread t))  ; We list unactivated groups
4348                    (> unread 0)         ; We list groups with unread articles
4349                    (and gnus-list-groups-with-ticked-articles
4350                         (cdr (assq 'tick (gnus-info-marks info))))
4351                                         ; And groups with tickeds
4352                    ;; Check for permanent visibility.
4353                    (and gnus-permanently-visible-groups
4354                         (string-match gnus-permanently-visible-groups
4355                                       group))
4356                    (memq 'visible params)
4357                    (cdr (assq 'visible params)))
4358                (gnus-group-insert-group-line
4359                 group (gnus-info-level info)
4360                 (gnus-info-marks info) unread (gnus-info-method info)))))
4361
4362     ;; List dead groups.
4363     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
4364          (gnus-group-prepare-flat-list-dead
4365           (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
4366           gnus-level-zombie ?Z
4367           regexp))
4368     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
4369          (gnus-group-prepare-flat-list-dead
4370           (setq gnus-killed-list (sort gnus-killed-list 'string<))
4371           gnus-level-killed ?K regexp))
4372
4373     (gnus-group-set-mode-line)
4374     (setq gnus-group-list-mode (cons level all))
4375     (run-hooks 'gnus-group-prepare-hook)))
4376
4377 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
4378   ;; List zombies and killed lists somewhat faster, which was
4379   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
4380   ;; this by ignoring the group format specification altogether.
4381   (let (group beg)
4382     (if regexp
4383         ;; This loop is used when listing groups that match some
4384         ;; regexp.
4385         (while groups
4386           (setq group (pop groups))
4387           (when (string-match regexp group)
4388             (add-text-properties
4389              (point) (prog1 (1+ (point))
4390                        (insert " " mark "     *: " group "\n"))
4391              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4392                    'gnus-unread t
4393                    'gnus-level level))))
4394       ;; This loop is used when listing all groups.
4395       (while groups
4396         (add-text-properties
4397          (point) (prog1 (1+ (point))
4398                    (insert " " mark "     *: "
4399                            (setq group (pop groups)) "\n"))
4400          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4401                'gnus-unread t
4402                'gnus-level level))))))
4403
4404 (defmacro gnus-group-real-name (group)
4405   "Find the real name of a foreign newsgroup."
4406   `(let ((gname ,group))
4407      (if (string-match ":[^:]+$" gname)
4408          (substring gname (1+ (match-beginning 0)))
4409        gname)))
4410
4411 (defsubst gnus-server-add-address (method)
4412   (let ((method-name (symbol-name (car method))))
4413     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
4414              (not (assq (intern (concat method-name "-address")) method)))
4415         (append method (list (list (intern (concat method-name "-address"))
4416                                    (nth 1 method))))
4417       method)))
4418
4419 (defsubst gnus-server-get-method (group method)
4420   ;; Input either a server name, and extended server name, or a
4421   ;; select method, and return a select method.
4422   (cond ((stringp method)
4423          (gnus-server-to-method method))
4424         ((and (stringp (car method)) group)
4425          (gnus-server-extend-method group method))
4426         (t
4427          (gnus-server-add-address method))))
4428
4429 (defun gnus-server-to-method (server)
4430   "Map virtual server names to select methods."
4431   (or (and (equal server "native") gnus-select-method)
4432       (cdr (assoc server gnus-server-alist))))
4433
4434 (defmacro gnus-server-equal (ss1 ss2)
4435   "Say whether two servers are equal."
4436   `(let ((s1 ,ss1)
4437          (s2 ,ss2))
4438      (or (equal s1 s2)
4439          (and (= (length s1) (length s2))
4440               (progn
4441                 (while (and s1 (member (car s1) s2))
4442                   (setq s1 (cdr s1)))
4443                 (null s1))))))
4444
4445 (defun gnus-group-prefixed-name (group method)
4446   "Return the whole name from GROUP and METHOD."
4447   (and (stringp method) (setq method (gnus-server-to-method method)))
4448   (concat (format "%s" (car method))
4449           (if (and
4450                (assoc (format "%s" (car method)) (gnus-methods-using 'address))
4451                (not (string= (nth 1 method) "")))
4452               (concat "+" (nth 1 method)))
4453           ":" group))
4454
4455 (defun gnus-group-real-prefix (group)
4456   "Return the prefix of the current group name."
4457   (if (string-match "^[^:]+:" group)
4458       (substring group 0 (match-end 0))
4459     ""))
4460
4461 (defun gnus-group-method-name (group)
4462   "Return the method used for selecting GROUP."
4463   (let ((prefix (gnus-group-real-prefix group)))
4464     (if (equal prefix "")
4465         gnus-select-method
4466       (if (string-match "^[^\\+]+\\+" prefix)
4467           (list (intern (substring prefix 0 (1- (match-end 0))))
4468                 (substring prefix (match-end 0) (1- (length prefix))))
4469         (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
4470
4471 (defsubst gnus-secondary-method-p (method)
4472   "Return whether METHOD is a secondary select method."
4473   (let ((methods gnus-secondary-select-methods)
4474         (gmethod (gnus-server-get-method nil method)))
4475     (while (and methods
4476                 (not (equal (gnus-server-get-method nil (car methods))
4477                             gmethod)))
4478       (setq methods (cdr methods)))
4479     methods))
4480
4481 (defun gnus-group-foreign-p (group)
4482   "Say whether a group is foreign or not."
4483   (and (not (gnus-group-native-p group))
4484        (not (gnus-group-secondary-p group))))
4485
4486 (defun gnus-group-native-p (group)
4487   "Say whether the group is native or not."
4488   (not (string-match ":" group)))
4489
4490 (defun gnus-group-secondary-p (group)
4491   "Say whether the group is secondary or not."
4492   (gnus-secondary-method-p (gnus-find-method-for-group group)))
4493
4494 (defun gnus-group-get-parameter (group &optional symbol)
4495   "Returns the group parameters for GROUP.
4496 If SYMBOL, return the value of that symbol in the group parameters."
4497   (let ((params (gnus-info-params (gnus-get-info group))))
4498     (if symbol
4499         (gnus-group-parameter-value params symbol)
4500       params)))
4501
4502 (defun gnus-group-parameter-value (params symbol)
4503   "Return the value of SYMBOL in group PARAMS."
4504   (or (car (memq symbol params))        ; It's either a simple symbol
4505       (cdr (assq symbol params))))      ; or a cons.
4506
4507 (defun gnus-group-add-parameter (group param)
4508   "Add parameter PARAM to GROUP."
4509   (let ((info (gnus-get-info group)))
4510     (if (not info)
4511         () ; This is a dead group.  We just ignore it.
4512       ;; Cons the new param to the old one and update.
4513       (gnus-group-set-info (cons param (gnus-info-params info))
4514                            group 'params))))
4515
4516 (defun gnus-group-add-score (group &optional score)
4517   "Add SCORE to the GROUP score.
4518 If SCORE is nil, add 1 to the score of GROUP."
4519   (let ((info (gnus-get-info group)))
4520     (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))
4521
4522 (defun gnus-summary-bubble-group ()
4523   "Increase the score of the current group.
4524 This is a handy function to add to `gnus-summary-exit-hook' to
4525 increase the score of each group you read."
4526   (gnus-group-add-score gnus-newsgroup-name))
4527
4528 (defun gnus-group-set-info (info &optional method-only-group part)
4529   (let* ((entry (gnus-gethash
4530                  (or method-only-group (gnus-info-group info))
4531                  gnus-newsrc-hashtb))
4532          (part-info info)
4533          (info (if method-only-group (nth 2 entry) info)))
4534     (when method-only-group
4535       (unless entry
4536         (error "Trying to change non-existent group %s" method-only-group))
4537       ;; We have received parts of the actual group info - either the
4538       ;; select method or the group parameters.  We first check
4539       ;; whether we have to extend the info, and if so, do that.
4540       (let ((len (length info))
4541             (total (if (eq part 'method) 5 6)))
4542         (when (< len total)
4543           (setcdr (nthcdr (1- len) info)
4544                   (make-list (- total len) nil)))
4545         ;; Then we enter the new info.
4546         (setcar (nthcdr (1- total) info) part-info)))
4547     (unless entry
4548       ;; This is a new group, so we just create it.
4549       (save-excursion
4550         (set-buffer gnus-group-buffer)
4551         (if (gnus-info-method info)
4552             ;; It's a foreign group...
4553             (gnus-group-make-group
4554              (gnus-group-real-name (gnus-info-group info))
4555              (prin1-to-string (car (gnus-info-method info)))
4556              (nth 1 (gnus-info-method info)))
4557           ;; It's a native group.
4558           (gnus-group-make-group (gnus-info-group info)))
4559         (gnus-message 6 "Note: New group created")
4560         (setq entry
4561               (gnus-gethash (gnus-group-prefixed-name
4562                              (gnus-group-real-name (gnus-info-group info))
4563                              (or (gnus-info-method info) gnus-select-method))
4564                             gnus-newsrc-hashtb))))
4565     ;; Whether it was a new group or not, we now have the entry, so we
4566     ;; can do the update.
4567     (if entry
4568         (progn
4569           (setcar (nthcdr 2 entry) info)
4570           (when (and (not (eq (car entry) t))
4571                      (gnus-active (gnus-info-group info)))
4572             (let ((marked (gnus-info-marks info)))
4573               (setcar entry (length (gnus-list-of-unread-articles
4574                                      (car info)))))))
4575       (error "No such group: %s" (gnus-info-group info)))))
4576
4577 (defun gnus-group-set-method-info (group select-method)
4578   (gnus-group-set-info select-method group 'method))
4579
4580 (defun gnus-group-set-params-info (group params)
4581   (gnus-group-set-info params group 'params))
4582
4583 (defun gnus-group-update-group-line ()
4584   "Update the current line in the group buffer."
4585   (let* ((buffer-read-only nil)
4586          (group (gnus-group-group-name))
4587          (gnus-group-indentation (gnus-group-group-indentation))
4588          (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
4589     (and entry
4590          (not (gnus-ephemeral-group-p group))
4591          (gnus-dribble-enter
4592           (concat "(gnus-group-set-info '"
4593                   (prin1-to-string (nth 2 entry)) ")")))
4594     (gnus-delete-line)
4595     (gnus-group-insert-group-line-info group)
4596     (forward-line -1)
4597     (gnus-group-position-point)))
4598
4599 (defun gnus-group-insert-group-line-info (group)
4600   "Insert GROUP on the current line."
4601   (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
4602         active info)
4603     (if entry
4604         (progn
4605           ;; (Un)subscribed group.
4606           (setq info (nth 2 entry))
4607           (gnus-group-insert-group-line
4608            group (gnus-info-level info) (gnus-info-marks info)
4609            (or (car entry) t) (gnus-info-method info)))
4610       ;; This group is dead.
4611       (gnus-group-insert-group-line
4612        group
4613        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
4614        nil
4615        (if (setq active (gnus-active group))
4616            (- (1+ (cdr active)) (car active)) 0)
4617        nil))))
4618
4619 (defun gnus-group-insert-group-line
4620   (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number
4621                   gnus-tmp-method)
4622   "Insert a group line in the group buffer."
4623   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
4624          (gnus-tmp-number-total
4625           (if gnus-tmp-active
4626               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
4627             0))
4628          (gnus-tmp-number-of-unread
4629           (if (numberp number) (int-to-string (max 0 number))
4630             "*"))
4631          (gnus-tmp-number-of-read
4632           (if (numberp number)
4633               (int-to-string (max 0 (- gnus-tmp-number-total number)))
4634             "*"))
4635          (gnus-tmp-subscribed
4636           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
4637                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
4638                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
4639                 (t ?K)))
4640          (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
4641          (gnus-tmp-newsgroup-description
4642           (if gnus-description-hashtb
4643               (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
4644             ""))
4645          (gnus-tmp-moderated
4646           (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
4647          (gnus-tmp-moderated-string
4648           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
4649          (gnus-tmp-method
4650           (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
4651          (gnus-tmp-news-server (or (car (cdr gnus-tmp-method)) ""))
4652          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
4653          (gnus-tmp-news-method-string
4654           (if gnus-tmp-method
4655               (format "(%s:%s)" (car gnus-tmp-method)
4656                       (car (cdr gnus-tmp-method))) ""))
4657          (gnus-tmp-marked-mark
4658           (if (and (numberp number)
4659                    (zerop number)
4660                    (cdr (assq 'tick gnus-tmp-marked)))
4661               ?* ? ))
4662          (gnus-tmp-process-marked
4663           (if (member gnus-tmp-group gnus-group-marked)
4664               gnus-process-mark ? ))
4665          (buffer-read-only nil)
4666          header gnus-tmp-header)                        ; passed as parameter to user-funcs.
4667     (beginning-of-line)
4668     (add-text-properties
4669      (point)
4670      (prog1 (1+ (point))
4671        ;; Insert the text.
4672        (eval gnus-group-line-format-spec))
4673      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
4674        gnus-unread ,(if (numberp number)
4675                         (string-to-int gnus-tmp-number-of-unread)
4676                       t)
4677        gnus-marked ,gnus-tmp-marked-mark
4678        gnus-indentation ,gnus-group-indentation
4679        gnus-level ,gnus-tmp-level))
4680     (when (gnus-visual-p 'group-highlight 'highlight)
4681       (forward-line -1)
4682       (run-hooks 'gnus-group-update-hook)
4683       (forward-line))
4684     ;; Allow XEmacs to remove front-sticky text properties.
4685     (gnus-group-remove-excess-properties)))
4686
4687 (defun gnus-group-update-group (group &optional visible-only)
4688   "Update all lines where GROUP appear.
4689 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
4690 already."
4691   (save-excursion
4692     (set-buffer gnus-group-buffer)
4693     ;; The buffer may be narrowed.
4694     (save-restriction
4695       (widen)
4696       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
4697             (loc (point-min))
4698             found buffer-read-only visible)
4699         ;; Enter the current status into the dribble buffer.
4700         (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
4701           (if (and entry (not (gnus-ephemeral-group-p group)))
4702               (gnus-dribble-enter
4703                (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
4704                        ")"))))
4705         ;; Find all group instances.  If topics are in use, each group
4706         ;; may be listed in more than once.
4707         (while (setq loc (text-property-any
4708                           loc (point-max) 'gnus-group ident))
4709           (setq found t)
4710           (goto-char loc)
4711           (let ((gnus-group-indentation (gnus-group-group-indentation)))
4712             (gnus-delete-line)
4713             (gnus-group-insert-group-line-info group))
4714           (setq loc (1+ loc)))
4715         (if (or found visible-only)
4716             ()
4717           ;; No such line in the buffer, find out where it's supposed to
4718           ;; go, and insert it there (or at the end of the buffer).
4719           ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
4720           (let ((entry (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb)))))
4721             (while (and entry (car entry)
4722                         (not
4723                          (gnus-goto-char
4724                           (text-property-any
4725                            (point-min) (point-max)
4726                            'gnus-group (gnus-intern-safe
4727                                         (car (car entry))
4728                                         gnus-active-hashtb)))))
4729               (setq entry (cdr entry)))
4730             (or entry (goto-char (point-max))))
4731           ;; Finally insert the line.
4732           (let ((gnus-group-indentation (gnus-group-group-indentation)))
4733             (gnus-group-insert-group-line-info group)))
4734         (gnus-group-set-mode-line)))))
4735
4736 (defun gnus-group-set-mode-line ()
4737   (when (memq 'group gnus-updated-mode-lines)
4738     (let* ((gformat (or gnus-group-mode-line-format-spec
4739                         (setq gnus-group-mode-line-format-spec
4740                               (gnus-parse-format
4741                                gnus-group-mode-line-format
4742                                gnus-group-mode-line-format-alist))))
4743            (gnus-tmp-news-server (car (cdr gnus-select-method)))
4744            (gnus-tmp-news-method (car gnus-select-method))
4745            (max-len 60)
4746            gnus-tmp-header                      ;Dummy binding for user-defined formats
4747            ;; Get the resulting string.
4748            (mode-string (eval gformat)))
4749       ;; If the line is too long, we chop it off.
4750       (when (> (length mode-string) max-len)
4751         (setq mode-string (substring mode-string 0 (- max-len 4))))
4752       (prog1
4753           (setq mode-line-buffer-identification (list mode-string))
4754         (set-buffer-modified-p t)))))
4755
4756 (defun gnus-group-group-name ()
4757   "Get the name of the newsgroup on the current line."
4758   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
4759     (and group (symbol-name group))))
4760
4761 (defun gnus-group-group-level ()
4762   "Get the level of the newsgroup on the current line."
4763   (get-text-property (gnus-point-at-bol) 'gnus-level))
4764
4765 (defun gnus-group-group-indentation ()
4766   "Get the indentation of the newsgroup on the current line."
4767   (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) ""))
4768
4769 (defun gnus-group-group-unread ()
4770   "Get the number of unread articles of the newsgroup on the current line."
4771   (get-text-property (gnus-point-at-bol) 'gnus-unread))
4772
4773 (defun gnus-group-search-forward (&optional backward all level first-too)
4774   "Find the next newsgroup with unread articles.
4775 If BACKWARD is non-nil, find the previous newsgroup instead.
4776 If ALL is non-nil, just find any newsgroup.
4777 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
4778 group exists.
4779 If FIRST-TOO, the current line is also eligible as a target."
4780   (let ((way (if backward -1 1))
4781         (low gnus-level-killed)
4782         (beg (point))
4783         pos found lev)
4784     (if (and backward (progn (beginning-of-line)) (bobp))
4785         nil
4786       (or first-too (forward-line way))
4787       (while (and
4788               (not (eobp))
4789               (not (setq
4790                     found
4791                     (and (or all
4792                              (and
4793                               (let ((unread
4794                                      (get-text-property (point) 'gnus-unread)))
4795                                 (and (numberp unread) (> unread 0)))
4796                               (setq lev (get-text-property (point)
4797                                                            'gnus-level))
4798                               (<= lev gnus-level-subscribed)))
4799                          (or (not level)
4800                              (and (setq lev (get-text-property (point)
4801                                                                'gnus-level))
4802                                   (or (= lev level)
4803                                       (and (< lev low)
4804                                            (< level lev)
4805                                            (progn
4806                                              (setq low lev)
4807                                              (setq pos (point))
4808                                              nil))))))))
4809               (zerop (forward-line way)))))
4810     (if found
4811         (progn (gnus-group-position-point) t)
4812       (goto-char (or pos beg))
4813       (and pos t))))
4814
4815 ;;; Gnus group mode commands
4816
4817 ;; Group marking.
4818
4819 (defun gnus-group-mark-group (n &optional unmark no-advance)
4820   "Mark the current group."
4821   (interactive "p")
4822   (let ((buffer-read-only nil)
4823         group)
4824     (while
4825         (and (> n 0)
4826              (setq group (gnus-group-group-name))
4827              (progn
4828                (beginning-of-line)
4829                (forward-char
4830                 (or (cdr (assq 'process gnus-group-mark-positions)) 2))
4831                (delete-char 1)
4832                (if unmark
4833                    (progn
4834                      (insert " ")
4835                      (setq gnus-group-marked (delete group gnus-group-marked)))
4836                  (insert "#")
4837                  (setq gnus-group-marked
4838                        (cons group (delete group gnus-group-marked))))
4839                t)
4840              (or no-advance (zerop (gnus-group-next-group 1))))
4841       (setq n (1- n)))
4842     (gnus-summary-position-point)
4843     n))
4844
4845 (defun gnus-group-unmark-group (n)
4846   "Remove the mark from the current group."
4847   (interactive "p")
4848   (gnus-group-mark-group n 'unmark)
4849   (gnus-group-position-point))
4850
4851 (defun gnus-group-unmark-all-groups ()
4852   "Unmark all groups."
4853   (let ((groups gnus-group-marked))
4854     (save-excursion
4855       (while groups
4856         (gnus-group-remove-mark (pop groups)))))
4857   (gnus-group-position-point))
4858
4859 (defun gnus-group-mark-region (unmark beg end)
4860   "Mark all groups between point and mark.
4861 If UNMARK, remove the mark instead."
4862   (interactive "P\nr")
4863   (let ((num (count-lines beg end)))
4864     (save-excursion
4865       (goto-char beg)
4866       (- num (gnus-group-mark-group num unmark)))))
4867
4868 (defun gnus-group-mark-buffer (&optional unmark)
4869   "Mark all groups in the buffer.
4870 If UNMARK, remove the mark instead."
4871   (interactive "P")
4872   (gnus-group-mark-region unmark (point-min) (point-max)))
4873
4874 (defun gnus-group-mark-regexp (regexp)
4875   "Mark all groups that match some regexp."
4876   (interactive "sMark (regexp): ")
4877   (let ((alist (cdr gnus-newsrc-alist))
4878         group)
4879     (while alist
4880       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
4881         (gnus-group-set-mark group))))
4882   (gnus-group-position-point))
4883
4884 (defun gnus-group-remove-mark (group)
4885   "Remove the process mark from GROUP and move point there.
4886 Return nil if the group isn't displayed."
4887   (if (gnus-group-goto-group group)
4888       (save-excursion
4889         (gnus-group-mark-group 1 'unmark t)
4890         t)
4891     (setq gnus-group-marked
4892           (delete group gnus-group-marked))
4893     nil))
4894
4895 (defun gnus-group-set-mark (group)
4896   "Set the process mark on GROUP."
4897   (if (gnus-group-goto-group group)
4898       (save-excursion
4899         (gnus-group-mark-group 1 nil t))
4900     (setq gnus-group-marked
4901           (cons group (delete group gnus-group-marked)))))
4902
4903 (defun gnus-group-universal-argument (arg &optional groups func)
4904   "Perform any command on all groups accoring to the process/prefix convention."
4905   (interactive "P")
4906   (let ((groups (or groups (gnus-group-process-prefix arg)))
4907         group func)
4908     (if (eq (setq func (or func
4909                            (key-binding
4910                             (read-key-sequence
4911                              (substitute-command-keys
4912                               "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
4913             'undefined)
4914         (progn
4915           (message "Undefined key")
4916           (ding))
4917       (while groups
4918         (gnus-group-remove-mark (setq group (pop groups)))
4919         (command-execute func))))
4920   (gnus-group-position-point))
4921
4922 (defun gnus-group-process-prefix (n)
4923   "Return a list of groups to work on.
4924 Take into consideration N (the prefix) and the list of marked groups."
4925   (cond
4926    (n
4927     (setq n (prefix-numeric-value n))
4928     ;; There is a prefix, so we return a list of the N next
4929     ;; groups.
4930     (let ((way (if (< n 0) -1 1))
4931           (n (abs n))
4932           group groups)
4933       (save-excursion
4934         (while (and (> n 0)
4935                     (setq group (gnus-group-group-name)))
4936           (setq groups (cons group groups))
4937           (setq n (1- n))
4938           (gnus-group-next-group way)))
4939       (nreverse groups)))
4940    ((and (boundp 'transient-mark-mode)
4941          transient-mark-mode
4942          mark-active)
4943     ;; Work on the region between point and mark.
4944     (let ((max (max (point) (mark)))
4945           groups)
4946       (save-excursion
4947         (goto-char (min (point) (mark)))
4948         (while
4949             (and
4950              (push (gnus-group-group-name) groups)
4951              (zerop (gnus-group-next-group 1))
4952              (< (point) max)))
4953         (nreverse groups))))
4954    (gnus-group-marked
4955     ;; No prefix, but a list of marked articles.
4956     (reverse gnus-group-marked))
4957    (t
4958     ;; Neither marked articles or a prefix, so we return the
4959     ;; current group.
4960     (let ((group (gnus-group-group-name)))
4961       (and group (list group))))))
4962
4963 ;; Selecting groups.
4964
4965 (defun gnus-group-read-group (&optional all no-article group)
4966   "Read news in this newsgroup.
4967 If the prefix argument ALL is non-nil, already read articles become
4968 readable.  IF ALL is a number, fetch this number of articles.  If the
4969 optional argument NO-ARTICLE is non-nil, no article will be
4970 auto-selected upon group entry.  If GROUP is non-nil, fetch that
4971 group."
4972   (interactive "P")
4973   (let ((group (or group (gnus-group-group-name)))
4974         number active marked entry)
4975     (or group (error "No group on current line"))
4976     (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
4977                                             group gnus-newsrc-hashtb)))))
4978     ;; This group might be a dead group.  In that case we have to get
4979     ;; the number of unread articles from `gnus-active-hashtb'.
4980     (setq number
4981           (cond ((numberp all) all)
4982                 (entry (car entry))
4983                 ((setq active (gnus-active group))
4984                  (- (1+ (cdr active)) (car active)))))
4985     (gnus-summary-read-group
4986      group (or all (and (numberp number)
4987                         (zerop (+ number (length (cdr (assq 'tick marked)))
4988                                   (length (cdr (assq 'dormant marked)))))))
4989      no-article)))
4990
4991 (defun gnus-group-select-group (&optional all)
4992   "Select this newsgroup.
4993 No article is selected automatically.
4994 If ALL is non-nil, already read articles become readable.
4995 If ALL is a number, fetch this number of articles."
4996   (interactive "P")
4997   (gnus-group-read-group all t))
4998
4999 (defun gnus-group-quick-select-group (&optional all)
5000   "Select the current group \"quickly\".
5001 This means that no highlighting or scoring will be performed."
5002   (interactive "P")
5003   (let (gnus-visual
5004         gnus-score-find-score-files-function
5005         gnus-apply-kill-hook
5006         gnus-summary-expunge-below)
5007     (gnus-group-read-group all t)))
5008
5009 (defun gnus-group-visible-select-group (&optional all)
5010   "Select the current group without hiding any articles."
5011   (interactive "P")
5012   (let ((gnus-inhibit-limiting t))
5013     (gnus-group-read-group all t)))
5014
5015 ;;;###autoload
5016 (defun gnus-fetch-group (group)
5017   "Start Gnus if necessary and enter GROUP.
5018 Returns whether the fetching was successful or not."
5019   (interactive "sGroup name: ")
5020   (or (get-buffer gnus-group-buffer)
5021       (gnus))
5022   (gnus-group-select-group))
5023
5024 ;; Enter a group that is not in the group buffer.  Non-nil is returned
5025 ;; if selection was successful.
5026 (defun gnus-group-read-ephemeral-group
5027   (group method &optional activate quit-config)
5028   (let ((group (if (gnus-group-foreign-p group) group
5029                  (gnus-group-prefixed-name group method))))
5030     (gnus-sethash
5031      group
5032      (list t nil (list group gnus-level-default-subscribed nil nil
5033                        (append method
5034                                (list
5035                                 (list 'quit-config
5036                                       (if quit-config quit-config
5037                                         (cons (current-buffer) 'summary)))))))
5038      gnus-newsrc-hashtb)
5039     (set-buffer gnus-group-buffer)
5040     (or (gnus-check-server method)
5041         (error "Unable to contact server: %s" (gnus-status-message method)))
5042     (if activate (or (gnus-request-group group)
5043                      (error "Couldn't request group")))
5044     (condition-case ()
5045         (gnus-group-read-group t t group)
5046       (error nil)
5047       (quit nil))))
5048
5049 (defun gnus-group-jump-to-group (group)
5050   "Jump to newsgroup GROUP."
5051   (interactive
5052    (list (completing-read
5053           "Group: " gnus-active-hashtb nil
5054           (memq gnus-select-method gnus-have-read-active-file))))
5055
5056   (if (equal group "")
5057       (error "Empty group name"))
5058
5059   (let ((b (text-property-any
5060             (point-min) (point-max)
5061             'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
5062     (if b
5063         ;; Either go to the line in the group buffer...
5064         (goto-char b)
5065       ;; ... or insert the line.
5066       (or
5067        (gnus-active group)
5068        (gnus-activate-group group)
5069        (error "%s error: %s" group (gnus-status-message group)))
5070
5071       (gnus-group-update-group group)
5072       (goto-char (text-property-any
5073                   (point-min) (point-max)
5074                   'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
5075   ;; Adjust cursor point.
5076   (gnus-group-position-point))
5077
5078 (defun gnus-group-goto-group (group)
5079   "Goto to newsgroup GROUP."
5080   (when group
5081     (let ((b (text-property-any (point-min) (point-max)
5082                                 'gnus-group (gnus-intern-safe
5083                                              group gnus-active-hashtb))))
5084       (and b (goto-char b)))))
5085
5086 (defun gnus-group-next-group (n)
5087   "Go to next N'th newsgroup.
5088 If N is negative, search backward instead.
5089 Returns the difference between N and the number of skips actually
5090 done."
5091   (interactive "p")
5092   (gnus-group-next-unread-group n t))
5093
5094 (defun gnus-group-next-unread-group (n &optional all level)
5095   "Go to next N'th unread newsgroup.
5096 If N is negative, search backward instead.
5097 If ALL is non-nil, choose any newsgroup, unread or not.
5098 If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
5099 such group can be found, the next group with a level higher than
5100 LEVEL.
5101 Returns the difference between N and the number of skips actually
5102 made."
5103   (interactive "p")
5104   (let ((backward (< n 0))
5105         (n (abs n)))
5106     (while (and (> n 0)
5107                 (gnus-group-search-forward
5108                  backward (or (not gnus-group-goto-unread) all) level))
5109       (setq n (1- n)))
5110     (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
5111                                (if level " on this level or higher" "")))
5112     n))
5113
5114 (defun gnus-group-prev-group (n)
5115   "Go to previous N'th newsgroup.
5116 Returns the difference between N and the number of skips actually
5117 done."
5118   (interactive "p")
5119   (gnus-group-next-unread-group (- n) t))
5120
5121 (defun gnus-group-prev-unread-group (n)
5122   "Go to previous N'th unread newsgroup.
5123 Returns the difference between N and the number of skips actually
5124 done."
5125   (interactive "p")
5126   (gnus-group-next-unread-group (- n)))
5127
5128 (defun gnus-group-next-unread-group-same-level (n)
5129   "Go to next N'th unread newsgroup on the same level.
5130 If N is negative, search backward instead.
5131 Returns the difference between N and the number of skips actually
5132 done."
5133   (interactive "p")
5134   (gnus-group-next-unread-group n t (gnus-group-group-level))
5135   (gnus-group-position-point))
5136
5137 (defun gnus-group-prev-unread-group-same-level (n)
5138   "Go to next N'th unread newsgroup on the same level.
5139 Returns the difference between N and the number of skips actually
5140 done."
5141   (interactive "p")
5142   (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
5143   (gnus-group-position-point))
5144
5145 (defun gnus-group-best-unread-group (&optional exclude-group)
5146   "Go to the group with the highest level.
5147 If EXCLUDE-GROUP, do not go to that group."
5148   (interactive)
5149   (goto-char (point-min))
5150   (let ((best 100000)
5151         unread best-point)
5152     (while (setq unread (get-text-property (point) 'gnus-unread))
5153       (if (and (numberp unread) (> unread 0))
5154           (progn
5155             (if (and (< (get-text-property (point) 'gnus-level) best)
5156                      (or (not exclude-group)
5157                          (not (equal exclude-group (gnus-group-group-name)))))
5158                 (progn
5159                   (setq best (get-text-property (point) 'gnus-level))
5160                   (setq best-point (point))))))
5161       (forward-line 1))
5162     (if best-point (goto-char best-point))
5163     (gnus-summary-position-point)
5164     (and best-point (gnus-group-group-name))))
5165
5166 (defun gnus-group-first-unread-group ()
5167   "Go to the first group with unread articles."
5168   (interactive)
5169   (prog1
5170       (let ((opoint (point))
5171             unread)
5172         (goto-char (point-min))
5173         (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
5174                 (and (numberp unread)   ; Not a topic.
5175                      (not (zerop unread))) ; Has unread articles.
5176                 (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
5177             (point)                     ; Success.
5178           (goto-char opoint)
5179           nil))                         ; Not success.
5180     (gnus-group-position-point)))
5181
5182 (defun gnus-group-enter-server-mode ()
5183   "Jump to the server buffer."
5184   (interactive)
5185   (gnus-enter-server-buffer))
5186
5187 (defun gnus-group-make-group (name &optional method address)
5188   "Add a new newsgroup.
5189 The user will be prompted for a NAME, for a select METHOD, and an
5190 ADDRESS."
5191   (interactive
5192    (cons
5193     (read-string "Group name: ")
5194     (let ((method
5195            (completing-read
5196             "Method: " (append gnus-valid-select-methods gnus-server-alist)
5197             nil t)))
5198       (if (assoc method gnus-valid-select-methods)
5199           (list method
5200                 (if (memq 'prompt-address
5201                           (assoc method gnus-valid-select-methods))
5202                     (read-string "Address: ")
5203                   ""))
5204         (list method nil)))))
5205
5206   (save-excursion
5207     (set-buffer gnus-group-buffer)
5208     (let* ((meth (and method (if address (list (intern method) address)
5209                                method)))
5210            (nname (if method (gnus-group-prefixed-name name meth) name))
5211            info)
5212       (and (gnus-gethash nname gnus-newsrc-hashtb)
5213            (error "Group %s already exists" nname))
5214       (gnus-group-change-level
5215        (setq info (list t nname gnus-level-default-subscribed nil nil meth))
5216        gnus-level-default-subscribed gnus-level-killed
5217        (and (gnus-group-group-name)
5218             (gnus-gethash (gnus-group-group-name)
5219                           gnus-newsrc-hashtb))
5220        t)
5221       (gnus-set-active nname (cons 1 0))
5222       (or (gnus-ephemeral-group-p name)
5223           (gnus-dribble-enter
5224            (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
5225       (gnus-group-insert-group-line-info nname)
5226
5227       (if (assoc method gnus-valid-select-methods)
5228           (require (intern method)))
5229       (and (gnus-check-backend-function 'request-create-group nname)
5230            (gnus-request-create-group nname))
5231       t)))
5232
5233 (defun gnus-group-delete-group (group &optional force)
5234   "Delete the current group.
5235 If FORCE (the prefix) is non-nil, all the articles in the group will
5236 be deleted.  This is \"deleted\" as in \"removed forever from the face
5237 of the Earth\".  There is no undo."
5238   (interactive
5239    (list (gnus-group-group-name)
5240          current-prefix-arg))
5241   (or group (error "No group to rename"))
5242   (or (gnus-check-backend-function 'request-delete-group group)
5243       (error "This backend does not support group deletion"))
5244   (prog1
5245       (if (not (gnus-yes-or-no-p
5246                 (format
5247                  "Do you really want to delete %s%s? "
5248                  group (if force " and all its contents" ""))))
5249           () ; Whew!
5250         (gnus-message 6 "Deleting group %s..." group)
5251         (if (not (gnus-request-delete-group group force))
5252             (progn
5253               (gnus-message 3 "Couldn't delete group %s" group)
5254               (ding))
5255           (gnus-message 6 "Deleting group %s...done" group)
5256           (gnus-group-goto-group group)
5257           (gnus-group-kill-group 1 t)
5258           t))
5259     (gnus-group-position-point)))
5260
5261 (defun gnus-group-rename-group (group new-name)
5262   (interactive
5263    (list
5264     (gnus-group-group-name)
5265     (progn
5266       (or (gnus-check-backend-function
5267            'request-rename-group (gnus-group-group-name))
5268           (error "This backend does not support renaming groups"))
5269       (read-string "New group name: "))))
5270
5271   (or (gnus-check-backend-function 'request-rename-group group)
5272       (error "This backend does not support renaming groups"))
5273
5274   (or group (error "No group to rename"))
5275   (and (string-match "^[ \t]*$" new-name)
5276        (error "Not a valid group name"))
5277
5278   ;; We find the proper prefixed name.
5279   (setq new-name
5280         (gnus-group-prefixed-name
5281          (gnus-group-real-name new-name)
5282          (gnus-info-method (gnus-get-info group))))
5283
5284   (gnus-message 6 "Renaming group %s to %s..." group new-name)
5285   (prog1
5286       (if (not (gnus-request-rename-group group new-name))
5287           (progn
5288             (gnus-message 3 "Couldn't rename group %s to %s" group new-name)
5289             (ding))
5290         ;; We rename the group internally by killing it...
5291         (gnus-group-goto-group group)
5292         (gnus-group-kill-group)
5293         ;; ... changing its name ...
5294         (setcar (cdr (car gnus-list-of-killed-groups))
5295                 new-name)
5296         ;; ... and then yanking it.  Magic!
5297         (gnus-group-yank-group)
5298         (gnus-set-active new-name (gnus-active group))
5299         (gnus-message 6 "Renaming group %s to %s...done" group new-name)
5300         new-name)
5301     (gnus-group-position-point)))
5302
5303
5304 (defun gnus-group-edit-group (group &optional part)
5305   "Edit the group on the current line."
5306   (interactive (list (gnus-group-group-name)))
5307   (let ((done-func '(lambda ()
5308                       "Exit editing mode and update the information."
5309                       (interactive)
5310                       (gnus-group-edit-group-done 'part 'group)))
5311         (part (or part 'info))
5312         (winconf (current-window-configuration))
5313         info)
5314     (or group (error "No group on current line"))
5315     (or (setq info (gnus-get-info group))
5316         (error "Killed group; can't be edited"))
5317     (set-buffer (get-buffer-create gnus-group-edit-buffer))
5318     (gnus-configure-windows 'edit-group)
5319     (gnus-add-current-to-buffer-list)
5320     (emacs-lisp-mode)
5321     ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
5322     (use-local-map (copy-keymap emacs-lisp-mode-map))
5323     (local-set-key "\C-c\C-c" done-func)
5324     (make-local-variable 'gnus-prev-winconf)
5325     (setq gnus-prev-winconf winconf)
5326     ;; We modify the func to let it know what part it is editing.
5327     (setcar (cdr (nth 4 done-func)) (list 'quote part))
5328     (setcar (cdr (cdr (nth 4 done-func))) group)
5329     (erase-buffer)
5330     (insert
5331      (cond
5332       ((eq part 'method)
5333        ";; Type `C-c C-c' after editing the select method.\n\n")
5334       ((eq part 'params)
5335        ";; Type `C-c C-c' after editing the group parameters.\n\n")
5336       ((eq part 'info)
5337        ";; Type `C-c C-c' after editing the group info.\n\n")))
5338     (insert
5339      (pp-to-string
5340       (cond ((eq part 'method)
5341              (or (gnus-info-method info) "native"))
5342             ((eq part 'params)
5343              (gnus-info-params info))
5344             (t info)))
5345      "\n")))
5346
5347 (defun gnus-group-edit-group-method (group)
5348   "Edit the select method of GROUP."
5349   (interactive (list (gnus-group-group-name)))
5350   (gnus-group-edit-group group 'method))
5351
5352 (defun gnus-group-edit-group-parameters (group)
5353   "Edit the group parameters of GROUP."
5354   (interactive (list (gnus-group-group-name)))
5355   (gnus-group-edit-group group 'params))
5356
5357 (defun gnus-group-edit-group-done (part group)
5358   "Get info from buffer, update variables and jump to the group buffer."
5359   (set-buffer (get-buffer-create gnus-group-edit-buffer))
5360   (goto-char (point-min))
5361   (let* ((form (read (current-buffer)))
5362          (winconf gnus-prev-winconf)
5363          (new-group (when (eq part 'info)
5364                       (if (or (not (nth 4 form))
5365                               (gnus-server-equal
5366                                gnus-select-method (nth 4 form)))
5367                           (gnus-group-real-name (car form))
5368                         (gnus-group-prefixed-name
5369                          (gnus-group-real-name (car form)) (nth 4 form))))))
5370     ;; Set the info.
5371     (if (eq part 'info)
5372         (progn
5373           (when new-group (setcar form new-group))
5374           (gnus-group-set-info form))
5375       (gnus-group-set-info form group part))
5376     (kill-buffer (current-buffer))
5377     (and winconf (set-window-configuration winconf))
5378     (set-buffer gnus-group-buffer)
5379     (when (and new-group
5380              (not (equal new-group group)))
5381       (when (gnus-group-goto-group group)
5382         (gnus-group-kill-group 1))
5383       (gnus-activate-group new-group))
5384     (gnus-group-update-group (or new-group group))
5385     (gnus-group-position-point)))
5386
5387 (defun gnus-group-make-help-group ()
5388   "Create the Gnus documentation group."
5389   (interactive)
5390   (let ((path load-path)
5391         (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
5392         file dir)
5393     (and (gnus-gethash name gnus-newsrc-hashtb)
5394          (error "Documentation group already exists"))
5395     (while path
5396       (setq dir (file-name-as-directory (expand-file-name (pop path)))
5397             file nil)
5398       (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt")))
5399                 (file-exists-p
5400                  (setq file (concat (file-name-directory
5401                                      (directory-file-name dir))
5402                                     "etc/gnus-tut.txt"))))
5403         (setq path nil)))
5404     (if (not file)
5405         (message "Couldn't find doc group")
5406       (gnus-group-make-group
5407        (gnus-group-real-name name)
5408        (list 'nndoc name
5409              (list 'nndoc-address file)
5410              (list 'nndoc-article-type 'mbox)))))
5411   (gnus-group-position-point))
5412
5413 (defun gnus-group-make-doc-group (file type)
5414   "Create a group that uses a single file as the source."
5415   (interactive
5416    (list (read-file-name "File name: ")
5417          (and current-prefix-arg 'ask)))
5418   (when (eq type 'ask)
5419     (let ((err "")
5420           char found)
5421       (while (not found)
5422         (message
5423          "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
5424          err)
5425         (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
5426                           ((= char ?b) 'babyl)
5427                           ((= char ?d) 'digest)
5428                           ((= char ?f) 'forward)
5429                           ((= char ?a) 'mmfd)
5430                           (t (setq err (format "%c unknown. " char))
5431                              nil))))
5432       (setq type found)))
5433   (let* ((file (expand-file-name file))
5434          (name (gnus-generate-new-group-name
5435                 (gnus-group-prefixed-name
5436                  (file-name-nondirectory file) '(nndoc "")))))
5437     (gnus-group-make-group
5438      (gnus-group-real-name name)
5439      (list 'nndoc name
5440            (list 'nndoc-address file)
5441            (list 'nndoc-article-type (or type 'guess))))
5442     (forward-line -1)
5443     (gnus-group-position-point)))
5444
5445 (defun gnus-group-make-archive-group (&optional all)
5446   "Create the (ding) Gnus archive group of the most recent articles.
5447 Given a prefix, create a full group."
5448   (interactive "P")
5449   (let ((group (gnus-group-prefixed-name
5450                 (if all "ding.archives" "ding.recent") '(nndir ""))))
5451     (and (gnus-gethash group gnus-newsrc-hashtb)
5452          (error "Archive group already exists"))
5453     (gnus-group-make-group
5454      (gnus-group-real-name group)
5455      (list 'nndir (if all "hpc" "edu")
5456            (list 'nndir-directory
5457                  (if all gnus-group-archive-directory
5458                    gnus-group-recent-archive-directory)))))
5459   (forward-line -1)
5460   (gnus-group-position-point))
5461
5462 (defun gnus-group-make-directory-group (dir)
5463   "Create an nndir group.
5464 The user will be prompted for a directory.  The contents of this
5465 directory will be used as a newsgroup.  The directory should contain
5466 mail messages or news articles in files that have numeric names."
5467   (interactive
5468    (list (read-file-name "Create group from directory: ")))
5469   (or (file-exists-p dir) (error "No such directory"))
5470   (or (file-directory-p dir) (error "Not a directory"))
5471   (let ((ext "")
5472         (i 0)
5473         group)
5474     (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
5475       (setq group
5476             (gnus-group-prefixed-name
5477              (concat (file-name-as-directory (directory-file-name dir))
5478                      ext)
5479              '(nndir "")))
5480       (setq ext (format "<%d>" (setq i (1+ i)))))
5481     (gnus-group-make-group
5482      (gnus-group-real-name group)
5483      (list 'nndir group (list 'nndir-directory dir))))
5484   (forward-line -1)
5485   (gnus-group-position-point))
5486
5487 (defun gnus-group-make-kiboze-group (group address scores)
5488   "Create an nnkiboze group.
5489 The user will be prompted for a name, a regexp to match groups, and
5490 score file entries for articles to include in the group."
5491   (interactive
5492    (list
5493     (read-string "nnkiboze group name: ")
5494     (read-string "Source groups (regexp): ")
5495     (let ((headers (mapcar (lambda (group) (list group))
5496                            '("subject" "from" "number" "date" "message-id"
5497                              "references" "chars" "lines" "xref"
5498                              "followup" "all" "body" "head")))
5499           scores header regexp regexps)
5500       (while (not (equal "" (setq header (completing-read
5501                                           "Match on header: " headers nil t))))
5502         (setq regexps nil)
5503         (while (not (equal "" (setq regexp (read-string
5504                                             (format "Match on %s (string): "
5505                                                     header)))))
5506           (setq regexps (cons (list regexp nil nil 'r) regexps)))
5507         (setq scores (cons (cons header regexps) scores)))
5508       scores)))
5509   (gnus-group-make-group group "nnkiboze" address)
5510   (save-excursion
5511     (gnus-set-work-buffer)
5512     (let (emacs-lisp-mode-hook)
5513       (pp scores (current-buffer)))
5514     (write-region (point-min) (point-max)
5515                   (gnus-score-file-name (concat "nnkiboze:" group))))
5516   (forward-line -1)
5517   (gnus-group-position-point))
5518
5519 (defun gnus-group-add-to-virtual (n vgroup)
5520   "Add the current group to a virtual group."
5521   (interactive
5522    (list current-prefix-arg
5523          (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
5524                           "nnvirtual:")))
5525   (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
5526       (error "%s is not an nnvirtual group" vgroup))
5527   (let* ((groups (gnus-group-process-prefix n))
5528          (method (gnus-info-method (gnus-get-info vgroup))))
5529     (setcar (cdr method)
5530             (concat
5531              (nth 1 method) "\\|"
5532              (mapconcat
5533               (lambda (s)
5534                 (gnus-group-remove-mark s)
5535                 (concat "\\(^" (regexp-quote s) "$\\)"))
5536               groups "\\|"))))
5537   (gnus-group-position-point))
5538
5539 (defun gnus-group-make-empty-virtual (group)
5540   "Create a new, fresh, empty virtual group."
5541   (interactive "sCreate new, empty virtual group: ")
5542   (let* ((method (list 'nnvirtual "^$"))
5543          (pgroup (gnus-group-prefixed-name group method)))
5544     ;; Check whether it exists already.
5545     (and (gnus-gethash pgroup gnus-newsrc-hashtb)
5546          (error "Group %s already exists." pgroup))
5547     ;; Subscribe the new group after the group on the current line.
5548     (gnus-subscribe-group pgroup (gnus-group-group-name) method)
5549     (gnus-group-update-group pgroup)
5550     (forward-line -1)
5551     (gnus-group-position-point)))
5552
5553 (defun gnus-group-enter-directory (dir)
5554   "Enter an ephemeral nneething group."
5555   (interactive "DDirectory to read: ")
5556   (let* ((method (list 'nneething dir))
5557          (leaf (gnus-group-prefixed-name
5558                 (file-name-nondirectory (directory-file-name dir))
5559                 method))
5560          (name (gnus-generate-new-group-name leaf)))
5561     (let ((nneething-read-only t))
5562       (or (gnus-group-read-ephemeral-group
5563            name method t
5564            (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
5565                                       'summary 'group)))
5566           (error "Couldn't enter %s" dir)))))
5567
5568 ;; Group sorting commands
5569 ;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
5570
5571 (defun gnus-group-sort-groups (func &optional reverse)
5572   "Sort the group buffer according to FUNC.
5573 If REVERSE, reverse the sorting order."
5574   (interactive (list gnus-group-sort-function
5575                      current-prefix-arg))
5576   (let ((func (cond 
5577                ((not (listp func)) func)
5578                ((null func) func)
5579                ((= 1 (length func)) (car func))
5580                (t `(lambda (t1 t2)
5581                      ,(gnus-make-sort-function 
5582                        (reverse func)))))))
5583     ;; We peel off the dummy group from the alist.
5584     (when func
5585       (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
5586         (pop gnus-newsrc-alist))
5587       ;; Do the sorting.
5588       (setq gnus-newsrc-alist
5589             (sort gnus-newsrc-alist func))
5590       (when reverse
5591         (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
5592       ;; Regenerate the hash table.
5593       (gnus-make-hashtable-from-newsrc-alist)
5594       (gnus-group-list-groups))))
5595
5596 (defun gnus-group-sort-groups-by-alphabet (&optional reverse)
5597   "Sort the group buffer alphabetically by group name.
5598 If REVERSE, sort in reverse order."
5599   (interactive "P")
5600   (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
5601
5602 (defun gnus-group-sort-groups-by-unread (&optional reverse)
5603   "Sort the group buffer by number of unread articles.
5604 If REVERSE, sort in reverse order."
5605   (interactive "P")
5606   (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
5607
5608 (defun gnus-group-sort-groups-by-level (&optional reverse)
5609   "Sort the group buffer by group level.
5610 If REVERSE, sort in reverse order."
5611   (interactive "P")
5612   (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
5613
5614 (defun gnus-group-sort-groups-by-score (&optional reverse)
5615   "Sort the group buffer by group score.
5616 If REVERSE, sort in reverse order."
5617   (interactive "P")
5618   (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
5619
5620 (defun gnus-group-sort-groups-by-rank (&optional reverse)
5621   "Sort the group buffer by group rank.
5622 If REVERSE, sort in reverse order."
5623   (interactive "P")
5624   (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
5625
5626 (defun gnus-group-sort-groups-by-method (&optional reverse)
5627   "Sort the group buffer alphabetically by backend name.
5628 If REVERSE, sort in reverse order."
5629   (interactive "P")
5630   (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
5631
5632 (defun gnus-group-sort-by-alphabet (info1 info2)
5633   "Sort alphabetically."
5634   (string< (gnus-info-group info1) (gnus-info-group info2)))
5635
5636 (defun gnus-group-sort-by-unread (info1 info2)
5637   "Sort by number of unread articles."
5638   (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
5639         (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
5640     (< (or (and (numberp n1) n1) 0)
5641        (or (and (numberp n2) n2) 0))))
5642
5643 (defun gnus-group-sort-by-level (info1 info2)
5644   "Sort by level."
5645   (< (gnus-info-level info1) (gnus-info-level info2)))
5646
5647 (defun gnus-group-sort-by-method (info1 info2)
5648   "Sort alphabetically by backend name."
5649   (string< (symbol-name (car (gnus-find-method-for-group
5650                               (gnus-info-group info1) info1)))
5651            (symbol-name (car (gnus-find-method-for-group
5652                               (gnus-info-group info2) info2)))))
5653
5654 (defun gnus-group-sort-by-score (info1 info2)
5655   "Sort by group score."
5656   (< (gnus-info-score info1) (gnus-info-score info2)))
5657
5658 (defun gnus-group-sort-by-rank (info1 info2)
5659   "Sort by level and score."
5660   (let ((level1 (gnus-info-level info1))
5661         (level2 (gnus-info-level info2)))
5662     (or (< level1 level2)
5663         (and (= level1 level2)
5664              (< (gnus-info-score info1) (gnus-info-score info2))))))
5665
5666 ;; Group catching up.
5667
5668 (defun gnus-group-catchup-current (&optional n all)
5669   "Mark all articles not marked as unread in current newsgroup as read.
5670 If prefix argument N is numeric, the ARG next newsgroups will be
5671 caught up.  If ALL is non-nil, marked articles will also be marked as
5672 read.  Cross references (Xref: header) of articles are ignored.
5673 The difference between N and actual number of newsgroups that were
5674 caught up is returned."
5675   (interactive "P")
5676   (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
5677                gnus-expert-user
5678                (gnus-y-or-n-p
5679                 (if all
5680                     "Do you really want to mark all articles as read? "
5681                   "Mark all unread articles as read? "))))
5682       n
5683     (let ((groups (gnus-group-process-prefix n))
5684           (ret 0))
5685       (while groups
5686         ;; Virtual groups have to be given special treatment.
5687         (let ((method (gnus-find-method-for-group (car groups))))
5688           (if (eq 'nnvirtual (car method))
5689               (nnvirtual-catchup-group
5690                (gnus-group-real-name (car groups)) (nth 1 method) all)))
5691         (gnus-group-remove-mark (car groups))
5692         (if (prog1
5693                 (gnus-group-goto-group (car groups))
5694               (gnus-group-catchup (car groups) all))
5695             (gnus-group-update-group-line)
5696           (setq ret (1+ ret)))
5697         (setq groups (cdr groups)))
5698       (gnus-group-next-unread-group 1)
5699       ret)))
5700
5701 (defun gnus-group-catchup-current-all (&optional n)
5702   "Mark all articles in current newsgroup as read.
5703 Cross references (Xref: header) of articles are ignored."
5704   (interactive "P")
5705   (gnus-group-catchup-current n 'all))
5706
5707 (defun gnus-group-catchup (group &optional all)
5708   "Mark all articles in GROUP as read.
5709 If ALL is non-nil, all articles are marked as read.
5710 The return value is the number of articles that were marked as read,
5711 or nil if no action could be taken."
5712   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
5713          (num (car entry)))
5714     ;; Do the updating only if the newsgroup isn't killed.
5715     (if (not (numberp (car entry)))
5716         (gnus-message 1 "Can't catch up; non-active group")
5717       ;; Do auto-expirable marks if that's required.
5718       (when (gnus-group-auto-expirable-p group)
5719         (gnus-add-marked-articles
5720          group 'expire (gnus-list-of-unread-articles group))
5721         (when all
5722           (let ((marks (nth 3 (nth 2 entry))))
5723             (gnus-add-marked-articles
5724              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
5725             (gnus-add-marked-articles
5726              group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
5727       (when entry
5728         (gnus-update-read-articles group nil)
5729         ;; Also nix out the lists of marks and dormants.
5730         (when all
5731           (gnus-add-marked-articles group 'tick nil nil 'force)
5732           (gnus-add-marked-articles group 'dormant nil nil 'force))
5733         (run-hooks 'gnus-group-catchup-group-hook)
5734         num))))
5735
5736 (defun gnus-group-expire-articles (&optional n)
5737   "Expire all expirable articles in the current newsgroup."
5738   (interactive "P")
5739   (let ((groups (gnus-group-process-prefix n))
5740         group)
5741     (unless groups
5742       (error "No groups to expire"))
5743     (while (setq group (pop groups))
5744       (gnus-group-remove-mark group)
5745       (when (gnus-check-backend-function 'request-expire-articles group)
5746         (gnus-message 6 "Expiring articles in %s..." group)
5747         (let* ((info (gnus-get-info group))
5748                (expirable (if (gnus-group-total-expirable-p group)
5749                               (cons nil (gnus-list-of-read-articles group))
5750                             (assq 'expire (gnus-info-marks info))))
5751                (expiry-wait (gnus-group-get-parameter group 'expiry-wait)))
5752           (when expirable
5753             (setcdr expirable
5754                     (gnus-compress-sequence
5755                      (if expiry-wait
5756                          (let ((nnmail-expiry-wait-function nil)
5757                                (nnmail-expiry-wait expiry-wait))
5758                            (gnus-request-expire-articles
5759                             (gnus-uncompress-sequence (cdr expirable)) group))
5760                        (gnus-request-expire-articles
5761                         (gnus-uncompress-sequence (cdr expirable))
5762                         group)))))
5763           (gnus-message 6 "Expiring articles in %s...done" group)))
5764       (gnus-group-position-point))))
5765
5766
5767 (defun gnus-group-expire-all-groups ()
5768   "Expire all expirable articles in all newsgroups."
5769   (interactive)
5770   (save-excursion
5771     (gnus-message 5 "Expiring...")
5772     (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
5773                                      (cdr gnus-newsrc-alist))))
5774       (gnus-group-expire-articles nil)))
5775   (gnus-group-position-point)
5776   (gnus-message 5 "Expiring...done"))
5777
5778 (defun gnus-group-set-current-level (n level)
5779   "Set the level of the next N groups to LEVEL."
5780   (interactive
5781    (list
5782     current-prefix-arg
5783     (string-to-int
5784      (let ((s (read-string
5785                (format "Level (default %s): " (gnus-group-group-level)))))
5786        (if (string-match "^\\s-*$" s)
5787            (int-to-string (gnus-group-group-level))
5788          s)))))
5789   (or (and (>= level 1) (<= level gnus-level-killed))
5790       (error "Illegal level: %d" level))
5791   (let ((groups (gnus-group-process-prefix n))
5792         group)
5793     (while groups
5794       (setq group (car groups)
5795             groups (cdr groups))
5796       (gnus-group-remove-mark group)
5797       (gnus-message 6 "Changed level of %s from %d to %d"
5798                     group (or (gnus-group-group-level) gnus-level-killed)
5799                     level)
5800       (gnus-group-change-level
5801        group level (or (gnus-group-group-level) gnus-level-killed))
5802       (gnus-group-update-group-line)))
5803   (gnus-group-position-point))
5804
5805 (defun gnus-group-unsubscribe-current-group (&optional n)
5806   "Toggle subscription of the current group.
5807 If given numerical prefix, toggle the N next groups."
5808   (interactive "P")
5809   (let ((groups (gnus-group-process-prefix n))
5810         group)
5811     (while groups
5812       (setq group (car groups)
5813             groups (cdr groups))
5814       (gnus-group-remove-mark group)
5815       (gnus-group-unsubscribe-group
5816        group (if (<= (gnus-group-group-level) gnus-level-subscribed)
5817                  gnus-level-default-unsubscribed
5818                gnus-level-default-subscribed) t)
5819       (gnus-group-update-group-line))
5820     (gnus-group-next-group 1)))
5821
5822 (defun gnus-group-unsubscribe-group (group &optional level silent)
5823   "Toggle subscription to GROUP.
5824 Killed newsgroups are subscribed.  If SILENT, don't try to update the
5825 group line."
5826   (interactive
5827    (list (completing-read
5828           "Group: " gnus-active-hashtb nil
5829           (memq gnus-select-method gnus-have-read-active-file))))
5830   (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
5831     (cond
5832      ((string-match "^[ \t]$" group)
5833       (error "Empty group name"))
5834      (newsrc
5835       ;; Toggle subscription flag.
5836       (gnus-group-change-level
5837        newsrc (if level level (if (<= (nth 1 (nth 2 newsrc))
5838                                       gnus-level-subscribed)
5839                                   (1+ gnus-level-subscribed)
5840                                 gnus-level-default-subscribed)))
5841       (unless silent
5842         (gnus-group-update-group group)))
5843      ((and (stringp group)
5844            (or (not (memq gnus-select-method gnus-have-read-active-file))
5845                (gnus-active group)))
5846       ;; Add new newsgroup.
5847       (gnus-group-change-level
5848        group
5849        (if level level gnus-level-default-subscribed)
5850        (or (and (member group gnus-zombie-list)
5851                 gnus-level-zombie)
5852            gnus-level-killed)
5853        (and (gnus-group-group-name)
5854             (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
5855       (unless silent
5856         (gnus-group-update-group group)))
5857      (t (error "No such newsgroup: %s" group)))
5858     (gnus-group-position-point)))
5859
5860 (defun gnus-group-transpose-groups (n)
5861   "Move the current newsgroup up N places.
5862 If given a negative prefix, move down instead.  The difference between
5863 N and the number of steps taken is returned."
5864   (interactive "p")
5865   (or (gnus-group-group-name)
5866       (error "No group on current line"))
5867   (gnus-group-kill-group 1)
5868   (prog1
5869       (forward-line (- n))
5870     (gnus-group-yank-group)
5871     (gnus-group-position-point)))
5872
5873 (defun gnus-group-kill-all-zombies ()
5874   "Kill all zombie newsgroups."
5875   (interactive)
5876   (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
5877   (setq gnus-zombie-list nil)
5878   (gnus-group-list-groups))
5879
5880 (defun gnus-group-kill-region (begin end)
5881   "Kill newsgroups in current region (excluding current point).
5882 The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
5883   (interactive "r")
5884   (let ((lines
5885          ;; Count lines.
5886          (save-excursion
5887            (count-lines
5888             (progn
5889               (goto-char begin)
5890               (beginning-of-line)
5891               (point))
5892             (progn
5893               (goto-char end)
5894               (beginning-of-line)
5895               (point))))))
5896     (goto-char begin)
5897     (beginning-of-line)                 ;Important when LINES < 1
5898     (gnus-group-kill-group lines)))
5899
5900 (defun gnus-group-kill-group (&optional n discard)
5901   "Kill the next N groups.
5902 The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
5903 However, only groups that were alive can be yanked; already killed
5904 groups or zombie groups can't be yanked.
5905 The return value is the name of the group that was killed, or a list
5906 of groups killed."
5907   (interactive "P")
5908   (let ((buffer-read-only nil)
5909         (groups (gnus-group-process-prefix n))
5910         group entry level out)
5911     (if (< (length groups) 10)
5912         ;; This is faster when there are few groups.
5913         (while groups
5914           (push (setq group (pop groups)) out)
5915           (gnus-group-remove-mark group)
5916           (setq level (gnus-group-group-level))
5917           (gnus-delete-line)
5918           (if (and (not discard)
5919                    (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
5920               (setq gnus-list-of-killed-groups
5921                     (cons (cons (car entry) (nth 2 entry))
5922                           gnus-list-of-killed-groups)))
5923           (gnus-group-change-level
5924            (if entry entry group) gnus-level-killed (if entry nil level)))
5925       ;; If there are lots and lots of groups to be killed, we use
5926       ;; this thing instead.
5927       (let (entry)
5928         (setq groups (nreverse groups))
5929         (while groups
5930           (gnus-group-remove-mark (car groups))
5931           (gnus-delete-line)
5932           (when (setq entry (gnus-gethash (pop groups) gnus-newsrc-hashtb))
5933             (push (cons (car entry) (nth 2 entry))
5934                   gnus-list-of-killed-groups)
5935             (setcdr (cdr entry) (cdr (cdr (cdr entry))))))
5936         (gnus-make-hashtable-from-newsrc-alist)))
5937
5938     (gnus-group-position-point)
5939     (if (< (length out) 2) (car out) (nreverse out))))
5940
5941 (defun gnus-group-yank-group (&optional arg)
5942   "Yank the last newsgroups killed with \\[gnus-group-kill-group],
5943 inserting it before the current newsgroup.  The numeric ARG specifies
5944 how many newsgroups are to be yanked.  The name of the newsgroup yanked
5945 is returned, or (if several groups are yanked) a list of yanked groups
5946 is returned."
5947   (interactive "p")
5948   (setq arg (or arg 1))
5949   (let (info group prev out)
5950     (while (>= (decf arg) 0)
5951       (if (not (setq info (pop gnus-list-of-killed-groups)))
5952           (error "No more newsgroups to yank"))
5953       (push (setq group (nth 1 info)) out)
5954       ;; Find which newsgroup to insert this one before - search
5955       ;; backward until something suitable is found.  If there are no
5956       ;; other newsgroups in this buffer, just make this newsgroup the
5957       ;; first newsgroup.
5958       (setq prev (gnus-group-group-name))
5959       (gnus-group-change-level
5960        info (nth 2 info) gnus-level-killed
5961        (and prev (gnus-gethash prev gnus-newsrc-hashtb))
5962        t)
5963       (gnus-group-insert-group-line-info group))
5964     (forward-line -1)
5965     (gnus-group-position-point)
5966     (if (< (length out) 2) (car out) (nreverse out))))
5967
5968 (defun gnus-group-kill-level (level)
5969   "Kill all groups that is on a certain LEVEL."
5970   (interactive "nKill all groups on level: ")
5971   (cond
5972    ((= level gnus-level-zombie)
5973     (setq gnus-killed-list
5974           (nconc gnus-zombie-list gnus-killed-list))
5975     (setq gnus-zombie-list nil))
5976    ((and (< level gnus-level-zombie)
5977          (> level 0)
5978          (or gnus-expert-user
5979              (gnus-yes-or-no-p
5980               (format
5981                "Do you really want to kill all groups on level %d? "
5982                level))))
5983     (let* ((prev gnus-newsrc-alist)
5984            (alist (cdr prev)))
5985       (while alist
5986         (if (= (gnus-info-level level) level)
5987             (setcdr prev (cdr alist))
5988           (setq prev alist))
5989         (setq alist (cdr alist)))
5990       (gnus-make-hashtable-from-newsrc-alist)
5991       (gnus-group-list-groups)))
5992    (t
5993     (error "Can't kill; illegal level: %d" level))))
5994
5995 (defun gnus-group-list-all-groups (&optional arg)
5996   "List all newsgroups with level ARG or lower.
5997 Default is gnus-level-unsubscribed, which lists all subscribed and most
5998 unsubscribed groups."
5999   (interactive "P")
6000   (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
6001
6002 ;; Redefine this to list ALL killed groups if prefix arg used.
6003 ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
6004 (defun gnus-group-list-killed (&optional arg)
6005   "List all killed newsgroups in the group buffer.
6006 If ARG is non-nil, list ALL killed groups known to Gnus.  This may
6007 entail asking the server for the groups."
6008   (interactive "P")
6009   ;; Find all possible killed newsgroups if arg.
6010   (when arg
6011     ;; First make sure active file has been read.
6012     (unless gnus-have-read-active-file
6013       (let ((gnus-read-active-file t))
6014         (gnus-read-active-file)))
6015     (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
6016     ;; Go through all newsgroups that are known to Gnus - enlarge kill list
6017     (mapatoms
6018      (lambda (sym)
6019        (let ((groups 0)
6020              (group (symbol-name sym)))
6021          (if (or (null group)
6022                  (gnus-gethash group gnus-killed-hashtb)
6023                  (gnus-gethash group gnus-newsrc-hashtb))
6024              ()
6025            (let ((do-sub (gnus-matches-options-n group)))
6026              (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
6027                  ()
6028                (setq groups (1+ groups))
6029                (setq gnus-killed-list
6030                      (cons group gnus-killed-list))
6031                (gnus-sethash group group gnus-killed-hashtb))))))
6032      gnus-active-hashtb))
6033   (if (not gnus-killed-list)
6034       (gnus-message 6 "No killed groups")
6035     (let (gnus-group-list-mode)
6036       (funcall gnus-group-prepare-function
6037                gnus-level-killed t gnus-level-killed))
6038     (goto-char (point-min)))
6039   (gnus-group-position-point))
6040
6041 (defun gnus-group-list-zombies ()
6042   "List all zombie newsgroups in the group buffer."
6043   (interactive)
6044   (if (not gnus-zombie-list)
6045       (gnus-message 6 "No zombie groups")
6046     (let (gnus-group-list-mode)
6047       (funcall gnus-group-prepare-function
6048                gnus-level-zombie t gnus-level-zombie))
6049     (goto-char (point-min)))
6050   (gnus-group-position-point))
6051
6052 (defun gnus-group-list-active ()
6053   "List all groups that are available from the server(s)."
6054   (interactive)
6055   ;; First we make sure that we have really read the active file.
6056   (unless gnus-have-read-active-file
6057     (let ((gnus-read-active-file t))
6058       (gnus-read-active-file)))
6059   ;; Find all groups and sort them.
6060   (let ((groups
6061          (sort
6062           (let (list)
6063             (mapatoms
6064              (lambda (sym)
6065                (and (symbol-value sym)
6066                     (setq list (cons (symbol-name sym) list))))
6067              gnus-active-hashtb)
6068             list)
6069           'string<))
6070         (buffer-read-only nil))
6071     (erase-buffer)
6072     (while groups
6073       (gnus-group-insert-group-line-info (car groups))
6074       (setq groups (cdr groups)))
6075     (goto-char (point-min))))
6076
6077 (defun gnus-activate-all-groups (level)
6078   "Activate absolutely all groups."
6079   (interactive (list 7))
6080   (let ((gnus-activate-level level)
6081         (gnus-activate-foreign-newsgroups level))
6082     (gnus-group-get-new-news)))
6083
6084 (defun gnus-group-get-new-news (&optional arg)
6085   "Get newly arrived articles.
6086 If ARG is a number, it specifies which levels you are interested in
6087 re-scanning.  If ARG is non-nil and not a number, this will force
6088 \"hard\" re-reading of the active files from all servers."
6089   (interactive "P")
6090   (run-hooks 'gnus-get-new-news-hook)
6091   ;; We might read in new NoCeM messages here.
6092   (and gnus-use-nocem (gnus-nocem-scan-groups))
6093   ;; If ARG is not a number, then we read the active file.
6094   (and arg
6095        (not (numberp arg))
6096        (progn
6097          (let ((gnus-read-active-file t))
6098            (gnus-read-active-file))
6099          (setq arg nil)))
6100
6101   (setq arg (gnus-group-default-level arg t))
6102   (if (and gnus-read-active-file (not arg))
6103       (progn
6104         (gnus-read-active-file)
6105         (gnus-get-unread-articles arg))
6106     (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
6107       (gnus-get-unread-articles arg)))
6108   (gnus-group-list-groups))
6109
6110 (defun gnus-group-get-new-news-this-group (&optional n)
6111   "Check for newly arrived news in the current group (and the N-1 next groups).
6112 The difference between N and the number of newsgroup checked is returned.
6113 If N is negative, this group and the N-1 previous groups will be checked."
6114   (interactive "P")
6115   (let* ((groups (gnus-group-process-prefix n))
6116          (ret (if (numberp n) (- n (length groups)) 0))
6117          group)
6118     (while groups
6119       (setq group (car groups)
6120             groups (cdr groups))
6121       (gnus-group-remove-mark group)
6122       (unless (gnus-get-new-news-in-group group)
6123         (ding)
6124         (gnus-message 3 "%s error: %s" group (gnus-status-message group))))
6125     (when gnus-goto-next-group-when-activating
6126       (gnus-group-next-unread-group 1 t))
6127     (gnus-summary-position-point)
6128     ret))
6129
6130 (defun gnus-get-new-news-in-group (group)
6131   (when (and group (gnus-activate-group group 'scan))
6132     (gnus-get-unread-articles-in-group
6133      (gnus-get-info group) (gnus-active group) t)
6134     (when (gnus-group-goto-group group)
6135       (gnus-group-update-group-line))
6136     t))
6137
6138 (defun gnus-group-fetch-faq (group &optional faq-dir)
6139   "Fetch the FAQ for the current group."
6140   (interactive
6141    (list
6142     (gnus-group-real-name (gnus-group-group-name))
6143     (cond (current-prefix-arg
6144            (completing-read
6145             "Faq dir: " (and (listp gnus-group-faq-directory)
6146                              gnus-group-faq-directory))))))
6147   (or faq-dir
6148       (setq faq-dir (if (listp gnus-group-faq-directory)
6149                         (car gnus-group-faq-directory)
6150                       gnus-group-faq-directory)))
6151   (or group (error "No group name given"))
6152   (let ((file (concat (file-name-as-directory faq-dir)
6153                       (gnus-group-real-name group))))
6154     (if (not (file-exists-p file))
6155         (error "No such file: %s" file)
6156       (find-file file))))
6157
6158 (defun gnus-group-describe-group (force &optional group)
6159   "Display a description of the current newsgroup."
6160   (interactive (list current-prefix-arg (gnus-group-group-name)))
6161   (and force (setq gnus-description-hashtb nil))
6162   (let ((method (gnus-find-method-for-group group))
6163         desc)
6164     (or group (error "No group name given"))
6165     (and (or (and gnus-description-hashtb
6166                   ;; We check whether this group's method has been
6167                   ;; queried for a description file.
6168                   (gnus-gethash
6169                    (gnus-group-prefixed-name "" method)
6170                    gnus-description-hashtb))
6171              (setq desc (gnus-group-get-description group))
6172              (gnus-read-descriptions-file method))
6173          (message
6174           (or desc (gnus-gethash group gnus-description-hashtb)
6175               "No description available")))))
6176
6177 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6178 (defun gnus-group-describe-all-groups (&optional force)
6179   "Pop up a buffer with descriptions of all newsgroups."
6180   (interactive "P")
6181   (and force (setq gnus-description-hashtb nil))
6182   (if (not (or gnus-description-hashtb
6183                (gnus-read-all-descriptions-files)))
6184       (error "Couldn't request descriptions file"))
6185   (let ((buffer-read-only nil)
6186         b)
6187     (erase-buffer)
6188     (mapatoms
6189      (lambda (group)
6190        (setq b (point))
6191        (insert (format "      *: %-20s %s\n" (symbol-name group)
6192                        (symbol-value group)))
6193        (add-text-properties
6194         b (1+ b) (list 'gnus-group group
6195                        'gnus-unread t 'gnus-marked nil
6196                        'gnus-level (1+ gnus-level-subscribed))))
6197      gnus-description-hashtb)
6198     (goto-char (point-min))
6199     (gnus-group-position-point)))
6200
6201 ;; Suggested by by Daniel Quinlan <quinlan@best.com>.
6202 (defun gnus-group-apropos (regexp &optional search-description)
6203   "List all newsgroups that have names that match a regexp."
6204   (interactive "sGnus apropos (regexp): ")
6205   (let ((prev "")
6206         (obuf (current-buffer))
6207         groups des)
6208     ;; Go through all newsgroups that are known to Gnus.
6209     (mapatoms
6210      (lambda (group)
6211        (and (symbol-name group)
6212             (string-match regexp (symbol-name group))
6213             (setq groups (cons (symbol-name group) groups))))
6214      gnus-active-hashtb)
6215     ;; Go through all descriptions that are known to Gnus.
6216     (if search-description
6217         (mapatoms
6218          (lambda (group)
6219            (and (string-match regexp (symbol-value group))
6220                 (gnus-active (symbol-name group))
6221                 (setq groups (cons (symbol-name group) groups))))
6222          gnus-description-hashtb))
6223     (if (not groups)
6224         (gnus-message 3 "No groups matched \"%s\"." regexp)
6225       ;; Print out all the groups.
6226       (save-excursion
6227         (pop-to-buffer "*Gnus Help*")
6228         (buffer-disable-undo (current-buffer))
6229         (erase-buffer)
6230         (setq groups (sort groups 'string<))
6231         (while groups
6232           ;; Groups may be entered twice into the list of groups.
6233           (if (not (string= (car groups) prev))
6234               (progn
6235                 (insert (setq prev (car groups)) "\n")
6236                 (if (and gnus-description-hashtb
6237                          (setq des (gnus-gethash (car groups)
6238                                                  gnus-description-hashtb)))
6239                     (insert "  " des "\n"))))
6240           (setq groups (cdr groups)))
6241         (goto-char (point-min))))
6242     (pop-to-buffer obuf)))
6243
6244 (defun gnus-group-description-apropos (regexp)
6245   "List all newsgroups that have names or descriptions that match a regexp."
6246   (interactive "sGnus description apropos (regexp): ")
6247   (if (not (or gnus-description-hashtb
6248                (gnus-read-all-descriptions-files)))
6249       (error "Couldn't request descriptions file"))
6250   (gnus-group-apropos regexp t))
6251
6252 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
6253 (defun gnus-group-list-matching (level regexp &optional all lowest)
6254   "List all groups with unread articles that match REGEXP.
6255 If the prefix LEVEL is non-nil, it should be a number that says which
6256 level to cut off listing groups.
6257 If ALL, also list groups with no unread articles.
6258 If LOWEST, don't list groups with level lower than LOWEST."
6259   (interactive "P\nsList newsgroups matching: ")
6260   (gnus-group-prepare-flat (or level gnus-level-subscribed)
6261                            all (or lowest 1) regexp)
6262   (goto-char (point-min))
6263   (gnus-group-position-point))
6264
6265 (defun gnus-group-list-all-matching (level regexp &optional lowest)
6266   "List all groups that match REGEXP.
6267 If the prefix LEVEL is non-nil, it should be a number that says which
6268 level to cut off listing groups.
6269 If LOWEST, don't list groups with level lower than LOWEST."
6270   (interactive "P\nsList newsgroups matching: ")
6271   (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
6272
6273 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
6274 (defun gnus-group-save-newsrc (&optional force)
6275   "Save the Gnus startup files.
6276 If FORCE, force saving whether it is necessary or not."
6277   (interactive "P")
6278   (gnus-save-newsrc-file force))
6279
6280 (defun gnus-group-restart (&optional arg)
6281   "Force Gnus to read the .newsrc file."
6282   (interactive "P")
6283   (gnus-save-newsrc-file)
6284   (gnus-setup-news 'force)
6285   (gnus-group-list-groups arg))
6286
6287 (defun gnus-group-read-init-file ()
6288   "Read the Gnus elisp init file."
6289   (interactive)
6290   (gnus-read-init-file))
6291
6292 (defun gnus-group-check-bogus-groups (&optional silent)
6293   "Check bogus newsgroups.
6294 If given a prefix, don't ask for confirmation before removing a bogus
6295 group."
6296   (interactive "P")
6297   (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
6298   (gnus-group-list-groups))
6299
6300 (defun gnus-group-edit-global-kill (&optional article group)
6301   "Edit the global kill file.
6302 If GROUP, edit that local kill file instead."
6303   (interactive "P")
6304   (setq gnus-current-kill-article article)
6305   (gnus-kill-file-edit-file group)
6306   (gnus-message
6307    6
6308    (substitute-command-keys
6309     (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
6310             (if group "local" "global")))))
6311
6312 (defun gnus-group-edit-local-kill (article group)
6313   "Edit a local kill file."
6314   (interactive (list nil (gnus-group-group-name)))
6315   (gnus-group-edit-global-kill article group))
6316
6317 (defun gnus-group-force-update ()
6318   "Update `.newsrc' file."
6319   (interactive)
6320   (gnus-save-newsrc-file))
6321
6322 (defun gnus-group-suspend ()
6323   "Suspend the current Gnus session.
6324 In fact, cleanup buffers except for group mode buffer.
6325 The hook gnus-suspend-gnus-hook is called before actually suspending."
6326   (interactive)
6327   (run-hooks 'gnus-suspend-gnus-hook)
6328   ;; Kill Gnus buffers except for group mode buffer.
6329   (let ((group-buf (get-buffer gnus-group-buffer)))
6330     ;; Do this on a separate list in case the user does a ^G before we finish
6331     (let ((gnus-buffer-list
6332            (delq group-buf (delq gnus-dribble-buffer
6333                                  (append gnus-buffer-list nil)))))
6334       (while gnus-buffer-list
6335         (gnus-kill-buffer (car gnus-buffer-list))
6336         (setq gnus-buffer-list (cdr gnus-buffer-list))))
6337     (if group-buf
6338         (progn
6339           (setq gnus-buffer-list (list group-buf))
6340           (bury-buffer group-buf)
6341           (delete-windows-on group-buf t)))))
6342
6343 (defun gnus-group-clear-dribble ()
6344   "Clear all information from the dribble buffer."
6345   (interactive)
6346   (gnus-dribble-clear)
6347   (gnus-message 7 "Cleared dribble buffer"))
6348
6349 (defun gnus-group-exit ()
6350   "Quit reading news after updating .newsrc.eld and .newsrc.
6351 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6352   (interactive)
6353   (if (or noninteractive                ;For gnus-batch-kill
6354           (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
6355           (not gnus-interactive-exit)   ;Without confirmation
6356           gnus-expert-user
6357           (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
6358       (progn
6359         (run-hooks 'gnus-exit-gnus-hook)
6360         ;; Offer to save data from non-quitted summary buffers.
6361         (gnus-offer-save-summaries)
6362         ;; Save the newsrc file(s).
6363         (gnus-save-newsrc-file)
6364         ;; Kill-em-all.
6365         (gnus-close-backends)
6366         ;; Shut down the cache.
6367         (when gnus-use-cache
6368           (gnus-cache-close))
6369         ;; Reset everything.
6370         (gnus-clear-system))))
6371
6372 (defun gnus-close-backends ()
6373   ;; Send a close request to all backends that support such a request.
6374   (let ((methods gnus-valid-select-methods)
6375         func)
6376     (while methods
6377       (if (fboundp (setq func (intern (concat (car (car methods))
6378                                               "-request-close"))))
6379           (funcall func))
6380       (setq methods (cdr methods)))))
6381
6382 (defun gnus-group-quit ()
6383   "Quit reading news without updating .newsrc.eld or .newsrc.
6384 The hook `gnus-exit-gnus-hook' is called before actually exiting."
6385   (interactive)
6386   (when (or noninteractive              ;For gnus-batch-kill
6387             (zerop (buffer-size))
6388             (not (gnus-server-opened gnus-select-method))
6389             gnus-expert-user
6390             (not gnus-current-startup-file)
6391             (gnus-yes-or-no-p
6392              (format "Quit reading news without saving %s? "
6393                      (file-name-nondirectory gnus-current-startup-file))))
6394     (run-hooks 'gnus-exit-gnus-hook)
6395     (if gnus-use-full-window
6396         (delete-other-windows)
6397       (gnus-remove-some-windows))
6398     (gnus-dribble-save)
6399     (gnus-close-backends)
6400     ;; Shut down the cache.
6401     (when gnus-use-cache
6402       (gnus-cache-close))
6403     (gnus-clear-system)))
6404
6405 (defun gnus-offer-save-summaries ()
6406   "Offer to save all active summary buffers."
6407   (save-excursion
6408     (let ((buflist (buffer-list))
6409           buffers bufname)
6410       ;; Go through all buffers and find all summaries.
6411       (while buflist
6412         (and (setq bufname (buffer-name (car buflist)))
6413              (string-match "Summary" bufname)
6414              (save-excursion
6415                (set-buffer bufname)
6416                ;; We check that this is, indeed, a summary buffer.
6417                (and (eq major-mode 'gnus-summary-mode)
6418                     ;; Also make sure this isn't bogus.
6419                     gnus-newsgroup-prepared))
6420              (push bufname buffers))
6421         (setq buflist (cdr buflist)))
6422       ;; Go through all these summary buffers and offer to save them.
6423       (when buffers
6424         (map-y-or-n-p
6425          "Update summary buffer %s? "
6426          (lambda (buf) (set-buffer buf) (gnus-summary-exit))
6427          buffers)))))
6428
6429 (defun gnus-group-describe-briefly ()
6430   "Give a one line description of the group mode commands."
6431   (interactive)
6432   (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")))
6433
6434 (defun gnus-group-browse-foreign-server (method)
6435   "Browse a foreign news server.
6436 If called interactively, this function will ask for a select method
6437  (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
6438 If not, METHOD should be a list where the first element is the method
6439 and the second element is the address."
6440   (interactive
6441    (list (let ((how (completing-read
6442                      "Which backend: "
6443                      (append gnus-valid-select-methods gnus-server-alist)
6444                      nil t (cons "nntp" 0))))
6445            ;; We either got a backend name or a virtual server name.
6446            ;; If the first, we also need an address.
6447            (if (assoc how gnus-valid-select-methods)
6448                (list (intern how)
6449                      ;; Suggested by mapjph@bath.ac.uk.
6450                      (completing-read
6451                       "Address: "
6452                       (mapcar (lambda (server) (list server))
6453                               gnus-secondary-servers)))
6454              ;; We got a server name, so we find the method.
6455              (gnus-server-to-method how)))))
6456   (gnus-browse-foreign-server method))
6457
6458 \f
6459 ;;;
6460 ;;; Gnus summary mode
6461 ;;;
6462
6463 (defvar gnus-summary-mode-map nil)
6464
6465 (put 'gnus-summary-mode 'mode-class 'special)
6466
6467 (unless gnus-summary-mode-map
6468   (setq gnus-summary-mode-map (make-keymap))
6469   (suppress-keymap gnus-summary-mode-map)
6470
6471   ;; Non-orthogonal keys
6472
6473   (gnus-define-keys
6474    gnus-summary-mode-map
6475    " " gnus-summary-next-page
6476    "\177" gnus-summary-prev-page
6477    "\r" gnus-summary-scroll-up
6478    "n" gnus-summary-next-unread-article
6479    "p" gnus-summary-prev-unread-article
6480    "N" gnus-summary-next-article
6481    "P" gnus-summary-prev-article
6482    "\M-\C-n" gnus-summary-next-same-subject
6483    "\M-\C-p" gnus-summary-prev-same-subject
6484    "\M-n" gnus-summary-next-unread-subject
6485    "\M-p" gnus-summary-prev-unread-subject
6486    "." gnus-summary-first-unread-article
6487    "," gnus-summary-best-unread-article
6488    "\M-s" gnus-summary-search-article-forward
6489    "\M-r" gnus-summary-search-article-backward
6490    "<" gnus-summary-beginning-of-article
6491    ">" gnus-summary-end-of-article
6492    "j" gnus-summary-goto-article
6493    "^" gnus-summary-refer-parent-article
6494    "\M-^" gnus-summary-refer-article
6495    "u" gnus-summary-tick-article-forward
6496    "!" gnus-summary-tick-article-forward
6497    "U" gnus-summary-tick-article-backward
6498    "d" gnus-summary-mark-as-read-forward
6499    "D" gnus-summary-mark-as-read-backward
6500    "E" gnus-summary-mark-as-expirable
6501    "\M-u" gnus-summary-clear-mark-forward
6502    "\M-U" gnus-summary-clear-mark-backward
6503    "k" gnus-summary-kill-same-subject-and-select
6504    "\C-k" gnus-summary-kill-same-subject
6505    "\M-\C-k" gnus-summary-kill-thread
6506    "\M-\C-l" gnus-summary-lower-thread
6507    "e" gnus-summary-edit-article
6508    "#" gnus-summary-mark-as-processable
6509    "\M-#" gnus-summary-unmark-as-processable
6510    "\M-\C-t" gnus-summary-toggle-threads
6511    "\M-\C-s" gnus-summary-show-thread
6512    "\M-\C-h" gnus-summary-hide-thread
6513    "\M-\C-f" gnus-summary-next-thread
6514    "\M-\C-b" gnus-summary-prev-thread
6515    "\M-\C-u" gnus-summary-up-thread
6516    "\M-\C-d" gnus-summary-down-thread
6517    "&" gnus-summary-execute-command
6518    "c" gnus-summary-catchup-and-exit
6519    "\C-w" gnus-summary-mark-region-as-read
6520    "\C-t" gnus-summary-toggle-truncation
6521    "?" gnus-summary-mark-as-dormant
6522    "\C-c\M-\C-s" gnus-summary-limit-include-expunged
6523    "\C-c\C-s\C-n" gnus-summary-sort-by-number
6524    "\C-c\C-s\C-a" gnus-summary-sort-by-author
6525    "\C-c\C-s\C-s" gnus-summary-sort-by-subject
6526    "\C-c\C-s\C-d" gnus-summary-sort-by-date
6527    "\C-c\C-s\C-i" gnus-summary-sort-by-score
6528    "=" gnus-summary-expand-window
6529    "\C-x\C-s" gnus-summary-reselect-current-group
6530    "\M-g" gnus-summary-rescan-group
6531    "w" gnus-summary-stop-page-breaking
6532    "\C-c\C-r" gnus-summary-caesar-message
6533    "\M-t" gnus-summary-toggle-mime
6534    "f" gnus-summary-followup
6535    "F" gnus-summary-followup-with-original
6536    "C" gnus-summary-cancel-article
6537    "r" gnus-summary-reply
6538    "R" gnus-summary-reply-with-original
6539    "\C-c\C-f" gnus-summary-mail-forward
6540    "o" gnus-summary-save-article
6541    "\C-o" gnus-summary-save-article-mail
6542    "|" gnus-summary-pipe-output
6543    "\M-k" gnus-summary-edit-local-kill
6544    "\M-K" gnus-summary-edit-global-kill
6545    "V" gnus-version
6546    "\C-c\C-d" gnus-summary-describe-group
6547    "q" gnus-summary-exit
6548    "Q" gnus-summary-exit-no-update
6549    "\C-c\C-i" gnus-info-find-node
6550    gnus-mouse-2 gnus-mouse-pick-article
6551    "m" gnus-summary-mail-other-window
6552    "a" gnus-summary-post-news
6553    "x" gnus-summary-limit-to-unread
6554    "s" gnus-summary-isearch-article
6555    "t" gnus-article-hide-headers
6556    "g" gnus-summary-show-article
6557    "l" gnus-summary-goto-last-article
6558    "\C-c\C-v\C-v" gnus-uu-decode-uu-view
6559    "\C-d" gnus-summary-enter-digest-group
6560    "v" gnus-summary-verbose-headers
6561    "\C-c\C-b" gnus-bug
6562    "*" gnus-cache-enter-article
6563    "\M-*" gnus-cache-remove-article
6564    "\M-&" gnus-summary-universal-argument
6565    "\C-l" gnus-recenter
6566    "I" gnus-summary-increase-score
6567    "L" gnus-summary-lower-score
6568
6569    "V" gnus-summary-score-map
6570    "X" gnus-uu-extract-map
6571    "S" gnus-summary-send-map)
6572
6573   ;; Sort of orthogonal keymap
6574   (gnus-define-keys
6575    (gnus-summary-mark-map "M" gnus-summary-mode-map)
6576    "t" gnus-summary-tick-article-forward
6577    "!" gnus-summary-tick-article-forward
6578    "d" gnus-summary-mark-as-read-forward
6579    "r" gnus-summary-mark-as-read-forward
6580    "c" gnus-summary-clear-mark-forward
6581    " " gnus-summary-clear-mark-forward
6582    "e" gnus-summary-mark-as-expirable
6583    "x" gnus-summary-mark-as-expirable
6584    "?" gnus-summary-mark-as-dormant
6585    "b" gnus-summary-set-bookmark
6586    "B" gnus-summary-remove-bookmark
6587    "#" gnus-summary-mark-as-processable
6588    "\M-#" gnus-summary-unmark-as-processable
6589    "S" gnus-summary-limit-include-expunged
6590    "C" gnus-summary-catchup
6591    "H" gnus-summary-catchup-to-here
6592    "\C-c" gnus-summary-catchup-all
6593    "k" gnus-summary-kill-same-subject-and-select
6594    "K" gnus-summary-kill-same-subject
6595    "P" gnus-uu-mark-map)
6596
6597   (gnus-define-keys
6598    (gnus-summary-mscore-map "V" gnus-summary-mode-map)
6599    "c" gnus-summary-clear-above
6600    "u" gnus-summary-tick-above
6601    "m" gnus-summary-mark-above
6602    "k" gnus-summary-kill-below)
6603
6604   (gnus-define-keys
6605    (gnus-summary-limit-map "/" gnus-summary-mode-map)
6606    "/" gnus-summary-limit-to-subject
6607    "n" gnus-summary-limit-to-articles
6608    "w" gnus-summary-pop-limit
6609    "s" gnus-summary-limit-to-subject
6610    "a" gnus-summary-limit-to-author
6611    "u" gnus-summary-limit-to-unread
6612    "m" gnus-summary-limit-to-marks
6613    "v" gnus-summary-limit-to-score
6614    "D" gnus-summary-limit-include-dormant
6615    "d" gnus-summary-limit-exclude-dormant
6616 ;;  "t" gnus-summary-limit-exclude-thread
6617    "E" gnus-summary-limit-include-expunged
6618    "c" gnus-summary-limit-exclude-childless-dormant
6619    "C" gnus-summary-limit-mark-excluded-as-read)
6620
6621   (gnus-define-keys
6622    (gnus-summary-goto-map "G" gnus-summary-mode-map)
6623    "n" gnus-summary-next-unread-article
6624    "p" gnus-summary-prev-unread-article
6625    "N" gnus-summary-next-article
6626    "P" gnus-summary-prev-article
6627    "\C-n" gnus-summary-next-same-subject
6628    "\C-p" gnus-summary-prev-same-subject
6629    "\M-n" gnus-summary-next-unread-subject
6630    "\M-p" gnus-summary-prev-unread-subject
6631    "f" gnus-summary-first-unread-article
6632    "b" gnus-summary-best-unread-article
6633    "g" gnus-summary-goto-subject
6634    "l" gnus-summary-goto-last-article
6635    "p" gnus-summary-pop-article)
6636
6637   (gnus-define-keys
6638    (gnus-summary-thread-map "T" gnus-summary-mode-map)
6639    "k" gnus-summary-kill-thread
6640    "l" gnus-summary-lower-thread
6641    "i" gnus-summary-raise-thread
6642    "T" gnus-summary-toggle-threads
6643    "t" gnus-summary-rethread-current
6644    "^" gnus-summary-reparent-thread
6645    "s" gnus-summary-show-thread
6646    "S" gnus-summary-show-all-threads
6647    "h" gnus-summary-hide-thread
6648    "H" gnus-summary-hide-all-threads
6649    "n" gnus-summary-next-thread
6650    "p" gnus-summary-prev-thread
6651    "u" gnus-summary-up-thread
6652    "o" gnus-summary-top-thread
6653    "d" gnus-summary-down-thread
6654    "#" gnus-uu-mark-thread
6655    "\M-#" gnus-uu-unmark-thread)
6656
6657   (gnus-define-keys
6658    (gnus-summary-exit-map "Z" gnus-summary-mode-map)
6659    "c" gnus-summary-catchup-and-exit
6660    "C" gnus-summary-catchup-all-and-exit
6661    "E" gnus-summary-exit-no-update
6662    "Q" gnus-summary-exit
6663    "Z" gnus-summary-exit
6664    "n" gnus-summary-catchup-and-goto-next-group
6665    "R" gnus-summary-reselect-current-group
6666    "G" gnus-summary-rescan-group
6667    "N" gnus-summary-next-group
6668    "P" gnus-summary-prev-group)
6669
6670   (gnus-define-keys
6671    (gnus-summary-article-map "A" gnus-summary-mode-map)
6672    " " gnus-summary-next-page
6673    "n" gnus-summary-next-page
6674    "\177" gnus-summary-prev-page
6675    "p" gnus-summary-prev-page
6676    "\r" gnus-summary-scroll-up
6677    "<" gnus-summary-beginning-of-article
6678    ">" gnus-summary-end-of-article
6679    "b" gnus-summary-beginning-of-article
6680    "e" gnus-summary-end-of-article
6681    "^" gnus-summary-refer-parent-article
6682    "r" gnus-summary-refer-parent-article
6683    "R" gnus-summary-refer-references
6684    "g" gnus-summary-show-article
6685    "s" gnus-summary-isearch-article)
6686
6687   (gnus-define-keys
6688    (gnus-summary-wash-map "W" gnus-summary-mode-map)
6689    "b" gnus-article-add-buttons
6690    "B" gnus-article-add-buttons-to-head
6691    "o" gnus-article-treat-overstrike
6692 ;;  "w" gnus-article-word-wrap
6693    "w" gnus-article-fill-cited-article
6694    "c" gnus-article-remove-cr
6695    "L" gnus-article-remove-trailing-blank-lines
6696    "q" gnus-article-de-quoted-unreadable
6697    "f" gnus-article-display-x-face
6698    "l" gnus-summary-stop-page-breaking
6699    "r" gnus-summary-caesar-message
6700    "t" gnus-summary-toggle-header
6701    "m" gnus-summary-toggle-mime)
6702
6703   (gnus-define-keys
6704    (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
6705    "a" gnus-article-hide
6706    "h" gnus-article-hide-headers
6707    "b" gnus-article-hide-boring-headers
6708    "s" gnus-article-hide-signature
6709    "c" gnus-article-hide-citation
6710    "p" gnus-article-hide-pgp
6711    "\C-c" gnus-article-hide-citation-maybe)
6712
6713   (gnus-define-keys
6714    (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
6715    "a" gnus-article-highlight
6716    "h" gnus-article-highlight-headers
6717    "c" gnus-article-highlight-citation
6718    "s" gnus-article-highlight-signature)
6719
6720   (gnus-define-keys
6721    (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
6722    "z" gnus-article-date-ut
6723    "u" gnus-article-date-ut
6724    "l" gnus-article-date-local
6725    "e" gnus-article-date-lapsed
6726    "o" gnus-article-date-original)
6727
6728   (gnus-define-keys
6729    (gnus-summary-help-map "H" gnus-summary-mode-map)
6730    "v" gnus-version
6731    "f" gnus-summary-fetch-faq
6732    "d" gnus-summary-describe-group
6733    "h" gnus-summary-describe-briefly
6734    "i" gnus-info-find-node)
6735
6736   (gnus-define-keys
6737    (gnus-summary-backend-map "B" gnus-summary-mode-map)
6738    "e" gnus-summary-expire-articles
6739    "\M-\C-e" gnus-summary-expire-articles-now
6740    "\177" gnus-summary-delete-article
6741    "m" gnus-summary-move-article
6742    "r" gnus-summary-respool-article
6743    "w" gnus-summary-edit-article
6744    "c" gnus-summary-copy-article
6745    "B" gnus-summary-crosspost-article
6746    "q" gnus-summary-respool-query
6747    "i" gnus-summary-import-article)
6748
6749   (gnus-define-keys
6750    (gnus-summary-save-map "O" gnus-summary-mode-map)
6751    "o" gnus-summary-save-article
6752    "m" gnus-summary-save-article-mail
6753    "r" gnus-summary-save-article-rmail
6754    "f" gnus-summary-save-article-file
6755    "b" gnus-summary-save-article-body-file
6756    "h" gnus-summary-save-article-folder
6757    "v" gnus-summary-save-article-vm
6758    "p" gnus-summary-pipe-output
6759    "s" gnus-soup-add-article)
6760   )
6761
6762
6763 \f
6764
6765 (defun gnus-summary-mode (&optional group)
6766   "Major mode for reading articles.
6767
6768 All normal editing commands are switched off.
6769 \\<gnus-summary-mode-map>
6770 Each line in this buffer represents one article.  To read an
6771 article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
6772 and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
6773 respectively.
6774
6775 You can also post articles and send mail from this buffer.  To
6776 follow up an article, type `\\[gnus-summary-followup]'.  To mail a reply to the author
6777 of an article, type `\\[gnus-summary-reply]'.
6778
6779 There are approx. one gazillion commands you can execute in this
6780 buffer; read the info pages for more information (`\\[gnus-info-find-node]').
6781
6782 The following commands are available:
6783
6784 \\{gnus-summary-mode-map}"
6785   (interactive)
6786   (when (and menu-bar-mode
6787              (gnus-visual-p 'summary-menu 'menu))
6788     (gnus-summary-make-menu-bar))
6789   (kill-all-local-variables)
6790   (let ((locals gnus-summary-local-variables))
6791     (while locals
6792       (if (consp (car locals))
6793           (progn
6794             (make-local-variable (car (car locals)))
6795             (set (car (car locals)) (eval (cdr (car locals)))))
6796         (make-local-variable (car locals))
6797         (set (car locals) nil))
6798       (setq locals (cdr locals))))
6799   (gnus-make-thread-indent-array)
6800   (gnus-simplify-mode-line)
6801   (setq major-mode 'gnus-summary-mode)
6802   (setq mode-name "Summary")
6803   (make-local-variable 'minor-mode-alist)
6804   (use-local-map gnus-summary-mode-map)
6805   (buffer-disable-undo (current-buffer))
6806   (setq buffer-read-only t)             ;Disable modification
6807   (setq truncate-lines t)
6808   (setq selective-display t)
6809   (setq selective-display-ellipses t)   ;Display `...'
6810   (setq buffer-display-table gnus-summary-display-table)
6811   (setq gnus-newsgroup-name group)
6812   (run-hooks 'gnus-summary-mode-hook))
6813
6814 (defun gnus-summary-make-display-table ()
6815   ;; Change the display table.  Odd characters have a tendency to mess
6816   ;; up nicely formatted displays - we make all possible glyphs
6817   ;; display only a single character.
6818
6819   ;; We start from the standard display table, if any.
6820   (setq gnus-summary-display-table
6821         (or (copy-sequence standard-display-table)
6822             (make-display-table)))
6823   ;; Nix out all the control chars...
6824   (let ((i 32))
6825     (while (>= (setq i (1- i)) 0)
6826       (aset gnus-summary-display-table i [??])))
6827   ;; ... but not newline and cr, of course. (cr is necessary for the
6828   ;; selective display).
6829   (aset gnus-summary-display-table ?\n nil)
6830   (aset gnus-summary-display-table ?\r nil)
6831   ;; We nix out any glyphs over 126 that are not set already.
6832   (let ((i 256))
6833     (while (>= (setq i (1- i)) 127)
6834       ;; Only modify if the entry is nil.
6835       (or (aref gnus-summary-display-table i)
6836           (aset gnus-summary-display-table i [??])))))
6837
6838 (defun gnus-summary-clear-local-variables ()
6839   (let ((locals gnus-summary-local-variables))
6840     (while locals
6841       (if (consp (car locals))
6842           (and (vectorp (car (car locals)))
6843                (set (car (car locals)) nil))
6844         (and (vectorp (car locals))
6845              (set (car locals) nil)))
6846       (setq locals (cdr locals)))))
6847
6848 ;; Summary data functions.
6849
6850 (defmacro gnus-data-number (data)
6851   `(car ,data))
6852
6853 (defmacro gnus-data-set-number (data number)
6854   `(setcar ,data ,number))
6855
6856 (defmacro gnus-data-mark (data)
6857   `(nth 1 ,data))
6858
6859 (defmacro gnus-data-set-mark (data mark)
6860   `(setcar (nthcdr 1 ,data) ,mark))
6861
6862 (defmacro gnus-data-pos (data)
6863   `(nth 2 ,data))
6864
6865 (defmacro gnus-data-set-pos (data pos)
6866   `(setcar (nthcdr 2 ,data) ,pos))
6867
6868 (defmacro gnus-data-header (data)
6869   `(nth 3 ,data))
6870
6871 (defmacro gnus-data-level (data)
6872   `(nth 4 ,data))
6873
6874 (defmacro gnus-data-unread-p (data)
6875   `(= (nth 1 ,data) gnus-unread-mark))
6876
6877 (defmacro gnus-data-pseudo-p (data)
6878   `(consp (nth 3 ,data)))
6879
6880 (defmacro gnus-data-find (number)
6881   `(assq ,number gnus-newsgroup-data))
6882
6883 (defmacro gnus-data-find-list (number &optional data)
6884   `(let ((bdata ,(or data 'gnus-newsgroup-data)))
6885      (memq (assq ,number bdata)
6886            bdata)))
6887
6888 (defmacro gnus-data-make (number mark pos header level)
6889   `(list ,number ,mark ,pos ,header ,level))
6890
6891 (defun gnus-data-enter (after-article number mark pos header level offset)
6892   (let ((data (gnus-data-find-list after-article)))
6893     (or data (error "No such article: %d" after-article))
6894     (setcdr data (cons (gnus-data-make number mark pos header level)
6895                        (cdr data)))
6896     (setq gnus-newsgroup-data-reverse nil)
6897     (gnus-data-update-list (cdr (cdr data)) offset)))
6898
6899 (defun gnus-data-enter-list (after-article list &optional offset)
6900   (when list
6901     (let ((data (and after-article (gnus-data-find-list after-article)))
6902           (ilist list))
6903       (or data (not after-article) (error "No such article: %d" after-article))
6904       ;; Find the last element in the list to be spliced into the main
6905       ;; list.
6906       (while (cdr list)
6907         (setq list (cdr list)))
6908       (if (not data)
6909           (progn
6910             (setcdr list gnus-newsgroup-data)
6911             (setq gnus-newsgroup-data ilist)
6912             (and offset (gnus-data-update-list (cdr list) offset)))
6913         (setcdr list (cdr data))
6914         (setcdr data ilist)
6915         (and offset (gnus-data-update-list (cdr data) offset)))
6916       (setq gnus-newsgroup-data-reverse nil))))
6917
6918 (defun gnus-data-remove (article &optional offset)
6919   (let ((data gnus-newsgroup-data))
6920     (if (= (gnus-data-number (car data)) article)
6921         (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
6922               gnus-newsgroup-data-reverse nil)
6923       (while (cdr data)
6924         (and (= (gnus-data-number (car (cdr data))) article)
6925              (progn
6926                (setcdr data (cdr (cdr data)))
6927                (and offset (gnus-data-update-list (cdr data) offset))
6928                (setq data nil
6929                      gnus-newsgroup-data-reverse nil)))
6930         (setq data (cdr data))))))
6931
6932 (defmacro gnus-data-list (backward)
6933   `(if ,backward
6934        (or gnus-newsgroup-data-reverse
6935            (setq gnus-newsgroup-data-reverse
6936                  (reverse gnus-newsgroup-data)))
6937      gnus-newsgroup-data))
6938
6939 (defun gnus-data-update-list (data offset)
6940   "Add OFFSET to the POS of all data entries in DATA."
6941   (while data
6942     (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
6943     (setq data (cdr data))))
6944
6945 (defun gnus-data-compute-positions ()
6946   "Compute the positions of all articles."
6947   (let ((data gnus-newsgroup-data)
6948         pos)
6949     (while data
6950       (when (setq pos (text-property-any
6951                        (point-min) (point-max)
6952                        'gnus-number (gnus-data-number (car data))))
6953         (gnus-data-set-pos (car data) (+ pos 3)))
6954       (setq data (cdr data)))))
6955
6956 (defun gnus-summary-article-pseudo-p (article)
6957   "Say whether this article is a pseudo article or not."
6958   (not (vectorp (gnus-data-header (gnus-data-find article)))))
6959
6960 (defun gnus-article-parent-p (number)
6961   "Say whether this article is a parent or not."
6962   (let* ((data (gnus-data-find-list number)))
6963     (and (cdr data)                     ; There has to be an article after...
6964          (< (gnus-data-level (car data)) ; And it has to have a higher level.
6965             (gnus-data-level (nth 1 data))))))
6966
6967 (defmacro gnus-summary-skip-intangible ()
6968   "If the current article is intangible, then jump to a different article."
6969   '(let ((to (get-text-property (point) 'gnus-intangible)))
6970     (when to
6971       (gnus-summary-goto-subject to))))
6972
6973 (defmacro gnus-summary-article-intangible-p ()
6974   "Say whether this article is intangible or not."
6975   '(get-text-property (point) 'gnus-intangible))
6976
6977 ;; Some summary mode macros.
6978
6979 (defmacro gnus-summary-article-number ()
6980   "The article number of the article on the current line.
6981 If there isn's an article number here, then we return the current
6982 article number."
6983   '(progn
6984      (gnus-summary-skip-intangible)
6985      (or (get-text-property (point) 'gnus-number)
6986          (gnus-summary-last-subject))))
6987
6988 (defmacro gnus-summary-article-header (&optional number)
6989   `(gnus-data-header (gnus-data-find
6990                       ,(or number '(gnus-summary-article-number)))))
6991
6992 (defmacro gnus-summary-thread-level (&optional number)
6993   `(if (and (eq gnus-summary-make-false-root 'dummy)
6994             (get-text-property (point) 'gnus-intangible))
6995        0
6996      (gnus-data-level (gnus-data-find
6997                        ,(or number '(gnus-summary-article-number))))))
6998
6999 (defmacro gnus-summary-article-mark (&optional number)
7000   `(gnus-data-mark (gnus-data-find
7001                     ,(or number '(gnus-summary-article-number)))))
7002
7003 (defmacro gnus-summary-article-pos (&optional number)
7004   `(gnus-data-pos (gnus-data-find
7005                    ,(or number '(gnus-summary-article-number)))))
7006
7007 (defmacro gnus-summary-article-subject (&optional number)
7008   "Return current subject string or nil if nothing."
7009   `(let ((headers
7010           ,(if number
7011                `(gnus-data-header (assq ,number gnus-newsgroup-data))
7012              '(gnus-data-header (assq (gnus-summary-article-number)
7013                                       gnus-newsgroup-data)))))
7014      (and headers
7015           (vectorp headers)
7016           (mail-header-subject headers))))
7017
7018 (defmacro gnus-summary-article-score (&optional number)
7019   "Return current article score."
7020   `(or (cdr (assq ,(or number '(gnus-summary-article-number))
7021                   gnus-newsgroup-scored))
7022        gnus-summary-default-score 0))
7023
7024 (defun gnus-summary-article-children (&optional number)
7025   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
7026          (level (gnus-data-level (car data)))
7027          l children)
7028     (while (and (setq data (cdr data))
7029                 (> (setq l (gnus-data-level (car data))) level))
7030       (and (= (1+ level) l)
7031            (setq children (cons (gnus-data-number (car data))
7032                                 children))))
7033     (nreverse children)))
7034
7035 (defun gnus-summary-article-parent (&optional number)
7036   (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
7037                                     (gnus-data-list t)))
7038          (level (gnus-data-level (car data)))
7039          l)
7040     (if (zerop level)
7041         () ; This is a root.
7042       ;; We search until we find an article with a level less than
7043       ;; this one.  That function has to be the parent.
7044       (while (and (setq data (cdr data))
7045                   (not (< (gnus-data-level (car data)) level))))
7046       (and data (gnus-data-number (car data))))))
7047
7048
7049 ;; Various summary mode internalish functions.
7050
7051 (defun gnus-mouse-pick-article (e)
7052   (interactive "e")
7053   (mouse-set-point e)
7054   (gnus-summary-next-page nil t))
7055
7056 (defun gnus-summary-setup-buffer (group)
7057   "Initialize summary buffer."
7058   (let ((buffer (concat "*Summary " group "*")))
7059     (if (get-buffer buffer)
7060         (progn
7061           (set-buffer buffer)
7062           (setq gnus-summary-buffer (current-buffer))
7063           (not gnus-newsgroup-prepared))
7064       ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
7065       (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
7066       (gnus-add-current-to-buffer-list)
7067       (gnus-summary-mode group)
7068       (when gnus-carpal
7069         (gnus-carpal-setup-buffer 'summary))
7070       (unless gnus-single-article-buffer
7071         (make-local-variable 'gnus-article-buffer)
7072         (make-local-variable 'gnus-original-article-buffer))
7073       (setq gnus-newsgroup-name group)
7074       t)))
7075
7076 (defun gnus-set-global-variables ()
7077   ;; Set the global equivalents of the summary buffer-local variables
7078   ;; to the latest values they had.  These reflect the summary buffer
7079   ;; that was in action when the last article was fetched.
7080   (when (eq major-mode 'gnus-summary-mode)
7081     (setq gnus-summary-buffer (current-buffer))
7082     (let ((name gnus-newsgroup-name)
7083           (marked gnus-newsgroup-marked)
7084           (unread gnus-newsgroup-unreads)
7085           (headers gnus-current-headers)
7086           (data gnus-newsgroup-data)
7087           (article-buffer gnus-article-buffer)
7088           (score-file gnus-current-score-file))
7089       (save-excursion
7090         (set-buffer gnus-group-buffer)
7091         (setq gnus-newsgroup-name name)
7092         (setq gnus-newsgroup-marked marked)
7093         (setq gnus-newsgroup-unreads unread)
7094         (setq gnus-current-headers headers)
7095         (setq gnus-newsgroup-data data)
7096         (setq gnus-article-buffer article-buffer)
7097         (setq gnus-current-score-file score-file)))))
7098
7099 (defun gnus-summary-last-article-p (&optional article)
7100   "Return whether ARTICLE is the last article in the buffer."
7101   (if (not (setq article (or article (gnus-summary-article-number))))
7102       t ; All non-existant numbers are the last article. :-)
7103     (cdr (gnus-data-find-list article))))
7104
7105 (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
7106   "Insert a dummy root in the summary buffer."
7107   (beginning-of-line)
7108   (add-text-properties
7109    (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
7110    (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
7111
7112 (defvar gnus-thread-indent-array nil)
7113 (defvar gnus-thread-indent-array-level gnus-thread-indent-level)
7114 (defun gnus-make-thread-indent-array ()
7115   (let ((n 200))
7116     (if (and gnus-thread-indent-array
7117              (= gnus-thread-indent-level gnus-thread-indent-array-level))
7118         nil
7119       (setq gnus-thread-indent-array (make-vector 201 "")
7120             gnus-thread-indent-array-level gnus-thread-indent-level)
7121       (while (>= n 0)
7122         (aset gnus-thread-indent-array n
7123               (make-string (* n gnus-thread-indent-level) ? ))
7124         (setq n (1- n))))))
7125
7126 (defun gnus-summary-insert-line
7127   (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread
7128                    gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
7129                    &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
7130   (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
7131          (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
7132          (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
7133          (gnus-tmp-score-char
7134           (if (or (null gnus-summary-default-score)
7135                   (<= (abs (- gnus-tmp-score gnus-summary-default-score))
7136                       gnus-summary-zcore-fuzz)) ? 
7137             (if (< gnus-tmp-score gnus-summary-default-score)
7138                 gnus-score-below-mark gnus-score-over-mark)))
7139          (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark)
7140                                  ((memq gnus-tmp-current gnus-newsgroup-cached)
7141                                   gnus-cached-mark)
7142                                  (gnus-tmp-replied gnus-replied-mark)
7143                                  ((memq gnus-tmp-current gnus-newsgroup-saved)
7144                                   gnus-saved-mark)
7145                                  (t gnus-unread-mark)))
7146          (gnus-tmp-from (mail-header-from gnus-tmp-header))
7147          (gnus-tmp-name
7148           (cond
7149            ((string-match "(.+)" gnus-tmp-from)
7150             (substring gnus-tmp-from
7151                        (1+ (match-beginning 0)) (1- (match-end 0))))
7152            ((string-match "<[^>]+> *$" gnus-tmp-from)
7153             (let ((beg (match-beginning 0)))
7154               (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
7155                        (substring gnus-tmp-from (1+ (match-beginning 0))
7156                                   (1- (match-end 0))))
7157                   (substring gnus-tmp-from 0 beg))))
7158            (t gnus-tmp-from)))
7159          (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
7160          (gnus-tmp-number (mail-header-number gnus-tmp-header))
7161          (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
7162          (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
7163          (buffer-read-only nil))
7164     (when (string= gnus-tmp-name "")
7165       (setq gnus-tmp-name gnus-tmp-from))
7166     (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
7167     (put-text-property
7168      (point)
7169      (progn (eval gnus-summary-line-format-spec) (point))
7170      'gnus-number gnus-tmp-number)
7171     (when (gnus-visual-p 'summary-highlight 'highlight)
7172       (forward-line -1)
7173       (run-hooks 'gnus-summary-update-hook)
7174       (forward-line 1))))
7175
7176 (defun gnus-summary-update-line (&optional dont-update)
7177   ;; Update summary line after change.
7178   (when (and gnus-summary-default-score
7179              (not gnus-summary-inhibit-highlight))
7180     (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
7181            (article (gnus-summary-article-number))
7182            (score (gnus-summary-article-score article)))
7183       (unless dont-update
7184         (if (and gnus-summary-mark-below
7185                  (< (gnus-summary-article-score)
7186                     gnus-summary-mark-below))
7187             ;; This article has a low score, so we mark it as read.
7188             (when (memq article gnus-newsgroup-unreads)
7189               (gnus-summary-mark-article-as-read gnus-low-score-mark))
7190           (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
7191             ;; This article was previously marked as read on account
7192             ;; of a low score, but now it has risen, so we mark it as
7193             ;; unread.
7194             (gnus-summary-mark-article-as-unread gnus-unread-mark)))
7195         (gnus-summary-update-mark
7196          (if (or (null gnus-summary-default-score)
7197                  (<= (abs (- score gnus-summary-default-score))
7198                      gnus-summary-zcore-fuzz)) ? 
7199            (if (< score gnus-summary-default-score)
7200                gnus-score-below-mark gnus-score-over-mark)) 'score))
7201       ;; Do visual highlighting.
7202       (when (gnus-visual-p 'summary-highlight 'highlight)
7203         (run-hooks 'gnus-summary-update-hook)))))
7204
7205 (defvar gnus-tmp-new-adopts nil)
7206
7207 (defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
7208   ;; Sum up all elements (and sub-elements) in a list.
7209   (let* ((number
7210           ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
7211           (cond
7212            ((and (consp thread) (cdr thread))
7213             (apply
7214              '+ 1 (mapcar
7215                    'gnus-summary-number-of-articles-in-thread (cdr thread))))
7216            ((null thread)
7217             1)
7218            ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
7219             1)
7220            (t 1))))
7221     (when (and level (zerop level) gnus-tmp-new-adopts)
7222       (incf number
7223             (apply '+ (mapcar
7224                        'gnus-summary-number-of-articles-in-thread
7225                        gnus-tmp-new-adopts))))
7226     (if char
7227         (if (> number 1) gnus-not-empty-thread-mark
7228           gnus-empty-thread-mark)
7229       number)))
7230
7231 (defun gnus-summary-set-local-parameters (group)
7232  "Go through the local params of GROUP and set all variable specs in that list."
7233   (let ((params (gnus-info-params (gnus-get-info group)))
7234         elem)
7235     (while params
7236       (setq elem (car params)
7237             params (cdr params))
7238       (and (consp elem)                 ; Has to be a cons.
7239            (consp (cdr elem))           ; The cdr has to be a list.
7240            (symbolp (car elem))         ; Has to be a symbol in there.
7241            (progn                       ; So we set it.
7242              (make-local-variable (car elem))
7243              (set (car elem) (eval (nth 1 elem))))))))
7244
7245 (defun gnus-summary-read-group
7246   (group &optional show-all no-article kill-buffer no-display)
7247   "Start reading news in newsgroup GROUP.
7248 If SHOW-ALL is non-nil, already read articles are also listed.
7249 If NO-ARTICLE is non-nil, no article is selected initially.
7250 If NO-DISPLAY, don't generate a summary buffer."
7251   (gnus-message 5 "Retrieving newsgroup: %s..." group)
7252   (let* ((new-group (gnus-summary-setup-buffer group))
7253          (quit-config (gnus-group-quit-config group))
7254          (did-select (and new-group (gnus-select-newsgroup group show-all))))
7255     (cond
7256      ;; This summary buffer exists already, so we just select it.
7257      ((not new-group)
7258       (gnus-set-global-variables)
7259       (when kill-buffer
7260         (gnus-kill-or-deaden-summary kill-buffer))
7261       (gnus-configure-windows 'summary 'force)
7262       (gnus-set-mode-line 'summary)
7263       (gnus-summary-position-point)
7264       (message "")
7265       t)
7266      ;; We couldn't select this group.
7267      ((null did-select)
7268       (when (and (eq major-mode 'gnus-summary-mode)
7269                  (not (equal (current-buffer) kill-buffer)))
7270         (kill-buffer (current-buffer))
7271         (if (not quit-config)
7272             (progn
7273               (set-buffer gnus-group-buffer)
7274               (gnus-group-jump-to-group group)
7275               (gnus-group-next-unread-group 1))
7276           (if (not (buffer-name (car quit-config)))
7277               (gnus-configure-windows 'group 'force)
7278             (set-buffer (car quit-config))
7279             (and (eq major-mode 'gnus-summary-mode)
7280                  (gnus-set-global-variables))
7281             (gnus-configure-windows (cdr quit-config)))))
7282       (gnus-message 3 "Can't select group")
7283       nil)
7284      ;; The user did a `C-g' while prompting for number of articles,
7285      ;; so we exit this group.
7286      ((eq did-select 'quit)
7287       (and (eq major-mode 'gnus-summary-mode)
7288            (not (equal (current-buffer) kill-buffer))
7289            (kill-buffer (current-buffer)))
7290       (when kill-buffer
7291         (gnus-kill-or-deaden-summary kill-buffer))
7292       (if (not quit-config)
7293           (progn
7294             (set-buffer gnus-group-buffer)
7295             (gnus-group-jump-to-group group)
7296             (gnus-group-next-unread-group 1)
7297             (gnus-configure-windows 'group 'force))
7298         (if (not (buffer-name (car quit-config)))
7299             (gnus-configure-windows 'group 'force)
7300           (set-buffer (car quit-config))
7301           (and (eq major-mode 'gnus-summary-mode)
7302                (gnus-set-global-variables))
7303           (gnus-configure-windows (cdr quit-config))))
7304       ;; Finally signal the quit.
7305       (signal 'quit nil))
7306      ;; The group was successfully selected.
7307      (t
7308       (gnus-set-global-variables)
7309       ;; Save the active value in effect when the group was entered.
7310       (setq gnus-newsgroup-active
7311             (gnus-copy-sequence
7312              (gnus-active gnus-newsgroup-name)))
7313       ;; You can change the summary buffer in some way with this hook.
7314       (run-hooks 'gnus-select-group-hook)
7315       ;; Set any local variables in the group parameters.
7316       (gnus-summary-set-local-parameters gnus-newsgroup-name)
7317       (gnus-update-format-specifications)
7318       ;; Do score processing.
7319       (when gnus-use-scoring
7320         (gnus-possibly-score-headers))
7321       ;; Check whether to fill in the gaps in the threads.
7322       (when gnus-build-sparse-threads
7323         (gnus-build-sparse-threads))
7324       ;; Find the initial limit.
7325       (gnus-summary-initial-limit show-all)
7326       ;; Generate the summary buffer.
7327       (unless no-display
7328         (gnus-summary-prepare))
7329       (when gnus-use-trees
7330         (gnus-tree-open group)
7331         (setq gnus-summary-highlight-line-function
7332               'gnus-tree-highlight-article))
7333       ;; If the summary buffer is empty, but there are some low-scored
7334       ;; articles or some excluded dormants, we include these in the
7335       ;; buffer.
7336       (when (zerop (buffer-size))
7337         (cond (gnus-newsgroup-dormant
7338                (gnus-summary-limit-include-dormant))
7339               ((and gnus-newsgroup-scored show-all)
7340                (gnus-summary-limit-include-expunged))))
7341       ;; Function `gnus-apply-kill-file' must be called in this hook.
7342       (run-hooks 'gnus-apply-kill-hook)
7343       (if (zerop (buffer-size))
7344           (progn
7345             ;; This newsgroup is empty.
7346             (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
7347             (gnus-message 6 "No unread news")
7348             (when kill-buffer
7349               (gnus-kill-or-deaden-summary kill-buffer))
7350             ;; Return nil from this function.
7351             nil)
7352         ;; Hide conversation thread subtrees.  We cannot do this in
7353         ;; gnus-summary-prepare-hook since kill processing may not
7354         ;; work with hidden articles.
7355         (and gnus-show-threads
7356              gnus-thread-hide-subtree
7357              (gnus-summary-hide-all-threads))
7358         ;; Show first unread article if requested.
7359         (if (and (not no-article)
7360                  gnus-newsgroup-unreads
7361                  gnus-auto-select-first)
7362             (if (eq gnus-auto-select-first 'best)
7363                 (gnus-summary-best-unread-article)
7364               (gnus-summary-first-unread-article))
7365           ;; Don't select any articles, just move point to the first
7366           ;; article in the group.
7367           (goto-char (point-min))
7368           (gnus-summary-position-point)
7369           (gnus-set-mode-line 'summary)
7370           (gnus-configure-windows 'summary 'force))
7371         ;; If we are in async mode, we send some info to the backend.
7372         (when gnus-newsgroup-async
7373           (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data))
7374         (when kill-buffer
7375           (gnus-kill-or-deaden-summary kill-buffer))
7376         (when (get-buffer-window gnus-group-buffer)
7377           ;; Gotta use windows, because recenter does wierd stuff if
7378           ;; the current buffer ain't the displayed window.
7379           (let ((owin (selected-window)))
7380             (select-window (get-buffer-window gnus-group-buffer))
7381             (when (gnus-group-goto-group group)
7382               (recenter))
7383             (select-window owin))))
7384       ;; Mark this buffer as "prepared".
7385       (setq gnus-newsgroup-prepared t)
7386       t))))
7387
7388 (defun gnus-summary-prepare ()
7389   "Generate the summary buffer."
7390   (let ((buffer-read-only nil))
7391     (erase-buffer)
7392     (setq gnus-newsgroup-data nil
7393           gnus-newsgroup-data-reverse nil)
7394     (run-hooks 'gnus-summary-generate-hook)
7395     ;; Generate the buffer, either with threads or without.
7396     (when gnus-newsgroup-headers
7397       (gnus-summary-prepare-threads
7398        (if gnus-show-threads
7399            (gnus-sort-gathered-threads
7400             (funcall gnus-summary-thread-gathering-function
7401                      (gnus-sort-threads
7402                       (gnus-cut-threads (gnus-make-threads)))))
7403          ;; Unthreaded display.
7404          (gnus-sort-articles gnus-newsgroup-headers))))
7405     (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
7406     ;; Call hooks for modifying summary buffer.
7407     (goto-char (point-min))
7408     (run-hooks 'gnus-summary-prepare-hook)))
7409
7410 (defun gnus-gather-threads-by-subject (threads)
7411   "Gather threads by looking at Subject headers."
7412   (if (not gnus-summary-make-false-root)
7413       threads
7414     (let ((hashtb (gnus-make-hashtable 1023))
7415           (prev threads)
7416           (result threads)
7417           subject hthread whole-subject)
7418       (while threads
7419         (setq whole-subject (mail-header-subject (car (car threads))))
7420         (if (and gnus-summary-gather-exclude-subject
7421                  (string-match gnus-summary-gather-exclude-subject
7422                                whole-subject))
7423             () ; We don't want to do anything with this article.
7424           ;; We simplify the subject before looking it up in the
7425           ;; hash table.
7426           (setq subject
7427                 (cond
7428                  ;; Truncate the subject.
7429                  ((numberp gnus-summary-gather-subject-limit)
7430                   (setq subject (gnus-simplify-subject-re whole-subject))
7431                   (if (> (length subject) gnus-summary-gather-subject-limit)
7432                       (substring subject 0 gnus-summary-gather-subject-limit)
7433                     subject))
7434                  ;; Fuzzily simplify it.
7435                  ((eq 'fuzzy gnus-summary-gather-subject-limit)
7436                   (gnus-simplify-subject-fuzzy whole-subject))
7437                  ;; Just remove the leading "Re:".
7438                  (t
7439                   (gnus-simplify-subject-re whole-subject))))
7440
7441           (if (setq hthread (gnus-gethash subject hashtb))
7442               (progn
7443                 ;; We enter a dummy root into the thread, if we
7444                 ;; haven't done that already.
7445                 (unless (stringp (car (car hthread)))
7446                   (setcar hthread (list whole-subject (car hthread))))
7447                 ;; We add this new gathered thread to this gathered
7448                 ;; thread.
7449                 (setcdr (car hthread)
7450                         (nconc (cdr (car hthread)) (list (car threads))))
7451                 ;; Remove it from the list of threads.
7452                 (setcdr prev (cdr threads))
7453                 (setq threads prev))
7454             ;; Enter this thread into the hash table.
7455             (gnus-sethash subject threads hashtb)))
7456         (setq prev threads)
7457         (setq threads (cdr threads)))
7458       result)))
7459
7460 (defun gnus-summary-gather-threads-by-references (threads)
7461   "Gather threads by looking at References headers."
7462   (let ((idhashtb (gnus-make-hashtable 1023))
7463         (thhashtb (gnus-make-hashtable 1023))
7464         (prev threads)
7465         (result threads)
7466         ids references id gthread gid entered)
7467     (while threads
7468       (when (setq references (mail-header-references (caar threads)))
7469         (setq id (mail-header-id (caar threads)))
7470         (setq ids (gnus-split-references references))
7471         (setq entered nil)
7472         (while ids
7473           (if (not (setq gid (gnus-gethash (car ids) idhashtb)))
7474               (progn
7475                 (gnus-sethash (car ids) id idhashtb)
7476                 (gnus-sethash id threads thhashtb))
7477             (setq gthread (gnus-gethash gid thhashtb))
7478             (unless entered
7479               ;; We enter a dummy root into the thread, if we
7480               ;; haven't done that already.
7481               (unless (stringp (caar gthread))
7482                 (setcar gthread (list (mail-header-subject (caar gthread))
7483                                       (car gthread))))
7484               ;; We add this new gathered thread to this gathered
7485               ;; thread.
7486               (setcdr (car gthread)
7487                       (nconc (cdar gthread) (list (car threads)))))
7488             ;; Add it into the thread hash table.
7489             (gnus-sethash id gthread thhashtb)
7490             (setq entered t)
7491             ;; Remove it from the list of threads.
7492             (setcdr prev (cdr threads))
7493             (setq threads prev))
7494           (setq ids (cdr ids))))
7495       (setq prev threads)
7496       (setq threads (cdr threads)))
7497     result))
7498
7499 (defun gnus-sort-gathered-threads (threads)
7500   "Sort subtreads inside each gathered thread by article number."
7501   (let ((result threads))
7502     (while threads
7503       (when (stringp (car (car threads)))
7504         (setcdr (car threads)
7505                 (sort (cdr (car threads)) 'gnus-thread-sort-by-number)))
7506       (setq threads (cdr threads)))
7507     result))
7508
7509 (defun gnus-make-threads ()
7510   "Go through the dependency hashtb and find the roots.  Return all threads."
7511   (let (threads)
7512     (mapatoms
7513      (lambda (refs)
7514        (unless (car (symbol-value refs))
7515          ;; These threads do not refer back to any other articles,
7516          ;; so they're roots.
7517          (setq threads (append (cdr (symbol-value refs)) threads))))
7518      gnus-newsgroup-dependencies)
7519     threads))
7520
7521 (defun gnus-build-sparse-threads ()
7522   (let ((headers gnus-newsgroup-headers)
7523         (deps gnus-newsgroup-dependencies)
7524         header references generation relations 
7525         cthread subject child end pthread relation)
7526     ;; First we create an alist of generations/relations, where 
7527     ;; generations is how much we trust the ralation, and the relation
7528     ;; is parent/child.
7529     (gnus-message 7 "Making sparse threads...")
7530     (save-excursion
7531       (nnheader-set-temp-buffer " *gnus sparse threads*")
7532       (while (setq header (pop headers))
7533         (when (and (setq references (mail-header-references header))
7534                    (not (string= references "")))
7535           (insert references)
7536           (setq child (downcase (mail-header-id header))
7537                 subject (mail-header-subject header))
7538           (setq generation 0)
7539           (while (search-backward ">" nil t)
7540             (setq end (1+ (point)))
7541             (when (search-backward "<" nil t)
7542               (push (list (incf generation) 
7543                           child (setq child (downcase
7544                                              (buffer-substring (point) end)))
7545                           subject)
7546                     relations)))
7547           (push (list (1+ generation) child nil subject) relations)
7548           (erase-buffer)))
7549       (kill-buffer (current-buffer)))
7550     ;; Sort over trustworthiness.
7551     (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2)))))
7552     (while (setq relation (pop relations))
7553       (when (if (boundp (setq cthread (intern (cadr relation) deps)))
7554                 (unless (car (symbol-value cthread))
7555                   ;; Make this article the parent of these threads.
7556                   (setcar (symbol-value cthread)
7557                           (vector gnus-reffed-article-number 
7558                                   (cadddr relation) 
7559                                   "" ""
7560                                   (cadr relation) 
7561                                   (or (caddr relation) "") 0 0 "")))
7562               (set cthread (list (vector gnus-reffed-article-number
7563                                          (cadddr relation) 
7564                                          "" "" (cadr relation) 
7565                                          (or (caddr relation) "") 0 0 ""))))
7566         (push gnus-reffed-article-number gnus-newsgroup-limit)
7567         (push gnus-reffed-article-number gnus-newsgroup-sparse)
7568         (push (cons gnus-reffed-article-number gnus-sparse-mark)
7569               gnus-newsgroup-reads)
7570         (decf gnus-reffed-article-number)
7571         ;; Make this new thread the child of its parent.
7572         (if (boundp (setq pthread (intern (or (caddr relation) "none") deps)))
7573             (setcdr (symbol-value pthread)
7574                     (nconc (cdr (symbol-value pthread))
7575                            (list (symbol-value cthread))))
7576           (set pthread (list nil (symbol-value cthread))))))
7577     (gnus-message 7 "Making sparse threads...done")))
7578
7579 (defun gnus-build-old-threads ()
7580   ;; Look at all the articles that refer back to old articles, and
7581   ;; fetch the headers for the articles that aren't there.  This will
7582   ;; build complete threads - if the roots haven't been expired by the
7583   ;; server, that is.
7584   (let (id heads)
7585     (mapatoms
7586      (lambda (refs)
7587        (when (not (car (symbol-value refs)))
7588          (setq heads (cdr (symbol-value refs)))
7589          (while heads
7590            (if (memq (mail-header-number (car (car heads)))
7591                      gnus-newsgroup-dormant)
7592                (setq heads (cdr heads))
7593              (setq id (symbol-name refs))
7594              (while (and (setq id (gnus-build-get-header id))
7595                          (not (car (gnus-gethash
7596                                     id gnus-newsgroup-dependencies)))))
7597              (setq heads nil)))))
7598      gnus-newsgroup-dependencies)))
7599
7600 (defun gnus-build-get-header (id)
7601   ;; Look through the buffer of NOV lines and find the header to
7602   ;; ID.  Enter this line into the dependencies hash table, and return
7603   ;; the id of the parent article (if any).
7604   (let ((deps gnus-newsgroup-dependencies)
7605         found header)
7606     (prog1
7607         (save-excursion
7608           (set-buffer nntp-server-buffer)
7609           (goto-char (point-min))
7610           (while (and (not found) (search-forward id nil t))
7611             (beginning-of-line)
7612             (setq found (looking-at
7613                          (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
7614                                  (regexp-quote id))))
7615             (or found (beginning-of-line 2)))
7616           (when found
7617             (let (ref)
7618               (beginning-of-line)
7619               (and
7620                (setq header (gnus-nov-parse-line
7621                              (read (current-buffer)) deps))
7622                (gnus-parent-id (mail-header-references header))))))
7623       (when header
7624         (let ((number (mail-header-number header)))
7625           (push number gnus-newsgroup-limit)
7626           (push header gnus-newsgroup-headers)
7627           (if (memq number gnus-newsgroup-unselected)
7628               (progn
7629                 (push number gnus-newsgroup-unreads)
7630                 (setq gnus-newsgroup-unselected
7631                       (delq number gnus-newsgroup-unselected)))
7632             (push number gnus-newsgroup-ancient)))))))
7633
7634 (defun gnus-summary-update-article (article &optional header)
7635   "Update ARTICLE in the summary buffer."
7636   (let ((id (mail-header-id (gnus-summary-article-header article)))
7637         (data (gnus-data-find article)))
7638     (setcar (gnus-id-to-thread id) nil)
7639     (gnus-summary-insert-subject id)
7640     ;; Set the (possibly) new article number in the data structure.
7641     (gnus-data-set-number data (gnus-id-to-article id))))
7642
7643 (defun gnus-rebuild-thread (id)
7644   "Rebuild the thread containing ID."
7645   (let ((dep gnus-newsgroup-dependencies)
7646         (buffer-read-only nil)
7647         current headers refs thread art data)
7648     (if (not gnus-show-threads)
7649         (setq thread (list (car (gnus-id-to-thread id))))
7650       ;; Get the thread this article is part of.
7651       (setq thread (gnus-remove-thread id)))
7652     (setq current (save-excursion
7653                     (and (zerop (forward-line -1))
7654                          (gnus-summary-article-number))))
7655     ;; If this is a gathered thread, we have to go some re-gathering.
7656     (when (stringp (car thread))
7657       (let ((subject (car thread))
7658             roots thr)
7659         (setq thread (cdr thread))
7660         (while thread
7661           (unless (memq (setq thr (gnus-id-to-thread
7662                                       (gnus-root-id
7663                                        (mail-header-id (car (car thread))))))
7664                         roots)
7665             (push thr roots))
7666           (setq thread (cdr thread)))
7667         ;; We now have all (unique) roots.
7668         (if (= (length roots) 1)
7669             ;; All the loose roots are now one solid root.
7670             (setq thread (car roots))
7671           (setq thread (cons subject (gnus-sort-threads roots))))))
7672     (let ((beg (point))
7673           threads)
7674       ;; We then insert this thread into the summary buffer.
7675       (let (gnus-newsgroup-data gnus-newsgroup-threads)
7676         (gnus-summary-prepare-threads (list thread))
7677         (setq data (nreverse gnus-newsgroup-data))
7678         (setq threads gnus-newsgroup-threads))
7679       ;; We splice the new data into the data structure.
7680       (gnus-data-enter-list current data)
7681       (gnus-data-compute-positions)
7682       (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
7683
7684 (defun gnus-id-to-thread (id)
7685   "Return the (sub-)thread where ID appears."
7686   (gnus-gethash (downcase id) gnus-newsgroup-dependencies))
7687
7688 (defun gnus-id-to-article (id)
7689   "Return the article number of ID."
7690   (let ((thread (gnus-id-to-thread id)))
7691     (when thread
7692       (mail-header-number (car thread)))))
7693
7694 (defun gnus-id-to-header (id)
7695   "Return the article headers of ID."
7696   (car (gnus-id-to-thread id)))
7697
7698 (defun gnus-article-displayed-root-p (article)
7699   "Say whether ARTICLE is a root(ish) article."
7700   (let ((level (gnus-summary-thread-level article))
7701         particle)
7702     (cond 
7703      ((null level) nil)
7704      ((zerop level) t)
7705      ((and (= 1 level)
7706            (null (setq particle (gnus-id-to-article
7707                                  (gnus-parent-id 
7708                                   (mail-header-references 
7709                                    (gnus-summary-article-header article))))))
7710            (null (gnus-summary-thread-level particle)))))))
7711
7712 (defun gnus-root-id (id)
7713   "Return the id of the root of the thread where ID appears."
7714   (let (last-id prev)
7715     (while (and id (setq prev (car (gnus-gethash
7716                                     (downcase id)
7717                                     gnus-newsgroup-dependencies))))
7718       (setq last-id id
7719             id (gnus-parent-id (mail-header-references prev))))
7720     last-id))
7721
7722 (defun gnus-remove-thread (id &optional dont-remove)
7723   "Remove the thread that has ID in it."
7724   (let ((dep gnus-newsgroup-dependencies)
7725         headers thread prev last-id)
7726     ;; First go up in this thread until we find the root.
7727     (setq last-id (gnus-root-id id))
7728     (setq headers (list (car (gnus-id-to-thread last-id))
7729                         (car (car (cdr (gnus-id-to-thread last-id))))))
7730     ;; We have now found the real root of this thread.  It might have
7731     ;; been gathered into some loose thread, so we have to search
7732     ;; through the threads to find the thread we wanted.
7733     (let ((threads gnus-newsgroup-threads)
7734           sub)
7735       (while threads
7736         (setq sub (car threads))
7737         (if (stringp (car sub))
7738             ;; This is a gathered threads, so we look at the roots
7739             ;; below it to find whether this article in in this
7740             ;; gathered root.
7741             (progn
7742               (setq sub (cdr sub))
7743               (while sub
7744                 (when (member (car (car sub)) headers)
7745                   (setq thread (car threads)
7746                         threads nil
7747                         sub nil))
7748                 (setq sub (cdr sub))))
7749           ;; It's an ordinary thread, so we check it.
7750           (when (eq (car sub) (car headers))
7751             (setq thread sub
7752                   threads nil)))
7753         (setq threads (cdr threads)))
7754       ;; If this article is in no thread, then it's a root.
7755       (if thread
7756           (unless dont-remove
7757             (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
7758         (setq thread (gnus-gethash (downcase last-id) dep)))
7759       (when thread
7760         (prog1
7761             thread ; We return this thread.
7762           (unless dont-remove
7763             (if (stringp (car thread))
7764                 (progn
7765                   ;; If we use dummy roots, then we have to remove the
7766                   ;; dummy root as well.
7767                   (when (eq gnus-summary-make-false-root 'dummy)
7768                     ;; Uhm.
7769                     )
7770                   (setq thread (cdr thread))
7771                   (while thread
7772                     (gnus-remove-thread-1 (car thread))
7773                     (setq thread (cdr thread))))
7774               (gnus-remove-thread-1 thread))))))))
7775
7776 (defun gnus-remove-thread-1 (thread)
7777   "Remove the thread THREAD recursively."
7778   (let ((number (mail-header-number (car thread)))
7779         pos)
7780     (when (setq pos (text-property-any
7781                      (point-min) (point-max) 'gnus-number number))
7782       (goto-char pos)
7783       (gnus-delete-line)
7784       (gnus-data-remove number))
7785     (setq thread (cdr thread))
7786     (while thread
7787       (gnus-remove-thread-1 (car thread))
7788       (setq thread (cdr thread)))))
7789
7790 (defun gnus-sort-threads (threads)
7791   "Sort THREADS."
7792   (if (not gnus-thread-sort-functions)
7793       threads
7794     (let ((func (if (= 1 (length gnus-thread-sort-functions))
7795                     (car gnus-thread-sort-functions)
7796                   `(lambda (t1 t2)
7797                      ,(gnus-make-sort-function 
7798                        (reverse gnus-thread-sort-functions))))))
7799       (gnus-message 7 "Sorting threads...")
7800       (prog1
7801           (sort threads func)
7802         (gnus-message 7 "Sorting threads...done")))))
7803
7804 (defun gnus-sort-articles (articles)
7805   "Sort ARTICLES."
7806   (when gnus-article-sort-functions
7807     (let ((func (if (= 1 (length gnus-article-sort-functions))
7808                     (car gnus-article-sort-functions)
7809                   `(lambda (t1 t2)
7810                      ,(gnus-make-sort-function 
7811                        (reverse gnus-article-sort-functions))))))
7812       (gnus-message 7 "Sorting articles...")
7813       (prog1
7814           (setq gnus-newsgroup-headers (sort articles func))
7815         (gnus-message 7 "Sorting articles...done")))))
7816
7817 (defun gnus-make-sort-function (funs)
7818   "Return a composite sort condition based on the functions in FUNC."
7819   (if (cdr funs)
7820       `(or (,(car funs) t1 t2)
7821            (and (not (,(car funs) t2 t1))
7822                 ,(gnus-make-sort-function (cdr funs))))
7823     `(,(car funs) t1 t2)))
7824                  
7825 ;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
7826 (defmacro gnus-thread-header (thread)
7827   ;; Return header of first article in THREAD.
7828   ;; Note that THREAD must never, ever be anything else than a variable -
7829   ;; using some other form will lead to serious barfage.
7830   (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
7831   ;; (8% speedup to gnus-summary-prepare, just for fun :-)
7832   (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
7833         (vector thread) 2))
7834
7835 (defsubst gnus-article-sort-by-number (h1 h2)
7836   "Sort articles by article number."
7837   (< (mail-header-number h1)
7838      (mail-header-number h2)))
7839
7840 (defun gnus-thread-sort-by-number (h1 h2)
7841   "Sort threads by root article number."
7842   (gnus-article-sort-by-number
7843    (gnus-thread-header h1) (gnus-thread-header h2)))
7844
7845 (defsubst gnus-article-sort-by-author (h1 h2)
7846   "Sort articles by root author."
7847   (string-lessp
7848    (let ((extract (funcall
7849                    gnus-extract-address-components
7850                    (mail-header-from h1))))
7851      (or (car extract) (cdr extract)))
7852    (let ((extract (funcall
7853                    gnus-extract-address-components
7854                    (mail-header-from h2))))
7855      (or (car extract) (cdr extract)))))
7856
7857 (defun gnus-thread-sort-by-author (h1 h2)
7858   "Sort threads by root author."
7859   (gnus-article-sort-by-author
7860    (gnus-thread-header h1)  (gnus-thread-header h2)))
7861
7862 (defsubst gnus-article-sort-by-subject (h1 h2)
7863   "Sort articles by root subject."
7864   (string-lessp
7865    (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
7866    (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
7867
7868 (defun gnus-thread-sort-by-subject (h1 h2)
7869   "Sort threads by root subject."
7870   (gnus-article-sort-by-subject
7871    (gnus-thread-header h1) (gnus-thread-header h2)))
7872
7873 (defsubst gnus-article-sort-by-date (h1 h2)
7874   "Sort articles by root article date."
7875   (string-lessp
7876    (gnus-sortable-date (mail-header-date h1))
7877    (gnus-sortable-date (mail-header-date h2))))
7878
7879 (defun gnus-thread-sort-by-date (h1 h2)
7880   "Sort threads by root article date."
7881   (gnus-article-sort-by-date
7882    (gnus-thread-header h1) (gnus-thread-header h2)))
7883
7884 (defsubst gnus-article-sort-by-score (h1 h2)
7885   "Sort articles by root article score.
7886 Unscored articles will be counted as having a score of zero."
7887   (> (or (cdr (assq (mail-header-number h1)
7888                     gnus-newsgroup-scored))
7889          gnus-summary-default-score 0)
7890      (or (cdr (assq (mail-header-number h2)
7891                     gnus-newsgroup-scored))
7892          gnus-summary-default-score 0)))
7893
7894 (defun gnus-thread-sort-by-score (h1 h2)
7895   "Sort threads by root article score."
7896   (gnus-article-sort-by-score
7897    (gnus-thread-header h1) (gnus-thread-header h2)))
7898
7899 (defun gnus-thread-sort-by-total-score (h1 h2)
7900   "Sort threads by the sum of all scores in the thread.
7901 Unscored articles will be counted as having a score of zero."
7902   (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
7903
7904 (defun gnus-thread-total-score (thread)
7905   ;;  This function find the total score of THREAD.
7906   (if (consp thread)
7907       (if (stringp (car thread))
7908           (apply gnus-thread-score-function 0
7909                  (mapcar 'gnus-thread-total-score-1 (cdr thread)))
7910         (gnus-thread-total-score-1 thread))
7911     (gnus-thread-total-score-1 (list thread))))
7912
7913 (defun gnus-thread-total-score-1 (root)
7914   ;; This function find the total score of the thread below ROOT.
7915   (setq root (car root))
7916   (apply gnus-thread-score-function
7917          (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
7918              gnus-summary-default-score 0)
7919          (mapcar 'gnus-thread-total-score
7920                  (cdr (gnus-gethash (downcase (mail-header-id root))
7921                                     gnus-newsgroup-dependencies)))))
7922
7923 ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
7924 (defvar gnus-tmp-prev-subject nil)
7925 (defvar gnus-tmp-false-parent nil)
7926 (defvar gnus-tmp-root-expunged nil)
7927 (defvar gnus-tmp-dummy-line nil)
7928
7929 (defun gnus-summary-prepare-threads (threads)
7930   "Prepare summary buffer from THREADS and indentation LEVEL.
7931 THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
7932 or a straight list of headers."
7933   (gnus-message 7 "Generating summary...")
7934
7935   (setq gnus-newsgroup-threads threads)
7936   (beginning-of-line)
7937
7938   (let ((gnus-tmp-level 0)
7939         (default-score (or gnus-summary-default-score 0))
7940         (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
7941         thread number subject stack state gnus-tmp-gathered beg-match
7942         new-roots gnus-tmp-new-adopts thread-end
7943         gnus-tmp-header gnus-tmp-unread
7944         gnus-tmp-replied gnus-tmp-subject-or-nil
7945         gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
7946         gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
7947         gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
7948
7949     (setq gnus-tmp-prev-subject nil)
7950
7951     (if (vectorp (car threads))
7952         ;; If this is a straight (sic) list of headers, then a
7953         ;; threaded summary display isn't required, so we just create
7954         ;; an unthreaded one.
7955         (gnus-summary-prepare-unthreaded threads)
7956
7957       ;; Do the threaded display.
7958
7959       (while (or threads stack gnus-tmp-new-adopts new-roots)
7960
7961         (if (and (= gnus-tmp-level 0)
7962                  (not (setq gnus-tmp-dummy-line nil))
7963                  (or (not stack)
7964                      (= (car (car stack)) 0))
7965                  (not gnus-tmp-false-parent)
7966                  (or gnus-tmp-new-adopts new-roots))
7967             (if gnus-tmp-new-adopts
7968                 (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
7969                       thread (list (car gnus-tmp-new-adopts))
7970                       gnus-tmp-header (car (car thread))
7971                       gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
7972               (if new-roots
7973                   (setq thread (list (car new-roots))
7974                         gnus-tmp-header (car (car thread))
7975                         new-roots (cdr new-roots))))
7976
7977           (if threads
7978               ;; If there are some threads, we do them before the
7979               ;; threads on the stack.
7980               (setq thread threads
7981                     gnus-tmp-header (car (car thread)))
7982             ;; There were no current threads, so we pop something off
7983             ;; the stack.
7984             (setq state (car stack)
7985                   gnus-tmp-level (car state)
7986                   thread (cdr state)
7987                   stack (cdr stack)
7988                   gnus-tmp-header (car (car thread)))))
7989
7990         (setq gnus-tmp-false-parent nil)
7991         (setq gnus-tmp-root-expunged nil)
7992         (setq thread-end nil)
7993
7994         (if (stringp gnus-tmp-header)
7995             ;; The header is a dummy root.
7996             (cond
7997              ((eq gnus-summary-make-false-root 'adopt)
7998               ;; We let the first article adopt the rest.
7999               (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
8000                                                (cdr (cdr (car thread)))))
8001               (setq gnus-tmp-gathered
8002                     (nconc (mapcar
8003                             (lambda (h) (mail-header-number (car h)))
8004                             (cdr (cdr (car thread))))
8005                            gnus-tmp-gathered))
8006               (setq thread (cons (list (car (car thread))
8007                                        (car (cdr (car thread))))
8008                                  (cdr thread)))
8009               (setq gnus-tmp-level -1
8010                     gnus-tmp-false-parent t))
8011              ((eq gnus-summary-make-false-root 'empty)
8012               ;; We print adopted articles with empty subject fields.
8013               (setq gnus-tmp-gathered
8014                     (nconc (mapcar
8015                             (lambda (h) (mail-header-number (car h)))
8016                             (cdr (cdr (car thread))))
8017                            gnus-tmp-gathered))
8018               (setq gnus-tmp-level -1))
8019              ((eq gnus-summary-make-false-root 'dummy)
8020               ;; We remember that we probably want to output a dummy
8021               ;; root.
8022               (setq gnus-tmp-dummy-line gnus-tmp-header)
8023               (setq gnus-tmp-prev-subject gnus-tmp-header))
8024              (t
8025               ;; We do not make a root for the gathered
8026               ;; sub-threads at all.
8027               (setq gnus-tmp-level -1)))
8028
8029           (setq number (mail-header-number gnus-tmp-header)
8030                 subject (mail-header-subject gnus-tmp-header))
8031
8032           (cond
8033            ;; If the thread has changed subject, we might want to make
8034            ;; this subthread into a root.
8035            ((and (null gnus-thread-ignore-subject)
8036                  (not (zerop gnus-tmp-level))
8037                  gnus-tmp-prev-subject
8038                  (not (inline
8039                         (gnus-subject-equal gnus-tmp-prev-subject subject))))
8040             (setq new-roots (nconc new-roots (list (car thread)))
8041                   thread-end t
8042                   gnus-tmp-header nil))
8043            ;; If the article lies outside the current limit,
8044            ;; then we do not display it.
8045            ((and (not (memq number gnus-newsgroup-limit))
8046                  (not gnus-tmp-dummy-line))
8047             (setq gnus-tmp-gathered
8048                   (nconc (mapcar
8049                           (lambda (h) (mail-header-number (car h)))
8050                           (cdr (car thread)))
8051                          gnus-tmp-gathered))
8052             (setq gnus-tmp-new-adopts (if (cdr (car thread))
8053                                           (append gnus-tmp-new-adopts
8054                                                   (cdr (car thread)))
8055                                         gnus-tmp-new-adopts)
8056                   thread-end t
8057                   gnus-tmp-header nil)
8058             (when (zerop gnus-tmp-level)
8059               (setq gnus-tmp-root-expunged t)))
8060            ;; Perhaps this article is to be marked as read?
8061            ((and gnus-summary-mark-below
8062                  (< (or (cdr (assq number gnus-newsgroup-scored))
8063                         default-score)
8064                     gnus-summary-mark-below))
8065             (setq gnus-newsgroup-unreads
8066                   (delq number gnus-newsgroup-unreads))
8067             (if gnus-newsgroup-auto-expire
8068                 (push number gnus-newsgroup-expirable)
8069               (push (cons number gnus-low-score-mark)
8070                     gnus-newsgroup-reads))))
8071
8072           (when gnus-tmp-header
8073             ;; We may have an old dummy line to output before this
8074             ;; article.
8075             (if gnus-tmp-dummy-line
8076                 (progn
8077                   (gnus-summary-insert-dummy-line
8078                    gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
8079                   (setq gnus-tmp-dummy-line nil))
8080
8081               ;; Compute the mark.
8082               (setq
8083                gnus-tmp-unread
8084                (cond
8085                 ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8086                 ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8087                 ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8088                 ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8089                 (t (or (cdr (assq number gnus-newsgroup-reads))
8090                        gnus-ancient-mark))))
8091
8092               (push (gnus-data-make number gnus-tmp-unread (1+ (point))
8093                                     gnus-tmp-header gnus-tmp-level)
8094                     gnus-newsgroup-data)
8095
8096               ;; Actually insert the line.
8097               (setq
8098                gnus-tmp-subject-or-nil
8099                (cond
8100                 ((and gnus-thread-ignore-subject
8101                       gnus-tmp-prev-subject
8102                       (not (inline (gnus-subject-equal
8103                                     gnus-tmp-prev-subject subject))))
8104                  subject)
8105                 ((zerop gnus-tmp-level)
8106                  (if (and (eq gnus-summary-make-false-root 'empty)
8107                           (memq number gnus-tmp-gathered)
8108                           gnus-tmp-prev-subject
8109                           (inline (gnus-subject-equal
8110                                    gnus-tmp-prev-subject subject)))
8111                      gnus-summary-same-subject
8112                    subject))
8113                 (t gnus-summary-same-subject)))
8114               (if (and (eq gnus-summary-make-false-root 'adopt)
8115                        (= gnus-tmp-level 1)
8116                        (memq number gnus-tmp-gathered))
8117                   (setq gnus-tmp-opening-bracket ?\<
8118                         gnus-tmp-closing-bracket ?\>)
8119                 (setq gnus-tmp-opening-bracket ?\[
8120                       gnus-tmp-closing-bracket ?\]))
8121               (setq
8122                gnus-tmp-indentation
8123                (aref gnus-thread-indent-array gnus-tmp-level)
8124                gnus-tmp-lines (mail-header-lines gnus-tmp-header)
8125                gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
8126                                   gnus-summary-default-score 0)
8127                gnus-tmp-score-char
8128                (if (or (null gnus-summary-default-score)
8129                        (<= (abs (- gnus-tmp-score gnus-summary-default-score))
8130                            gnus-summary-zcore-fuzz)) ? 
8131                  (if (< gnus-tmp-score gnus-summary-default-score)
8132                      gnus-score-below-mark gnus-score-over-mark))
8133                gnus-tmp-replied
8134                (cond ((memq number gnus-newsgroup-processable)
8135                       gnus-process-mark)
8136                      ((memq number gnus-newsgroup-cached)
8137                       gnus-cached-mark)
8138                      ((memq number gnus-newsgroup-replied)
8139                       gnus-replied-mark)
8140                      (t gnus-unread-mark))
8141                gnus-tmp-from (mail-header-from gnus-tmp-header)
8142                gnus-tmp-name
8143                (cond
8144                 ((string-match "(.+)" gnus-tmp-from)
8145                  (substring gnus-tmp-from
8146                             (1+ (match-beginning 0)) (1- (match-end 0))))
8147                 ((string-match "<[^>]+> *$" gnus-tmp-from)
8148                  (setq beg-match (match-beginning 0))
8149                  (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
8150                           (substring gnus-tmp-from (1+ (match-beginning 0))
8151                                      (1- (match-end 0))))
8152                      (substring gnus-tmp-from 0 beg-match)))
8153                 (t gnus-tmp-from)))
8154               (when (string= gnus-tmp-name "")
8155                 (setq gnus-tmp-name gnus-tmp-from))
8156               (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
8157               (put-text-property
8158                (point)
8159                (progn (eval gnus-summary-line-format-spec) (point))
8160                'gnus-number number)
8161               (when gnus-visual-p
8162                 (forward-line -1)
8163                 (run-hooks 'gnus-summary-update-hook)
8164                 (forward-line 1))
8165
8166               )
8167
8168             (setq gnus-tmp-prev-subject subject)))
8169
8170         (when (nth 1 thread)
8171           (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
8172         (incf gnus-tmp-level)
8173         (setq threads (if thread-end nil (cdr (car thread))))
8174         (unless threads
8175           (setq gnus-tmp-level 0)))))
8176   (gnus-message 7 "Generating summary...done"))
8177
8178 (defun gnus-summary-prepare-unthreaded (headers)
8179   "Generate an unthreaded summary buffer based on HEADERS."
8180   (let (header number mark)
8181
8182     (while headers
8183       (setq header (car headers)
8184             headers (cdr headers)
8185             number (mail-header-number header))
8186
8187       ;; We may have to root out some bad articles...
8188       (when (memq number gnus-newsgroup-limit)
8189         (when (and gnus-summary-mark-below
8190                    (< (or (cdr (assq number gnus-newsgroup-scored))
8191                           gnus-summary-default-score 0)
8192                       gnus-summary-mark-below))
8193           (setq gnus-newsgroup-unreads
8194                 (delq number gnus-newsgroup-unreads))
8195           (if gnus-newsgroup-auto-expire
8196               (push number gnus-newsgroup-expirable)
8197             (push (cons number gnus-low-score-mark)
8198                   gnus-newsgroup-reads)))
8199
8200         (setq mark
8201               (cond
8202                ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
8203                ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
8204                ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
8205                ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
8206                (t (or (cdr (assq number gnus-newsgroup-reads))
8207                       gnus-ancient-mark))))
8208         (setq gnus-newsgroup-data
8209               (cons (gnus-data-make number mark (1+ (point)) header 0)
8210                     gnus-newsgroup-data))
8211         (gnus-summary-insert-line
8212          header 0 nil mark (memq number gnus-newsgroup-replied)
8213          (memq number gnus-newsgroup-expirable)
8214          (mail-header-subject header) nil
8215          (cdr (assq number gnus-newsgroup-scored))
8216          (memq number gnus-newsgroup-processable))))))
8217
8218 (defun gnus-select-newsgroup (group &optional read-all)
8219   "Select newsgroup GROUP.
8220 If READ-ALL is non-nil, all articles in the group are selected."
8221   (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
8222          (info (nth 2 entry))
8223          articles fetched-articles cached)
8224
8225     (or (gnus-check-server
8226          (setq gnus-current-select-method (gnus-find-method-for-group group)))
8227         (error "Couldn't open server"))
8228
8229     (or (and entry (not (eq (car entry) t))) ; Either it's active...
8230         (gnus-activate-group group) ; Or we can activate it...
8231         (progn ; Or we bug out.
8232           (kill-buffer (current-buffer))
8233           (error "Couldn't request group %s: %s"
8234                  group (gnus-status-message group))))
8235
8236     (setq gnus-newsgroup-name group)
8237     (setq gnus-newsgroup-unselected nil)
8238     (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
8239
8240     (and gnus-asynchronous
8241          (gnus-check-backend-function
8242           'request-asynchronous gnus-newsgroup-name)
8243          (setq gnus-newsgroup-async
8244                (gnus-request-asynchronous gnus-newsgroup-name)))
8245
8246     ;; Adjust and set lists of article marks.
8247     (when info
8248       (gnus-adjust-marked-articles info))
8249
8250     ;; Kludge to avoid having cached articles nixed out in virtual groups.
8251     (when (gnus-virtual-group-p group)
8252       (setq cached gnus-newsgroup-cached))
8253
8254     (setq gnus-newsgroup-unreads
8255           (gnus-set-difference
8256            (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
8257            gnus-newsgroup-dormant))
8258
8259     (setq gnus-newsgroup-processable nil)
8260
8261     (setq articles (gnus-articles-to-read group read-all))
8262
8263     (cond
8264      ((null articles)
8265       (gnus-message 3 "Couldn't select newsgroup -- no articles to display")
8266       'quit)
8267      ((eq articles 0) nil)
8268      (t
8269       ;; Init the dependencies hash table.
8270       (setq gnus-newsgroup-dependencies
8271             (gnus-make-hashtable (length articles)))
8272       ;; Retrieve the headers and read them in.
8273       (gnus-message 5 "Fetching headers...")
8274       (setq gnus-newsgroup-headers
8275             (if (eq 'nov
8276                     (setq gnus-headers-retrieved-by
8277                           (gnus-retrieve-headers
8278                            articles gnus-newsgroup-name
8279                            ;; We might want to fetch old headers, but
8280                            ;; not if there is only 1 article.
8281                            (and gnus-fetch-old-headers
8282                                 (or (and
8283                                      (not (eq gnus-fetch-old-headers 'some))
8284                                      (not (numberp gnus-fetch-old-headers)))
8285                                     (> (length articles) 1))))))
8286                 (gnus-get-newsgroup-headers-xover articles)
8287               (gnus-get-newsgroup-headers)))
8288       (gnus-message 5 "Fetching headers...done")
8289
8290       ;; Kludge to avoid having cached articles nixed out in virtual groups.
8291       (when cached
8292         (setq gnus-newsgroup-cached cached))
8293
8294       ;; Set the initial limit.
8295       (setq gnus-newsgroup-limit (copy-sequence articles))
8296       ;; Remove canceled articles from the list of unread articles.
8297       (setq gnus-newsgroup-unreads
8298             (gnus-set-sorted-intersection
8299              gnus-newsgroup-unreads
8300              (setq fetched-articles
8301                    (mapcar (lambda (headers) (mail-header-number headers))
8302                            gnus-newsgroup-headers))))
8303       ;; Removed marked articles that do not exist.
8304       (gnus-update-missing-marks
8305        (gnus-sorted-complement fetched-articles articles))
8306       ;; We might want to build some more threads first.
8307       (and gnus-fetch-old-headers
8308            (eq gnus-headers-retrieved-by 'nov)
8309            (gnus-build-old-threads))
8310       ;; Check whether auto-expire is to be done in this group.
8311       (setq gnus-newsgroup-auto-expire
8312             (gnus-group-auto-expirable-p group))
8313       ;; First and last article in this newsgroup.
8314       (and gnus-newsgroup-headers
8315            (setq gnus-newsgroup-begin
8316                  (mail-header-number (car gnus-newsgroup-headers)))
8317            (setq gnus-newsgroup-end
8318                  (mail-header-number
8319                   (gnus-last-element gnus-newsgroup-headers))))
8320       (setq gnus-reffed-article-number -1)
8321       ;; GROUP is successfully selected.
8322       (or gnus-newsgroup-headers t)))))
8323
8324 (defun gnus-articles-to-read (group read-all)
8325   ;; Find out what articles the user wants to read.
8326   (let* ((articles
8327           ;; Select all articles if `read-all' is non-nil, or if there
8328           ;; are no unread articles.
8329           (if (or read-all
8330                   (and (zerop (length gnus-newsgroup-marked))
8331                        (zerop (length gnus-newsgroup-unreads))))
8332               (gnus-uncompress-range (gnus-active group))
8333             (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
8334                           (copy-sequence gnus-newsgroup-unreads))
8335                   '<)))
8336          (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
8337          (scored (length scored-list))
8338          (number (length articles))
8339          (marked (+ (length gnus-newsgroup-marked)
8340                     (length gnus-newsgroup-dormant)))
8341          (select
8342           (cond
8343            ((numberp read-all)
8344             read-all)
8345            (t
8346             (condition-case ()
8347                 (cond
8348                  ((and (or (<= scored marked) (= scored number))
8349                        (numberp gnus-large-newsgroup)
8350                        (> number gnus-large-newsgroup))
8351                   (let ((input
8352                          (read-string
8353                           (format
8354                            "How many articles from %s (default %d): "
8355                            gnus-newsgroup-name number))))
8356                     (if (string-match "^[ \t]*$" input) number input)))
8357                  ((and (> scored marked) (< scored number))
8358                   (let ((input
8359                          (read-string
8360                           (format "%s %s (%d scored, %d total): "
8361                                   "How many articles from"
8362                                   group scored number))))
8363                     (if (string-match "^[ \t]*$" input)
8364                         number input)))
8365                  (t number))
8366               (quit nil))))))
8367     (setq select (if (stringp select) (string-to-number select) select))
8368     (if (or (null select) (zerop select))
8369         select
8370       (if (and (not (zerop scored)) (<= (abs select) scored))
8371           (progn
8372             (setq articles (sort scored-list '<))
8373             (setq number (length articles)))
8374         (setq articles (copy-sequence articles)))
8375
8376       (if (< (abs select) number)
8377           (if (< select 0)
8378               ;; Select the N oldest articles.
8379               (setcdr (nthcdr (1- (abs select)) articles) nil)
8380             ;; Select the N most recent articles.
8381             (setq articles (nthcdr (- number select) articles))))
8382       (setq gnus-newsgroup-unselected
8383             (gnus-sorted-intersection
8384              gnus-newsgroup-unreads
8385              (gnus-sorted-complement gnus-newsgroup-unreads articles)))
8386       articles)))
8387
8388 (defun gnus-killed-articles (killed articles)
8389   (let (out)
8390     (while articles
8391       (if (inline (gnus-member-of-range (car articles) killed))
8392           (setq out (cons (car articles) out)))
8393       (setq articles (cdr articles)))
8394     out))
8395
8396 (defun gnus-uncompress-marks (marks)
8397   "Uncompress the mark ranges in MARKS."
8398   (let ((uncompressed '(score bookmark))
8399         out)
8400     (while marks
8401       (if (memq (caar marks) uncompressed)
8402           (push (car marks) out)
8403         (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
8404       (setq marks (cdr marks)))
8405     out))
8406
8407 (defun gnus-adjust-marked-articles (info)
8408   "Set all article lists and remove all marks that are no longer legal."
8409   (let* ((marked-lists (gnus-info-marks info))
8410          (active (gnus-active (gnus-info-group info)))
8411          (min (car active))
8412          (max (cdr active))
8413          (types gnus-article-mark-lists)
8414          (uncompressed '(score bookmark))
8415          marks var articles article mark)
8416
8417     (while marked-lists
8418       (setq marks (pop marked-lists))
8419       (set (setq var (intern (format "gnus-newsgroup-%s"
8420                                      (car (rassq (setq mark (car marks))
8421                                                  types)))))
8422            (if (memq (car marks) uncompressed) (cdr marks)
8423              (gnus-uncompress-range (cdr marks))))
8424
8425       (setq articles (symbol-value var))
8426
8427       ;; All articles have to be subsets of the active articles.
8428       (cond
8429        ;; Adjust "simple" lists.
8430        ((memq mark '(tick dormant expirable reply killed save))
8431         (while articles
8432           (when (or (< (setq article (pop articles)) min) (> article max))
8433             (set var (delq article (symbol-value var))))))
8434        ;; Adjust assocs.
8435        ((memq mark '(score bookmark))
8436         (while articles
8437           (when (or (< (car (setq article (pop articles))) min)
8438                     (> (car article) max))
8439             (set var (delq article (symbol-value var))))))))))
8440
8441 (defun gnus-update-missing-marks (missing)
8442   "Go through the list of MISSING articles and remove them mark lists."
8443   (when missing
8444     (let ((types gnus-article-mark-lists)
8445           var m)
8446       ;; Go through all types.
8447       (while types
8448         (setq var (intern (format "gnus-newsgroup-%s" (car (pop types)))))
8449         (when (symbol-value var)
8450           ;; This list has articles.  So we delete all missing articles
8451           ;; from it.
8452           (setq m missing)
8453           (while m
8454             (set var (delq (pop m) (symbol-value var)))))))))
8455
8456 (defun gnus-update-marks ()
8457   "Enter the various lists of marked articles into the newsgroup info list."
8458   (let ((types gnus-article-mark-lists)
8459         (info (gnus-get-info gnus-newsgroup-name))
8460         (uncompressed '(score bookmark killed))
8461         var type list newmarked symbol)
8462     (when info
8463       ;; Add all marks lists that are non-nil to the list of marks lists.
8464       (while types
8465         (setq type (pop types))
8466         (when (setq list (symbol-value
8467                           (setq symbol
8468                                 (intern (format "gnus-newsgroup-%s"
8469                                                 (car type))))))
8470           (push (cons (cdr type)
8471                       (if (memq (cdr type) uncompressed) list
8472                         (gnus-compress-sequence (set symbol (sort list '<)) t)))
8473                 newmarked)))
8474
8475       ;; Enter these new marks into the info of the group.
8476       (if (nthcdr 3 info)
8477           (setcar (nthcdr 3 info) newmarked)
8478         ;; Add the marks lists to the end of the info.
8479         (when newmarked
8480           (setcdr (nthcdr 2 info) (list newmarked))))
8481
8482       ;; Cut off the end of the info if there's nothing else there.
8483       (let ((i 5))
8484         (while (and (> i 2)
8485                     (not (nth i info)))
8486           (when (nthcdr (decf i) info)
8487             (setcdr (nthcdr i info) nil)))))))
8488
8489 (defun gnus-add-marked-articles (group type articles &optional info force)
8490   ;; Add ARTICLES of TYPE to the info of GROUP.
8491   ;; If INFO is non-nil, use that info.  If FORCE is non-nil, don't
8492   ;; add, but replace marked articles of TYPE with ARTICLES.
8493   (let ((info (or info (gnus-get-info group)))
8494         (uncompressed '(score bookmark killed))
8495         marked m)
8496     (or (not info)
8497         (and (not (setq marked (nthcdr 3 info)))
8498              (setcdr (nthcdr 2 info)
8499                      (list (list (cons type (gnus-compress-sequence
8500                                              articles t))))))
8501         (and (not (setq m (assq type (car marked))))
8502              (setcar marked
8503                      (cons (cons type (gnus-compress-sequence articles t) )
8504                            (car marked))))
8505         (if force
8506             (setcdr m (gnus-compress-sequence articles t))
8507           (setcdr m (gnus-compress-sequence
8508                      (sort (nconc (gnus-uncompress-range m)
8509                                   (copy-sequence articles)) '<) t))))))
8510
8511 (defun gnus-set-mode-line (where)
8512   "This function sets the mode line of the article or summary buffers.
8513 If WHERE is `summary', the summary mode line format will be used."
8514   ;; Is this mode line one we keep updated?
8515   (when (memq where gnus-updated-mode-lines)
8516     (let (mode-string)
8517       (save-excursion
8518         ;; We evaluate this in the summary buffer since these
8519         ;; variables are buffer-local to that buffer.
8520         (set-buffer gnus-summary-buffer)
8521         ;; We bind all these variables that are used in the `eval' form
8522         ;; below.
8523         (let* ((mformat (symbol-value
8524                          (intern
8525                           (format "gnus-%s-mode-line-format-spec" where))))
8526                (gnus-tmp-group-name gnus-newsgroup-name)
8527                (gnus-tmp-article-number (or gnus-current-article 0))
8528                (gnus-tmp-unread gnus-newsgroup-unreads)
8529                (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
8530                (gnus-tmp-unselected (length gnus-newsgroup-unselected))
8531                (gnus-tmp-unread-and-unselected
8532                 (cond ((and (zerop gnus-tmp-unread-and-unticked)
8533                             (zerop gnus-tmp-unselected)) "")
8534                       ((zerop gnus-tmp-unselected)
8535                        (format "{%d more}" gnus-tmp-unread-and-unticked))
8536                       (t (format "{%d(+%d) more}"
8537                                  gnus-tmp-unread-and-unticked
8538                                  gnus-tmp-unselected))))
8539                (gnus-tmp-subject
8540                 (if (and gnus-current-headers
8541                          (vectorp gnus-current-headers))
8542                     (mail-header-subject gnus-current-headers) ""))
8543                max-len
8544                gnus-tmp-header);; passed as argument to any user-format-funcs
8545           (setq mode-string (eval mformat))
8546           (setq max-len (max 4 (if gnus-mode-non-string-length
8547                                    (- (frame-width)
8548                                       gnus-mode-non-string-length)
8549                                  (length mode-string))))
8550           ;; We might have to chop a bit of the string off...
8551           (when (> (length mode-string) max-len)
8552             (setq mode-string
8553                   (concat (gnus-truncate-string mode-string (- max-len 3))
8554                           "...")))
8555           ;; Pad the mode string a bit.
8556           (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
8557       ;; Update the mode line.
8558       (setq mode-line-buffer-identification (list mode-string))
8559       (set-buffer-modified-p t))))
8560
8561 (defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
8562   "Go through the HEADERS list and add all Xrefs to a hash table.
8563 The resulting hash table is returned, or nil if no Xrefs were found."
8564   (let* ((from-method (gnus-find-method-for-group from-newsgroup))
8565          (virtual (gnus-virtual-group-p from-newsgroup))
8566          (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
8567          (xref-hashtb (make-vector 63 0))
8568          start group entry number xrefs header)
8569     (while headers
8570       (setq header (pop headers))
8571       (when (and (setq xrefs (mail-header-xref header))
8572                  (not (memq (setq number (mail-header-number header))
8573                             unreads)))
8574         (setq start 0)
8575         (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
8576           (setq start (match-end 0))
8577           (setq group (concat prefix (substring xrefs (match-beginning 1)
8578                                                 (match-end 1))))
8579           (setq number
8580                 (string-to-int (substring xrefs (match-beginning 2)
8581                                           (match-end 2))))
8582           (if (setq entry (gnus-gethash group xref-hashtb))
8583               (setcdr entry (cons number (cdr entry)))
8584             (gnus-sethash group (cons number nil) xref-hashtb)))))
8585     (and start xref-hashtb)))
8586
8587 (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
8588   "Look through all the headers and mark the Xrefs as read."
8589   (let ((virtual (gnus-virtual-group-p from-newsgroup))
8590         name entry info xref-hashtb idlist method nth4)
8591     (save-excursion
8592       (set-buffer gnus-group-buffer)
8593       (when (setq xref-hashtb
8594                   (gnus-create-xref-hashtb from-newsgroup headers unreads))
8595         (mapatoms
8596          (lambda (group)
8597            (unless (string= from-newsgroup (setq name (symbol-name group)))
8598              (setq idlist (symbol-value group))
8599              ;; Dead groups are not updated.
8600              (and (prog1
8601                       (setq entry (gnus-gethash name gnus-newsrc-hashtb)
8602                             info (nth 2 entry))
8603                     (if (stringp (setq nth4 (gnus-info-method info)))
8604                         (setq nth4 (gnus-server-to-method nth4))))
8605                   ;; Only do the xrefs if the group has the same
8606                   ;; select method as the group we have just read.
8607                   (or (gnus-methods-equal-p
8608                        nth4 (gnus-find-method-for-group from-newsgroup))
8609                       virtual
8610                       (equal nth4 (setq method (gnus-find-method-for-group
8611                                                 from-newsgroup)))
8612                       (and (equal (car nth4) (car method))
8613                            (equal (nth 1 nth4) (nth 1 method))))
8614                   gnus-use-cross-reference
8615                   (or (not (eq gnus-use-cross-reference t))
8616                       virtual
8617                       ;; Only do cross-references on subscribed
8618                       ;; groups, if that is what is wanted.
8619                       (<= (gnus-info-level info) gnus-level-subscribed))
8620                   (gnus-group-make-articles-read name idlist))))
8621          xref-hashtb)))))
8622
8623 (defun gnus-group-make-articles-read (group articles)
8624   (let* ((num 0)
8625          (entry (gnus-gethash group gnus-newsrc-hashtb))
8626          (info (nth 2 entry))
8627          (active (gnus-active group))
8628          range)
8629     ;; First peel off all illegal article numbers.
8630     (if active
8631         (let ((ids articles)
8632               id first)
8633           (while ids
8634             (setq id (car ids))
8635             (if (and first (> id (cdr active)))
8636                 (progn
8637                   ;; We'll end up in this situation in one particular
8638                   ;; obscure situation.  If you re-scan a group and get
8639                   ;; a new article that is cross-posted to a different
8640                   ;; group that has not been re-scanned, you might get
8641                   ;; crossposted article that has a higher number than
8642                   ;; Gnus believes possible.  So we re-activate this
8643                   ;; group as well.  This might mean doing the
8644                   ;; crossposting thingy will *increase* the number
8645                   ;; of articles in some groups.  Tsk, tsk.
8646                   (setq active (or (gnus-activate-group group) active))))
8647             (if (or (> id (cdr active))
8648                     (< id (car active)))
8649                 (setq articles (delq id articles)))
8650             (setq ids (cdr ids)))))
8651     ;; If the read list is nil, we init it.
8652     (and active
8653          (null (gnus-info-read info))
8654          (> (car active) 1)
8655          (gnus-info-set-read info (cons 1 (1- (car active)))))
8656     ;; Then we add the read articles to the range.
8657     (gnus-info-set-read
8658      info
8659      (setq range
8660            (gnus-add-to-range
8661             (gnus-info-read info) (setq articles (sort articles '<)))))
8662     ;; Then we have to re-compute how many unread
8663     ;; articles there are in this group.
8664     (if active
8665         (progn
8666           (cond
8667            ((not range)
8668             (setq num (- (1+ (cdr active)) (car active))))
8669            ((not (listp (cdr range)))
8670             (setq num (- (cdr active) (- (1+ (cdr range))
8671                                          (car range)))))
8672            (t
8673             (while range
8674               (if (numberp (car range))
8675                   (setq num (1+ num))
8676                 (setq num (+ num (- (1+ (cdr (car range)))
8677                                     (car (car range))))))
8678               (setq range (cdr range)))
8679             (setq num (- (cdr active) num))))
8680           ;; Update the number of unread articles.
8681           (setcar entry num)
8682           ;; Update the group buffer.
8683           (gnus-group-update-group group t)))))
8684
8685 (defun gnus-methods-equal-p (m1 m2)
8686   (let ((m1 (or m1 gnus-select-method))
8687         (m2 (or m2 gnus-select-method)))
8688     (or (equal m1 m2)
8689         (and (eq (car m1) (car m2))
8690              (or (not (memq 'address (assoc (symbol-name (car m1))
8691                                             gnus-valid-select-methods)))
8692                  (equal (nth 1 m1) (nth 1 m2)))))))
8693
8694 (defsubst gnus-header-value ()
8695   (buffer-substring (match-end 0) (gnus-point-at-eol)))
8696
8697 (defvar gnus-newsgroup-none-id 0)
8698
8699 (defun gnus-get-newsgroup-headers (&optional dependencies force-new)
8700   (let ((cur nntp-server-buffer)
8701         (dependencies
8702          (or dependencies
8703              (save-excursion (set-buffer gnus-summary-buffer)
8704                              gnus-newsgroup-dependencies)))
8705         headers id id-dep ref-dep end ref)
8706     (save-excursion
8707       (set-buffer nntp-server-buffer)
8708       (let ((case-fold-search t)
8709             in-reply-to header number p lines)
8710         (goto-char (point-min))
8711         ;; Search to the beginning of the next header.  Error messages
8712         ;; do not begin with 2 or 3.
8713         (while (re-search-forward "^[23][0-9]+ " nil t)
8714           (setq id nil
8715                 ref nil)
8716           ;; This implementation of this function, with nine
8717           ;; search-forwards instead of the one re-search-forward and
8718           ;; a case (which basically was the old function) is actually
8719           ;; about twice as fast, even though it looks messier.  You
8720           ;; can't have everything, I guess.  Speed and elegance
8721           ;; doesn't always go hand in hand.
8722           (setq
8723            header
8724            (vector
8725             ;; Number.
8726             (prog1
8727                 (read cur)
8728               (end-of-line)
8729               (setq p (point))
8730               (narrow-to-region (point)
8731                                 (or (and (search-forward "\n.\n" nil t)
8732                                          (- (point) 2))
8733                                     (point))))
8734             ;; Subject.
8735             (progn
8736               (goto-char p)
8737               (if (search-forward "\nsubject: " nil t)
8738                   (gnus-header-value) "(none)"))
8739             ;; From.
8740             (progn
8741               (goto-char p)
8742               (if (search-forward "\nfrom: " nil t)
8743                   (gnus-header-value) "(nobody)"))
8744             ;; Date.
8745             (progn
8746               (goto-char p)
8747               (if (search-forward "\ndate: " nil t)
8748                   (gnus-header-value) ""))
8749             ;; Message-ID.
8750             (progn
8751               (goto-char p)
8752               (if (search-forward "\nmessage-id: " nil t)
8753                   (setq id (gnus-header-value))
8754                 ;; If there was no message-id, we just fake one to make
8755                 ;; subsequent routines simpler.
8756                 (setq id (concat "none+"
8757                                  (int-to-string
8758                                   (setq gnus-newsgroup-none-id
8759                                         (1+ gnus-newsgroup-none-id)))))))
8760             ;; References.
8761             (progn
8762               (goto-char p)
8763               (if (search-forward "\nreferences: " nil t)
8764                   (prog1
8765                       (gnus-header-value)
8766                     (setq end (match-end 0))
8767                     (save-excursion
8768                       (setq ref
8769                             (downcase
8770                              (buffer-substring
8771                               (progn
8772                                 (end-of-line)
8773                                 (search-backward ">" end t)
8774                                 (1+ (point)))
8775                               (progn
8776                                 (search-backward "<" end t)
8777                                 (point)))))))
8778                 ;; Get the references from the in-reply-to header if there
8779                 ;; were no references and the in-reply-to header looks
8780                 ;; promising.
8781                 (if (and (search-forward "\nin-reply-to: " nil t)
8782                          (setq in-reply-to (gnus-header-value))
8783                          (string-match "<[^>]+>" in-reply-to))
8784                     (prog1
8785                         (setq ref (substring in-reply-to (match-beginning 0)
8786                                              (match-end 0)))
8787                       (setq ref (downcase ref))))
8788                 (setq ref "")))
8789             ;; Chars.
8790             0
8791             ;; Lines.
8792             (progn
8793               (goto-char p)
8794               (if (search-forward "\nlines: " nil t)
8795                   (if (numberp (setq lines (read cur)))
8796                       lines 0)
8797                 0))
8798             ;; Xref.
8799             (progn
8800               (goto-char p)
8801               (and (search-forward "\nxref: " nil t)
8802                    (gnus-header-value)))))
8803           (if (and gnus-nocem-hashtb
8804                    (gnus-gethash id gnus-nocem-hashtb))
8805               ;; Banned article.
8806               (setq header nil)
8807             ;; We do the threading while we read the headers.  The
8808             ;; message-id and the last reference are both entered into
8809             ;; the same hash table.  Some tippy-toeing around has to be
8810             ;; done in case an article has arrived before the article
8811             ;; which it refers to.
8812             (if (boundp (setq id-dep (intern (downcase id) dependencies)))
8813                 (if (and (car (symbol-value id-dep))
8814                          (not force-new))
8815                     ;; An article with this Message-ID has already
8816                     ;; been seen, so we ignore this one, except we add
8817                     ;; any additional Xrefs (in case the two articles
8818                     ;; came from different servers).
8819                     (progn
8820                       (mail-header-set-xref
8821                        (car (symbol-value id-dep))
8822                        (concat (or (mail-header-xref
8823                                     (car (symbol-value id-dep))) "")
8824                                (or (mail-header-xref header) "")))
8825                       (setq header nil))
8826                   (setcar (symbol-value id-dep) header))
8827               (set id-dep (list header))))
8828           (when header
8829             (if (boundp (setq ref-dep (intern ref dependencies)))
8830                 (setcdr (symbol-value ref-dep)
8831                         (nconc (cdr (symbol-value ref-dep))
8832                                (list (symbol-value id-dep))))
8833               (set ref-dep (list nil (symbol-value id-dep))))
8834             (setq headers (cons header headers)))
8835           (goto-char (point-max))
8836           (widen))
8837         (nreverse headers)))))
8838
8839 ;; The following macros and functions were written by Felix Lee
8840 ;; <flee@cse.psu.edu>.
8841
8842 (defmacro gnus-nov-read-integer ()
8843   '(prog1
8844        (if (= (following-char) ?\t)
8845            0
8846          (let ((num (condition-case nil (read buffer) (error nil))))
8847            (if (numberp num) num 0)))
8848      (or (eobp) (forward-char 1))))
8849
8850 (defmacro gnus-nov-skip-field ()
8851   '(search-forward "\t" eol 'move))
8852
8853 (defmacro gnus-nov-field ()
8854   '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
8855
8856 ;; Goes through the xover lines and returns a list of vectors
8857 (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new)
8858   "Parse the news overview data in the server buffer, and return a
8859 list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
8860   ;; Get the Xref when the users reads the articles since most/some
8861   ;; NNTP servers do not include Xrefs when using XOVER.
8862   (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
8863   (let ((cur nntp-server-buffer)
8864         (dependencies gnus-newsgroup-dependencies)
8865         number headers header)
8866     (save-excursion
8867       (set-buffer nntp-server-buffer)
8868       ;; Allow the user to mangle the headers before parsing them.
8869       (run-hooks 'gnus-parse-headers-hook)
8870       ;; Allow the user to mangle the headers before parsing them.
8871       (run-hooks 'gnus-parse-headers-hook)
8872       (goto-char (point-min))
8873       (while (and sequence (not (eobp)))
8874         (setq number (read cur))
8875         (while (and sequence (< (car sequence) number))
8876           (setq sequence (cdr sequence)))
8877         (and sequence
8878              (eq number (car sequence))
8879              (progn
8880                (setq sequence (cdr sequence))
8881                (if (setq header
8882                          (inline (gnus-nov-parse-line
8883                                   number dependencies force-new)))
8884                    (setq headers (cons header headers)))))
8885         (forward-line 1))
8886       (setq headers (nreverse headers)))
8887     headers))
8888
8889 ;; This function has to be called with point after the article number
8890 ;; on the beginning of the line.
8891 (defun gnus-nov-parse-line (number dependencies &optional force-new)
8892   (let ((none 0)
8893         (eol (gnus-point-at-eol))
8894         (buffer (current-buffer))
8895         header ref id id-dep ref-dep)
8896
8897     ;; overview: [num subject from date id refs chars lines misc]
8898     (narrow-to-region (point) eol)
8899     (or (eobp) (forward-char))
8900
8901     (condition-case nil
8902         (setq header
8903               (vector
8904                number                   ; number
8905                (gnus-nov-field)         ; subject
8906                (gnus-nov-field)         ; from
8907                (gnus-nov-field)         ; date
8908                (setq id (or (gnus-nov-field)
8909                             (concat "none+"
8910                                     (int-to-string
8911                                      (setq none (1+ none)))))) ; id
8912                (progn
8913                  (save-excursion
8914                    (let ((beg (point)))
8915                      (search-forward "\t" eol)
8916                      (if (search-backward ">" beg t)
8917                          (setq ref
8918                                (downcase
8919                                 (buffer-substring
8920                                  (1+ (point))
8921                                  (progn
8922                                    (search-backward "<" beg t)
8923                                    (point)))))
8924                        (setq ref nil))))
8925                  (gnus-nov-field))      ; refs
8926                (gnus-nov-read-integer)  ; chars
8927                (gnus-nov-read-integer)  ; lines
8928                (if (= (following-char) ?\n)
8929                    nil
8930                  (gnus-nov-field))      ; misc
8931                ))
8932       (error (progn
8933                (ding)
8934                (gnus-message 4 "Strange nov line")
8935                (setq header nil)
8936                (goto-char eol))))
8937
8938     (widen)
8939
8940     ;; We build the thread tree.
8941     (and header
8942          (if (and gnus-nocem-hashtb
8943                   (gnus-gethash id gnus-nocem-hashtb))
8944              ;; Banned article.
8945              (setq header nil)
8946            (if (boundp (setq id-dep (intern (downcase id) dependencies)))
8947                (if (and (car (symbol-value id-dep))
8948                         (not force-new))
8949                    ;; An article with this Message-ID has already been seen,
8950                    ;; so we ignore this one, except we add any additional
8951                    ;; Xrefs (in case the two articles came from different
8952                    ;; servers.
8953                    (progn
8954                      (mail-header-set-xref
8955                       (car (symbol-value id-dep))
8956                       (concat (or (mail-header-xref
8957                                    (car (symbol-value id-dep))) "")
8958                               (or (mail-header-xref header) "")))
8959                      (setq header nil))
8960                  (setcar (symbol-value id-dep) header))
8961              (set id-dep (list header)))))
8962     (if header
8963         (progn
8964           (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
8965               (setcdr (symbol-value ref-dep)
8966                       (nconc (cdr (symbol-value ref-dep))
8967                              (list (symbol-value id-dep))))
8968             (set ref-dep (list nil (symbol-value id-dep))))))
8969     header))
8970
8971 (defun gnus-article-get-xrefs ()
8972   "Fill in the Xref value in `gnus-current-headers', if necessary.
8973 This is meant to be called in `gnus-article-internal-prepare-hook'."
8974   (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
8975                                  gnus-current-headers)))
8976     (or (not gnus-use-cross-reference)
8977         (not headers)
8978         (and (mail-header-xref headers)
8979              (not (string= (mail-header-xref headers) "")))
8980         (let ((case-fold-search t)
8981               xref)
8982           (save-restriction
8983             (nnheader-narrow-to-headers)
8984             (goto-char (point-min))
8985             (if (or (and (eq (downcase (following-char)) ?x)
8986                          (looking-at "Xref:"))
8987                     (search-forward "\nXref:" nil t))
8988                 (progn
8989                   (goto-char (1+ (match-end 0)))
8990                   (setq xref (buffer-substring (point)
8991                                                (progn (end-of-line) (point))))
8992                   (mail-header-set-xref headers xref))))))))
8993
8994 (defun gnus-summary-insert-subject (id)
8995   "Find article ID and insert the summary line for that article."
8996   (let ((header (gnus-read-header id))
8997         (number (and (numberp id) id)))
8998     (when header
8999       ;; Rebuild the thread that this article is part of and go to the
9000       ;; article we have fetched.
9001       (gnus-rebuild-thread (mail-header-id header))
9002       (gnus-summary-goto-subject (setq number (mail-header-number header))))
9003     (when (and (numberp number)
9004                (> number 0))
9005       ;; We have to update the boundaries even if we can't fetch the
9006       ;; article if ID is a number -- so that the next `P' or `N'
9007       ;; command will fetch the previous (or next) article even
9008       ;; if the one we tried to fetch this time has been canceled.
9009       (and (> number gnus-newsgroup-end)
9010            (setq gnus-newsgroup-end number))
9011       (and (< number gnus-newsgroup-begin)
9012            (setq gnus-newsgroup-begin number))
9013       (setq gnus-newsgroup-unselected
9014             (delq number gnus-newsgroup-unselected)))
9015     ;; Report back a success?
9016     (and header number)))
9017
9018 (defun gnus-summary-work-articles (n)
9019   "Return a list of articles to be worked upon.  The prefix argument,
9020 the list of process marked articles, and the current article will be
9021 taken into consideration."
9022   (cond
9023    ((and n (numberp n))
9024     ;; A numerical prefix has been given.
9025     (let ((backward (< n 0))
9026           (n (abs n))
9027           articles article)
9028       (save-excursion
9029         (while
9030             (and (> n 0)
9031                  (push (setq article (gnus-summary-article-number))
9032                        articles)
9033                  (if backward
9034                      (gnus-summary-find-prev nil article)
9035                    (gnus-summary-find-next nil article)))
9036           (decf n)))
9037       (nreverse articles)))
9038    ((and (boundp 'transient-mark-mode)
9039          transient-mark-mode
9040          mark-active)
9041     ;; Work on the region between point and mark.
9042     (let ((max (max (point) (mark)))
9043           articles article)
9044       (save-excursion
9045         (goto-char (min (point) (mark)))
9046         (while
9047             (and
9048              (push (setq article (gnus-summary-article-number)) articles)
9049              (gnus-summary-find-next nil article)
9050              (< (point) max)))
9051         (nreverse articles))))
9052    (gnus-newsgroup-processable
9053     ;; There are process-marked articles present.
9054     (reverse gnus-newsgroup-processable))
9055    (t
9056     ;; Just return the current article.
9057     (list (gnus-summary-article-number)))))
9058
9059 (defun gnus-summary-search-group (&optional backward use-level)
9060   "Search for next unread newsgroup.
9061 If optional argument BACKWARD is non-nil, search backward instead."
9062   (save-excursion
9063     (set-buffer gnus-group-buffer)
9064     (if (gnus-group-search-forward
9065          backward nil (if use-level (gnus-group-group-level) nil))
9066         (gnus-group-group-name))))
9067
9068 (defun gnus-summary-best-group (&optional exclude-group)
9069   "Find the name of the best unread group.
9070 If EXCLUDE-GROUP, do not go to this group."
9071   (save-excursion
9072     (set-buffer gnus-group-buffer)
9073     (save-excursion
9074       (gnus-group-best-unread-group exclude-group))))
9075
9076 (defun gnus-summary-find-next (&optional unread article backward)
9077   (if backward (gnus-summary-find-prev)
9078     (let* ((article (or article (gnus-summary-article-number)))
9079            (arts (gnus-data-find-list article))
9080            result)
9081       (when (or (not gnus-summary-check-current)
9082                 (not unread)
9083                 (not (gnus-data-unread-p (car arts))))
9084         (setq arts (cdr arts)))
9085       (when (setq result
9086                   (if unread
9087                       (progn
9088                         (while arts
9089                           (when (gnus-data-unread-p (car arts))
9090                             (setq result (car arts)
9091                                   arts nil))
9092                           (setq arts (cdr arts)))
9093                         result)
9094                     (car arts)))
9095         (goto-char (gnus-data-pos result))
9096         (gnus-data-number result)))))
9097
9098 (defun gnus-summary-find-prev (&optional unread article)
9099   (let* ((article (or article (gnus-summary-article-number)))
9100          (arts (gnus-data-find-list article (gnus-data-list 'rev)))
9101          result)
9102     (when (or (not gnus-summary-check-current)
9103               (not unread)
9104               (not (gnus-data-unread-p (car arts))))
9105       (setq arts (cdr arts)))
9106     (if (setq result
9107               (if unread
9108                   (progn
9109                     (while arts
9110                       (and (gnus-data-unread-p (car arts))
9111                            (setq result (car arts)
9112                                  arts nil))
9113                       (setq arts (cdr arts)))
9114                     result)
9115                 (car arts)))
9116         (progn
9117           (goto-char (gnus-data-pos result))
9118           (gnus-data-number result)))))
9119
9120 (defun gnus-summary-find-subject (subject &optional unread backward article)
9121   (let* ((simp-subject (gnus-simplify-subject-fully subject))
9122          (article (or article (gnus-summary-article-number)))
9123          (articles (gnus-data-list backward))
9124          (arts (gnus-data-find-list article articles))
9125          result)
9126     (when (or (not gnus-summary-check-current)
9127               (not unread)
9128               (not (gnus-data-unread-p (car arts))))
9129       (setq arts (cdr arts)))
9130     (while arts
9131       (and (or (not unread)
9132                (gnus-data-unread-p (car arts)))
9133            (vectorp (gnus-data-header (car arts)))
9134            (gnus-subject-equal
9135             simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
9136            (setq result (car arts)
9137                  arts nil))
9138       (setq arts (cdr arts)))
9139     (and result
9140          (goto-char (gnus-data-pos result))
9141          (gnus-data-number result))))
9142
9143 (defun gnus-summary-search-forward (&optional unread subject backward)
9144   (cond (subject
9145          (gnus-summary-find-subject subject unread backward))
9146         (backward
9147          (gnus-summary-find-prev unread))
9148         (t
9149          (gnus-summary-find-next unread))))
9150
9151 (defun gnus-recenter ()
9152   "Center point in window and redisplay frame.
9153 Also do horizontal recentering."
9154   (interactive)
9155   (gnus-horizontal-recenter)
9156   (recenter))
9157
9158 (defun gnus-summary-recenter ()
9159   "Center point in the summary window.
9160 If `gnus-auto-center-summary' is nil, or the article buffer isn't
9161 displayed, no centering will be performed."
9162   ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
9163   ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
9164   (let* ((top (cond ((< (window-height) 4) 0)
9165                     ((< (window-height) 7) 1)
9166                     (t 2)))
9167          (height (1- (window-height)))
9168          (bottom (save-excursion (goto-char (point-max))
9169                                  (forward-line (- height))
9170                                  (point)))
9171          (window (get-buffer-window (current-buffer))))
9172     ;; The user has to want it.
9173     (when gnus-auto-center-summary
9174       (when (get-buffer-window gnus-article-buffer)
9175        ;; Only do recentering when the article buffer is displayed,
9176        ;; Set the window start to either `bottom', which is the biggest
9177        ;; possible valid number, or the second line from the top,
9178        ;; whichever is the least.
9179        (set-window-start
9180         window (min bottom (save-excursion 
9181                              (forward-line (- top)) (point)))))
9182       ;; Do horizontal recentering while we're at it.
9183       (let ((selected (selected-window)))
9184         (select-window (get-buffer-window (current-buffer) t))
9185         (gnus-summary-position-point)
9186         (gnus-horizontal-recenter)
9187         (select-window selected)))))
9188
9189 (defun gnus-horizontal-recenter ()
9190   "Recenter the current buffer horizontally."
9191   (if (< (current-column) (/ (window-width) 2))
9192       (set-window-hscroll (get-buffer-window (current-buffer) t) 0)
9193     (let* ((orig (point))
9194            (end (window-end (get-buffer-window (current-buffer) t)))
9195            (max 0))
9196       ;; Find the longest line currently displayed in the window.
9197       (goto-char (window-start))
9198       (while (and (not (eobp)) 
9199                   (< (point) end))
9200         (end-of-line)
9201         (setq max (max max (current-column)))
9202         (forward-line 1))
9203       (goto-char orig)
9204       ;; Scroll horizontally to center (sort of) the point.
9205       (if (> max (window-width))
9206           (set-window-hscroll 
9207            (get-buffer-window (current-buffer) t)
9208            (min (- (current-column) (/ (window-width) 3))
9209                 (+ 2 (- max (window-width)))))
9210         (set-window-hscroll (get-buffer-window (current-buffer) t) 0))
9211       max)))
9212
9213 ;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
9214 (defun gnus-short-group-name (group &optional levels)
9215   "Collapse GROUP name LEVELS."
9216   (let* ((name "") 
9217          (foreign "")
9218          (depth 0) 
9219          (skip 1)
9220          (levels (or levels
9221                      (progn
9222                        (while (string-match "\\." group skip)
9223                          (setq skip (match-end 0)
9224                                depth (+ depth 1)))
9225                        depth))))
9226     (if (string-match ":" group)
9227         (setq foreign (substring group 0 (match-end 0))
9228               group (substring group (match-end 0))))
9229     (while group
9230       (if (and (string-match "\\." group)
9231                (> levels (- gnus-group-uncollapsed-levels 1)))
9232           (setq name (concat name (substring group 0 1))
9233                 group (substring group (match-end 0))
9234                 levels (- levels 1)
9235                 name (concat name "."))
9236         (setq name (concat foreign name group)
9237               group nil)))
9238     name))
9239
9240 (defun gnus-summary-jump-to-group (newsgroup)
9241   "Move point to NEWSGROUP in group mode buffer."
9242   ;; Keep update point of group mode buffer if visible.
9243   (if (eq (current-buffer) (get-buffer gnus-group-buffer))
9244       (save-window-excursion
9245         ;; Take care of tree window mode.
9246         (if (get-buffer-window gnus-group-buffer)
9247             (pop-to-buffer gnus-group-buffer))
9248         (gnus-group-jump-to-group newsgroup))
9249     (save-excursion
9250       ;; Take care of tree window mode.
9251       (if (get-buffer-window gnus-group-buffer)
9252           (pop-to-buffer gnus-group-buffer)
9253         (set-buffer gnus-group-buffer))
9254       (gnus-group-jump-to-group newsgroup))))
9255
9256 ;; This function returns a list of article numbers based on the
9257 ;; difference between the ranges of read articles in this group and
9258 ;; the range of active articles.
9259 (defun gnus-list-of-unread-articles (group)
9260   (let* ((read (gnus-info-read (gnus-get-info group)))
9261          (active (gnus-active group))
9262          (last (cdr active))
9263          first nlast unread)
9264     ;; If none are read, then all are unread.
9265     (if (not read)
9266         (setq first (car active))
9267       ;; If the range of read articles is a single range, then the
9268       ;; first unread article is the article after the last read
9269       ;; article.  Sounds logical, doesn't it?
9270       (if (not (listp (cdr read)))
9271           (setq first (1+ (cdr read)))
9272         ;; `read' is a list of ranges.
9273         (if (/= (setq nlast (or (and (numberp (car read)) (car read))
9274                                 (car (car read)))) 1)
9275             (setq first 1))
9276         (while read
9277           (if first
9278               (while (< first nlast)
9279                 (setq unread (cons first unread))
9280                 (setq first (1+ first))))
9281           (setq first (1+ (if (atom (car read)) (car read) (cdr (car read)))))
9282           (setq nlast (if (atom (car (cdr read)))
9283                           (car (cdr read))
9284                         (car (car (cdr read)))))
9285           (setq read (cdr read)))))
9286     ;; And add the last unread articles.
9287     (while (<= first last)
9288       (setq unread (cons first unread))
9289       (setq first (1+ first)))
9290     ;; Return the list of unread articles.
9291     (nreverse unread)))
9292
9293 (defun gnus-list-of-read-articles (group)
9294   "Return a list of unread, unticked and non-dormant articles."
9295   (let* ((info (gnus-get-info group))
9296          (marked (gnus-info-marks info))
9297          (active (gnus-active group)))
9298     (and info active
9299          (gnus-set-difference
9300           (gnus-sorted-complement
9301            (gnus-uncompress-range active)
9302            (gnus-list-of-unread-articles group))
9303           (append
9304            (gnus-uncompress-range (cdr (assq 'dormant marked)))
9305            (gnus-uncompress-range (cdr (assq 'tick marked))))))))
9306
9307 ;; Various summary commands
9308
9309 (defun gnus-summary-universal-argument (arg)
9310   "Perform any operation on all articles that are process/prefixed."
9311   (interactive "P")
9312   (gnus-set-global-variables)
9313   (let ((articles (gnus-summary-work-articles arg))
9314         func article)
9315     (if (eq
9316          (setq
9317           func
9318           (key-binding
9319            (read-key-sequence
9320             (substitute-command-keys
9321              "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
9322              ))))
9323          'undefined)
9324         (progn
9325           (message "Undefined key")
9326           (ding))
9327       (save-excursion
9328         (while articles
9329           (gnus-summary-goto-subject (setq article (pop articles)))
9330           (command-execute func)
9331           (gnus-summary-remove-process-mark article)))))
9332   (gnus-summary-position-point))
9333
9334 (defun gnus-summary-toggle-truncation (&optional arg)
9335   "Toggle truncation of summary lines.
9336 With arg, turn line truncation on iff arg is positive."
9337   (interactive "P")
9338   (setq truncate-lines
9339         (if (null arg) (not truncate-lines)
9340           (> (prefix-numeric-value arg) 0)))
9341   (redraw-display))
9342
9343 (defun gnus-summary-reselect-current-group (&optional all rescan)
9344   "Exit and then reselect the current newsgroup.
9345 The prefix argument ALL means to select all articles."
9346   (interactive "P")
9347   (gnus-set-global-variables)
9348   (let ((current-subject (gnus-summary-article-number))
9349         (group gnus-newsgroup-name))
9350     (setq gnus-newsgroup-begin nil)
9351     (gnus-summary-exit)
9352     ;; We have to adjust the point of group mode buffer because the
9353     ;; current point was moved to the next unread newsgroup by
9354     ;; exiting.
9355     (gnus-summary-jump-to-group group)
9356     (when rescan
9357       (save-excursion
9358         (gnus-group-get-new-news-this-group 1)))
9359     (gnus-group-read-group all t)
9360     (gnus-summary-goto-subject current-subject)))
9361
9362 (defun gnus-summary-rescan-group (&optional all)
9363   "Exit the newsgroup, ask for new articles, and select the newsgroup."
9364   (interactive "P")
9365   (gnus-summary-reselect-current-group all t))
9366
9367 (defun gnus-summary-update-info ()
9368   (let* ((group gnus-newsgroup-name))
9369     (when gnus-newsgroup-kill-headers
9370       (setq gnus-newsgroup-killed
9371             (gnus-compress-sequence
9372              (nconc
9373               (gnus-set-sorted-intersection
9374                (gnus-uncompress-range gnus-newsgroup-killed)
9375                (setq gnus-newsgroup-unselected
9376                      (sort gnus-newsgroup-unselected '<)))
9377               (setq gnus-newsgroup-unreads
9378                     (sort gnus-newsgroup-unreads '<))) t)))
9379     (unless (listp (cdr gnus-newsgroup-killed))
9380       (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
9381     (let ((headers gnus-newsgroup-headers))
9382       (gnus-close-group group)
9383       (run-hooks 'gnus-exit-group-hook)
9384       (unless gnus-save-score
9385         (setq gnus-newsgroup-scored nil))
9386       ;; Set the new ranges of read articles.
9387       (gnus-update-read-articles
9388        group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
9389       ;; Set the current article marks.
9390       (gnus-update-marks)
9391       ;; Do the cross-ref thing.
9392       (when gnus-use-cross-reference
9393         (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
9394       ;; Do adaptive scoring, and possibly save score files.
9395       (when gnus-newsgroup-adaptive
9396         (gnus-score-adaptive))
9397       (when gnus-use-scoring
9398         (gnus-score-save))
9399       ;; Do not switch windows but change the buffer to work.
9400       (set-buffer gnus-group-buffer)
9401       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
9402           (gnus-group-update-group group)))))
9403
9404 (defun gnus-summary-exit (&optional temporary)
9405   "Exit reading current newsgroup, and then return to group selection mode.
9406 gnus-exit-group-hook is called with no arguments if that value is non-nil."
9407   (interactive)
9408   (gnus-set-global-variables)
9409   (gnus-kill-save-kill-buffer)
9410   (let* ((group gnus-newsgroup-name)
9411          (quit-config (gnus-group-quit-config gnus-newsgroup-name))
9412          (mode major-mode)
9413          (buf (current-buffer)))
9414     (run-hooks 'gnus-summary-prepare-exit-hook)
9415     (when gnus-use-cache
9416       (gnus-cache-possibly-remove-articles)
9417       (gnus-cache-save-buffers))
9418     (when gnus-use-trees
9419       (gnus-tree-close group))
9420     ;; Make all changes in this group permanent.
9421     (gnus-summary-update-info)
9422     ;; Make sure where I was, and go to next newsgroup.
9423     (set-buffer gnus-group-buffer)
9424     (or quit-config
9425         (progn
9426           (gnus-group-jump-to-group group)
9427           (gnus-group-next-unread-group 1)))
9428     (run-hooks 'gnus-summary-exit-hook)
9429     (if temporary
9430         nil                             ;Nothing to do.
9431       ;; If we have several article buffers, we kill them at exit.
9432       (unless gnus-single-article-buffer
9433         (gnus-kill-buffer gnus-article-buffer)
9434         (gnus-kill-buffer gnus-original-article-buffer))
9435       (set-buffer buf)
9436       (if (not gnus-kill-summary-on-exit)
9437           (gnus-deaden-summary)
9438         ;; We set all buffer-local variables to nil.  It is unclear why
9439         ;; this is needed, but if we don't, buffer-local variables are
9440         ;; not garbage-collected, it seems.  This would the lead to en
9441         ;; ever-growing Emacs.
9442         (gnus-summary-clear-local-variables)
9443         (when (get-buffer gnus-article-buffer)
9444           (bury-buffer gnus-article-buffer))
9445         ;; We clear the global counterparts of the buffer-local
9446         ;; variables as well, just to be on the safe side.
9447         (gnus-configure-windows 'group 'force)
9448         (gnus-summary-clear-local-variables)
9449         ;; Return to group mode buffer.
9450         (if (eq mode 'gnus-summary-mode)
9451             (gnus-kill-buffer buf)))
9452       (setq gnus-current-select-method gnus-select-method)
9453       (pop-to-buffer gnus-group-buffer)
9454       ;; Clear the current group name.
9455       (if (not quit-config)
9456           (progn
9457             (gnus-group-jump-to-group group)
9458             (gnus-group-next-unread-group 1)
9459             (gnus-configure-windows 'group 'force))
9460         (if (not (buffer-name (car quit-config)))
9461             (gnus-configure-windows 'group 'force)
9462           (set-buffer (car quit-config))
9463           (and (eq major-mode 'gnus-summary-mode)
9464                (gnus-set-global-variables))
9465           (gnus-configure-windows (cdr quit-config))))
9466       (unless quit-config
9467         (setq gnus-newsgroup-name nil)))))
9468
9469 (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
9470 (defun gnus-summary-exit-no-update (&optional no-questions)
9471   "Quit reading current newsgroup without updating read article info."
9472   (interactive)
9473   (gnus-set-global-variables)
9474   (let* ((group gnus-newsgroup-name)
9475          (quit-config (gnus-group-quit-config group)))
9476     (when (or no-questions
9477               gnus-expert-user
9478               (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
9479       ;; If we have several article buffers, we kill them at exit.
9480       (unless gnus-single-article-buffer
9481         (gnus-kill-buffer gnus-article-buffer)
9482         (gnus-kill-buffer gnus-original-article-buffer))
9483       (if (not gnus-kill-summary-on-exit)
9484           (gnus-deaden-summary)
9485         (gnus-close-group group)
9486         (gnus-summary-clear-local-variables)
9487         (set-buffer gnus-group-buffer)
9488         (gnus-summary-clear-local-variables)
9489         (when (get-buffer gnus-summary-buffer)
9490           (kill-buffer gnus-summary-buffer)))
9491       (when gnus-use-trees
9492         (gnus-tree-close group))
9493       (when (get-buffer gnus-article-buffer)
9494         (bury-buffer gnus-article-buffer))
9495       ;; Return to the group buffer.
9496       (gnus-configure-windows 'group 'force)
9497       ;; Clear the current group name.
9498       (setq gnus-newsgroup-name nil)
9499       (when (equal (gnus-group-group-name) group)
9500         (gnus-group-next-unread-group 1))
9501       (when quit-config
9502         (if (not (buffer-name (car quit-config)))
9503             (gnus-configure-windows 'group 'force)
9504           (set-buffer (car quit-config))
9505           (when (eq major-mode 'gnus-summary-mode)
9506             (gnus-set-global-variables))
9507           (gnus-configure-windows (cdr quit-config)))))))
9508
9509 ;;; Dead summaries.
9510
9511 (defvar gnus-dead-summary-mode-map nil)
9512
9513 (if gnus-dead-summary-mode-map
9514     nil
9515   (setq gnus-dead-summary-mode-map (make-keymap))
9516   (suppress-keymap gnus-dead-summary-mode-map)
9517   (substitute-key-definition
9518    'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
9519   (let ((keys '("\C-d" "\r" "\177")))
9520     (while keys
9521       (define-key gnus-dead-summary-mode-map
9522         (pop keys) 'gnus-summary-wake-up-the-dead))))
9523
9524 (defvar gnus-dead-summary-mode nil
9525   "Minor mode for Gnus summary buffers.")
9526
9527 (defun gnus-dead-summary-mode (&optional arg)
9528   "Minor mode for Gnus summary buffers."
9529   (interactive "P")
9530   (when (eq major-mode 'gnus-summary-mode)
9531     (make-local-variable 'gnus-dead-summary-mode)
9532     (setq gnus-dead-summary-mode
9533           (if (null arg) (not gnus-dead-summary-mode)
9534             (> (prefix-numeric-value arg) 0)))
9535     (when gnus-dead-summary-mode
9536       (unless (assq 'gnus-dead-summary-mode minor-mode-alist)
9537         (push '(gnus-dead-summary-mode " Dead") minor-mode-alist))
9538       (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist)
9539         (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map)
9540               minor-mode-map-alist)))))
9541
9542 (defun gnus-deaden-summary ()
9543   "Make the current summary buffer into a dead summary buffer."
9544   ;; Kill any previous dead summary buffer.
9545   (when (and gnus-dead-summary
9546              (buffer-name gnus-dead-summary))
9547     (save-excursion
9548       (set-buffer gnus-dead-summary)
9549       (when gnus-dead-summary-mode
9550         (kill-buffer (current-buffer)))))
9551   ;; Make this the current dead summary.
9552   (setq gnus-dead-summary (current-buffer))
9553   (gnus-dead-summary-mode 1)
9554   (let ((name (buffer-name)))
9555     (when (string-match "Summary" name)
9556       (rename-buffer
9557        (concat (substring name 0 (match-beginning 0)) "Dead "
9558                (substring name (match-beginning 0))) t))))
9559
9560 (defun gnus-kill-or-deaden-summary (buffer)
9561   "Kill or deaden the summary BUFFER."
9562   (cond (gnus-kill-summary-on-exit
9563          (when (and gnus-use-trees
9564                     (and (get-buffer buffer)
9565                          (buffer-name (get-buffer buffer))))
9566            (save-excursion
9567              (set-buffer (get-buffer buffer))
9568              (gnus-tree-close gnus-newsgroup-name)))
9569          (gnus-kill-buffer buffer))
9570         ((and (get-buffer buffer)
9571               (buffer-name (get-buffer buffer)))
9572          (save-excursion
9573            (set-buffer buffer)
9574            (gnus-deaden-summary)))))
9575
9576 (defun gnus-summary-wake-up-the-dead (&rest args)
9577   "Wake up the dead summary buffer."
9578   (interactive)
9579   (gnus-dead-summary-mode -1)
9580   (let ((name (buffer-name)))
9581     (when (string-match "Dead " name)
9582       (rename-buffer
9583        (concat (substring name 0 (match-beginning 0))
9584                (substring name (match-end 0))) t)))
9585   (gnus-message 3 "This dead summary is now alive again"))
9586
9587 ;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
9588 (defun gnus-summary-fetch-faq (&optional faq-dir)
9589   "Fetch the FAQ for the current group.
9590 If FAQ-DIR (the prefix), prompt for a directory to search for the faq
9591 in."
9592   (interactive
9593    (list
9594     (if current-prefix-arg
9595         (completing-read
9596          "Faq dir: " (and (listp gnus-group-faq-directory)
9597                           gnus-group-faq-directory)))))
9598   (let (gnus-faq-buffer)
9599     (and (setq gnus-faq-buffer
9600                (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
9601          (gnus-configure-windows 'summary-faq))))
9602
9603 ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
9604 (defun gnus-summary-describe-group (&optional force)
9605   "Describe the current newsgroup."
9606   (interactive "P")
9607   (gnus-group-describe-group force gnus-newsgroup-name))
9608
9609 (defun gnus-summary-describe-briefly ()
9610   "Describe summary mode commands briefly."
9611   (interactive)
9612   (gnus-message 6
9613                 (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")))
9614
9615 ;; Walking around group mode buffer from summary mode.
9616
9617 (defun gnus-summary-next-group (&optional no-article target-group backward)
9618   "Exit current newsgroup and then select next unread newsgroup.
9619 If prefix argument NO-ARTICLE is non-nil, no article is selected
9620 initially.  If NEXT-GROUP, go to this group.  If BACKWARD, go to
9621 previous group instead."
9622   (interactive "P")
9623   (gnus-set-global-variables)
9624   (let ((current-group gnus-newsgroup-name)
9625         (current-buffer (current-buffer))
9626         entered)
9627     ;; First we semi-exit this group to update Xrefs and all variables.
9628     ;; We can't do a real exit, because the window conf must remain
9629     ;; the same in case the user is prompted for info, and we don't
9630     ;; want the window conf to change before that...
9631     (gnus-summary-exit t)
9632     (while (not entered)
9633       ;; Then we find what group we are supposed to enter.
9634       (set-buffer gnus-group-buffer)
9635       (gnus-group-jump-to-group current-group)
9636       (setq target-group
9637             (or target-group
9638                 (if (eq gnus-keep-same-level 'best)
9639                     (gnus-summary-best-group gnus-newsgroup-name)
9640                   (gnus-summary-search-group backward gnus-keep-same-level))))
9641       (if (not target-group)
9642           ;; There are no further groups, so we return to the group
9643           ;; buffer.
9644           (progn
9645             (gnus-message 5 "Returning to the group buffer")
9646             (setq entered t)
9647             (set-buffer current-buffer)
9648             (gnus-summary-exit))
9649         ;; We try to enter the target group.
9650         (gnus-group-jump-to-group target-group)
9651         (let ((unreads (gnus-group-group-unread)))
9652           (if (and (or (eq t unreads)
9653                        (and unreads (not (zerop unreads))))
9654                    (gnus-summary-read-group
9655                     target-group nil no-article current-buffer))
9656               (setq entered t)
9657             (setq current-group target-group
9658                   target-group nil)))))))
9659
9660 (defun gnus-summary-prev-group (&optional no-article)
9661   "Exit current newsgroup and then select previous unread newsgroup.
9662 If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
9663   (interactive "P")
9664   (gnus-summary-next-group no-article nil t))
9665
9666 ;; Walking around summary lines.
9667
9668 (defun gnus-summary-first-subject (&optional unread)
9669   "Go to the first unread subject.
9670 If UNREAD is non-nil, go to the first unread article.
9671 Returns the article selected or nil if there are no unread articles."
9672   (interactive "P")
9673   (prog1
9674       (cond
9675        ;; Empty summary.
9676        ((null gnus-newsgroup-data)
9677         (gnus-message 3 "No articles in the group")
9678         nil)
9679        ;; Pick the first article.
9680        ((not unread)
9681         (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
9682         (gnus-data-number (car gnus-newsgroup-data)))
9683        ;; No unread articles.
9684        ((null gnus-newsgroup-unreads)
9685         (gnus-message 3 "No more unread articles")
9686         nil)
9687        ;; Find the first unread article.
9688        (t
9689         (let ((data gnus-newsgroup-data))
9690           (while (and data
9691                       (not (gnus-data-unread-p (car data))))
9692             (setq data (cdr data)))
9693           (if data
9694               (progn
9695                 (goto-char (gnus-data-pos (car data)))
9696                 (gnus-data-number (car data)))))))
9697     (gnus-summary-position-point)))
9698
9699 (defun gnus-summary-next-subject (n &optional unread dont-display)
9700   "Go to next N'th summary line.
9701 If N is negative, go to the previous N'th subject line.
9702 If UNREAD is non-nil, only unread articles are selected.
9703 The difference between N and the actual number of steps taken is
9704 returned."
9705   (interactive "p")
9706   (let ((backward (< n 0))
9707         (n (abs n)))
9708     (while (and (> n 0)
9709                 (if backward
9710                     (gnus-summary-find-prev unread)
9711                   (gnus-summary-find-next unread)))
9712       (setq n (1- n)))
9713     (if (/= 0 n) (gnus-message 7 "No more%s articles"
9714                                (if unread " unread" "")))
9715     (or dont-display
9716         (progn
9717           (gnus-summary-recenter)
9718           (gnus-summary-position-point)))
9719     n))
9720
9721 (defun gnus-summary-next-unread-subject (n)
9722   "Go to next N'th unread summary line."
9723   (interactive "p")
9724   (gnus-summary-next-subject n t))
9725
9726 (defun gnus-summary-prev-subject (n &optional unread)
9727   "Go to previous N'th summary line.
9728 If optional argument UNREAD is non-nil, only unread article is selected."
9729   (interactive "p")
9730   (gnus-summary-next-subject (- n) unread))
9731
9732 (defun gnus-summary-prev-unread-subject (n)
9733   "Go to previous N'th unread summary line."
9734   (interactive "p")
9735   (gnus-summary-next-subject (- n) t))
9736
9737 (defun gnus-summary-goto-subject (article &optional force silent)
9738   "Go the subject line of ARTICLE.
9739 If FORCE, also allow jumping to articles not currently shown."
9740   (let ((b (point))
9741         (data (gnus-data-find article)))
9742     ;; We read in the article if we have to.
9743     (and (not data)
9744          force
9745          (gnus-summary-insert-subject article)
9746          (setq data (gnus-data-find article)))
9747     (goto-char b)
9748     (if (not data)
9749         (progn
9750           (unless silent
9751             (gnus-message 3 "Can't find article %d" article))
9752           nil)
9753       (goto-char (gnus-data-pos data))
9754       article)))
9755
9756 ;; Walking around summary lines with displaying articles.
9757
9758 (defun gnus-summary-expand-window (&optional arg)
9759   "Make the summary buffer take up the entire Emacs frame.
9760 Given a prefix, will force an `article' buffer configuration."
9761   (interactive "P")
9762   (gnus-set-global-variables)
9763   (if arg
9764       (gnus-configure-windows 'article 'force)
9765     (gnus-configure-windows 'summary 'force)))
9766
9767 (defun gnus-summary-display-article (article &optional all-header)
9768   "Display ARTICLE in article buffer."
9769   (gnus-set-global-variables)
9770   (if (null article)
9771       nil
9772     (prog1
9773         (if gnus-summary-display-article-function
9774             (funcall gnus-summary-display-article-function article all-header)
9775           (gnus-article-prepare article all-header))
9776       (run-hooks 'gnus-select-article-hook)
9777       (gnus-summary-recenter)
9778       (gnus-summary-goto-subject article)
9779       (when gnus-use-trees
9780         (gnus-possibly-generate-tree article)
9781         (gnus-highlight-selected-tree article))
9782       ;; Successfully display article.
9783       (gnus-article-set-window-start
9784        (cdr (assq article gnus-newsgroup-bookmarks)))
9785       t)))
9786
9787 (defun gnus-summary-select-article (&optional all-headers force pseudo article)
9788   "Select the current article.
9789 If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
9790 non-nil, the article will be re-fetched even if it already present in
9791 the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
9792 be displayed."
9793   (let ((article (or article (gnus-summary-article-number)))
9794         (all-headers (not (not all-headers))) ;Must be T or NIL.
9795         gnus-summary-display-article-function
9796         did)
9797     (and (not pseudo)
9798          (gnus-summary-article-pseudo-p article)
9799          (error "This is a pseudo-article."))
9800     (prog1
9801         (save-excursion
9802           (set-buffer gnus-summary-buffer)
9803           (if (or (and gnus-single-article-buffer
9804                        (or (null gnus-current-article)
9805                            (null gnus-article-current)
9806                            (null (get-buffer gnus-article-buffer))
9807                            (not (eq article (cdr gnus-article-current)))
9808                            (not (equal (car gnus-article-current)
9809                                        gnus-newsgroup-name))))
9810                   (and (not gnus-single-article-buffer)
9811                        (null gnus-current-article))
9812                   force)
9813               ;; The requested article is different from the current article.
9814               (prog1
9815                   (gnus-summary-display-article article all-headers)
9816                 (setq did article))
9817             (if (or all-headers gnus-show-all-headers)
9818                 (gnus-article-show-all-headers))
9819             'old))
9820       (if did
9821           (gnus-article-set-window-start
9822            (cdr (assq article gnus-newsgroup-bookmarks)))))))
9823
9824 (defun gnus-summary-set-current-mark (&optional current-mark)
9825   "Obsolete function."
9826   nil)
9827
9828 (defun gnus-summary-next-article (&optional unread subject backward push)
9829   "Select the next article.
9830 If UNREAD, only unread articles are selected.
9831 If SUBJECT, only articles with SUBJECT are selected.
9832 If BACKWARD, the previous article is selected instead of the next."
9833   (interactive "P")
9834   (gnus-set-global-variables)
9835   (let (header)
9836     (cond
9837      ;; Is there such an article?
9838      ((and (gnus-summary-search-forward unread subject backward)
9839            (or (gnus-summary-display-article (gnus-summary-article-number))
9840                (eq (gnus-summary-article-mark) gnus-canceled-mark)))
9841       (gnus-summary-position-point))
9842      ;; If not, we try the first unread, if that is wanted.
9843      ((and subject
9844            gnus-auto-select-same
9845            (or (gnus-summary-first-unread-article)
9846                (eq (gnus-summary-article-mark) gnus-canceled-mark)))
9847       (gnus-summary-position-point)
9848       (gnus-message 6 "Wrapped"))
9849      ;; Try to get next/previous article not displayed in this group.
9850      ((and gnus-auto-extend-newsgroup
9851            (not unread) (not subject))
9852       (gnus-summary-goto-article
9853        (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
9854        nil t))
9855      ;; Go to next/previous group.
9856      (t
9857       (or (gnus-ephemeral-group-p gnus-newsgroup-name)
9858           (gnus-summary-jump-to-group gnus-newsgroup-name))
9859       (let ((cmd last-command-char)
9860             (group
9861              (if (eq gnus-keep-same-level 'best)
9862                  (gnus-summary-best-group gnus-newsgroup-name)
9863                (gnus-summary-search-group backward gnus-keep-same-level))))
9864         ;; For some reason, the group window gets selected.  We change
9865         ;; it back.
9866         (select-window (get-buffer-window (current-buffer)))
9867         ;; Select next unread newsgroup automagically.
9868         (cond
9869          ((not gnus-auto-select-next)
9870           (gnus-message 7 "No more%s articles" (if unread " unread" "")))
9871          ((or (eq gnus-auto-select-next 'quietly)
9872               (and (eq gnus-auto-select-next 'slightly-quietly)
9873                    push)
9874               (and (eq gnus-auto-select-next 'almost-quietly)
9875                    (gnus-summary-last-article-p)))
9876           ;; Select quietly.
9877           (if (gnus-ephemeral-group-p gnus-newsgroup-name)
9878               (gnus-summary-exit)
9879             (gnus-message 7 "No more%s articles (%s)..."
9880                           (if unread " unread" "")
9881                           (if group (concat "selecting " group)
9882                             "exiting"))
9883             (gnus-summary-next-group nil group backward)))
9884          (t
9885           (gnus-summary-walk-group-buffer
9886            gnus-newsgroup-name cmd unread backward))))))))
9887
9888 (defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
9889   (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
9890                       (?\C-p (gnus-group-prev-unread-group 1))))
9891         keve key group ended)
9892     (save-excursion
9893       (set-buffer gnus-group-buffer)
9894       (gnus-summary-jump-to-group from-group)
9895       (setq group
9896             (if (eq gnus-keep-same-level 'best)
9897                 (gnus-summary-best-group gnus-newsgroup-name)
9898               (gnus-summary-search-group backward gnus-keep-same-level))))
9899     (while (not ended)
9900       (gnus-message
9901        5 "No more%s articles%s" (if unread " unread" "")
9902        (if (and group
9903                 (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
9904            (format " (Type %s for %s [%s])"
9905                    (single-key-description cmd) group
9906                    (car (gnus-gethash group gnus-newsrc-hashtb)))
9907          (format " (Type %s to exit %s)"
9908                  (single-key-description cmd)
9909                  gnus-newsgroup-name)))
9910       ;; Confirm auto selection.
9911       (setq key (car (setq keve (gnus-read-event-char))))
9912       (setq ended t)
9913       (cond
9914        ((assq key keystrokes)
9915         (let ((obuf (current-buffer)))
9916           (switch-to-buffer gnus-group-buffer)
9917           (and group
9918                (gnus-group-jump-to-group group))
9919           (eval (car (cdr (assq key keystrokes))))
9920           (setq group (gnus-group-group-name))
9921           (switch-to-buffer obuf))
9922         (setq ended nil))
9923        ((equal key cmd)
9924         (if (or (not group)
9925                 (gnus-ephemeral-group-p gnus-newsgroup-name))
9926             (gnus-summary-exit)
9927           (gnus-summary-next-group nil group backward)))
9928        (t
9929         (push (cdr keve) unread-command-events))))))
9930
9931 (defun gnus-read-event-char ()
9932   "Get the next event."
9933   (let ((event (read-event)))
9934     (cons (and (numberp event) event) event)))
9935
9936 (defun gnus-summary-next-unread-article ()
9937   "Select unread article after current one."
9938   (interactive)
9939   (gnus-summary-next-article t (and gnus-auto-select-same
9940                                     (gnus-summary-article-subject))))
9941
9942 (defun gnus-summary-prev-article (&optional unread subject)
9943   "Select the article after the current one.
9944 If UNREAD is non-nil, only unread articles are selected."
9945   (interactive "P")
9946   (gnus-summary-next-article unread subject t))
9947
9948 (defun gnus-summary-prev-unread-article ()
9949   "Select unred article before current one."
9950   (interactive)
9951   (gnus-summary-prev-article t (and gnus-auto-select-same
9952                                     (gnus-summary-article-subject))))
9953
9954 (defun gnus-summary-next-page (&optional lines circular)
9955   "Show next page of the selected article.
9956 If at the end of the current article, select the next article.
9957 LINES says how many lines should be scrolled up.
9958
9959 If CIRCULAR is non-nil, go to the start of the article instead of
9960 selecting the next article when reaching the end of the current
9961 article."
9962   (interactive "P")
9963   (setq gnus-summary-buffer (current-buffer))
9964   (gnus-set-global-variables)
9965   (let ((article (gnus-summary-article-number))
9966         (endp nil))
9967     (gnus-configure-windows 'article)
9968     (if (or (null gnus-current-article)
9969             (null gnus-article-current)
9970             (/= article (cdr gnus-article-current))
9971             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
9972         ;; Selected subject is different from current article's.
9973         (gnus-summary-display-article article)
9974       (gnus-eval-in-buffer-window
9975        gnus-article-buffer
9976        (setq endp (gnus-article-next-page lines)))
9977       (if endp
9978           (cond (circular
9979                  (gnus-summary-beginning-of-article))
9980                 (lines
9981                  (gnus-message 3 "End of message"))
9982                 ((null lines)
9983                  (if (eq gnus-summary-goto-unread 'always)
9984                      (gnus-summary-next-article)
9985                    (gnus-summary-next-unread-article))))))
9986     (gnus-summary-recenter)
9987     (gnus-summary-position-point)))
9988
9989 (defun gnus-summary-prev-page (&optional lines)
9990   "Show previous page of selected article.
9991 Argument LINES specifies lines to be scrolled down."
9992   (interactive "P")
9993   (gnus-set-global-variables)
9994   (let ((article (gnus-summary-article-number)))
9995     (gnus-configure-windows 'article)
9996     (if (or (null gnus-current-article)
9997             (null gnus-article-current)
9998             (/= article (cdr gnus-article-current))
9999             (not (equal (car gnus-article-current) gnus-newsgroup-name)))
10000         ;; Selected subject is different from current article's.
10001         (gnus-summary-display-article article)
10002       (gnus-summary-recenter)
10003       (gnus-eval-in-buffer-window gnus-article-buffer
10004                                   (gnus-article-prev-page lines))))
10005   (gnus-summary-position-point))
10006
10007 (defun gnus-summary-scroll-up (lines)
10008   "Scroll up (or down) one line current article.
10009 Argument LINES specifies lines to be scrolled up (or down if negative)."
10010   (interactive "p")
10011   (gnus-set-global-variables)
10012   (gnus-configure-windows 'article)
10013   (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
10014     (gnus-eval-in-buffer-window
10015      gnus-article-buffer
10016      (cond ((> lines 0)
10017             (if (gnus-article-next-page lines)
10018                 (gnus-message 3 "End of message")))
10019            ((< lines 0)
10020             (gnus-article-prev-page (- lines))))))
10021   (gnus-summary-recenter)
10022   (gnus-summary-position-point))
10023
10024 (defun gnus-summary-next-same-subject ()
10025   "Select next article which has the same subject as current one."
10026   (interactive)
10027   (gnus-set-global-variables)
10028   (gnus-summary-next-article nil (gnus-summary-article-subject)))
10029
10030 (defun gnus-summary-prev-same-subject ()
10031   "Select previous article which has the same subject as current one."
10032   (interactive)
10033   (gnus-set-global-variables)
10034   (gnus-summary-prev-article nil (gnus-summary-article-subject)))
10035
10036 (defun gnus-summary-next-unread-same-subject ()
10037   "Select next unread article which has the same subject as current one."
10038   (interactive)
10039   (gnus-set-global-variables)
10040   (gnus-summary-next-article t (gnus-summary-article-subject)))
10041
10042 (defun gnus-summary-prev-unread-same-subject ()
10043   "Select previous unread article which has the same subject as current one."
10044   (interactive)
10045   (gnus-set-global-variables)
10046   (gnus-summary-prev-article t (gnus-summary-article-subject)))
10047
10048 (defun gnus-summary-first-unread-article ()
10049   "Select the first unread article.
10050 Return nil if there are no unread articles."
10051   (interactive)
10052   (gnus-set-global-variables)
10053   (prog1
10054       (if (gnus-summary-first-subject t)
10055           (progn
10056             (gnus-summary-show-thread)
10057             (gnus-summary-first-subject t)
10058             (gnus-summary-display-article (gnus-summary-article-number))))
10059     (gnus-summary-position-point)))
10060
10061 (defun gnus-summary-best-unread-article ()
10062   "Select the unread article with the highest score."
10063   (interactive)
10064   (gnus-set-global-variables)
10065   (let ((best -1000000)
10066         (data gnus-newsgroup-data)
10067         article score)
10068     (while data
10069       (and (gnus-data-unread-p (car data))
10070            (> (setq score
10071                     (gnus-summary-article-score (gnus-data-number (car data))))
10072               best)
10073            (setq best score
10074                  article (gnus-data-number (car data))))
10075       (setq data (cdr data)))
10076     (if article
10077         (gnus-summary-goto-article article)
10078       (error "No unread articles"))
10079     (gnus-summary-position-point)))
10080
10081 (defun gnus-summary-last-subject ()
10082   "Go to the last displayed subject line in the group."
10083   (let ((article (gnus-data-number (car (gnus-data-list t)))))
10084     (when article
10085       (gnus-summary-goto-subject article))))
10086
10087 (defun gnus-summary-goto-article (article &optional all-headers force)
10088   "Fetch ARTICLE and display it if it exists.
10089 If ALL-HEADERS is non-nil, no header lines are hidden."
10090   (interactive
10091    (list
10092     (string-to-int
10093      (completing-read
10094       "Article number: "
10095       (mapcar (lambda (number) (list (int-to-string number)))
10096               gnus-newsgroup-limit)))
10097     current-prefix-arg
10098     t))
10099   (prog1
10100       (if (gnus-summary-goto-subject article force)
10101           (gnus-summary-display-article article all-headers)
10102         (gnus-message 4 "Couldn't go to article %s" article) nil)
10103     (gnus-summary-position-point)))
10104
10105 (defun gnus-summary-goto-last-article ()
10106   "Go to the previously read article."
10107   (interactive)
10108   (prog1
10109       (and gnus-last-article
10110            (gnus-summary-goto-article gnus-last-article))
10111     (gnus-summary-position-point)))
10112
10113 (defun gnus-summary-pop-article (number)
10114   "Pop one article off the history and go to the previous.
10115 NUMBER articles will be popped off."
10116   (interactive "p")
10117   (let (to)
10118     (setq gnus-newsgroup-history
10119           (cdr (setq to (nthcdr number gnus-newsgroup-history))))
10120     (if to
10121         (gnus-summary-goto-article (car to))
10122       (error "Article history empty")))
10123   (gnus-summary-position-point))
10124
10125 ;; Summary commands and functions for limiting the summary buffer.
10126
10127 (defun gnus-summary-limit-to-articles (n)
10128   "Limit the summary buffer to the next N articles.
10129 If not given a prefix, use the process marked articles instead."
10130   (interactive "P")
10131   (gnus-set-global-variables)
10132   (prog1
10133       (let ((articles (gnus-summary-work-articles n)))
10134         (setq gnus-newsgroup-processable nil)
10135         (gnus-summary-limit articles))
10136     (gnus-summary-position-point)))
10137
10138 (defun gnus-summary-pop-limit (&optional total)
10139   "Restore the previous limit.
10140 If given a prefix, remove all limits."
10141   (interactive "P")
10142   (gnus-set-global-variables)
10143   (when total 
10144     (setq gnus-newsgroup-limits
10145           (list (mapcar (lambda (h) (mail-header-number h))
10146                         gnus-newsgroup-headers))))
10147   (unless gnus-newsgroup-limits
10148     (error "No limit to pop"))
10149   (prog1
10150       (gnus-summary-limit nil 'pop)
10151     (gnus-summary-position-point)))
10152
10153 (defun gnus-summary-limit-to-subject (subject &optional header)
10154   "Limit the summary buffer to articles that have subjects that match a regexp."
10155   (interactive "sRegexp: ")
10156   (unless header
10157     (setq header "subject"))
10158   (when (not (equal "" subject))
10159     (prog1
10160         (let ((articles (gnus-summary-find-matching "subject" subject 'all)))
10161           (or articles (error "Found no matches for \"%s\"" subject))
10162           (gnus-summary-limit articles))
10163       (gnus-summary-position-point))))
10164
10165 (defun gnus-summary-limit-to-author (from)
10166   "Limit the summary buffer to articles that have authors that match a regexp."
10167   (interactive "sRegexp: ")
10168   (gnus-summary-limit-to-subject from "from"))
10169
10170 (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10171 (make-obsolete
10172  'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
10173
10174 (defun gnus-summary-limit-to-unread (&optional all)
10175   "Limit the summary buffer to articles that are not marked as read.
10176 If ALL is non-nil, limit strictly to unread articles."
10177   (interactive "P")
10178   (if all
10179       (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
10180     (gnus-summary-limit-to-marks
10181      ;; Concat all the marks that say that an article is read and have
10182      ;; those removed.
10183      (list gnus-del-mark gnus-read-mark gnus-ancient-mark
10184            gnus-killed-mark gnus-kill-file-mark
10185            gnus-low-score-mark gnus-expirable-mark
10186            gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark)
10187      'reverse)))
10188
10189 (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10190 (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
10191
10192 (defun gnus-summary-limit-to-marks (marks &optional reverse)
10193   "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
10194 If REVERSE, limit the summary buffer to articles that are not marked
10195 with MARKS.  MARKS can either be a string of marks or a list of marks.
10196 Returns how many articles were removed."
10197   (interactive "sMarks: ")
10198   (gnus-set-global-variables)
10199   (prog1
10200       (let ((data gnus-newsgroup-data)
10201             (marks (if (listp marks) marks
10202                      (append marks nil))) ; Transform to list.
10203             articles)
10204         (while data
10205           (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
10206                  (memq (gnus-data-mark (car data)) marks))
10207                (setq articles (cons (gnus-data-number (car data)) articles)))
10208           (setq data (cdr data)))
10209         (gnus-summary-limit articles))
10210     (gnus-summary-position-point)))
10211
10212 (defun gnus-summary-limit-to-score (&optional score)
10213   "Limit to articles with score at or above SCORE."
10214   (interactive "P")
10215   (gnus-set-global-variables)
10216   (setq score (if score
10217                   (prefix-numeric-value score)
10218                 (or gnus-summary-default-score 0)))
10219   (let ((data gnus-newsgroup-data)
10220         articles)
10221     (while data
10222       (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
10223                 score)
10224         (push (gnus-data-number (car data)) articles))
10225       (setq data (cdr data)))
10226     (prog1
10227         (gnus-summary-limit articles)
10228       (gnus-summary-position-point))))
10229
10230 (defun gnus-summary-limit-include-dormant ()
10231   "Display all the hidden articles that are marked as dormant."
10232   (interactive)
10233   (gnus-set-global-variables)
10234   (or gnus-newsgroup-dormant
10235       (error "There are no dormant articles in this group"))
10236   (prog1
10237       (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
10238     (gnus-summary-position-point)))
10239
10240 (defun gnus-summary-limit-exclude-dormant ()
10241   "Hide all dormant articles."
10242   (interactive)
10243   (gnus-set-global-variables)
10244   (prog1
10245       (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
10246     (gnus-summary-position-point)))
10247
10248 (defun gnus-summary-limit-exclude-childless-dormant ()
10249   "Hide all dormant articles that have no children."
10250   (interactive)
10251   (gnus-set-global-variables)
10252   (let ((data gnus-newsgroup-data)
10253         articles)
10254     ;; Find all articles that are either not dormant or have
10255     ;; children.
10256     (while data
10257       (and (or (not (= (gnus-data-mark (car data)) gnus-dormant-mark))
10258                (gnus-article-parent-p (gnus-data-number (car data))))
10259            (setq articles (cons (gnus-data-number (car data))
10260                                 articles)))
10261       (setq data (cdr data)))
10262     ;; Do the limiting.
10263     (prog1
10264         (gnus-summary-limit articles)
10265       (gnus-summary-position-point))))
10266
10267 (defun gnus-summary-limit-mark-excluded-as-read (&optional all)
10268   "Mark all unread excluded articles as read.
10269 If ALL, mark even excluded ticked and dormants as read."
10270   (interactive "P")
10271   (let ((articles (gnus-sorted-complement
10272                    (sort
10273                     (mapcar (lambda (h) (mail-header-number h))
10274                             gnus-newsgroup-headers)
10275                     '<)
10276                    (sort gnus-newsgroup-limit '<)))
10277         article)
10278     (setq gnus-newsgroup-unreads nil)
10279     (if all
10280         (setq gnus-newsgroup-dormant nil
10281               gnus-newsgroup-marked nil
10282               gnus-newsgroup-reads
10283               (nconc
10284                (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
10285                gnus-newsgroup-reads))
10286       (while (setq article (pop articles))
10287         (unless (or (memq article gnus-newsgroup-dormant)
10288                     (memq article gnus-newsgroup-marked))
10289           (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
10290
10291
10292 (defun gnus-summary-limit (articles &optional pop)
10293   (if pop
10294       ;; We pop the previous limit off the stack and use that.
10295       (setq articles (car gnus-newsgroup-limits)
10296             gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
10297     ;; We use the new limit, so we push the old limit on the stack.
10298     (setq gnus-newsgroup-limits
10299           (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
10300   ;; Set the limit.
10301   (setq gnus-newsgroup-limit articles)
10302   (let ((total (length gnus-newsgroup-data))
10303         (data (gnus-data-find-list (gnus-summary-article-number)))
10304         found)
10305     ;; This will do all the work of generating the new summary buffer
10306     ;; according to the new limit.
10307     (gnus-summary-prepare)
10308     ;; Hide any threads, possibly.
10309     (and gnus-show-threads
10310          gnus-thread-hide-subtree
10311          (gnus-summary-hide-all-threads))
10312     ;; Try to return to the article you were at, or one in the
10313     ;; neighborhood.
10314     (if data
10315         ;; We try to find some article after the current one.
10316         (while data
10317           (and (gnus-summary-goto-subject
10318                 (gnus-data-number (car data)) nil t)
10319                (setq data nil
10320                      found t))
10321           (setq data (cdr data))))
10322     (or found
10323         ;; If there is no data, that means that we were after the last
10324         ;; article.  The same goes when we can't find any articles
10325         ;; after the current one.
10326         (progn
10327           (goto-char (point-max))
10328           (gnus-summary-find-prev)))
10329     ;; We return how many articles were removed from the summary
10330     ;; buffer as a result of the new limit.
10331     (- total (length gnus-newsgroup-data))))
10332
10333 (defsubst gnus-cut-thread (thread)
10334   "Go forwards in the thread until we find an article that we want to display."
10335   (if (eq gnus-fetch-old-headers 'some)
10336       (while (and thread
10337                   (memq (mail-header-number (car thread)) 
10338                         gnus-newsgroup-ancient)
10339                   (<= (length (cdr thread)) 1))
10340         (setq thread (cadr thread)))
10341     (while (and thread
10342                 (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
10343                 (= (length (cdr thread)) 1))
10344       (setq thread (cadr thread))))
10345   thread)
10346
10347 (defun gnus-cut-threads (threads)
10348   "Cut off all uninteresting articles from the beginning of threads."
10349   (when (or (eq gnus-fetch-old-headers 'some)
10350             (eq gnus-build-sparse-threads 'some)
10351             (eq gnus-build-sparse-threads 'more))
10352     (let ((th threads))
10353       (while th
10354         (setcar th (gnus-cut-thread (car th)))
10355         (setq th (cdr th)))))
10356   threads)
10357
10358 (defun gnus-summary-initial-limit (&optional show-if-empty)
10359   "Figure out what the initial limit is supposed to be on group entry.
10360 This entails weeding out unwanted dormants, low-scored articles,
10361 fetch-old-headers verbiage, and so on."
10362   ;; Most groups have nothing to remove.
10363   (if (or gnus-inhibit-limiting
10364           (and (null gnus-newsgroup-dormant)
10365                (not (eq gnus-fetch-old-headers 'some))
10366                (null gnus-summary-expunge-below)
10367                (not (eq gnus-build-sparse-threads 'some))
10368                (not (eq gnus-build-sparse-threads 'more))
10369                (null gnus-thread-expunge-below)))
10370       () ; Do nothing.
10371     (push gnus-newsgroup-limit gnus-newsgroup-limits)
10372     (setq gnus-newsgroup-limit nil)
10373     (mapatoms
10374      (lambda (node)
10375        (unless (car (symbol-value node))
10376          ;; These threads have no parents -- they are roots.
10377          (let ((nodes (cdr (symbol-value node)))
10378                thread)
10379            (while nodes
10380              (if (and gnus-thread-expunge-below
10381                       (< (gnus-thread-total-score (car nodes))
10382                          gnus-thread-expunge-below))
10383                  (gnus-expunge-thread (pop nodes))
10384                (setq thread (pop nodes))
10385                (gnus-summary-limit-children thread))))))
10386      gnus-newsgroup-dependencies)
10387     ;; If this limitation resulted in an empty group, we might
10388     ;; pop the previous limit and use it instead.
10389     (when (and (not gnus-newsgroup-limit)
10390                show-if-empty)
10391       (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
10392     gnus-newsgroup-limit))
10393
10394 (defun gnus-summary-limit-children (thread)
10395   "Return 1 if this subthread is visible and 0 if it is not."
10396   ;; First we get the number of visible children to this thread.  This
10397   ;; is done by recursing down the thread using this function, so this
10398   ;; will really go down to a leaf article first, before slowly
10399   ;; working its way up towards the root.
10400   (when thread
10401     (let ((children
10402            (if (cdr thread)
10403                (apply '+ (mapcar 'gnus-summary-limit-children
10404                                  (cdr thread)))
10405              0))
10406           (number (mail-header-number (car thread)))
10407           score)
10408       (if (or
10409            ;; If this article is dormant and has absolutely no visible
10410            ;; children, then this article isn't visible.
10411            (and (memq number gnus-newsgroup-dormant)
10412                 (= children 0))
10413            ;; If this is a "fetch-old-headered" and there is only one
10414            ;; visible child (or less), then we don't want this article.
10415            (and (eq gnus-fetch-old-headers 'some)
10416                 (memq number gnus-newsgroup-ancient)
10417                 (zerop children))
10418            ;; If this is a sparsely inserted article with no children,
10419            ;; we don't want it.
10420            (and (eq gnus-build-sparse-threads 'some)
10421                 (memq number gnus-newsgroup-sparse)
10422                 (zerop children))
10423            ;; If we use expunging, and this article is really
10424            ;; low-scored, then we don't want this article.
10425            (when (and gnus-summary-expunge-below
10426                       (< (setq score
10427                                (or (cdr (assq number gnus-newsgroup-scored))
10428                                    gnus-summary-default-score))
10429                          gnus-summary-expunge-below))
10430              ;; We increase the expunge-tally here, but that has
10431              ;; nothing to do with the limits, really.
10432              (incf gnus-newsgroup-expunged-tally)
10433              ;; We also mark as read here, if that's wanted.
10434              (when (and gnus-summary-mark-below
10435                         (< score gnus-summary-mark-below))
10436                (setq gnus-newsgroup-unreads
10437                      (delq number gnus-newsgroup-unreads))
10438                (if gnus-newsgroup-auto-expire
10439                    (push number gnus-newsgroup-expirable)
10440                  (push (cons number gnus-low-score-mark)
10441                        gnus-newsgroup-reads)))
10442              t))
10443           ;; Nope, invisible article.
10444           0
10445         ;; Ok, this article is to be visible, so we add it to the limit
10446         ;; and return 1.
10447         (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
10448         1))))
10449
10450 (defun gnus-expunge-thread (thread)
10451   "Mark all articles in THREAD as read."
10452   (let* ((number (mail-header-number (car thread))))
10453     (incf gnus-newsgroup-expunged-tally)
10454     ;; We also mark as read here, if that's wanted.
10455     (setq gnus-newsgroup-unreads
10456           (delq number gnus-newsgroup-unreads))
10457     (if gnus-newsgroup-auto-expire
10458         (push number gnus-newsgroup-expirable)
10459       (push (cons number gnus-low-score-mark)
10460             gnus-newsgroup-reads)))
10461   ;; Go recursively through all subthreads.
10462   (mapcar 'gnus-expunge-thread (cdr thread)))
10463
10464 ;; Summary article oriented commands
10465
10466 (defun gnus-summary-refer-parent-article (n)
10467   "Refer parent article N times.
10468 The difference between N and the number of articles fetched is returned."
10469   (interactive "p")
10470   (gnus-set-global-variables)
10471   (while
10472       (and
10473        (> n 0)
10474        (let* ((header (gnus-summary-article-header))
10475               (ref
10476                ;; If we try to find the parent of the currently
10477                ;; displayed article, then we take a look at the actual
10478                ;; References header, since this is slightly more
10479                ;; reliable than the References field we got from the
10480                ;; server.
10481                (if (and (eq (mail-header-number header)
10482                             (cdr gnus-article-current))
10483                         (equal gnus-newsgroup-name
10484                                (car gnus-article-current)))
10485                    (save-excursion
10486                      (set-buffer gnus-original-article-buffer)
10487                      (nnheader-narrow-to-headers)
10488                      (prog1
10489                          (mail-fetch-field "references")
10490                        (widen)))
10491                  ;; It's not the current article, so we take a bet on
10492                  ;; the value we got from the server.
10493                  (mail-header-references header))))
10494          (if ref
10495              (or (gnus-summary-refer-article (gnus-parent-id ref))
10496                  (gnus-message 1 "Couldn't find parent"))
10497            (gnus-message 1 "No references in article %d"
10498                          (gnus-summary-article-number))
10499            nil)))
10500     (setq n (1- n)))
10501   (gnus-summary-position-point)
10502   n)
10503
10504 (defun gnus-summary-refer-references ()
10505   "Fetch all articles mentioned in the References header.
10506 Return how many articles were fetched."
10507   (interactive)
10508   (gnus-set-global-variables)
10509   (let ((ref (mail-header-references (gnus-summary-article-header)))
10510         (current (gnus-summary-article-number))
10511         (n 0))
10512     ;; For each Message-ID in the References header...
10513     (while (string-match "<[^>]*>" ref)
10514       (incf n)
10515       ;; ... fetch that article.
10516       (gnus-summary-refer-article
10517        (prog1 (match-string 0 ref)
10518          (setq ref (substring ref (match-end 0))))))
10519     (gnus-summary-goto-subject current)
10520     (gnus-summary-position-point)
10521     n))
10522
10523 (defun gnus-summary-refer-article (message-id)
10524   "Fetch an article specified by MESSAGE-ID."
10525   (interactive "sMessage-ID: ")
10526   (when (and (stringp message-id)
10527              (not (zerop (length message-id))))
10528     ;; Construct the correct Message-ID if necessary.
10529     ;; Suggested by tale@pawl.rpi.edu.
10530     (unless (string-match "^<" message-id)
10531       (setq message-id (concat "<" message-id)))
10532     (unless (string-match ">$" message-id)
10533       (setq message-id (concat message-id ">")))
10534     (let ((header (car (gnus-gethash (downcase message-id)
10535                                      gnus-newsgroup-dependencies))))
10536       (if header
10537           ;; The article is present in the buffer, to we just go to it.
10538           (gnus-summary-goto-article (mail-header-number header) nil t)
10539         ;; We fetch the article
10540         (let ((gnus-override-method gnus-refer-article-method)
10541               number)
10542           ;; Start the special refer-article method, if necessary.
10543           (when gnus-refer-article-method
10544             (gnus-check-server gnus-refer-article-method))
10545           ;; Fetch the header, and display the article.
10546           (if (setq number (gnus-summary-insert-subject message-id))
10547               (gnus-summary-select-article nil nil nil number)
10548             (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
10549
10550 (defun gnus-summary-enter-digest-group (&optional force)
10551   "Enter a digest group based on the current article."
10552   (interactive "P")
10553   (gnus-set-global-variables)
10554   (gnus-summary-select-article)
10555   (let ((name (format "%s-%d"
10556                       (gnus-group-prefixed-name
10557                        gnus-newsgroup-name (list 'nndoc ""))
10558                       gnus-current-article))
10559         (ogroup gnus-newsgroup-name)
10560         (case-fold-search t)
10561         (buf (current-buffer))
10562         dig)
10563     (save-excursion
10564       (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
10565       (insert-buffer-substring gnus-original-article-buffer)
10566       (narrow-to-region
10567        (goto-char (point-min))
10568        (or (search-forward "\n\n" nil t) (point)))
10569       (goto-char (point-min))
10570       (delete-matching-lines "^\\(Path\\):")
10571       (widen))
10572     (unwind-protect
10573         (if (gnus-group-read-ephemeral-group
10574              name `(nndoc ,name (nndoc-address
10575                                  ,(get-buffer dig))
10576                           (nndoc-article-type ,(if force 'digest 'guess))) t)
10577             ;; Make all postings to this group go to the parent group.
10578             (setcdr (nthcdr 4 (gnus-get-info name))
10579                     (list (list (cons 'to-group ogroup))))
10580           ;; Couldn't select this doc group.
10581           (switch-to-buffer buf)
10582           (gnus-set-global-variables)
10583           (gnus-configure-windows 'summary)
10584           (gnus-message 3 "Article couldn't be entered?"))
10585       (kill-buffer dig))))
10586
10587 (defun gnus-summary-isearch-article (&optional regexp-p)
10588   "Do incremental search forward on the current article.
10589 If REGEXP-P (the prefix) is non-nil, do regexp isearch."
10590   (interactive "P")
10591   (gnus-set-global-variables)
10592   (gnus-summary-select-article)
10593   (gnus-configure-windows 'article)
10594   (gnus-eval-in-buffer-window
10595    gnus-article-buffer
10596    (goto-char (point-min))
10597    (isearch-forward regexp-p)))
10598
10599 (defun gnus-summary-search-article-forward (regexp &optional backward)
10600   "Search for an article containing REGEXP forward.
10601 If BACKWARD, search backward instead."
10602   (interactive
10603    (list (read-string
10604           (format "Search article %s (regexp%s): "
10605                   (if current-prefix-arg "backward" "forward")
10606                   (if gnus-last-search-regexp
10607                       (concat ", default " gnus-last-search-regexp)
10608                     "")))
10609          current-prefix-arg))
10610   (gnus-set-global-variables)
10611   (if (string-equal regexp "")
10612       (setq regexp (or gnus-last-search-regexp ""))
10613     (setq gnus-last-search-regexp regexp))
10614   (if (gnus-summary-search-article regexp backward)
10615       (gnus-article-set-window-start
10616        (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks)))
10617     (error "Search failed: \"%s\"" regexp)))
10618
10619 (defun gnus-summary-search-article-backward (regexp)
10620   "Search for an article containing REGEXP backward."
10621   (interactive
10622    (list (read-string
10623           (format "Search article backward (regexp%s): "
10624                   (if gnus-last-search-regexp
10625                       (concat ", default " gnus-last-search-regexp)
10626                     "")))))
10627   (gnus-summary-search-article-forward regexp 'backward))
10628
10629 (defun gnus-summary-search-article (regexp &optional backward)
10630   "Search for an article containing REGEXP.
10631 Optional argument BACKWARD means do search for backward.
10632 gnus-select-article-hook is not called during the search."
10633   (let ((gnus-select-article-hook nil)  ;Disable hook.
10634         (gnus-mark-article-hook nil)    ;Inhibit marking as read.
10635         (re-search
10636          (if backward
10637              (function re-search-backward) (function re-search-forward)))
10638         (found nil)
10639         (last nil))
10640     ;; Hidden thread subtrees must be searched for ,too.
10641     (gnus-summary-show-all-threads)
10642     ;; First of all, search current article.
10643     ;; We don't want to read article again from NNTP server nor reset
10644     ;; current point.
10645     (gnus-summary-select-article)
10646     (gnus-message 9 "Searching article: %d..." gnus-current-article)
10647     (setq last gnus-current-article)
10648     (gnus-eval-in-buffer-window
10649      gnus-article-buffer
10650      (save-restriction
10651        (widen)
10652        ;; Begin search from current point.
10653        (setq found (funcall re-search regexp nil t))))
10654     ;; Then search next articles.
10655     (while (and (not found)
10656                 (gnus-summary-display-article
10657                  (if backward (gnus-summary-find-prev)
10658                    (gnus-summary-find-next))))
10659       (gnus-message 9 "Searching article: %d..." gnus-current-article)
10660       (gnus-eval-in-buffer-window
10661        gnus-article-buffer
10662        (save-restriction
10663          (widen)
10664          (goto-char (if backward (point-max) (point-min)))
10665          (setq found (funcall re-search regexp nil t)))))
10666     (message "")
10667     ;; Adjust article pointer.
10668     (or (eq last gnus-current-article)
10669         (setq gnus-last-article last))
10670     ;; Return T if found such article.
10671     found))
10672
10673 (defun gnus-summary-find-matching (header regexp &optional backward unread
10674                                           not-case-fold)
10675   "Return a list of all articles that match REGEXP on HEADER.
10676 The search stars on the current article and goes forwards unless
10677 BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
10678 If UNREAD is non-nil, only unread articles will
10679 be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
10680 in the comparisons."
10681   (let ((data (if (eq backward 'all) gnus-newsgroup-data
10682                 (gnus-data-find-list
10683                  (gnus-summary-article-number) (gnus-data-list backward))))
10684         (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
10685         (case-fold-search (not not-case-fold))
10686         articles d)
10687     (or (fboundp (intern (concat "mail-header-" header)))
10688         (error "%s is not a valid header" header))
10689     (while data
10690       (setq d (car data))
10691       (and (or (not unread)             ; We want all articles...
10692                (gnus-data-unread-p d))  ; Or just unreads.
10693            (vectorp (gnus-data-header d)) ; It's not a pseudo.
10694            (string-match regexp (funcall func (gnus-data-header d))) ; Match.
10695            (setq articles (cons (gnus-data-number d) articles))) ; Success!
10696       (setq data (cdr data)))
10697     (nreverse articles)))
10698
10699 (defun gnus-summary-execute-command (header regexp command &optional backward)
10700   "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
10701 If HEADER is an empty string (or nil), the match is done on the entire
10702 article.  If BACKWARD (the prefix) is non-nil, search backward instead."
10703   (interactive
10704    (list (let ((completion-ignore-case t))
10705            (completing-read
10706             "Header name: "
10707             (mapcar (lambda (string) (list string))
10708                     '("Number" "Subject" "From" "Lines" "Date"
10709                       "Message-ID" "Xref" "References"))
10710             nil 'require-match))
10711          (read-string "Regexp: ")
10712          (read-key-sequence "Command: ")
10713          current-prefix-arg))
10714   (gnus-set-global-variables)
10715   ;; Hidden thread subtrees must be searched as well.
10716   (gnus-summary-show-all-threads)
10717   ;; We don't want to change current point nor window configuration.
10718   (save-excursion
10719     (save-window-excursion
10720       (gnus-message 6 "Executing %s..." (key-description command))
10721       ;; We'd like to execute COMMAND interactively so as to give arguments.
10722       (gnus-execute header regexp
10723                     `(lambda () (call-interactively ',(key-binding command)))
10724                     backward)
10725       (gnus-message 6 "Executing %s...done" (key-description command)))))
10726
10727 (defun gnus-summary-beginning-of-article ()
10728   "Scroll the article back to the beginning."
10729   (interactive)
10730   (gnus-set-global-variables)
10731   (gnus-summary-select-article)
10732   (gnus-configure-windows 'article)
10733   (gnus-eval-in-buffer-window
10734    gnus-article-buffer
10735    (widen)
10736    (goto-char (point-min))
10737    (and gnus-break-pages (gnus-narrow-to-page))))
10738
10739 (defun gnus-summary-end-of-article ()
10740   "Scroll to the end of the article."
10741   (interactive)
10742   (gnus-set-global-variables)
10743   (gnus-summary-select-article)
10744   (gnus-configure-windows 'article)
10745   (gnus-eval-in-buffer-window
10746    gnus-article-buffer
10747    (widen)
10748    (goto-char (point-max))
10749    (recenter -3)
10750    (and gnus-break-pages (gnus-narrow-to-page))))
10751
10752 (defun gnus-summary-show-article (&optional arg)
10753   "Force re-fetching of the current article.
10754 If ARG (the prefix) is non-nil, show the raw article without any
10755 article massaging functions being run."
10756   (interactive "P")
10757   (gnus-set-global-variables)
10758   (if (not arg)
10759       ;; Select the article the normal way.
10760       (gnus-summary-select-article nil 'force)
10761     ;; Bind the article treatment functions to nil.
10762     (let ((gnus-have-all-headers t)
10763           gnus-article-display-hook
10764           gnus-article-prepare-hook
10765           gnus-visual)
10766       (gnus-summary-select-article nil 'force)))
10767 ;  (gnus-configure-windows 'article)
10768   (gnus-summary-position-point))
10769
10770 (defun gnus-summary-verbose-headers (&optional arg)
10771   "Toggle permanent full header display.
10772 If ARG is a positive number, turn header display on.
10773 If ARG is a negative number, turn header display off."
10774   (interactive "P")
10775   (gnus-set-global-variables)
10776   (gnus-summary-toggle-header arg)
10777   (setq gnus-show-all-headers
10778         (cond ((or (not (numberp arg))
10779                    (zerop arg))
10780                (not gnus-show-all-headers))
10781               ((natnump arg)
10782                t))))
10783
10784 (defun gnus-summary-toggle-header (&optional arg)
10785   "Show the headers if they are hidden, or hide them if they are shown.
10786 If ARG is a positive number, show the entire header.
10787 If ARG is a negative number, hide the unwanted header lines."
10788   (interactive "P")
10789   (gnus-set-global-variables)
10790   (save-excursion
10791     (set-buffer gnus-article-buffer)
10792     (let* ((buffer-read-only nil)
10793            (inhibit-point-motion-hooks t)
10794            (hidden (text-property-any
10795                     (goto-char (point-min)) (search-forward "\n\n")
10796                     'invisible t))
10797            e)
10798       (goto-char (point-min))
10799       (when (search-forward "\n\n" nil t)
10800         (delete-region (point-min) (1- (point))))
10801       (goto-char (point-min))
10802       (save-excursion
10803         (set-buffer gnus-original-article-buffer)
10804         (goto-char (point-min))
10805         (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
10806       (insert-buffer-substring gnus-original-article-buffer 1 e)
10807       (let ((gnus-inhibit-hiding t))
10808         (run-hooks 'gnus-article-display-hook))
10809       (if (or (not hidden) (and (numberp arg) (< arg 0)))
10810           (gnus-article-hide-headers)))))
10811
10812 (defun gnus-summary-show-all-headers ()
10813   "Make all header lines visible."
10814   (interactive)
10815   (gnus-set-global-variables)
10816   (gnus-article-show-all-headers))
10817
10818 (defun gnus-summary-toggle-mime (&optional arg)
10819   "Toggle MIME processing.
10820 If ARG is a positive number, turn MIME processing on."
10821   (interactive "P")
10822   (gnus-set-global-variables)
10823   (setq gnus-show-mime
10824         (if (null arg) (not gnus-show-mime)
10825           (> (prefix-numeric-value arg) 0)))
10826   (gnus-summary-select-article t 'force))
10827
10828 (defun gnus-summary-caesar-message (&optional arg)
10829   "Caesar rotate the current article by 13.
10830 The numerical prefix specifies how manu places to rotate each letter
10831 forward."
10832   (interactive "P")
10833   (gnus-set-global-variables)
10834   (gnus-summary-select-article)
10835   (let ((mail-header-separator ""))
10836     (gnus-eval-in-buffer-window
10837      gnus-article-buffer
10838      (save-restriction
10839        (widen)
10840        (let ((start (window-start)))
10841          (news-caesar-buffer-body arg)
10842          (set-window-start (get-buffer-window (current-buffer)) start))))))
10843
10844 (defun gnus-summary-stop-page-breaking ()
10845   "Stop page breaking in the current article."
10846   (interactive)
10847   (gnus-set-global-variables)
10848   (gnus-summary-select-article)
10849   (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
10850
10851 (defun gnus-summary-move-article (&optional n to-newsgroup select-method action)
10852   "Move the current article to a different newsgroup.
10853 If N is a positive number, move the N next articles.
10854 If N is a negative number, move the N previous articles.
10855 If N is nil and any articles have been marked with the process mark,
10856 move those articles instead.
10857 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
10858 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
10859 re-spool using this method.
10860
10861 For this function to work, both the current newsgroup and the
10862 newsgroup that you want to move to have to support the `request-move'
10863 and `request-accept' functions."
10864   (interactive "P")
10865   (unless action (setq action 'move))
10866   (gnus-set-global-variables)
10867   ;; Check whether the source group supports the required functions.
10868   (cond ((and (eq action 'move)
10869               (not (gnus-check-backend-function
10870                     'request-move-article gnus-newsgroup-name)))
10871          (error "The current group does not support article moving"))
10872         ((and (eq action 'crosspost)
10873               (not (gnus-check-backend-function
10874                     'request-replace-article gnus-newsgroup-name)))
10875          (error "The current group does not support article editing")))
10876   (let ((articles (gnus-summary-work-articles n))
10877         (prefix (gnus-group-real-prefix gnus-newsgroup-name))
10878         (names '((move "move" "Moving")
10879                  (copy "copy" "Copying")
10880                  (crosspost "crosspost" "Crossposting")))
10881         (copy-buf (save-excursion
10882                     (nnheader-set-temp-buffer " *copy article*")))
10883         art-group to-method new-xref article)
10884     (unless (assq action names)
10885       (error "Unknown action %s" action))
10886     ;; Read the newsgroup name.
10887     (when (and (not to-newsgroup)
10888                (not select-method))
10889       (setq to-newsgroup
10890             (gnus-read-move-group-name
10891              (cadr (assq action names))
10892              gnus-current-move-group articles prefix))
10893       (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
10894     (setq to-method (if select-method (list select-method "")
10895                       (gnus-find-method-for-group to-newsgroup)))
10896     ;;(when (equal to-newsgroup gnus-newsgroup-name)
10897     ;;(error "Can't %s to the same group you're already in" action))
10898     ;; Check the method we are to move this article to...
10899     (or (gnus-check-backend-function 'request-accept-article (car to-method))
10900         (error "%s does not support article copying" (car to-method)))
10901     (or (gnus-check-server to-method)
10902         (error "Can't open server %s" (car to-method)))
10903     (gnus-message 6 "%s to %s: %s..."
10904                   (caddr (assq action names))
10905                   (or select-method to-newsgroup) articles)
10906     (while articles
10907       (setq article (pop articles))
10908       (setq
10909        art-group
10910        (cond
10911         ;; Move the article.
10912         ((eq action 'move)
10913          (gnus-request-move-article
10914           article               ; Article to move
10915           gnus-newsgroup-name   ; From newsgrouo
10916           (nth 1 (gnus-find-method-for-group
10917                   gnus-newsgroup-name)) ; Server
10918           (list 'gnus-request-accept-article
10919                 (if select-method
10920                     (list 'quote select-method)
10921                   to-newsgroup)
10922                 (not articles)) ; Accept form
10923           (not articles)))      ; Only save nov last time
10924         ;; Copy the article.
10925         ((eq action 'copy)
10926          (save-excursion
10927            (set-buffer copy-buf)
10928            (gnus-request-article-this-buffer article gnus-newsgroup-name)
10929            (gnus-request-accept-article
10930             (if select-method select-method to-newsgroup)
10931             (not articles))))
10932         ;; Crosspost the article.
10933         ((eq action 'crosspost)
10934          (let ((xref (mail-header-xref (gnus-summary-article-header article))))
10935            (setq new-xref (concat gnus-newsgroup-name ":" article))
10936            (if (and xref (not (string= xref "")))
10937                (progn
10938                  (when (string-match "^Xref: " xref)
10939                    (setq xref (substring xref (match-end 0))))
10940                  (setq new-xref (concat xref " " new-xref)))
10941              (setq new-xref (concat (system-name) " " new-xref)))
10942            (save-excursion
10943              (set-buffer copy-buf)
10944              (gnus-request-article-this-buffer article gnus-newsgroup-name)
10945              (nnheader-replace-header "xref" new-xref)
10946              (gnus-request-accept-article
10947               (if select-method select-method to-newsgroup)
10948               (not articles)))))))
10949       (if (not art-group)
10950           (gnus-message 1 "Couldn't %s article %s"
10951                         (cadr (assq action names)) article)
10952         (let* ((entry
10953                 (or
10954                  (gnus-gethash (car art-group) gnus-newsrc-hashtb)
10955                  (gnus-gethash
10956                   (gnus-group-prefixed-name
10957                    (car art-group)
10958                    (if select-method (list select-method "")
10959                      (gnus-find-method-for-group to-newsgroup)))
10960                   gnus-newsrc-hashtb)))
10961                (info (nth 2 entry)))
10962           ;; Update the group that has been moved to.
10963           (when (and info
10964                      (memq action '(move copy)))
10965             (unless (memq article gnus-newsgroup-unreads)
10966               (gnus-info-set-read
10967                info (gnus-add-to-range (gnus-info-read info)
10968                                        (list (cdr art-group)))))
10969
10970             ;; Copy any marks over to the new group.
10971             (let ((marks gnus-article-mark-lists)
10972                   (to-article (cdr art-group)))
10973
10974               ;; See whether the article is to be put in the cache.
10975               (when gnus-use-cache
10976                 (gnus-cache-possibly-enter-article
10977                  (gnus-info-group info) to-article
10978                  (let ((header (copy-sequence
10979                                 (gnus-summary-article-header article))))
10980                    (mail-header-set-number header to-article)
10981                    header)
10982                  (memq article gnus-newsgroup-marked)
10983                  (memq article gnus-newsgroup-dormant)
10984                  (memq article gnus-newsgroup-unreads)))
10985
10986                 (while marks
10987                   (when (memq article (symbol-value
10988                                        (intern (format "gnus-newsgroup-%s"
10989                                                        (caar marks)))))
10990                     (gnus-add-marked-articles
10991                      (gnus-info-group info) (caar marks)
10992                      (list to-article) info))
10993                   (setq marks (cdr marks)))))
10994
10995           ;; Update the Xref header in this article to point to
10996           ;; the new crossposted article we have just created.
10997           (when (eq action 'crosspost)
10998             (save-excursion
10999               (set-buffer copy-buf)
11000               (gnus-request-article-this-buffer article gnus-newsgroup-name)
11001               (nnheader-replace-header
11002                "xref" (concat new-xref " " (gnus-group-prefixed-name
11003                                             (car art-group) to-method)
11004                               ":" (cdr art-group)))
11005               (gnus-request-replace-article
11006                article gnus-newsgroup-name (current-buffer)))))
11007
11008         (gnus-summary-goto-subject article)
11009         (gnus-summary-mark-article article gnus-canceled-mark))
11010       (gnus-summary-remove-process-mark article))
11011     (gnus-kill-buffer copy-buf)
11012     (gnus-set-mode-line 'summary)))
11013
11014 (defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
11015   "Move the current article to a different newsgroup.
11016 If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
11017 If SELECT-METHOD is symbol, do not move to a specific newsgroup, but
11018 re-spool using this method."
11019   (interactive "P")
11020   (gnus-summary-move-article n nil nil 'copy))
11021
11022 (defun gnus-summary-crosspost-article (&optional n)
11023   "Crosspost the current article to some other group."
11024   (interactive "P")
11025   (gnus-summary-move-article n nil nil 'crosspost))
11026
11027 (defun gnus-summary-respool-article (&optional n respool-method)
11028   "Respool the current article.
11029 The article will be squeezed through the mail spooling process again,
11030 which means that it will be put in some mail newsgroup or other
11031 depending on `nnmail-split-methods'.
11032 If N is a positive number, respool the N next articles.
11033 If N is a negative number, respool the N previous articles.
11034 If N is nil and any articles have been marked with the process mark,
11035 respool those articles instead.
11036
11037 Respooling can be done both from mail groups and \"real\" newsgroups.
11038 In the former case, the articles in question will be moved from the
11039 current group into whatever groups they are destined to.  In the
11040 latter case, they will be copied into the relevant groups."
11041   (interactive "P")
11042   (gnus-set-global-variables)
11043   (let ((respool-methods (gnus-methods-using 'respool))
11044         (methname
11045          (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name)))))
11046     (or respool-method
11047         (setq respool-method
11048               (completing-read
11049                "What method do you want to use when respooling? "
11050                respool-methods nil t methname)))
11051     (or (string= respool-method "")
11052         (if (assoc (symbol-name
11053                     (car (gnus-find-method-for-group gnus-newsgroup-name)))
11054                    respool-methods)
11055             (gnus-summary-move-article n nil (intern respool-method))
11056           (gnus-summary-copy-article n nil (intern respool-method))))))
11057
11058 (defun gnus-summary-import-article (file)
11059   "Import a random file into a mail newsgroup."
11060   (interactive "fImport file: ")
11061   (gnus-set-global-variables)
11062   (let ((group gnus-newsgroup-name)
11063         (now (current-time))
11064         atts lines)
11065     (or (gnus-check-backend-function 'request-accept-article group)
11066         (error "%s does not support article importing" group))
11067     (or (file-readable-p file)
11068         (not (file-regular-p file))
11069         (error "Can't read %s" file))
11070     (save-excursion
11071       (set-buffer (get-buffer-create " *import file*"))
11072       (buffer-disable-undo (current-buffer))
11073       (erase-buffer)
11074       (insert-file-contents file)
11075       (goto-char (point-min))
11076       (unless (nnheader-article-p)
11077         ;; This doesn't look like an article, so we fudge some headers.
11078         (setq atts (file-attributes file)
11079               lines (count-lines (point-min) (point-max)))
11080         (insert "From: " (read-string "From: ") "\n"
11081                 "Subject: " (read-string "Subject: ") "\n"
11082                 "Date: " (timezone-make-date-arpa-standard
11083                           (current-time-string (nth 5 atts))
11084                           (current-time-zone now)
11085                           (current-time-zone now)) "\n"
11086                 "Message-ID: " (gnus-inews-message-id) "\n"
11087                 "Lines: " (int-to-string lines) "\n"
11088                 "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
11089       (gnus-request-accept-article group t)
11090       (kill-buffer (current-buffer)))))
11091
11092 (defun gnus-summary-expire-articles ()
11093   "Expire all articles that are marked as expirable in the current group."
11094   (interactive)
11095   (gnus-set-global-variables)
11096   (when (gnus-check-backend-function
11097          'request-expire-articles gnus-newsgroup-name)
11098     ;; This backend supports expiry.
11099     (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
11100            (expirable (if total
11101                           (gnus-list-of-read-articles gnus-newsgroup-name)
11102                         (setq gnus-newsgroup-expirable
11103                               (sort gnus-newsgroup-expirable '<))))
11104            (expiry-wait (gnus-group-get-parameter
11105                          gnus-newsgroup-name 'expiry-wait))
11106            es)
11107       (when expirable
11108         ;; There are expirable articles in this group, so we run them
11109         ;; through the expiry process.
11110         (gnus-message 6 "Expiring articles...")
11111         ;; The list of articles that weren't expired is returned.
11112         (if expiry-wait
11113             (let ((nnmail-expiry-wait-function nil)
11114                   (nnmail-expiry-wait expiry-wait))
11115               (setq es (gnus-request-expire-articles
11116                         expirable gnus-newsgroup-name)))
11117           (setq es (gnus-request-expire-articles
11118                     expirable gnus-newsgroup-name)))
11119         (or total (setq gnus-newsgroup-expirable es))
11120         ;; We go through the old list of expirable, and mark all
11121         ;; really expired articles as nonexistent.
11122         (unless (eq es expirable)       ;If nothing was expired, we don't mark.
11123           (let ((gnus-use-cache nil))
11124             (while expirable
11125               (unless (memq (car expirable) es)
11126                 (when (gnus-data-find (car expirable))
11127                   (gnus-summary-mark-article
11128                    (car expirable) gnus-canceled-mark)))
11129               (setq expirable (cdr expirable)))))
11130         (gnus-message 6 "Expiring articles...done")))))
11131
11132 (defun gnus-summary-expire-articles-now ()
11133   "Expunge all expirable articles in the current group.
11134 This means that *all* articles that are marked as expirable will be
11135 deleted forever, right now."
11136   (interactive)
11137   (gnus-set-global-variables)
11138   (or gnus-expert-user
11139       (gnus-y-or-n-p
11140        "Are you really, really, really sure you want to expunge? ")
11141       (error "Phew!"))
11142   (let ((nnmail-expiry-wait 'immediate)
11143         (nnmail-expiry-wait-function nil))
11144     (gnus-summary-expire-articles)))
11145
11146 ;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
11147 (defun gnus-summary-delete-article (&optional n)
11148   "Delete the N next (mail) articles.
11149 This command actually deletes articles.  This is not a marking
11150 command.  The article will disappear forever from your life, never to
11151 return.
11152 If N is negative, delete backwards.
11153 If N is nil and articles have been marked with the process mark,
11154 delete these instead."
11155   (interactive "P")
11156   (gnus-set-global-variables)
11157   (or (gnus-check-backend-function 'request-expire-articles
11158                                    gnus-newsgroup-name)
11159       (error "The current newsgroup does not support article deletion."))
11160   ;; Compute the list of articles to delete.
11161   (let ((articles (gnus-summary-work-articles n))
11162         not-deleted)
11163     (if (and gnus-novice-user
11164              (not (gnus-y-or-n-p
11165                    (format "Do you really want to delete %s forever? "
11166                            (if (> (length articles) 1) "these articles"
11167                              "this article")))))
11168         ()
11169       ;; Delete the articles.
11170       (setq not-deleted (gnus-request-expire-articles
11171                          articles gnus-newsgroup-name 'force))
11172       (while articles
11173         (gnus-summary-remove-process-mark (car articles))
11174         ;; The backend might not have been able to delete the article
11175         ;; after all.
11176         (or (memq (car articles) not-deleted)
11177             (gnus-summary-mark-article (car articles) gnus-canceled-mark))
11178         (setq articles (cdr articles))))
11179     (gnus-summary-position-point)
11180     (gnus-set-mode-line 'summary)
11181     not-deleted))
11182
11183 (defun gnus-summary-edit-article (&optional force)
11184   "Enter into a buffer and edit the current article.
11185 This will have permanent effect only in mail groups.
11186 If FORCE is non-nil, allow editing of articles even in read-only
11187 groups."
11188   (interactive "P")
11189   (save-excursion
11190     (set-buffer gnus-summary-buffer)
11191     (gnus-set-global-variables)
11192     (when (and (not force)
11193                (gnus-group-read-only-p))
11194       (error "The current newsgroup does not support article editing."))
11195     (gnus-summary-select-article t nil t)
11196     (gnus-configure-windows 'article)
11197     (select-window (get-buffer-window gnus-article-buffer))
11198     (gnus-message 6 "C-c C-c to end edits")
11199     (setq buffer-read-only nil)
11200     (text-mode)
11201     (use-local-map (copy-keymap (current-local-map)))
11202     (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
11203     (buffer-enable-undo)
11204     (widen)
11205     (goto-char (point-min))
11206     (search-forward "\n\n" nil t)))
11207
11208 (defun gnus-summary-edit-article-done ()
11209   "Make edits to the current article permanent."
11210   (interactive)
11211   (if (gnus-group-read-only-p)
11212       (progn
11213         (gnus-summary-edit-article-postpone)
11214         (gnus-message
11215          1 "The current newsgroup does not support article editing.")
11216         (ding))
11217     (let ((buf (buffer-substring-no-properties (point-min) (point-max))))
11218       (erase-buffer)
11219       (insert buf)
11220       (if (not (gnus-request-replace-article
11221                 (cdr gnus-article-current) (car gnus-article-current)
11222                 (current-buffer)))
11223           (error "Couldn't replace article.")
11224         (gnus-article-mode)
11225         (use-local-map gnus-article-mode-map)
11226         (setq buffer-read-only t)
11227         (buffer-disable-undo (current-buffer))
11228         (gnus-configure-windows 'summary)
11229         (gnus-summary-update-article (cdr gnus-article-current)))
11230       (run-hooks 'gnus-article-display-hook)
11231       (and (gnus-visual-p 'summary-highlight 'highlight)
11232            (run-hooks 'gnus-visual-mark-article-hook)))))
11233
11234 (defun gnus-summary-edit-article-postpone ()
11235   "Postpone changes to the current article."
11236   (interactive)
11237   (gnus-article-mode)
11238   (use-local-map gnus-article-mode-map)
11239   (setq buffer-read-only t)
11240   (buffer-disable-undo (current-buffer))
11241   (gnus-configure-windows 'summary)
11242   (and (gnus-visual-p 'summary-highlight 'highlight)
11243        (run-hooks 'gnus-visual-mark-article-hook)))
11244
11245 (defun gnus-summary-respool-query ()
11246   "Query where the respool algorithm would put this article."
11247   (interactive)
11248   (gnus-set-global-variables)
11249   (gnus-summary-select-article)
11250   (save-excursion
11251     (set-buffer gnus-article-buffer)
11252     (save-restriction
11253       (goto-char (point-min))
11254       (search-forward "\n\n")
11255       (narrow-to-region (point-min) (point))
11256       (pp-eval-expression
11257        (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
11258
11259 ;; Summary score commands.
11260
11261 ;; Suggested by boubaker@cenatls.cena.dgac.fr.
11262
11263 (defun gnus-summary-raise-score (n)
11264   "Raise the score of the current article by N."
11265   (interactive "p")
11266   (gnus-set-global-variables)
11267   (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
11268
11269 (defun gnus-summary-set-score (n)
11270   "Set the score of the current article to N."
11271   (interactive "p")
11272   (gnus-set-global-variables)
11273   (save-excursion
11274     (gnus-summary-show-thread)
11275     (let ((buffer-read-only nil))
11276       ;; Set score.
11277       (gnus-summary-update-mark
11278        (if (= n (or gnus-summary-default-score 0)) ? 
11279          (if (< n (or gnus-summary-default-score 0))
11280              gnus-score-below-mark gnus-score-over-mark)) 'score))
11281     (let* ((article (gnus-summary-article-number))
11282            (score (assq article gnus-newsgroup-scored)))
11283       (if score (setcdr score n)
11284         (setq gnus-newsgroup-scored
11285               (cons (cons article n) gnus-newsgroup-scored))))
11286     (gnus-summary-update-line)))
11287
11288 (defun gnus-summary-current-score ()
11289   "Return the score of the current article."
11290   (interactive)
11291   (gnus-set-global-variables)
11292   (message "%s" (gnus-summary-article-score)))
11293
11294 ;; Summary marking commands.
11295
11296 (defun gnus-summary-kill-same-subject-and-select (&optional unmark)
11297   "Mark articles which has the same subject as read, and then select the next.
11298 If UNMARK is positive, remove any kind of mark.
11299 If UNMARK is negative, tick articles."
11300   (interactive "P")
11301   (gnus-set-global-variables)
11302   (if unmark
11303       (setq unmark (prefix-numeric-value unmark)))
11304   (let ((count
11305          (gnus-summary-mark-same-subject
11306           (gnus-summary-article-subject) unmark)))
11307     ;; Select next unread article.  If auto-select-same mode, should
11308     ;; select the first unread article.
11309     (gnus-summary-next-article t (and gnus-auto-select-same
11310                                       (gnus-summary-article-subject)))
11311     (gnus-message 7 "%d article%s marked as %s"
11312                   count (if (= count 1) " is" "s are")
11313                   (if unmark "unread" "read"))))
11314
11315 (defun gnus-summary-kill-same-subject (&optional unmark)
11316   "Mark articles which has the same subject as read.
11317 If UNMARK is positive, remove any kind of mark.
11318 If UNMARK is negative, tick articles."
11319   (interactive "P")
11320   (gnus-set-global-variables)
11321   (if unmark
11322       (setq unmark (prefix-numeric-value unmark)))
11323   (let ((count
11324          (gnus-summary-mark-same-subject
11325           (gnus-summary-article-subject) unmark)))
11326     ;; If marked as read, go to next unread subject.
11327     (if (null unmark)
11328         ;; Go to next unread subject.
11329         (gnus-summary-next-subject 1 t))
11330     (gnus-message 7 "%d articles are marked as %s"
11331                   count (if unmark "unread" "read"))))
11332
11333 (defun gnus-summary-mark-same-subject (subject &optional unmark)
11334   "Mark articles with same SUBJECT as read, and return marked number.
11335 If optional argument UNMARK is positive, remove any kinds of marks.
11336 If optional argument UNMARK is negative, mark articles as unread instead."
11337   (let ((count 1))
11338     (save-excursion
11339       (cond
11340        ((null unmark)                   ; Mark as read.
11341         (while (and
11342                 (progn
11343                   (gnus-summary-mark-article-as-read gnus-killed-mark)
11344                   (gnus-summary-show-thread) t)
11345                 (gnus-summary-find-subject subject))
11346           (setq count (1+ count))))
11347        ((> unmark 0)                    ; Tick.
11348         (while (and
11349                 (progn
11350                   (gnus-summary-mark-article-as-unread gnus-ticked-mark)
11351                   (gnus-summary-show-thread) t)
11352                 (gnus-summary-find-subject subject))
11353           (setq count (1+ count))))
11354        (t                               ; Mark as unread.
11355         (while (and
11356                 (progn
11357                   (gnus-summary-mark-article-as-unread gnus-unread-mark)
11358                   (gnus-summary-show-thread) t)
11359                 (gnus-summary-find-subject subject))
11360           (setq count (1+ count)))))
11361       (gnus-set-mode-line 'summary)
11362       ;; Return the number of marked articles.
11363       count)))
11364
11365 (defun gnus-summary-mark-as-processable (n &optional unmark)
11366   "Set the process mark on the next N articles.
11367 If N is negative, mark backward instead.  If UNMARK is non-nil, remove
11368 the process mark instead.  The difference between N and the actual
11369 number of articles marked is returned."
11370   (interactive "p")
11371   (gnus-set-global-variables)
11372   (let ((backward (< n 0))
11373         (n (abs n)))
11374     (while (and
11375             (> n 0)
11376             (if unmark
11377                 (gnus-summary-remove-process-mark
11378                  (gnus-summary-article-number))
11379               (gnus-summary-set-process-mark (gnus-summary-article-number)))
11380             (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
11381       (setq n (1- n)))
11382     (if (/= 0 n) (gnus-message 7 "No more articles"))
11383     (gnus-summary-recenter)
11384     (gnus-summary-position-point)
11385     n))
11386
11387 (defun gnus-summary-unmark-as-processable (n)
11388   "Remove the process mark from the next N articles.
11389 If N is negative, mark backward instead.  The difference between N and
11390 the actual number of articles marked is returned."
11391   (interactive "p")
11392   (gnus-set-global-variables)
11393   (gnus-summary-mark-as-processable n t))
11394
11395 (defun gnus-summary-unmark-all-processable ()
11396   "Remove the process mark from all articles."
11397   (interactive)
11398   (gnus-set-global-variables)
11399   (save-excursion
11400     (while gnus-newsgroup-processable
11401       (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
11402   (gnus-summary-position-point))
11403
11404 (defun gnus-summary-mark-as-expirable (n)
11405   "Mark N articles forward as expirable.
11406 If N is negative, mark backward instead.  The difference between N and
11407 the actual number of articles marked is returned."
11408   (interactive "p")
11409   (gnus-set-global-variables)
11410   (gnus-summary-mark-forward n gnus-expirable-mark))
11411
11412 (defun gnus-summary-mark-article-as-replied (article)
11413   "Mark ARTICLE replied and update the summary line."
11414   (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
11415   (let ((buffer-read-only nil))
11416     (when (gnus-summary-goto-subject article)
11417       (gnus-summary-update-secondary-mark article))))
11418
11419 (defun gnus-summary-set-bookmark (article)
11420   "Set a bookmark in current article."
11421   (interactive (list (gnus-summary-article-number)))
11422   (gnus-set-global-variables)
11423   (if (or (not (get-buffer gnus-article-buffer))
11424           (not gnus-current-article)
11425           (not gnus-article-current)
11426           (not (equal gnus-newsgroup-name (car gnus-article-current))))
11427       (error "No current article selected"))
11428   ;; Remove old bookmark, if one exists.
11429   (let ((old (assq article gnus-newsgroup-bookmarks)))
11430     (if old (setq gnus-newsgroup-bookmarks
11431                   (delq old gnus-newsgroup-bookmarks))))
11432   ;; Set the new bookmark, which is on the form
11433   ;; (article-number . line-number-in-body).
11434   (setq gnus-newsgroup-bookmarks
11435         (cons
11436          (cons article
11437                (save-excursion
11438                  (set-buffer gnus-article-buffer)
11439                  (count-lines
11440                   (min (point)
11441                        (save-excursion
11442                          (goto-char (point-min))
11443                          (search-forward "\n\n" nil t)
11444                          (point)))
11445                   (point))))
11446          gnus-newsgroup-bookmarks))
11447   (gnus-message 6 "A bookmark has been added to the current article."))
11448
11449 (defun gnus-summary-remove-bookmark (article)
11450   "Remove the bookmark from the current article."
11451   (interactive (list (gnus-summary-article-number)))
11452   (gnus-set-global-variables)
11453   ;; Remove old bookmark, if one exists.
11454   (let ((old (assq article gnus-newsgroup-bookmarks)))
11455     (if old
11456         (progn
11457           (setq gnus-newsgroup-bookmarks
11458                 (delq old gnus-newsgroup-bookmarks))
11459           (gnus-message 6 "Removed bookmark."))
11460       (gnus-message 6 "No bookmark in current article."))))
11461
11462 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
11463 (defun gnus-summary-mark-as-dormant (n)
11464   "Mark N articles forward as dormant.
11465 If N is negative, mark backward instead.  The difference between N and
11466 the actual number of articles marked is returned."
11467   (interactive "p")
11468   (gnus-set-global-variables)
11469   (gnus-summary-mark-forward n gnus-dormant-mark))
11470
11471 (defun gnus-summary-set-process-mark (article)
11472   "Set the process mark on ARTICLE and update the summary line."
11473   (setq gnus-newsgroup-processable
11474         (cons article
11475               (delq article gnus-newsgroup-processable)))
11476   (when (gnus-summary-goto-subject article)
11477     (gnus-summary-show-thread)
11478     (gnus-summary-update-secondary-mark article)))
11479
11480 (defun gnus-summary-remove-process-mark (article)
11481   "Remove the process mark from ARTICLE and update the summary line."
11482   (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
11483   (when (gnus-summary-goto-subject article)
11484     (gnus-summary-show-thread)
11485     (gnus-summary-update-secondary-mark article)))
11486
11487 (defun gnus-summary-set-saved-mark (article)
11488   "Set the process mark on ARTICLE and update the summary line."
11489   (push article gnus-newsgroup-saved)
11490   (when (gnus-summary-goto-subject article)
11491     (gnus-summary-update-secondary-mark article)))
11492
11493 (defun gnus-summary-mark-forward (n &optional mark no-expire)
11494   "Mark N articles as read forwards.
11495 If N is negative, mark backwards instead.
11496 Mark with MARK.  If MARK is ? , ?! or ??, articles will be
11497 marked as unread.
11498 The difference between N and the actual number of articles marked is
11499 returned."
11500   (interactive "p")
11501   (gnus-set-global-variables)
11502   (let ((backward (< n 0))
11503         (gnus-summary-goto-unread
11504          (and gnus-summary-goto-unread
11505               (not (eq gnus-summary-goto-unread 'never))
11506               (not (memq mark (list gnus-unread-mark
11507                                     gnus-ticked-mark gnus-dormant-mark)))))
11508         (n (abs n))
11509         (mark (or mark gnus-del-mark)))
11510     (while (and (> n 0)
11511                 (gnus-summary-mark-article nil mark no-expire)
11512                 (zerop (gnus-summary-next-subject
11513                         (if backward -1 1)
11514                         (and gnus-summary-goto-unread
11515                              (not (eq gnus-summary-goto-unread 'never)))
11516                         t)))
11517       (setq n (1- n)))
11518     (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
11519     (gnus-summary-recenter)
11520     (gnus-summary-position-point)
11521     (gnus-set-mode-line 'summary)
11522     n))
11523
11524 (defun gnus-summary-mark-article-as-read (mark)
11525   "Mark the current article quickly as read with MARK."
11526   (let ((article (gnus-summary-article-number)))
11527     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11528     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11529     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11530     (setq gnus-newsgroup-reads
11531           (cons (cons article mark) gnus-newsgroup-reads))
11532     ;; Possibly remove from cache, if that is used.
11533     (and gnus-use-cache (gnus-cache-enter-remove-article article))
11534     ;; Allow the backend to change the mark.
11535     (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
11536     ;; Check for auto-expiry.
11537     (when (and gnus-newsgroup-auto-expire
11538                (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
11539                    (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
11540                    (= mark gnus-ancient-mark)
11541                    (= mark gnus-read-mark) (= mark gnus-souped-mark)))
11542       (setq mark gnus-expirable-mark)
11543       (push article gnus-newsgroup-expirable))
11544     ;; Set the mark in the buffer.
11545     (gnus-summary-update-mark mark 'unread)
11546     t))
11547
11548 (defun gnus-summary-mark-article-as-unread (mark)
11549   "Mark the current article quickly as unread with MARK."
11550   (let ((article (gnus-summary-article-number)))
11551     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11552     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11553     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
11554     (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
11555     (cond ((= mark gnus-ticked-mark)
11556            (push article gnus-newsgroup-marked))
11557           ((= mark gnus-dormant-mark)
11558            (push article gnus-newsgroup-dormant))
11559           (t
11560            (push article gnus-newsgroup-unreads)))
11561     (setq gnus-newsgroup-reads
11562           (delq (assq article gnus-newsgroup-reads)
11563                 gnus-newsgroup-reads))
11564
11565     ;; See whether the article is to be put in the cache.
11566     (and gnus-use-cache
11567          (vectorp (gnus-summary-article-header article))
11568          (save-excursion
11569            (gnus-cache-possibly-enter-article
11570             gnus-newsgroup-name article
11571             (gnus-summary-article-header article)
11572             (= mark gnus-ticked-mark)
11573             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
11574
11575     ;; Fix the mark.
11576     (gnus-summary-update-mark mark 'unread)
11577     t))
11578
11579 (defun gnus-summary-mark-article (&optional article mark no-expire)
11580   "Mark ARTICLE with MARK.  MARK can be any character.
11581 Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
11582 `??' (dormant) and `?E' (expirable).
11583 If MARK is nil, then the default character `?D' is used.
11584 If ARTICLE is nil, then the article on the current line will be
11585 marked."
11586   ;; The mark might be a string.
11587   (and (stringp mark)
11588        (setq mark (aref mark 0)))
11589   ;; If no mark is given, then we check auto-expiring.
11590   (and (not no-expire)
11591        gnus-newsgroup-auto-expire
11592        (or (not mark)
11593            (and (numberp mark)
11594                 (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
11595                     (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
11596                     (= mark gnus-read-mark) (= mark gnus-souped-mark))))
11597        (setq mark gnus-expirable-mark))
11598   (let* ((mark (or mark gnus-del-mark))
11599          (article (or article (gnus-summary-article-number))))
11600     (or article (error "No article on current line"))
11601     (if (or (= mark gnus-unread-mark)
11602             (= mark gnus-ticked-mark)
11603             (= mark gnus-dormant-mark))
11604         (gnus-mark-article-as-unread article mark)
11605       (gnus-mark-article-as-read article mark))
11606
11607     ;; See whether the article is to be put in the cache.
11608     (and gnus-use-cache
11609          (not (= mark gnus-canceled-mark))
11610          (vectorp (gnus-summary-article-header article))
11611          (save-excursion
11612            (gnus-cache-possibly-enter-article
11613             gnus-newsgroup-name article
11614             (gnus-summary-article-header article)
11615             (= mark gnus-ticked-mark)
11616             (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
11617
11618     (if (gnus-summary-goto-subject article nil t)
11619         (let ((buffer-read-only nil))
11620           (gnus-summary-show-thread)
11621           ;; Fix the mark.
11622           (gnus-summary-update-mark mark 'unread)
11623           t))))
11624
11625 (defun gnus-summary-update-secondary-mark (article)
11626   "Update the secondary (read, process, cache) mark."
11627   (gnus-summary-update-mark
11628    (cond ((memq article gnus-newsgroup-processable)
11629           gnus-process-mark)
11630          ((memq article gnus-newsgroup-cached)
11631           gnus-cached-mark)
11632          ((memq article gnus-newsgroup-replied)
11633           gnus-replied-mark)
11634          ((memq article gnus-newsgroup-saved)
11635           gnus-saved-mark)
11636          (t gnus-unread-mark))
11637    'replied)
11638   (when (gnus-visual-p 'summary-highlight 'highlight)
11639     (run-hooks 'gnus-summary-update-hook))
11640   t)
11641
11642 (defun gnus-summary-update-mark (mark type)
11643   (beginning-of-line)
11644   (let ((forward (cdr (assq type gnus-summary-mark-positions)))
11645         (buffer-read-only nil))
11646     (when forward
11647       ;; Go to the right position on the line.
11648       (forward-char forward)
11649       ;; Replace the old mark with the new mark.
11650       (subst-char-in-region (point) (1+ (point)) (following-char) mark)
11651       ;; Optionally update the marks by some user rule.
11652       (when (eq type 'unread)
11653         (gnus-data-set-mark
11654          (gnus-data-find (gnus-summary-article-number)) mark)
11655         (gnus-summary-update-line (eq mark gnus-unread-mark))))))
11656
11657 (defun gnus-mark-article-as-read (article &optional mark)
11658   "Enter ARTICLE in the pertinent lists and remove it from others."
11659   ;; Make the article expirable.
11660   (let ((mark (or mark gnus-del-mark)))
11661     (if (= mark gnus-expirable-mark)
11662         (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
11663       (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
11664     ;; Remove from unread and marked lists.
11665     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11666     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11667     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11668     (push (cons article mark) gnus-newsgroup-reads)
11669     ;; Possibly remove from cache, if that is used.
11670     (when gnus-use-cache
11671       (gnus-cache-enter-remove-article article))))
11672
11673 (defun gnus-mark-article-as-unread (article &optional mark)
11674   "Enter ARTICLE in the pertinent lists and remove it from others."
11675   (let ((mark (or mark gnus-ticked-mark)))
11676     (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
11677     (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
11678     (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
11679     (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
11680     (cond ((= mark gnus-ticked-mark)
11681            (push article gnus-newsgroup-marked))
11682           ((= mark gnus-dormant-mark)
11683            (push article gnus-newsgroup-dormant))
11684           (t
11685            (push article gnus-newsgroup-unreads)))
11686     (setq gnus-newsgroup-reads
11687           (delq (assq article gnus-newsgroup-reads)
11688                 gnus-newsgroup-reads))))
11689
11690 (defalias 'gnus-summary-mark-as-unread-forward
11691   'gnus-summary-tick-article-forward)
11692 (make-obsolete 'gnus-summary-mark-as-unread-forward
11693                'gnus-summary-tick-article-forward)
11694 (defun gnus-summary-tick-article-forward (n)
11695   "Tick N articles forwards.
11696 If N is negative, tick backwards instead.
11697 The difference between N and the number of articles ticked is returned."
11698   (interactive "p")
11699   (gnus-summary-mark-forward n gnus-ticked-mark))
11700
11701 (defalias 'gnus-summary-mark-as-unread-backward
11702   'gnus-summary-tick-article-backward)
11703 (make-obsolete 'gnus-summary-mark-as-unread-backward
11704                'gnus-summary-tick-article-backward)
11705 (defun gnus-summary-tick-article-backward (n)
11706   "Tick N articles backwards.
11707 The difference between N and the number of articles ticked is returned."
11708   (interactive "p")
11709   (gnus-summary-mark-forward (- n) gnus-ticked-mark))
11710
11711 (defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
11712 (make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
11713 (defun gnus-summary-tick-article (&optional article clear-mark)
11714   "Mark current article as unread.
11715 Optional 1st argument ARTICLE specifies article number to be marked as unread.
11716 Optional 2nd argument CLEAR-MARK remove any kinds of mark."
11717   (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
11718                                        gnus-ticked-mark)))
11719
11720 (defun gnus-summary-mark-as-read-forward (n)
11721   "Mark N articles as read forwards.
11722 If N is negative, mark backwards instead.
11723 The difference between N and the actual number of articles marked is
11724 returned."
11725   (interactive "p")
11726   (gnus-summary-mark-forward n gnus-del-mark t))
11727
11728 (defun gnus-summary-mark-as-read-backward (n)
11729   "Mark the N articles as read backwards.
11730 The difference between N and the actual number of articles marked is
11731 returned."
11732   (interactive "p")
11733   (gnus-summary-mark-forward (- n) gnus-del-mark t))
11734
11735 (defun gnus-summary-mark-as-read (&optional article mark)
11736   "Mark current article as read.
11737 ARTICLE specifies the article to be marked as read.
11738 MARK specifies a string to be inserted at the beginning of the line."
11739   (gnus-summary-mark-article article mark))
11740
11741 (defun gnus-summary-clear-mark-forward (n)
11742   "Clear marks from N articles forward.
11743 If N is negative, clear backward instead.
11744 The difference between N and the number of marks cleared is returned."
11745   (interactive "p")
11746   (gnus-summary-mark-forward n gnus-unread-mark))
11747
11748 (defun gnus-summary-clear-mark-backward (n)
11749   "Clear marks from N articles backward.
11750 The difference between N and the number of marks cleared is returned."
11751   (interactive "p")
11752   (gnus-summary-mark-forward (- n) gnus-unread-mark))
11753
11754 (defun gnus-summary-mark-unread-as-read ()
11755   "Intended to be used by `gnus-summary-mark-article-hook'."
11756   (when (memq gnus-current-article gnus-newsgroup-unreads)
11757     (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
11758
11759 (defun gnus-summary-mark-region-as-read (point mark all)
11760   "Mark all unread articles between point and mark as read.
11761 If given a prefix, mark all articles between point and mark as read,
11762 even ticked and dormant ones."
11763   (interactive "r\nP")
11764   (save-excursion
11765     (let (article)
11766       (goto-char point)
11767       (beginning-of-line)
11768       (while (and
11769               (< (point) mark)
11770               (progn
11771                 (when (or all
11772                           (memq (setq article (gnus-summary-article-number))
11773                                 gnus-newsgroup-unreads))
11774                   (gnus-summary-mark-article article gnus-del-mark))
11775                 t)
11776               (gnus-summary-find-next))))))
11777
11778 (defun gnus-summary-mark-below (score mark)
11779   "Mark articles with score less than SCORE with MARK."
11780   (interactive "P\ncMark: ")
11781   (gnus-set-global-variables)
11782   (setq score (if score
11783                   (prefix-numeric-value score)
11784                 (or gnus-summary-default-score 0)))
11785   (save-excursion
11786     (set-buffer gnus-summary-buffer)
11787     (goto-char (point-min))
11788     (while 
11789         (progn
11790           (and (< (gnus-summary-article-score) score)
11791                (gnus-summary-mark-article nil mark))
11792           (gnus-summary-find-next)))))
11793
11794 (defun gnus-summary-kill-below (&optional score)
11795   "Mark articles with score below SCORE as read."
11796   (interactive "P")
11797   (gnus-set-global-variables)
11798   (gnus-summary-mark-below score gnus-killed-mark))
11799
11800 (defun gnus-summary-clear-above (&optional score)
11801   "Clear all marks from articles with score above SCORE."
11802   (interactive "P")
11803   (gnus-set-global-variables)
11804   (gnus-summary-mark-above score gnus-unread-mark))
11805
11806 (defun gnus-summary-tick-above (&optional score)
11807   "Tick all articles with score above SCORE."
11808   (interactive "P")
11809   (gnus-set-global-variables)
11810   (gnus-summary-mark-above score gnus-ticked-mark))
11811
11812 (defun gnus-summary-mark-above (score mark)
11813   "Mark articles with score over SCORE with MARK."
11814   (interactive "P\ncMark: ")
11815   (gnus-set-global-variables)
11816   (setq score (if score
11817                   (prefix-numeric-value score)
11818                 (or gnus-summary-default-score 0)))
11819   (save-excursion
11820     (set-buffer gnus-summary-buffer)
11821     (goto-char (point-min))
11822     (while (and (progn
11823                   (if (> (gnus-summary-article-score) score)
11824                       (gnus-summary-mark-article nil mark))
11825                   t)
11826                 (gnus-summary-find-next)))))
11827
11828 ;; Suggested by Daniel Quinlan <quinlan@best.com>.
11829 (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
11830 (defun gnus-summary-limit-include-expunged ()
11831   "Display all the hidden articles that were expunged for low scores."
11832   (interactive)
11833   (gnus-set-global-variables)
11834   (let ((buffer-read-only nil))
11835     (let ((scored gnus-newsgroup-scored)
11836           headers h)
11837       (while scored
11838         (or (gnus-summary-goto-subject (car (car scored)))
11839             (and (setq h (gnus-summary-article-header (car (car scored))))
11840                  (< (cdr (car scored)) gnus-summary-expunge-below)
11841                  (setq headers (cons h headers))))
11842         (setq scored (cdr scored)))
11843       (or headers (error "No expunged articles hidden."))
11844       (goto-char (point-min))
11845       (gnus-summary-prepare-unthreaded (nreverse headers)))
11846     (goto-char (point-min))
11847     (gnus-summary-position-point)))
11848
11849 (defun gnus-summary-catchup (&optional all quietly to-here not-mark)
11850   "Mark all articles not marked as unread in this newsgroup as read.
11851 If prefix argument ALL is non-nil, all articles are marked as read.
11852 If QUIETLY is non-nil, no questions will be asked.
11853 If TO-HERE is non-nil, it should be a point in the buffer.  All
11854 articles before this point will be marked as read.
11855 The number of articles marked as read is returned."
11856   (interactive "P")
11857   (gnus-set-global-variables)
11858   (prog1
11859       (if (or quietly
11860               (not gnus-interactive-catchup) ;Without confirmation?
11861               gnus-expert-user
11862               (gnus-y-or-n-p
11863                (if all
11864                    "Mark absolutely all articles as read? "
11865                  "Mark all unread articles as read? ")))
11866           (if (and not-mark
11867                    (not gnus-newsgroup-adaptive)
11868                    (not gnus-newsgroup-auto-expire))
11869               (progn
11870                 (when all
11871                   (setq gnus-newsgroup-marked nil
11872                         gnus-newsgroup-dormant nil))
11873                 (setq gnus-newsgroup-unreads nil))
11874             ;; We actually mark all articles as canceled, which we
11875             ;; have to do when using auto-expiry or adaptive scoring.
11876             (gnus-summary-show-all-threads)
11877             (if (gnus-summary-first-subject (not all))
11878                 (while (and
11879                         (if to-here (< (point) to-here) t)
11880                         (gnus-summary-mark-article-as-read gnus-catchup-mark)
11881                         (gnus-summary-find-next (not all)))))
11882             (unless to-here
11883               (setq gnus-newsgroup-unreads nil))
11884             (gnus-set-mode-line 'summary)))
11885     (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
11886       (if (and (not to-here) (eq 'nnvirtual (car method)))
11887           (nnvirtual-catchup-group
11888            (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
11889     (gnus-summary-position-point)))
11890
11891 (defun gnus-summary-catchup-to-here (&optional all)
11892   "Mark all unticked articles before the current one as read.
11893 If ALL is non-nil, also mark ticked and dormant articles as read."
11894   (interactive "P")
11895   (gnus-set-global-variables)
11896   (save-excursion
11897     (let ((beg (point)))
11898       ;; We check that there are unread articles.
11899       (when (or all (gnus-summary-find-prev))
11900         (gnus-summary-catchup all t beg))))
11901   (gnus-summary-position-point))
11902
11903 (defun gnus-summary-catchup-all (&optional quietly)
11904   "Mark all articles in this newsgroup as read."
11905   (interactive "P")
11906   (gnus-set-global-variables)
11907   (gnus-summary-catchup t quietly))
11908
11909 (defun gnus-summary-catchup-and-exit (&optional all quietly)
11910   "Mark all articles not marked as unread in this newsgroup as read, then exit.
11911 If prefix argument ALL is non-nil, all articles are marked as read."
11912   (interactive "P")
11913   (gnus-set-global-variables)
11914   (gnus-summary-catchup all quietly nil 'fast)
11915   ;; Select next newsgroup or exit.
11916   (if (eq gnus-auto-select-next 'quietly)
11917       (gnus-summary-next-group nil)
11918     (gnus-summary-exit)))
11919
11920 (defun gnus-summary-catchup-all-and-exit (&optional quietly)
11921   "Mark all articles in this newsgroup as read, and then exit."
11922   (interactive "P")
11923   (gnus-set-global-variables)
11924   (gnus-summary-catchup-and-exit t quietly))
11925
11926 ;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
11927 (defun gnus-summary-catchup-and-goto-next-group (&optional all)
11928   "Mark all articles in this group as read and select the next group.
11929 If given a prefix, mark all articles, unread as well as ticked, as
11930 read."
11931   (interactive "P")
11932   (gnus-set-global-variables)
11933   (save-excursion
11934     (gnus-summary-catchup all))
11935   (gnus-summary-next-article t))
11936
11937 ;; Thread-based commands.
11938
11939 (defun gnus-summary-articles-in-thread (&optional article)
11940   "Return a list of all articles in the current thread.
11941 If ARTICLE is non-nil, return all articles in the thread that starts
11942 with that article."
11943   (let* ((article (or article (gnus-summary-article-number)))
11944          (data (gnus-data-find-list article))
11945          (top-level (gnus-data-level (car data)))
11946          (top-subject
11947           (cond ((null gnus-thread-operation-ignore-subject)
11948                  (gnus-simplify-subject-re
11949                   (mail-header-subject (gnus-data-header (car data)))))
11950                 ((eq gnus-thread-operation-ignore-subject 'fuzzy)
11951                  (gnus-simplify-subject-fuzzy
11952                   (mail-header-subject (gnus-data-header (car data)))))
11953                 (t nil)))
11954          articles)
11955     (if (not data)
11956         ()                              ; This article doesn't exist.
11957       (while data
11958         (and (or (not top-subject)
11959                  (string= top-subject
11960                           (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
11961                               (gnus-simplify-subject-fuzzy
11962                                (mail-header-subject
11963                                 (gnus-data-header (car data))))
11964                             (gnus-simplify-subject-re
11965                              (mail-header-subject
11966                               (gnus-data-header (car data)))))))
11967              (setq articles (cons (gnus-data-number (car data)) articles)))
11968         (if (and (setq data (cdr data))
11969                  (> (gnus-data-level (car data)) top-level))
11970             ()
11971           (setq data nil)))
11972       ;; Return the list of articles.
11973       (nreverse articles))))
11974
11975 (defun gnus-summary-rethread-current ()
11976   "Rethread the thread the current article is part of."
11977   (interactive)
11978   (gnus-set-global-variables)
11979   (let* ((gnus-show-threads t)
11980          (article (gnus-summary-article-number))
11981          (id (mail-header-id (gnus-summary-article-header)))
11982          (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id)))))
11983     (unless id
11984       (error "No article on the current line"))
11985     (gnus-rebuild-thread id)
11986     (gnus-summary-goto-subject article)))
11987
11988 (defun gnus-summary-reparent-thread ()
11989   "Make current article child of the marked (or previous) article.
11990
11991 Note that the re-threading will only work if `gnus-thread-ignore-subject'
11992 is non-nil or the Subject: of both articles are the same."
11993   (interactive)
11994   (or (not (gnus-group-read-only-p))
11995       (error "The current newsgroup does not support article editing."))
11996   (or (<= (length gnus-newsgroup-processable) 1)
11997       (error "No more than one article may be marked."))
11998   (save-window-excursion
11999     (let ((gnus-article-buffer " *reparent*")
12000           (current-article (gnus-summary-article-number))
12001           ; first grab the marked article, otherwise one line up.
12002           (parent-article (if (not (null gnus-newsgroup-processable))
12003                               (car gnus-newsgroup-processable)
12004                             (save-excursion
12005                               (if (eq (forward-line -1) 0)
12006                                   (gnus-summary-article-number)
12007                                 (error "Beginning of summary buffer."))))))
12008       (or (not (eq current-article parent-article))
12009           (error "An article may not be self-referential."))
12010       (let ((message-id (mail-header-id 
12011                          (gnus-summary-article-header parent-article))))
12012         (or (and message-id (not (equal message-id "")))
12013             (error "No message-id in desired parent."))
12014         (gnus-summary-select-article t t nil current-article)
12015         (set-buffer gnus-article-buffer)
12016         (setq buffer-read-only nil)
12017         (let ((buf (buffer-substring-no-properties (point-min) (point-max))))
12018           (erase-buffer)
12019           (insert buf))
12020         (goto-char (point-min))
12021         (if (search-forward-regexp "^References: " nil t)
12022             (insert message-id " " )
12023           (insert "References: " message-id "\n"))
12024         (or (gnus-request-replace-article current-article
12025                                           (car gnus-article-current)
12026                                           gnus-article-buffer)
12027             (error "Couldn't replace article."))
12028         (set-buffer gnus-summary-buffer)
12029         (gnus-summary-unmark-all-processable)
12030         (gnus-summary-rethread-current)
12031         (message "Article %d is now the child of article %d."
12032                  current-article parent-article)))))
12033
12034 (defun gnus-summary-toggle-threads (&optional arg)
12035   "Toggle showing conversation threads.
12036 If ARG is positive number, turn showing conversation threads on."
12037   (interactive "P")
12038   (gnus-set-global-variables)
12039   (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
12040     (setq gnus-show-threads
12041           (if (null arg) (not gnus-show-threads)
12042             (> (prefix-numeric-value arg) 0)))
12043     (gnus-summary-prepare)
12044     (gnus-summary-goto-subject current)
12045     (gnus-summary-position-point)))
12046
12047 (defun gnus-summary-show-all-threads ()
12048   "Show all threads."
12049   (interactive)
12050   (gnus-set-global-variables)
12051   (save-excursion
12052     (let ((buffer-read-only nil))
12053       (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
12054   (gnus-summary-position-point))
12055
12056 (defun gnus-summary-show-thread ()
12057   "Show thread subtrees.
12058 Returns nil if no thread was there to be shown."
12059   (interactive)
12060   (gnus-set-global-variables)
12061   (let ((buffer-read-only nil)
12062         (orig (point))
12063         ;; first goto end then to beg, to have point at beg after let
12064         (end (progn (end-of-line) (point)))
12065         (beg (progn (beginning-of-line) (point))))
12066     (prog1
12067         ;; Any hidden lines here?
12068         (search-forward "\r" end t)
12069       (subst-char-in-region beg end ?\^M ?\n t)
12070       (goto-char orig)
12071       (gnus-summary-position-point))))
12072
12073 (defun gnus-summary-hide-all-threads ()
12074   "Hide all thread subtrees."
12075   (interactive)
12076   (gnus-set-global-variables)
12077   (save-excursion
12078     (goto-char (point-min))
12079     (gnus-summary-hide-thread)
12080     (while (zerop (gnus-summary-next-thread 1 t))
12081       (gnus-summary-hide-thread)))
12082   (gnus-summary-position-point))
12083
12084 (defun gnus-summary-hide-thread ()
12085   "Hide thread subtrees.
12086 Returns nil if no threads were there to be hidden."
12087   (interactive)
12088   (gnus-set-global-variables)
12089   (let ((buffer-read-only nil)
12090         (start (point))
12091         (article (gnus-summary-article-number))
12092         end)
12093     ;; Go forward until either the buffer ends or the subthread
12094     ;; ends.
12095     (when (and (not (eobp))
12096                (or (zerop (gnus-summary-next-thread 1 t))
12097                    (goto-char (gnus-data-pos (car (gnus-data-list 'rev))))))
12098       (setq end (point))
12099       (prog1
12100           (if (and (> (point) start)
12101                    (search-backward "\n" start t))
12102               (progn
12103                 (subst-char-in-region start (point) ?\n ?\^M)
12104                 (gnus-summary-goto-subject article))
12105             (goto-char start)
12106             nil)
12107         (gnus-summary-position-point)))))
12108
12109 (defun gnus-summary-go-to-next-thread (&optional previous)
12110   "Go to the same level (or less) next thread.
12111 If PREVIOUS is non-nil, go to previous thread instead.
12112 Return the article number moved to, or nil if moving was impossible."
12113   (let* ((level (gnus-summary-thread-level))
12114          (article (gnus-summary-article-number))
12115          (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
12116          oart)
12117     (while data
12118       (if (<= (gnus-data-level (car data)) level)
12119           (setq oart (gnus-data-number (car data))
12120                 data nil)
12121         (setq data (cdr data))))
12122     (and oart
12123          (gnus-summary-goto-subject oart))))
12124
12125 (defun gnus-summary-next-thread (n &optional silent)
12126   "Go to the same level next N'th thread.
12127 If N is negative, search backward instead.
12128 Returns the difference between N and the number of skips actually
12129 done.
12130
12131 If SILENT, don't output messages."
12132   (interactive "p")
12133   (gnus-set-global-variables)
12134   (let ((backward (< n 0))
12135         (n (abs n))
12136         old dum)
12137     (while (and (> n 0)
12138                 (setq old (save-excursion (forward-line 1) (point)))
12139                 (gnus-summary-go-to-next-thread backward))
12140       (when (and (eq gnus-summary-make-false-root 'dummy)
12141                  (setq dum (text-property-not-all
12142                             old (point) 'gnus-intangible nil)))
12143         (goto-char dum))
12144       (decf n))
12145     (gnus-summary-position-point)
12146     (when (and (not silent) (/= 0 n))
12147       (gnus-message 7 "No more threads"))
12148     n))
12149
12150 (defun gnus-summary-prev-thread (n)
12151   "Go to the same level previous N'th thread.
12152 Returns the difference between N and the number of skips actually
12153 done."
12154   (interactive "p")
12155   (gnus-set-global-variables)
12156   (gnus-summary-next-thread (- n)))
12157
12158 (defun gnus-summary-go-down-thread ()
12159   "Go down one level in the current thread."
12160   (let ((children (gnus-summary-article-children)))
12161     (and children
12162          (gnus-summary-goto-subject (car children)))))
12163
12164 (defun gnus-summary-go-up-thread ()
12165   "Go up one level in the current thread."
12166   (let ((parent (gnus-summary-article-parent)))
12167     (and parent
12168          (gnus-summary-goto-subject parent))))
12169
12170 (defun gnus-summary-down-thread (n)
12171   "Go down thread N steps.
12172 If N is negative, go up instead.
12173 Returns the difference between N and how many steps down that were
12174 taken."
12175   (interactive "p")
12176   (gnus-set-global-variables)
12177   (let ((up (< n 0))
12178         (n (abs n)))
12179     (while (and (> n 0)
12180                 (if up (gnus-summary-go-up-thread)
12181                   (gnus-summary-go-down-thread)))
12182       (setq n (1- n)))
12183     (gnus-summary-position-point)
12184     (if (/= 0 n) (gnus-message 7 "Can't go further"))
12185     n))
12186
12187 (defun gnus-summary-up-thread (n)
12188   "Go up thread N steps.
12189 If N is negative, go up instead.
12190 Returns the difference between N and how many steps down that were
12191 taken."
12192   (interactive "p")
12193   (gnus-set-global-variables)
12194   (gnus-summary-down-thread (- n)))
12195
12196 (defun gnus-summary-top-thread ()
12197   "Go to the top of the thread."
12198   (interactive)
12199   (gnus-set-global-variables)
12200   (while (gnus-summary-go-up-thread))
12201   (gnus-summary-article-number))
12202
12203 (defun gnus-summary-kill-thread (&optional unmark)
12204   "Mark articles under current thread as read.
12205 If the prefix argument is positive, remove any kinds of marks.
12206 If the prefix argument is negative, tick articles instead."
12207   (interactive "P")
12208   (gnus-set-global-variables)
12209   (if unmark
12210       (setq unmark (prefix-numeric-value unmark)))
12211   (let ((articles (gnus-summary-articles-in-thread)))
12212     (save-excursion
12213       ;; Expand the thread.
12214       (gnus-summary-show-thread)
12215       ;; Mark all the articles.
12216       (while articles
12217         (gnus-summary-goto-subject (car articles))
12218         (cond ((null unmark)
12219                (gnus-summary-mark-article-as-read gnus-killed-mark))
12220               ((> unmark 0)
12221                (gnus-summary-mark-article-as-unread gnus-unread-mark))
12222               (t
12223                (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
12224         (setq articles (cdr articles))))
12225     ;; Hide killed subtrees.
12226     (and (null unmark)
12227          gnus-thread-hide-killed
12228          (gnus-summary-hide-thread))
12229     ;; If marked as read, go to next unread subject.
12230     (if (null unmark)
12231         ;; Go to next unread subject.
12232         (gnus-summary-next-subject 1 t)))
12233   (gnus-set-mode-line 'summary))
12234
12235 ;; Summary sorting commands
12236
12237 (defun gnus-summary-sort-by-number (&optional reverse)
12238   "Sort summary buffer by article number.
12239 Argument REVERSE means reverse order."
12240   (interactive "P")
12241   (gnus-summary-sort 'number reverse))
12242
12243 (defun gnus-summary-sort-by-author (&optional reverse)
12244   "Sort summary buffer by author name alphabetically.
12245 If case-fold-search is non-nil, case of letters is ignored.
12246 Argument REVERSE means reverse order."
12247   (interactive "P")
12248   (gnus-summary-sort 'author reverse))
12249
12250 (defun gnus-summary-sort-by-subject (&optional reverse)
12251   "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
12252 If case-fold-search is non-nil, case of letters is ignored.
12253 Argument REVERSE means reverse order."
12254   (interactive "P")
12255   (gnus-summary-sort 'subject reverse))
12256
12257 (defun gnus-summary-sort-by-date (&optional reverse)
12258   "Sort summary buffer by date.
12259 Argument REVERSE means reverse order."
12260   (interactive "P")
12261   (gnus-summary-sort 'date reverse))
12262
12263 (defun gnus-summary-sort-by-score (&optional reverse)
12264   "Sort summary buffer by score.
12265 Argument REVERSE means reverse order."
12266   (interactive "P")
12267   (gnus-summary-sort 'score reverse))
12268
12269 (defun gnus-summary-sort (predicate reverse)
12270   "Sort summary buffer by PREDICATE.  REVERSE means reverse order."
12271   (gnus-set-global-variables)
12272   (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
12273          (article (intern (format "gnus-article-sort-by-%s" predicate)))
12274          (gnus-thread-sort-functions
12275           (list
12276            (if (not reverse)
12277                thread
12278              `(lambda (t1 t2)
12279                 (,thread t2 t1)))))
12280          (gnus-article-sort-functions
12281           (list
12282            (if (not reverse)
12283                article
12284              `(lambda (t1 t2)
12285                 (,article t2 t1)))))
12286          (buffer-read-only)
12287          (gnus-summary-prepare-hook nil))
12288     ;; We do the sorting by regenerating the threads.
12289     (gnus-summary-prepare)
12290     ;; Hide subthreads if needed.
12291     (when (and gnus-show-threads gnus-thread-hide-subtree)
12292       (gnus-summary-hide-all-threads)))
12293   ;; If in async mode, we send some info to the backend.
12294   (when gnus-newsgroup-async
12295     (gnus-request-asynchronous
12296      gnus-newsgroup-name gnus-newsgroup-data)))
12297
12298 (defun gnus-sortable-date (date)
12299   "Make sortable string by string-lessp from DATE.
12300 Timezone package is used."
12301   (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S]
12302          (year (aref date 0))
12303          (month (aref date 1))
12304          (day (aref date 2)))
12305     (timezone-make-sortable-date
12306      year month day
12307      (timezone-make-time-string
12308       (aref date 3) (aref date 4) (aref date 5)))))
12309
12310
12311 ;; Summary saving commands.
12312
12313 (defun gnus-summary-save-article (&optional n not-saved)
12314   "Save the current article using the default saver function.
12315 If N is a positive number, save the N next articles.
12316 If N is a negative number, save the N previous articles.
12317 If N is nil and any articles have been marked with the process mark,
12318 save those articles instead.
12319 The variable `gnus-default-article-saver' specifies the saver function."
12320   (interactive "P")
12321   (gnus-set-global-variables)
12322   (let ((articles (gnus-summary-work-articles n))
12323         file header article)
12324     (while articles
12325       (setq header (gnus-summary-article-header
12326                     (setq article (pop articles))))
12327       (if (not (vectorp header))
12328           ;; This is a pseudo-article.
12329           (if (assq 'name header)
12330               (gnus-copy-file (cdr (assq 'name header)))
12331             (gnus-message 1 "Article %d is unsaveable" article))
12332         ;; This is a real article.
12333         (save-window-excursion
12334           (gnus-summary-select-article t nil nil article))
12335         (unless gnus-save-all-headers
12336           ;; Remove headers accoring to `gnus-saved-headers'.
12337           (let ((gnus-visible-headers
12338                  (or gnus-saved-headers gnus-visible-headers)))
12339             (gnus-article-hide-headers nil t)))
12340         ;; Remove any X-Gnus lines.
12341         (save-excursion
12342           (set-buffer gnus-article-buffer)
12343           (save-restriction
12344             (let ((buffer-read-only nil))
12345               (nnheader-narrow-to-headers)
12346               (while (re-search-forward "^X-Gnus" nil t)
12347                 (gnus-delete-line)))))
12348         (save-window-excursion
12349           (if (not gnus-default-article-saver)
12350               (error "No default saver is defined.")
12351             (setq file (funcall
12352                         gnus-default-article-saver
12353                         (cond
12354                          ((not gnus-prompt-before-saving)
12355                           'default)
12356                          ((eq gnus-prompt-before-saving 'always)
12357                           nil)
12358                          (t file))))))
12359         (gnus-summary-remove-process-mark article)
12360         (unless not-saved
12361           (gnus-summary-set-saved-mark article))))
12362     (gnus-summary-position-point)
12363     n))
12364
12365 (defun gnus-summary-pipe-output (&optional arg)
12366   "Pipe the current article to a subprocess.
12367 If N is a positive number, pipe the N next articles.
12368 If N is a negative number, pipe the N previous articles.
12369 If N is nil and any articles have been marked with the process mark,
12370 pipe those articles instead."
12371   (interactive "P")
12372   (gnus-set-global-variables)
12373   (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
12374     (gnus-summary-save-article arg t))
12375   (gnus-configure-windows 'pipe))
12376
12377 (defun gnus-summary-save-article-mail (&optional arg)
12378   "Append the current article to an mail file.
12379 If N is a positive number, save the N next articles.
12380 If N is a negative number, save the N previous articles.
12381 If N is nil and any articles have been marked with the process mark,
12382 save those articles instead."
12383   (interactive "P")
12384   (gnus-set-global-variables)
12385   (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
12386     (gnus-summary-save-article arg)))
12387
12388 (defun gnus-summary-save-article-rmail (&optional arg)
12389   "Append the current article to an rmail file.
12390 If N is a positive number, save the N next articles.
12391 If N is a negative number, save the N previous articles.
12392 If N is nil and any articles have been marked with the process mark,
12393 save those articles instead."
12394   (interactive "P")
12395   (gnus-set-global-variables)
12396   (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
12397     (gnus-summary-save-article arg)))
12398
12399 (defun gnus-summary-save-article-file (&optional arg)
12400   "Append the current article to a file.
12401 If N is a positive number, save the N next articles.
12402 If N is a negative number, save the N previous articles.
12403 If N is nil and any articles have been marked with the process mark,
12404 save those articles instead."
12405   (interactive "P")
12406   (gnus-set-global-variables)
12407   (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
12408     (gnus-summary-save-article arg)))
12409
12410 (defun gnus-summary-save-article-body-file (&optional arg)
12411   "Append the current article body to a file.
12412 If N is a positive number, save the N next articles.
12413 If N is a negative number, save the N previous articles.
12414 If N is nil and any articles have been marked with the process mark,
12415 save those articles instead."
12416   (interactive "P")
12417   (gnus-set-global-variables)
12418   (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
12419     (gnus-summary-save-article arg)))
12420
12421 (defun gnus-get-split-value (methods)
12422   "Return a value based on the split METHODS."
12423   (let (split-name method result match)
12424     (when methods
12425       (save-excursion
12426         (set-buffer gnus-original-article-buffer)
12427         (save-restriction
12428           (nnheader-narrow-to-headers)
12429           (while methods
12430             (goto-char (point-min))
12431             (setq method (pop methods))
12432             (setq match (pop method))
12433             (when (cond
12434                    ((stringp match)
12435                     ;; Regular expression.
12436                     (condition-case ()
12437                         (re-search-forward match nil t)
12438                       (error nil)))
12439                    ((gnus-functionp match)
12440                     ;; Function.
12441                     (save-restriction
12442                       (widen)
12443                       (setq result (funcall match gnus-newsgroup-name))))
12444                    ((consp match)
12445                     ;; Form.
12446                     (save-restriction
12447                       (widen)
12448                       (setq result (eval match)))))
12449               (setq split-name (append (cdr methods) split-name))
12450               (cond ((stringp result)
12451                      (push result split-name))
12452                     ((consp result)
12453                      (setq split-name (append result split-name)))))))))
12454     split-name))
12455
12456 (defun gnus-read-move-group-name (prompt default articles prefix)
12457   "Read a group name."
12458   (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
12459          (prom
12460           (format "Where do you want to %s %s? "
12461                   prompt
12462                   (if (> (length articles) 1)
12463                       (format "these %d articles" (length articles))
12464                     "this article")))
12465          (to-newsgroup
12466           (cond
12467            ((null split-name)
12468             (completing-read
12469              (concat prom
12470                      (if default
12471                          (format "(default %s) " default)
12472                        ""))
12473              gnus-active-hashtb nil nil prefix))
12474            ((= 1 (length split-name))
12475             (completing-read prom gnus-active-hashtb
12476                              nil nil (cons (car split-name) 0)))
12477            (t
12478             (completing-read
12479              prom (mapcar (lambda (el) (list el)) (nreverse split-name)))))))
12480
12481     (when to-newsgroup
12482       (if (or (string= to-newsgroup "")
12483               (string= to-newsgroup prefix))
12484           (setq to-newsgroup (or default "")))
12485       (or (gnus-active to-newsgroup)
12486           (gnus-activate-group to-newsgroup)
12487           (error "No such group: %s" to-newsgroup)))
12488     to-newsgroup))
12489
12490 (defun gnus-read-save-file-name (prompt default-name)
12491   (let* ((split-name (gnus-get-split-value gnus-split-methods))
12492          (file
12493           ;; Let the split methods have their say.
12494           (cond
12495            ;; No split name was found.
12496            ((null split-name)
12497             (read-file-name
12498              (concat prompt " (default "
12499                      (file-name-nondirectory default-name) ") ")
12500              (file-name-directory default-name)
12501              default-name))
12502            ;; A single split name was found
12503            ((= 1 (length split-name))
12504             (read-file-name
12505              (concat prompt " (default " (car split-name) ") ")
12506              gnus-article-save-directory
12507              (concat gnus-article-save-directory (car split-name))))
12508            ;; A list of splits was found.
12509            (t
12510             (setq split-name (mapcar (lambda (el) (list el))
12511                                      (nreverse split-name)))
12512             (let ((result (completing-read
12513                            (concat prompt " ") split-name nil nil)))
12514               (concat gnus-article-save-directory
12515                       (if (string= result "")
12516                           (car (car split-name))
12517                         result)))))))
12518     ;; If we have read a directory, we append the default file name.
12519     (when (file-directory-p file)
12520       (setq file (concat (file-name-as-directory file)
12521                          (file-name-nondirectory default-name))))
12522     ;; Possibly translate some charaters.
12523     (nnheader-translate-file-chars file)))
12524
12525 (defun gnus-article-archive-name (group)
12526   "Return the first instance of an \"Archive-name\" in the current buffer."
12527   (let ((case-fold-search t))
12528     (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
12529       (match-string 1))))
12530
12531 (defun gnus-summary-save-in-rmail (&optional filename)
12532   "Append this article to Rmail file.
12533 Optional argument FILENAME specifies file name.
12534 Directory to save to is default to `gnus-article-save-directory' which
12535 is initialized from the SAVEDIR environment variable."
12536   (interactive)
12537   (gnus-set-global-variables)
12538   (let ((default-name
12539           (funcall gnus-rmail-save-name gnus-newsgroup-name
12540                    gnus-current-headers gnus-newsgroup-last-rmail)))
12541     (setq filename
12542           (cond ((eq filename 'default)
12543                  default-name)
12544                 (filename filename)
12545                 (t (gnus-read-save-file-name
12546                     "Save in rmail file:" default-name))))
12547     (gnus-make-directory (file-name-directory filename))
12548     (gnus-eval-in-buffer-window
12549      gnus-original-article-buffer
12550      (save-excursion
12551        (save-restriction
12552          (widen)
12553          (gnus-output-to-rmail filename))))
12554     ;; Remember the directory name to save articles
12555     (setq gnus-newsgroup-last-rmail filename)))
12556
12557 (defun gnus-summary-save-in-mail (&optional filename)
12558   "Append this article to Unix mail file.
12559 Optional argument FILENAME specifies file name.
12560 Directory to save to is default to `gnus-article-save-directory' which
12561 is initialized from the SAVEDIR environment variable."
12562   (interactive)
12563   (gnus-set-global-variables)
12564   (let ((default-name
12565           (funcall gnus-mail-save-name gnus-newsgroup-name
12566                    gnus-current-headers gnus-newsgroup-last-mail)))
12567     (setq filename
12568           (cond ((eq filename 'default)
12569                  default-name)
12570                 (filename filename)
12571                 (t (gnus-read-save-file-name
12572                     "Save in Unix mail file:" default-name))))
12573     (setq filename
12574           (expand-file-name filename
12575                             (and default-name
12576                                  (file-name-directory default-name))))
12577     (gnus-make-directory (file-name-directory filename))
12578     (gnus-eval-in-buffer-window
12579      gnus-original-article-buffer
12580      (save-excursion
12581        (save-restriction
12582          (widen)
12583          (if (and (file-readable-p filename) (mail-file-babyl-p filename))
12584              (gnus-output-to-rmail filename)
12585            (let ((mail-use-rfc822 t))
12586              (rmail-output filename 1 t t))))))
12587     ;; Remember the directory name to save articles.
12588     (setq gnus-newsgroup-last-mail filename)))
12589
12590 (defun gnus-summary-save-in-file (&optional filename)
12591   "Append this article to file.
12592 Optional argument FILENAME specifies file name.
12593 Directory to save to is default to `gnus-article-save-directory' which
12594 is initialized from the SAVEDIR environment variable."
12595   (interactive)
12596   (gnus-set-global-variables)
12597   (let ((default-name
12598           (funcall gnus-file-save-name gnus-newsgroup-name
12599                    gnus-current-headers gnus-newsgroup-last-file)))
12600     (setq filename
12601           (cond ((eq filename 'default)
12602                  default-name)
12603                 (filename filename)
12604                 (t (gnus-read-save-file-name
12605                     "Save in file:" default-name))))
12606     (gnus-make-directory (file-name-directory filename))
12607     (gnus-eval-in-buffer-window
12608      gnus-article-buffer
12609      (save-excursion
12610        (save-restriction
12611          (widen)
12612          (gnus-output-to-file filename))))
12613     ;; Remember the directory name to save articles.
12614     (setq gnus-newsgroup-last-file filename)))
12615
12616 (defun gnus-summary-save-body-in-file (&optional filename)
12617   "Append this article body to a file.
12618 Optional argument FILENAME specifies file name.
12619 The directory to save in defaults to `gnus-article-save-directory' which
12620 is initialized from the SAVEDIR environment variable."
12621   (interactive)
12622   (gnus-set-global-variables)
12623   (let ((default-name
12624           (funcall gnus-file-save-name gnus-newsgroup-name
12625                    gnus-current-headers gnus-newsgroup-last-file)))
12626     (setq filename
12627           (cond ((eq filename 'default)
12628                  default-name)
12629                 (filename filename)
12630                 (t (gnus-read-save-file-name
12631                     "Save body in file:" default-name))))
12632     (gnus-make-directory (file-name-directory filename))
12633     (gnus-eval-in-buffer-window
12634      gnus-article-buffer
12635      (save-excursion
12636        (save-restriction
12637          (widen)
12638          (goto-char (point-min))
12639          (and (search-forward "\n\n" nil t)
12640               (narrow-to-region (point) (point-max)))
12641          (gnus-output-to-file filename))))
12642     ;; Remember the directory name to save articles.
12643     (setq gnus-newsgroup-last-file filename)))
12644
12645 (defun gnus-summary-save-in-pipe (&optional command)
12646   "Pipe this article to subprocess."
12647   (interactive)
12648   (gnus-set-global-variables)
12649   (setq command
12650         (cond ((eq command 'default)
12651                gnus-last-shell-command)
12652               (command command)
12653               (t (read-string "Shell command on article: "
12654                               gnus-last-shell-command))))
12655   (if (string-equal command "")
12656       (setq command gnus-last-shell-command))
12657   (gnus-eval-in-buffer-window
12658    gnus-article-buffer
12659    (save-restriction
12660      (widen)
12661      (shell-command-on-region (point-min) (point-max) command nil)))
12662   (setq gnus-last-shell-command command))
12663
12664 ;; Summary extract commands
12665
12666 (defun gnus-summary-insert-pseudos (pslist &optional not-view)
12667   (let ((buffer-read-only nil)
12668         (article (gnus-summary-article-number))
12669         after-article b e)
12670     (or (gnus-summary-goto-subject article)
12671         (error (format "No such article: %d" article)))
12672     (gnus-summary-position-point)
12673     ;; If all commands are to be bunched up on one line, we collect
12674     ;; them here.
12675     (if gnus-view-pseudos-separately
12676         ()
12677       (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
12678             files action)
12679         (while ps
12680           (setq action (cdr (assq 'action (car ps))))
12681           (setq files (list (cdr (assq 'name (car ps)))))
12682           (while (and ps (cdr ps)
12683                       (string= (or action "1")
12684                                (or (cdr (assq 'action (car (cdr ps)))) "2")))
12685             (setq files (cons (cdr (assq 'name (car (cdr ps)))) files))
12686             (setcdr ps (cdr (cdr ps))))
12687           (if (not files)
12688               ()
12689             (if (not (string-match "%s" action))
12690                 (setq files (cons " " files)))
12691             (setq files (cons " " files))
12692             (and (assq 'execute (car ps))
12693                  (setcdr (assq 'execute (car ps))
12694                          (funcall (if (string-match "%s" action)
12695                                       'format 'concat)
12696                                   action
12697                                   (mapconcat (lambda (f) f) files " ")))))
12698           (setq ps (cdr ps)))))
12699     (if (and gnus-view-pseudos (not not-view))
12700         (while pslist
12701           (and (assq 'execute (car pslist))
12702                (gnus-execute-command (cdr (assq 'execute (car pslist)))
12703                                      (eq gnus-view-pseudos 'not-confirm)))
12704           (setq pslist (cdr pslist)))
12705       (save-excursion
12706         (while pslist
12707           (setq after-article (or (cdr (assq 'article (car pslist)))
12708                                   (gnus-summary-article-number)))
12709           (gnus-summary-goto-subject after-article)
12710           (forward-line 1)
12711           (setq b (point))
12712           (insert "          " (file-name-nondirectory
12713                                 (cdr (assq 'name (car pslist))))
12714                   ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
12715           (setq e (point))
12716           (forward-line -1)             ; back to `b'
12717           (add-text-properties
12718            b e (list 'gnus-number gnus-reffed-article-number
12719                      gnus-mouse-face-prop gnus-mouse-face))
12720           (gnus-data-enter
12721            after-article gnus-reffed-article-number
12722            gnus-unread-mark b (car pslist) 0 (- e b))
12723           (push gnus-reffed-article-number gnus-newsgroup-unreads)
12724           (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
12725           (setq pslist (cdr pslist)))))))
12726
12727 (defun gnus-pseudos< (p1 p2)
12728   (let ((c1 (cdr (assq 'action p1)))
12729         (c2 (cdr (assq 'action p2))))
12730     (and c1 c2 (string< c1 c2))))
12731
12732 (defun gnus-request-pseudo-article (props)
12733   (cond ((assq 'execute props)
12734          (gnus-execute-command (cdr (assq 'execute props)))))
12735   (let ((gnus-current-article (gnus-summary-article-number)))
12736     (run-hooks 'gnus-mark-article-hook)))
12737
12738 (defun gnus-execute-command (command &optional automatic)
12739   (save-excursion
12740     (gnus-article-setup-buffer)
12741     (set-buffer gnus-article-buffer)
12742     (let ((command (if automatic command (read-string "Command: " command)))
12743           (buffer-read-only nil))
12744       (erase-buffer)
12745       (insert "$ " command "\n\n")
12746       (if gnus-view-pseudo-asynchronously
12747           (start-process "gnus-execute" nil "sh" "-c" command)
12748         (call-process "sh" nil t nil "-c" command)))))
12749
12750 (defun gnus-copy-file (file &optional to)
12751   "Copy FILE to TO."
12752   (interactive
12753    (list (read-file-name "Copy file: " default-directory)
12754          (read-file-name "Copy file to: " default-directory)))
12755   (gnus-set-global-variables)
12756   (or to (setq to (read-file-name "Copy file to: " default-directory)))
12757   (and (file-directory-p to)
12758        (setq to (concat (file-name-as-directory to)
12759                         (file-name-nondirectory file))))
12760   (copy-file file to))
12761
12762 ;; Summary kill commands.
12763
12764 (defun gnus-summary-edit-global-kill (article)
12765   "Edit the \"global\" kill file."
12766   (interactive (list (gnus-summary-article-number)))
12767   (gnus-set-global-variables)
12768   (gnus-group-edit-global-kill article))
12769
12770 (defun gnus-summary-edit-local-kill ()
12771   "Edit a local kill file applied to the current newsgroup."
12772   (interactive)
12773   (gnus-set-global-variables)
12774   (setq gnus-current-headers (gnus-summary-article-header))
12775   (gnus-set-global-variables)
12776   (gnus-group-edit-local-kill
12777    (gnus-summary-article-number) gnus-newsgroup-name))
12778
12779 \f
12780 ;;;
12781 ;;; Gnus article mode
12782 ;;;
12783
12784 (put 'gnus-article-mode 'mode-class 'special)
12785
12786 (if gnus-article-mode-map
12787     nil
12788   (setq gnus-article-mode-map (make-keymap))
12789   (suppress-keymap gnus-article-mode-map)
12790
12791   (gnus-define-keys
12792    gnus-article-mode-map
12793    " " gnus-article-goto-next-page
12794    "\177" gnus-article-goto-prev-page
12795    "\C-c^" gnus-article-refer-article
12796    "h" gnus-article-show-summary
12797    "s" gnus-article-show-summary
12798    "\C-c\C-m" gnus-article-mail
12799    "?" gnus-article-describe-briefly
12800    gnus-mouse-2 gnus-article-push-button
12801    "\r" gnus-article-press-button
12802    "\t" gnus-article-next-button
12803    "\M-\t" gnus-article-prev-button
12804    "\C-c\C-b" gnus-bug)
12805
12806   (substitute-key-definition
12807    'undefined 'gnus-article-read-summary-keys gnus-article-mode-map))
12808
12809
12810 (defun gnus-article-mode ()
12811   "Major mode for displaying an article.
12812
12813 All normal editing commands are switched off.
12814
12815 The following commands are available:
12816
12817 \\<gnus-article-mode-map>
12818 \\[gnus-article-next-page]\t Scroll the article one page forwards
12819 \\[gnus-article-prev-page]\t Scroll the article one page backwards
12820 \\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
12821 \\[gnus-article-show-summary]\t Display the summary buffer
12822 \\[gnus-article-mail]\t Send a reply to the address near point
12823 \\[gnus-article-describe-briefly]\t Describe the current mode briefly
12824 \\[gnus-info-find-node]\t Go to the Gnus info node"
12825   (interactive)
12826   (when (and menu-bar-mode
12827              (gnus-visual-p 'article-menu 'menu))
12828     (gnus-article-make-menu-bar))
12829   (kill-all-local-variables)
12830   (gnus-simplify-mode-line)
12831   (setq mode-name "Article")
12832   (setq major-mode 'gnus-article-mode)
12833   (make-local-variable 'minor-mode-alist)
12834   (or (assq 'gnus-show-mime minor-mode-alist)
12835       (setq minor-mode-alist
12836             (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
12837   (use-local-map gnus-article-mode-map)
12838   (make-local-variable 'page-delimiter)
12839   (setq page-delimiter gnus-page-delimiter)
12840   (buffer-disable-undo (current-buffer))
12841   (setq buffer-read-only t)             ;Disable modification
12842   (run-hooks 'gnus-article-mode-hook))
12843
12844 (defun gnus-article-setup-buffer ()
12845   "Initialize the article buffer."
12846   (let* ((name (if gnus-single-article-buffer "*Article*"
12847                  (concat "*Article " gnus-newsgroup-name "*")))
12848          (original
12849           (progn (string-match "\\*Article" name)
12850                  (concat " *Original Article"
12851                          (substring name (match-end 0))))))
12852     (setq gnus-article-buffer name)
12853     (setq gnus-original-article-buffer original)
12854     ;; This might be a variable local to the summary buffer.
12855     (unless gnus-single-article-buffer
12856       (save-excursion
12857         (set-buffer gnus-summary-buffer)
12858         (setq gnus-article-buffer name)
12859         (setq gnus-original-article-buffer original))
12860       (make-local-variable 'gnus-summary-buffer))
12861     (if (get-buffer name)
12862         (save-excursion
12863           (set-buffer name)
12864           (buffer-disable-undo (current-buffer))
12865           (setq buffer-read-only t)
12866           (gnus-add-current-to-buffer-list)
12867           (or (eq major-mode 'gnus-article-mode)
12868               (gnus-article-mode))
12869           (current-buffer))
12870       (save-excursion
12871         (set-buffer (get-buffer-create name))
12872         (gnus-add-current-to-buffer-list)
12873         (gnus-article-mode)
12874         (current-buffer)))))
12875
12876 ;; Set article window start at LINE, where LINE is the number of lines
12877 ;; from the head of the article.
12878 (defun gnus-article-set-window-start (&optional line)
12879   (set-window-start
12880    (get-buffer-window gnus-article-buffer)
12881    (save-excursion
12882      (set-buffer gnus-article-buffer)
12883      (goto-char (point-min))
12884      (if (not line)
12885          (point-min)
12886        (gnus-message 6 "Moved to bookmark")
12887        (search-forward "\n\n" nil t)
12888        (forward-line line)
12889        (point)))))
12890
12891 (defun gnus-kill-all-overlays ()
12892   "Delete all overlays in the current buffer."
12893   (when (fboundp 'overlay-lists)
12894     (let* ((overlayss (overlay-lists))
12895            (buffer-read-only nil)
12896            (overlays (nconc (car overlayss) (cdr overlayss))))
12897       (while overlays
12898         (delete-overlay (pop overlays))))))
12899
12900 (defun gnus-request-article-this-buffer (article group)
12901   "Get an article and insert it into this buffer."
12902   (prog1
12903       (save-excursion
12904         (if (get-buffer gnus-original-article-buffer)
12905             (set-buffer (get-buffer gnus-original-article-buffer))
12906           (set-buffer (get-buffer-create gnus-original-article-buffer))
12907           (buffer-disable-undo (current-buffer))
12908           (setq major-mode 'gnus-original-article-mode)
12909           (setq buffer-read-only t)
12910           (gnus-add-current-to-buffer-list))
12911
12912         (setq group (or group gnus-newsgroup-name))
12913
12914         ;; Open server if it has closed.
12915         (gnus-check-server (gnus-find-method-for-group group))
12916
12917         ;; Using `gnus-request-article' directly will insert the article into
12918         ;; `nntp-server-buffer' - so we'll save some time by not having to
12919         ;; copy it from the server buffer into the article buffer.
12920
12921         ;; We only request an article by message-id when we do not have the
12922         ;; headers for it, so we'll have to get those.
12923         (when (stringp article)
12924           (let ((gnus-override-method gnus-refer-article-method))
12925             (gnus-read-header article)))
12926
12927         ;; If the article number is negative, that means that this article
12928         ;; doesn't belong in this newsgroup (possibly), so we find its
12929         ;; message-id and request it by id instead of number.
12930         (when (numberp article)
12931           (save-excursion
12932             (set-buffer gnus-summary-buffer)
12933             (let ((header (gnus-summary-article-header article)))
12934               (if (< article 0)
12935                   (cond 
12936                    ((memq article gnus-newsgroup-sparse)
12937                     ;; This is a sparse gap article.
12938                     (setq article (mail-header-id header)))
12939                    ((vectorp header)
12940                     ;; It's a real article.
12941                     (setq article (mail-header-id header)))
12942                    (t
12943                     ;; It is an extracted pseudo-article.
12944                     (setq article 'pseudo)
12945                     (gnus-request-pseudo-article header))))
12946                 
12947               (let ((method (gnus-find-method-for-group 
12948                              gnus-newsgroup-name)))
12949                 (if (not (eq (car method) 'nneething))
12950                     ()
12951                   (let ((dir (concat (file-name-as-directory (nth 1 method))
12952                                      (mail-header-subject header))))
12953                     (if (file-directory-p dir)
12954                         (progn
12955                           (setq article 'nneething)
12956                           (gnus-group-enter-directory dir)))))))))
12957
12958         (cond
12959          ;; We first check `gnus-original-article-buffer'.
12960          ((and (equal (car gnus-original-article) group)
12961                (eq (cdr gnus-original-article) article))
12962           ;; We don't have to do anything, since it's already where we
12963           ;; want it.
12964           'article)
12965          ;; Check the backlog.
12966          ((and gnus-keep-backlog
12967                (gnus-backlog-request-article group article (current-buffer)))
12968           'article)
12969          ;; Check the cache.
12970          ((and gnus-use-cache
12971                (numberp article)
12972                (gnus-cache-request-article article group))
12973           'article)
12974          ;; Get the article and put into the article buffer.
12975          ((or (stringp article) (numberp article))
12976           (let ((gnus-override-method
12977                  (and (stringp article) gnus-refer-article-method))
12978                 (buffer-read-only nil))
12979             (erase-buffer)
12980             (gnus-kill-all-overlays)
12981             (if (gnus-request-article article group (current-buffer))
12982                 (progn
12983                   (and gnus-keep-backlog
12984                        (gnus-backlog-enter-article
12985                         group article (current-buffer)))
12986                   'article))))
12987          ;; It was a pseudo.
12988          (t article)))
12989
12990     ;; Take the article from the original article buffer
12991     ;; and place it in the buffer it's supposed to be in.
12992     (setq gnus-original-article (cons group article))
12993     (unless (equal (buffer-name (current-buffer))
12994                    (buffer-name (get-buffer gnus-original-article-buffer)))
12995       (let (buffer-read-only)
12996         (erase-buffer)
12997         (gnus-kill-all-overlays)
12998         (insert-buffer-substring gnus-original-article-buffer)))
12999     
13000     ;; Update sparse articles.
13001     (when (memq article gnus-newsgroup-sparse)
13002       (gnus-summary-update-article article))))
13003
13004 (defun gnus-read-header (id)
13005   "Read the headers of article ID and enter them into the Gnus system."
13006   (let ((group gnus-newsgroup-name)
13007         (headers gnus-newsgroup-headers)
13008         header where)
13009     ;; First we check to see whether the header in question is already
13010     ;; fetched.
13011     (if (stringp id)
13012         ;; This is a Message-ID.
13013         (setq header (gnus-id-to-header id))
13014       ;; This is an article number.
13015       (setq header (gnus-summary-article-header id)))
13016     (if header
13017         ;; We have found the header.
13018         header
13019       ;; We have to really fetch the header to this article.
13020       (when (setq where
13021                   (if (gnus-check-backend-function 'request-head group)
13022                       (gnus-request-head id group)
13023                     (gnus-request-article id group)))
13024         (save-excursion
13025           (set-buffer nntp-server-buffer)
13026           (and (search-forward "\n\n" nil t)
13027                (delete-region (1- (point)) (point-max)))
13028           (goto-char (point-max))
13029           (insert ".\n")
13030           (goto-char (point-min))
13031           (insert "211 "
13032                   (int-to-string
13033                    (cond
13034                     ((numberp id)
13035                      id)
13036                     ((cdr where)
13037                      (cdr where))
13038                     (t
13039                      gnus-reffed-article-number)))
13040                   " Article retrieved.\n"))
13041         (if (not (setq header (car (gnus-get-newsgroup-headers))))
13042             () ; Malformed head.
13043           (if (and (stringp id)
13044                    (not (string= (gnus-group-real-name group)
13045                                  (car where))))
13046               ;; If we fetched by Message-ID and the article came
13047               ;; from a different group, we fudge some bogus article
13048               ;; numbers for this article.
13049               (mail-header-set-number header gnus-reffed-article-number))
13050           (decf gnus-reffed-article-number)
13051           (push header gnus-newsgroup-headers)
13052           (setq gnus-current-headers header)
13053           (push (mail-header-number header) gnus-newsgroup-limit)
13054           header)))))
13055
13056 (defun gnus-article-prepare (article &optional all-headers header)
13057   "Prepare ARTICLE in article mode buffer.
13058 ARTICLE should either be an article number or a Message-ID.
13059 If ARTICLE is an id, HEADER should be the article headers.
13060 If ALL-HEADERS is non-nil, no headers are hidden."
13061   (save-excursion
13062     ;; Make sure we start in a summary buffer.
13063     (unless (eq major-mode 'gnus-summary-mode)
13064       (set-buffer gnus-summary-buffer))
13065     (setq gnus-summary-buffer (current-buffer))
13066     ;; Make sure the connection to the server is alive.
13067     (unless (gnus-server-opened
13068              (gnus-find-method-for-group gnus-newsgroup-name))
13069       (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
13070       (gnus-request-group gnus-newsgroup-name t))
13071     (let* ((article (if header (mail-header-number header) article))
13072            (summary-buffer (current-buffer))
13073            (internal-hook gnus-article-internal-prepare-hook)
13074            (group gnus-newsgroup-name)
13075            result)
13076       (save-excursion
13077         (gnus-article-setup-buffer)
13078         (set-buffer gnus-article-buffer)
13079         ;; Deactivate active regions.
13080         (when (and (boundp 'transient-mark-mode)
13081                    transient-mark-mode)
13082           (setq mark-active nil))
13083         (if (not (setq result (let ((buffer-read-only nil))
13084                                 (gnus-request-article-this-buffer
13085                                  article group))))
13086             ;; There is no such article.
13087             (save-excursion
13088               (when (and (numberp article)
13089                          (not (memq article gnus-newsgroup-sparse)))
13090                 (setq gnus-article-current
13091                       (cons gnus-newsgroup-name article))
13092                 (set-buffer gnus-summary-buffer)
13093                 (setq gnus-current-article article)
13094                 (gnus-summary-mark-article article gnus-canceled-mark))
13095               (unless (memq article gnus-newsgroup-sparse)
13096                 (gnus-message
13097                  1 "No such article (may have expired or been canceled)")
13098                 (ding)
13099                 nil))
13100           (if (or (eq result 'pseudo) (eq result 'nneething))
13101               (progn
13102                 (save-excursion
13103                   (set-buffer summary-buffer)
13104                   (setq gnus-last-article gnus-current-article
13105                         gnus-newsgroup-history (cons gnus-current-article
13106                                                      gnus-newsgroup-history)
13107                         gnus-current-article 0
13108                         gnus-current-headers nil
13109                         gnus-article-current nil)
13110                   (if (eq result 'nneething)
13111                       (gnus-configure-windows 'summary)
13112                     (gnus-configure-windows 'article))
13113                   (gnus-set-global-variables))
13114                 (gnus-set-mode-line 'article))
13115             ;; The result from the `request' was an actual article -
13116             ;; or at least some text that is now displayed in the
13117             ;; article buffer.
13118             (if (and (numberp article)
13119                      (not (eq article gnus-current-article)))
13120                 ;; Seems like a new article has been selected.
13121                 ;; `gnus-current-article' must be an article number.
13122                 (save-excursion
13123                   (set-buffer summary-buffer)
13124                   (setq gnus-last-article gnus-current-article
13125                         gnus-newsgroup-history (cons gnus-current-article
13126                                                      gnus-newsgroup-history)
13127                         gnus-current-article article
13128                         gnus-current-headers
13129                         (gnus-summary-article-header gnus-current-article)
13130                         gnus-article-current
13131                         (cons gnus-newsgroup-name gnus-current-article))
13132                   (unless (vectorp gnus-current-headers)
13133                     (setq gnus-current-headers nil))
13134                   (gnus-summary-show-thread)
13135                   (run-hooks 'gnus-mark-article-hook)
13136                   (gnus-set-mode-line 'summary)
13137                   (and (gnus-visual-p 'article-highlight 'highlight)
13138                        (run-hooks 'gnus-visual-mark-article-hook))
13139                   ;; Set the global newsgroup variables here.
13140                   ;; Suggested by Jim Sisolak
13141                   ;; <sisolak@trans4.neep.wisc.edu>.
13142                   (gnus-set-global-variables)
13143                   (setq gnus-have-all-headers
13144                         (or all-headers gnus-show-all-headers))
13145                   (and gnus-use-cache
13146                        (vectorp (gnus-summary-article-header article))
13147                        (gnus-cache-possibly-enter-article
13148                         group article
13149                         (gnus-summary-article-header article)
13150                         (memq article gnus-newsgroup-marked)
13151                         (memq article gnus-newsgroup-dormant)
13152                         (memq article gnus-newsgroup-unreads)))))
13153             ;; Hooks for getting information from the article.
13154             ;; This hook must be called before being narrowed.
13155             (let (buffer-read-only)
13156               (run-hooks 'internal-hook)
13157               (run-hooks 'gnus-article-prepare-hook)
13158               ;; Decode MIME message.
13159               (if gnus-show-mime
13160                   (if (or (not gnus-strict-mime)
13161                           (gnus-fetch-field "Mime-Version"))
13162                       (funcall gnus-show-mime-method)
13163                     (funcall gnus-decode-encoded-word-method)))
13164               ;; Perform the article display hooks.
13165               (run-hooks 'gnus-article-display-hook))
13166             ;; Do page break.
13167             (goto-char (point-min))
13168             (and gnus-break-pages (gnus-narrow-to-page))
13169             (gnus-set-mode-line 'article)
13170             (gnus-configure-windows 'article)
13171             (goto-char (point-min))
13172             t))))))
13173
13174 (defun gnus-article-show-all-headers ()
13175   "Show all article headers in article mode buffer."
13176   (save-excursion
13177     (gnus-article-setup-buffer)
13178     (set-buffer gnus-article-buffer)
13179     (let ((buffer-read-only nil))
13180       (remove-text-properties (point-min) (point-max)
13181                               gnus-hidden-properties))))
13182
13183 (defun gnus-article-hide-headers-if-wanted ()
13184   "Hide unwanted headers if `gnus-have-all-headers' is nil.
13185 Provided for backwards compatibility."
13186   (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
13187       gnus-inhibit-hiding
13188       (gnus-article-hide-headers)))
13189
13190 (defun gnus-article-hide-headers (&optional arg delete)
13191   "Toggle whether to hide unwanted headers and possibly sort them as well.
13192 If given a negative prefix, always show; if given a positive prefix,
13193 always hide."
13194   (interactive "P")
13195   (unless (gnus-article-check-hidden-text 'headers arg)
13196     ;; This function might be inhibited.
13197     (unless gnus-inhibit-hiding
13198       (save-excursion
13199         (set-buffer gnus-article-buffer)
13200         (save-restriction
13201           (let ((buffer-read-only nil)
13202                 (ignored (when (not (stringp gnus-visible-headers))
13203                            (cond ((stringp gnus-ignored-headers)
13204                                   gnus-ignored-headers)
13205                                  ((listp gnus-ignored-headers)
13206                                   (mapconcat 'identity gnus-ignored-headers
13207                                              "\\|")))))
13208                 (visible
13209                  (cond ((stringp gnus-visible-headers)
13210                         gnus-visible-headers)
13211                        ((listp gnus-visible-headers)
13212                         (mapconcat 'identity gnus-visible-headers "\\|"))))
13213                 want-list beg want-l)
13214             ;; First we narrow to just the headers.
13215             (widen)
13216             (goto-char (point-min))
13217             ;; Hide any "From " lines at the beginning of (mail) articles.
13218             (while (looking-at "From ")
13219               (forward-line 1))
13220             (unless (bobp)
13221               (add-text-properties
13222                (point-min) (point)
13223                (nconc (list 'gnus-type 'headers) gnus-hidden-properties)))
13224             ;; Then treat the rest of the header lines.
13225             (narrow-to-region
13226              (point)
13227              (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
13228             ;; Then we use the two regular expressions
13229             ;; `gnus-ignored-headers' and `gnus-visible-headers' to
13230             ;; select which header lines is to remain visible in the
13231             ;; article buffer.
13232             (goto-char (point-min))
13233             (while (re-search-forward "^[^ \t]*:" nil t)
13234               (beginning-of-line)
13235               ;; We add the headers we want to keep to a list and delete
13236               ;; them from the buffer.
13237               (if (or (and visible (looking-at visible))
13238                       (and ignored (not (looking-at ignored))))
13239                   (progn
13240                     (push (buffer-substring
13241                            (setq beg (point))
13242                            (progn
13243                              (forward-line 1)
13244                              ;; Be sure to get multi-line headers...
13245                              (re-search-forward "^[^ \t]*:" nil t)
13246                              (beginning-of-line)
13247                              (point)))
13248                           want-list)
13249                     (delete-region beg (point)))
13250                 (forward-line 1)))
13251             ;; Sort the headers that we want to display.
13252             (setq want-list (sort want-list 'gnus-article-header-less))
13253             (goto-char (point-min))
13254             (while want-list
13255               (insert (pop want-list)))
13256             ;; We make the unwanted headers invisible.
13257             (if delete
13258                 (delete-region (point-min) (point-max))
13259               ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
13260               (add-text-properties
13261                (point) (point-max)
13262                (nconc (list 'gnus-type 'headers)
13263                       gnus-hidden-properties)))))))))
13264
13265 (defsubst gnus-article-header-rank (header)
13266   "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
13267   (let ((list gnus-sorted-header-list)
13268         (i 0))
13269     (while list
13270       (when (string-match (car list) header)
13271         (setq list nil))
13272       (setq list (cdr list))
13273       (incf i))
13274     i))
13275
13276 (defun gnus-article-header-less (h1 h2)
13277   "Say whether string H1 is \"less\" than string H2."
13278   (< (gnus-article-header-rank h1)
13279      (gnus-article-header-rank h2)))
13280
13281 (defun gnus-article-hide-boring-headers (&optional arg)
13282   "Toggle hiding of headers that aren't very interesting.
13283 If given a negative prefix, always show; if given a positive prefix,
13284 always hide."
13285   (interactive "P")
13286   (unless (gnus-article-check-hidden-text 'boring-headers arg)
13287     (save-excursion
13288       (set-buffer gnus-article-buffer)
13289       (save-restriction
13290         (let ((buffer-read-only nil)
13291               (list gnus-boring-article-headers)
13292               (inhibit-point-motion-hooks t)
13293               elem)
13294           (nnheader-narrow-to-headers)
13295           (while list
13296             (setq elem (pop list))
13297             (goto-char (point-min))
13298             (cond
13299              ;; Hide empty headers.
13300              ((eq elem 'empty)
13301               (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t)
13302                 (forward-line -1)
13303                 (add-text-properties
13304                  (progn (beginning-of-line) (point))
13305                  (progn 
13306                    (end-of-line)
13307                    (if (re-search-forward "^[^ \t]" nil t)
13308                        (match-beginning 0)
13309                      (point-max)))
13310                  (nconc (list 'gnus-type 'boring-headers)
13311                         gnus-hidden-properties))))
13312              ;; Hide boring Newsgroups header.
13313              ((eq elem 'newsgroups)
13314               (when (equal (mail-fetch-field "newsgroups")
13315                            (gnus-group-real-name gnus-newsgroup-name))
13316                 (gnus-article-hide-header "newsgroups")))
13317              ((eq elem 'followup-to)
13318               (when (equal (mail-fetch-field "followup-to")
13319                            (mail-fetch-field "newsgroups"))
13320                 (gnus-article-hide-header "followup-to")))
13321              ((eq elem 'reply-to)
13322               (let ((from (mail-fetch-field "from"))
13323                     (reply-to (mail-fetch-field "reply-to")))
13324                 (when (and
13325                        from reply-to
13326                        (equal 
13327                         (nth 1 (mail-extract-address-components from))
13328                         (nth 1 (mail-extract-address-components reply-to))))
13329                   (gnus-article-hide-header "reply-to"))))
13330              ((eq elem 'date)
13331               (let ((date (mail-fetch-field "date")))
13332                 (when (and date
13333                            (< (gnus-days-between date (current-time-string))
13334                               4))
13335                   (gnus-article-hide-header "date")))))))))))
13336
13337 (defun gnus-article-hide-header (header)
13338   (save-excursion
13339     (goto-char (point-min))
13340     (when (re-search-forward (concat "^" header ":") nil t)
13341       (add-text-properties
13342        (progn (beginning-of-line) (point))
13343        (progn 
13344          (end-of-line)
13345          (if (re-search-forward "^[^ \t]" nil t)
13346              (match-beginning 0)
13347            (point-max)))
13348        (nconc (list 'gnus-type 'boring-headers)
13349               gnus-hidden-properties)))))
13350
13351 ;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
13352 (defun gnus-article-treat-overstrike ()
13353   "Translate overstrikes into bold text."
13354   (interactive)
13355   (save-excursion
13356     (set-buffer gnus-article-buffer)
13357     (let ((buffer-read-only nil))
13358       (while (search-forward "\b" nil t)
13359         (let ((next (following-char))
13360               (previous (char-after (- (point) 2))))
13361           (cond ((eq next previous)
13362                  (put-text-property (- (point) 2) (point) 'invisible t)
13363                  (put-text-property (point) (1+ (point)) 'face 'bold))
13364                 ((eq next ?_)
13365                  (put-text-property (1- (point)) (1+ (point)) 'invisible t)
13366                  (put-text-property
13367                   (- (point) 2) (1- (point)) 'face 'underline))
13368                 ((eq previous ?_)
13369                  (put-text-property (- (point) 2) (point) 'invisible t)
13370                  (put-text-property
13371                   (point) (1+ (point))  'face 'underline))))))))
13372
13373 (defun gnus-article-word-wrap ()
13374   "Format too long lines."
13375   (interactive)
13376   (save-excursion
13377     (set-buffer gnus-article-buffer)
13378     (let ((buffer-read-only nil)
13379           p)
13380       (widen)
13381       (goto-char (point-min))
13382       (search-forward "\n\n" nil t)
13383       (end-of-line 1)
13384       (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
13385             (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
13386             (adaptive-fill-mode t))
13387         (while (not (eobp))
13388           (and (>= (current-column) (min fill-column (window-width)))
13389                (/= (preceding-char) ?:)
13390                (fill-paragraph nil))
13391           (end-of-line 2))))))
13392
13393 (defun gnus-article-remove-cr ()
13394   "Remove carriage returns from an article."
13395   (interactive)
13396   (save-excursion
13397     (set-buffer gnus-article-buffer)
13398     (let ((buffer-read-only nil))
13399       (goto-char (point-min))
13400       (while (search-forward "\r" nil t)
13401         (replace-match "" t t)))))
13402
13403 (defun gnus-article-remove-trailing-blank-lines ()
13404   "Remove all trailing blank lines from the article."
13405   (interactive)
13406   (save-excursion
13407     (set-buffer gnus-article-buffer)
13408     (let ((buffer-read-only nil))
13409       (goto-char (point-max))
13410       (delete-region
13411        (point)
13412        (progn
13413          (while (looking-at "^[ \t]*$")
13414            (forward-line -1))
13415          (forward-line 1)
13416          (point))))))
13417
13418 (defun gnus-article-display-x-face (&optional force)
13419   "Look for an X-Face header and display it if present."
13420   (interactive (list 'force))
13421   (save-excursion
13422     (set-buffer gnus-article-buffer)
13423     ;; Delete the old process, if any.
13424     (when (process-status "gnus-x-face")
13425       (delete-process "gnus-x-face"))
13426     (let ((inhibit-point-motion-hooks t)
13427           (case-fold-search nil)
13428           from)
13429       (save-restriction
13430         (nnheader-narrow-to-headers)
13431         (setq from (mail-fetch-field "from"))
13432         (goto-char (point-min))
13433         (when (and gnus-article-x-face-command
13434                    (or force
13435                        ;; Check whether this face is censored.
13436                        (not gnus-article-x-face-too-ugly)
13437                        (and gnus-article-x-face-too-ugly from
13438                             (not (string-match gnus-article-x-face-too-ugly
13439                                                from))))
13440                    ;; Has to be present.
13441                    (re-search-forward "^X-Face: " nil t))
13442           ;; We now have the area of the buffer where the X-Face is stored.
13443           (let ((beg (point))
13444                 (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
13445             ;; We display the face.
13446             (if (symbolp gnus-article-x-face-command)
13447                 ;; The command is a lisp function, so we call it.
13448                 (if (gnus-functionp gnus-article-x-face-command)
13449                     (funcall gnus-article-x-face-command beg end)
13450                   (error "%s is not a function" gnus-article-x-face-command))
13451               ;; The command is a string, so we interpret the command
13452               ;; as a, well, command, and fork it off.
13453               (let ((process-connection-type nil))
13454                 (process-kill-without-query
13455                  (start-process
13456                   "gnus-x-face" nil "sh" "-c" gnus-article-x-face-command))
13457                 (process-send-region "gnus-x-face" beg end)
13458                 (process-send-eof "gnus-x-face")))))))))
13459
13460 (defun gnus-headers-decode-quoted-printable ()
13461   "Hack to remove QP encoding from headers."
13462   (let ((case-fold-search t)
13463         (inhibit-point-motion-hooks t)
13464         string)
13465     (goto-char (point-min))
13466     (while (re-search-forward "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
13467       (setq string (match-string 1))
13468       (narrow-to-region (match-beginning 0) (match-end 0))
13469       (delete-region (point-min) (point-max))
13470       (insert string)
13471       (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
13472       (subst-char-in-region (point-min) (point-max) ?_ ? )
13473       (widen)
13474       (goto-char (point-min)))))
13475
13476 (defun gnus-article-de-quoted-unreadable (&optional force)
13477   "Do a naive translation of a quoted-printable-encoded article.
13478 This is in no way, shape or form meant as a replacement for real MIME
13479 processing, but is simply a stop-gap measure until MIME support is
13480 written.
13481 If FORCE, decode the article whether it is marked as quoted-printable
13482 or not."
13483   (interactive (list 'force))
13484   (save-excursion
13485     (set-buffer gnus-article-buffer)
13486     (let ((case-fold-search t)
13487           (buffer-read-only nil)
13488           (type (gnus-fetch-field "content-transfer-encoding")))
13489       (when (or force
13490                 (and type (string-match "quoted-printable" type)))
13491         (goto-char (point-min))
13492         (search-forward "\n\n" nil 'move)
13493         (gnus-mime-decode-quoted-printable (point) (point-max))
13494         (gnus-headers-decode-quoted-printable)))))
13495
13496 (defun gnus-mime-decode-quoted-printable (from to)
13497   "Decode Quoted-Printable in the region between FROM and TO."
13498   (goto-char from)
13499   (while (search-forward "=" to t)
13500     (cond ((eq (following-char) ?\n)
13501            (delete-char -1)
13502            (delete-char 1))
13503           ((looking-at "[0-9A-F][0-9A-F]")
13504            (delete-char -1)
13505            (insert (hexl-hex-string-to-integer
13506                     (buffer-substring (point) (+ 2 (point)))))
13507            (delete-char 2))
13508           ((looking-at "=")
13509            (delete-char 1))
13510           ((gnus-message 3 "Malformed MIME quoted-printable message")))))
13511
13512 (defun gnus-article-hide-pgp (&optional arg)
13513   "Toggle hiding of any PGP headers and signatures in the current article.
13514 If given a negative prefix, always show; if given a positive prefix,
13515 always hide."
13516   (interactive "P")
13517   (unless (gnus-article-check-hidden-text 'pgp arg)
13518     (save-excursion
13519       (set-buffer gnus-article-buffer)
13520       (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties))
13521             buffer-read-only beg end)
13522         (widen)
13523         (goto-char (point-min))
13524         ;; Hide the "header".
13525         (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
13526              (add-text-properties (match-beginning 0) (match-end 0) props))
13527         (setq beg (point))
13528         ;; Hide the actual signature.
13529         (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
13530              (setq end (match-beginning 0))
13531              (add-text-properties
13532               (match-beginning 0)
13533               (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
13534                   (match-end 0)
13535                 ;; Perhaps we shouldn't hide to the end of the buffer
13536                 ;; if there is no end to the signature?
13537                 (point-max))
13538               props))
13539         ;; Hide "- " PGP quotation markers.
13540         (when (and beg end)
13541           (narrow-to-region beg end)
13542           (goto-char (point-min))
13543           (while (re-search-forward "^- " nil t)
13544             (add-text-properties (match-beginning 0) (match-end 0) props))
13545           (widen))))))
13546
13547 (defun gnus-article-hide-signature (&optional arg)
13548   "Hide the signature in the current article.
13549 If given a negative prefix, always show; if given a positive prefix,
13550 always hide."
13551   (interactive "P")
13552   (unless (gnus-article-check-hidden-text 'signature arg)
13553     (save-excursion
13554       (set-buffer gnus-article-buffer)
13555       (save-restriction
13556         (let ((buffer-read-only nil))
13557           (when (gnus-narrow-to-signature)
13558             (add-text-properties
13559              (point-min) (point-max)
13560              (nconc (list 'gnus-type 'signature)
13561                     gnus-hidden-properties))))))))
13562
13563 (defvar gnus-signature-limit nil
13564   "Provide a limit to what is considered a signature.
13565 If it is a number, no signature may not be longer (in characters) than
13566 that number.  If it is a function, the function will be called without
13567 any parameters, and if it returns nil, there is no signature in the
13568 buffer.  If it is a string, it will be used as a regexp.  If it
13569 matches, the text in question is not a signature.")
13570
13571 (defun gnus-narrow-to-signature ()
13572   "Narrow to the signature."
13573   (widen)
13574   (goto-char (point-max))
13575   (when (re-search-backward gnus-signature-separator nil t)
13576     (forward-line 1)
13577     (when (or (null gnus-signature-limit)
13578               (and (numberp gnus-signature-limit)
13579                    (< (- (point-max) (point)) gnus-signature-limit))
13580               (and (gnus-functionp gnus-signature-limit)
13581                    (funcall gnus-signature-limit))
13582               (and (stringp gnus-signature-limit)
13583                    (not (re-search-forward gnus-signature-limit nil t))))
13584       (narrow-to-region (point) (point-max))
13585       t)))
13586
13587 (defun gnus-article-check-hidden-text (type arg)
13588   "Return nil if hiding is necessary."
13589   (save-excursion
13590     (set-buffer gnus-article-buffer)
13591     (let ((hide (gnus-article-hidden-text-p type)))
13592       (cond ((or (and (null arg) (eq hide 'hidden))
13593                  (and arg (< 0 (prefix-numeric-value arg))))
13594              (gnus-article-show-hidden-text type))
13595             ((eq hide 'shown)
13596              (gnus-article-show-hidden-text type t))
13597             (t nil)))))
13598
13599 (defun gnus-article-hidden-text-p (type)
13600   "Say whether the current buffer contains hidden text of type TYPE."
13601   (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type))
13602         prop)
13603     (when pos
13604       (if (get-text-property pos 'invisible)
13605           'hidden
13606         'shown))))
13607
13608 (defun gnus-article-hide (&optional arg force)
13609   "Hide all the gruft in the current article.
13610 This means that PGP stuff, signatures, cited text and (some)
13611 headers will be hidden.
13612 If given a prefix, show the hidden text instead."
13613   (interactive (list current-prefix-arg 'force))
13614   (gnus-article-hide-headers arg)
13615   (gnus-article-hide-pgp arg)
13616   (gnus-article-hide-citation-maybe arg force)
13617   (gnus-article-hide-signature arg))
13618
13619 (defun gnus-article-show-hidden-text (type &optional hide)
13620   "Show all hidden text of type TYPE.
13621 If HIDE, hide the text instead."
13622   (save-excursion
13623     (set-buffer gnus-article-buffer)
13624     (let ((buffer-read-only nil)
13625           (inhibit-point-motion-hooks t)
13626           (beg (point)))
13627       (while (gnus-goto-char (text-property-any
13628                               beg (point-max) 'gnus-type type))
13629         (if hide
13630             (add-text-properties (point) (setq beg (1+ (point)))
13631                                  gnus-hidden-properties)
13632           (remove-text-properties (point) (setq beg (1+ (point)))
13633                                   gnus-hidden-properties)))
13634       t)))
13635
13636 (defvar gnus-article-time-units
13637   `((year . ,(* 365.25 24 60 60))
13638     (week . ,(* 7 24 60 60))
13639     (day . ,(* 24 60 60))
13640     (hour . ,(* 60 60))
13641     (minute . 60)
13642     (second . 1))
13643   "Mapping from time units to seconds.")
13644
13645 (defun gnus-article-date-ut (&optional type highlight)
13646   "Convert DATE date to universal time in the current article.
13647 If TYPE is `local', convert to local time; if it is `lapsed', output
13648 how much time has lapsed since DATE."
13649   (interactive (list 'ut t))
13650   (let* ((header (or gnus-current-headers
13651                      (gnus-summary-article-header) ""))
13652          (date (and (vectorp header) (mail-header-date header)))
13653          (date-regexp "^Date: \\|^X-Sent: ")
13654          (now (current-time))
13655          (inhibit-point-motion-hooks t))
13656     (when (and date (not (string= date "")))
13657       (save-excursion
13658         (set-buffer gnus-article-buffer)
13659         (save-restriction
13660           (nnheader-narrow-to-headers)
13661           (let ((buffer-read-only nil))
13662             ;; Delete any old Date headers.
13663             (if (zerop (nnheader-remove-header date-regexp t))
13664                 (beginning-of-line)
13665               (goto-char (point-max)))
13666             (insert
13667              (cond
13668               ;; Convert to the local timezone.  We have to slap a
13669               ;; `condition-case' round the calls to the timezone
13670               ;; functions since they aren't particularly resistant to
13671               ;; buggy dates.
13672               ((eq type 'local)
13673                (concat "Date: " (condition-case ()
13674                                     (timezone-make-date-arpa-standard date)
13675                                   (error date))
13676                        "\n"))
13677               ;; Convert to Universal Time.
13678               ((eq type 'ut)
13679                (concat "Date: "
13680                        (condition-case ()
13681                            (timezone-make-date-arpa-standard date nil "UT")
13682                          (error date))
13683                        "\n"))
13684               ;; Get the original date from the article.
13685               ((eq type 'original)
13686                (concat "Date: " date "\n"))
13687               ;; Do an X-Sent lapsed format.
13688               ((eq type 'lapsed)
13689                ;; If the date is seriously mangled, the timezone
13690                ;; functions are liable to bug out, so we condition-case
13691                ;; the entire thing.
13692                (let* ((real-time
13693                        (condition-case ()
13694                            (gnus-time-minus
13695                             (gnus-encode-date
13696                              (timezone-make-date-arpa-standard
13697                               (current-time-string now)
13698                               (current-time-zone now) "UT"))
13699                             (gnus-encode-date
13700                              (timezone-make-date-arpa-standard
13701                               date nil "UT")))
13702                          (error '(0 0))))
13703                       (real-sec (+ (* (float (car real-time)) 65536)
13704                                    (cadr real-time)))
13705                       (sec (abs real-sec))
13706                       num prev)
13707                  (if (zerop sec)
13708                      "X-Sent: Now\n"
13709                    (concat
13710                     "X-Sent: "
13711                     ;; This is a bit convoluted, but basically we go
13712                     ;; through the time units for years, weeks, etc,
13713                     ;; and divide things to see whether that results
13714                     ;; in positive answers.
13715                     (mapconcat
13716                      (lambda (unit)
13717                        (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
13718                            ;; The (remaining) seconds are too few to
13719                            ;; be divided into this time unit.
13720                            ""
13721                          ;; It's big enough, so we output it.
13722                          (setq sec (- sec (* num (cdr unit))))
13723                          (prog1
13724                              (concat (if prev ", " "") (int-to-string
13725                                                         (floor num))
13726                                      " " (symbol-name (car unit))
13727                                      (if (> num 1) "s" ""))
13728                            (setq prev t))))
13729                      gnus-article-time-units "")
13730                     ;; If dates are odd, then it might appear like the
13731                     ;; article was sent in the future.
13732                     (if (> real-sec 0)
13733                         " ago\n"
13734                       " in the future\n")))))
13735               (t
13736                (error "Unknown conversion type: %s" type)))))
13737           ;; Do highlighting.
13738           (when (and highlight (gnus-visual-p 'article-highlight 'highlight))
13739             (gnus-article-highlight-headers)))))))
13740
13741 (defun gnus-article-date-local (&optional highlight)
13742   "Convert the current article date to the local timezone."
13743   (interactive (list t))
13744   (gnus-article-date-ut 'local highlight))
13745
13746 (defun gnus-article-date-original (&optional highlight)
13747   "Convert the current article date to what it was originally.
13748 This is only useful if you have used some other date conversion
13749 function and want to see what the date was before converting."
13750   (interactive (list t))
13751   (gnus-article-date-ut 'original highlight))
13752
13753 (defun gnus-article-date-lapsed (&optional highlight)
13754   "Convert the current article date to time lapsed since it was sent."
13755   (interactive (list t))
13756   (gnus-article-date-ut 'lapsed highlight))
13757
13758 (defun gnus-article-maybe-highlight ()
13759   "Do some article highlighting if `gnus-visual' is non-nil."
13760   (if (gnus-visual-p 'article-highlight 'highlight)
13761       (gnus-article-highlight-some)))
13762
13763 ;; Article savers.
13764
13765 (defun gnus-output-to-rmail (file-name)
13766   "Append the current article to an Rmail file named FILE-NAME."
13767   (require 'rmail)
13768   ;; Most of these codes are borrowed from rmailout.el.
13769   (setq file-name (expand-file-name file-name))
13770   (setq rmail-default-rmail-file file-name)
13771   (let ((artbuf (current-buffer))
13772         (tmpbuf (get-buffer-create " *Gnus-output*")))
13773     (save-excursion
13774       (or (get-file-buffer file-name)
13775           (file-exists-p file-name)
13776           (if (gnus-yes-or-no-p
13777                (concat "\"" file-name "\" does not exist, create it? "))
13778               (let ((file-buffer (create-file-buffer file-name)))
13779                 (save-excursion
13780                   (set-buffer file-buffer)
13781                   (rmail-insert-rmail-file-header)
13782                   (let ((require-final-newline nil))
13783                     (write-region (point-min) (point-max) file-name t 1)))
13784                 (kill-buffer file-buffer))
13785             (error "Output file does not exist")))
13786       (set-buffer tmpbuf)
13787       (buffer-disable-undo (current-buffer))
13788       (erase-buffer)
13789       (insert-buffer-substring artbuf)
13790       (gnus-convert-article-to-rmail)
13791       ;; Decide whether to append to a file or to an Emacs buffer.
13792       (let ((outbuf (get-file-buffer file-name)))
13793         (if (not outbuf)
13794             (append-to-file (point-min) (point-max) file-name)
13795           ;; File has been visited, in buffer OUTBUF.
13796           (set-buffer outbuf)
13797           (let ((buffer-read-only nil)
13798                 (msg (and (boundp 'rmail-current-message)
13799                           (symbol-value 'rmail-current-message))))
13800             ;; If MSG is non-nil, buffer is in RMAIL mode.
13801             (if msg
13802                 (progn (widen)
13803                        (narrow-to-region (point-max) (point-max))))
13804             (insert-buffer-substring tmpbuf)
13805             (if msg
13806                 (progn
13807                   (goto-char (point-min))
13808                   (widen)
13809                   (search-backward "\^_")
13810                   (narrow-to-region (point) (point-max))
13811                   (goto-char (1+ (point-min)))
13812                   (rmail-count-new-messages t)
13813                   (rmail-show-message msg)))))))
13814     (kill-buffer tmpbuf)))
13815
13816 (defun gnus-output-to-file (file-name)
13817   "Append the current article to a file named FILE-NAME."
13818   (setq file-name (expand-file-name file-name))
13819   (let ((artbuf (current-buffer))
13820         (tmpbuf (get-buffer-create " *Gnus-output*")))
13821     (save-excursion
13822       (set-buffer tmpbuf)
13823       (buffer-disable-undo (current-buffer))
13824       (erase-buffer)
13825       (insert-buffer-substring artbuf)
13826       ;; Append newline at end of the buffer as separator, and then
13827       ;; save it to file.
13828       (goto-char (point-max))
13829       (insert "\n")
13830       (append-to-file (point-min) (point-max) file-name))
13831     (kill-buffer tmpbuf)))
13832
13833 (defun gnus-convert-article-to-rmail ()
13834   "Convert article in current buffer to Rmail message format."
13835   (let ((buffer-read-only nil))
13836     ;; Convert article directly into Babyl format.
13837     ;; Suggested by Rob Austein <sra@lcs.mit.edu>
13838     (goto-char (point-min))
13839     (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
13840     (while (search-forward "\n\^_" nil t) ;single char
13841       (replace-match "\n^_" t t))       ;2 chars: "^" and "_"
13842     (goto-char (point-max))
13843     (insert "\^_")))
13844
13845 (defun gnus-narrow-to-page (&optional arg)
13846   "Narrow the article buffer to a page.
13847 If given a numerical ARG, move forward ARG pages."
13848   (interactive "P")
13849   (setq arg (if arg (prefix-numeric-value arg) 0))
13850   (save-excursion
13851     (set-buffer gnus-article-buffer)
13852     (goto-char (point-min))
13853     (widen)
13854     (when (gnus-visual-p 'page-marker)
13855       (let ((buffer-read-only nil))
13856         (gnus-remove-text-with-property 'gnus-prev)
13857         (gnus-remove-text-with-property 'gnus-next)))
13858     (when
13859         (cond ((< arg 0)
13860                (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
13861               ((> arg 0)
13862                (re-search-forward page-delimiter nil 'move arg)))
13863       (goto-char (match-end 0)))
13864     (narrow-to-region
13865      (point)
13866      (if (re-search-forward page-delimiter nil 'move)
13867          (match-beginning 0)
13868        (point)))
13869     (when (and (gnus-visual-p 'page-marker)
13870                (not (= (point-min) 1)))
13871       (save-excursion
13872         (goto-char (point-min))
13873         (gnus-insert-prev-page-button)))
13874     (when (and (gnus-visual-p 'page-marker)
13875                (not (= (1- (point-max)) (buffer-size))))
13876       (save-excursion
13877         (goto-char (point-max))
13878         (gnus-insert-next-page-button)))))
13879
13880
13881 ;; Article mode commands
13882
13883 (defun gnus-article-goto-next-page ()
13884   "Show the next page of the article."
13885   (interactive)
13886   (when (gnus-article-next-page)
13887     (gnus-article-read-summary-keys nil ?n)))
13888
13889 (defun gnus-article-goto-prev-page ()
13890   "Show the next page of the article."
13891   (interactive)
13892   (if (bobp) (gnus-article-read-summary-keys nil ?n)
13893     (gnus-article-prev-page nil)))
13894
13895 (defun gnus-article-next-page (&optional lines)
13896   "Show the next page of the current article.
13897 If end of article, return non-nil.  Otherwise return nil.
13898 Argument LINES specifies lines to be scrolled up."
13899   (interactive "p")
13900   (move-to-window-line -1)
13901   ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
13902   (if (save-excursion
13903         (end-of-line)
13904         (and (pos-visible-in-window-p)  ;Not continuation line.
13905              (eobp)))
13906       ;; Nothing in this page.
13907       (if (or (not gnus-break-pages)
13908               (save-excursion
13909                 (save-restriction
13910                   (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
13911           t                             ;Nothing more.
13912         (gnus-narrow-to-page 1)         ;Go to next page.
13913         nil)
13914     ;; More in this page.
13915     (condition-case ()
13916         (scroll-up lines)
13917       (end-of-buffer
13918        ;; Long lines may cause an end-of-buffer error.
13919        (goto-char (point-max))))
13920     nil))
13921
13922 (defun gnus-article-prev-page (&optional lines)
13923   "Show previous page of current article.
13924 Argument LINES specifies lines to be scrolled down."
13925   (interactive "p")
13926   (move-to-window-line 0)
13927   (if (and gnus-break-pages
13928            (bobp)
13929            (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
13930       (progn
13931         (gnus-narrow-to-page -1)        ;Go to previous page.
13932         (goto-char (point-max))
13933         (recenter -1))
13934     (condition-case ()
13935         (scroll-down lines)
13936       (error nil))))
13937
13938 (defun gnus-article-refer-article ()
13939   "Read article specified by message-id around point."
13940   (interactive)
13941   (let ((point (point)))
13942     (search-forward ">" nil t)          ;Move point to end of "<....>".
13943     (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
13944         (let ((message-id (match-string 1)))
13945           (goto-char point)
13946           (set-buffer gnus-summary-buffer)
13947           (gnus-summary-refer-article message-id))
13948       (goto-char (point))
13949       (error "No references around point"))))
13950
13951 (defun gnus-article-show-summary ()
13952   "Reconfigure windows to show summary buffer."
13953   (interactive)
13954   (gnus-configure-windows 'article)
13955   (gnus-summary-goto-subject gnus-current-article))
13956
13957 (defun gnus-article-describe-briefly ()
13958   "Describe article mode commands briefly."
13959   (interactive)
13960   (gnus-message 6
13961                 (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")))
13962
13963 (defun gnus-article-summary-command ()
13964   "Execute the last keystroke in the summary buffer."
13965   (interactive)
13966   (let ((obuf (current-buffer))
13967         (owin (current-window-configuration))
13968         func)
13969     (switch-to-buffer gnus-summary-buffer 'norecord)
13970     (setq func (lookup-key (current-local-map) (this-command-keys)))
13971     (call-interactively func)
13972     (set-buffer obuf)
13973     (set-window-configuration owin)
13974     (set-window-point (get-buffer-window (current-buffer)) (point))))
13975
13976 (defun gnus-article-summary-command-nosave ()
13977   "Execute the last keystroke in the summary buffer."
13978   (interactive)
13979   (let (func)
13980     (pop-to-buffer gnus-summary-buffer 'norecord)
13981     (setq func (lookup-key (current-local-map) (this-command-keys)))
13982     (call-interactively func)))
13983
13984 (defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
13985   "Read a summary buffer key sequence and execute it from the article buffer."
13986   (interactive "P")
13987   (let ((nosaves
13988          '("q" "Q"  "c" "r" "R" "\C-c\C-f" "m"  "a" "f" "F"
13989            "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
13990            "=" "^" "\M-^"))
13991         keys)
13992     (save-excursion
13993       (set-buffer gnus-summary-buffer)
13994       (push (or key last-command-event) unread-command-events)
13995       (setq keys (read-key-sequence nil)))
13996     (message "")
13997
13998     (if (member keys nosaves)
13999         (let (func)
14000           (pop-to-buffer gnus-summary-buffer 'norecord)
14001           (if (setq func (lookup-key (current-local-map) keys))
14002               (call-interactively func)
14003             (ding)))
14004       (let ((obuf (current-buffer))
14005             (owin (current-window-configuration))
14006             (opoint (point))
14007             func in-buffer)
14008         (if not-restore-window
14009             (pop-to-buffer gnus-summary-buffer 'norecord)
14010           (switch-to-buffer gnus-summary-buffer 'norecord))
14011         (setq in-buffer (current-buffer))
14012         (if (setq func (lookup-key (current-local-map) keys))
14013             (call-interactively func)
14014           (ding))
14015         (when (eq in-buffer (current-buffer))
14016           (set-buffer obuf)
14017           (unless not-restore-window
14018             (set-window-configuration owin))
14019           (set-window-point (get-buffer-window (current-buffer)) opoint))))))
14020
14021 \f
14022 ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
14023
14024 ;;;###autoload
14025 (defalias 'gnus-batch-kill 'gnus-batch-score)
14026 ;;;###autoload
14027 (defun gnus-batch-score ()
14028   "Run batched scoring.
14029 Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
14030 Newsgroups is a list of strings in Bnews format.  If you want to score
14031 the comp hierarchy, you'd say \"comp.all\".  If you would not like to
14032 score the alt hierarchy, you'd say \"!alt.all\"."
14033   (interactive)
14034   (let* ((yes-and-no
14035           (gnus-newsrc-parse-options
14036            (apply (function concat)
14037                   (mapcar (lambda (g) (concat g " "))
14038                           command-line-args-left))))
14039          (gnus-expert-user t)
14040          (nnmail-spool-file nil)
14041          (gnus-use-dribble-file nil)
14042          (yes (car yes-and-no))
14043          (no (cdr yes-and-no))
14044          group newsrc entry
14045          ;; Disable verbose message.
14046          gnus-novice-user gnus-large-newsgroup)
14047     ;; Eat all arguments.
14048     (setq command-line-args-left nil)
14049     ;; Start Gnus.
14050     (gnus)
14051     ;; Apply kills to specified newsgroups in command line arguments.
14052     (setq newsrc (cdr gnus-newsrc-alist))
14053     (while newsrc
14054       (setq group (car (car newsrc)))
14055       (setq entry (gnus-gethash group gnus-newsrc-hashtb))
14056       (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
14057                (and (car entry)
14058                     (or (eq (car entry) t)
14059                         (not (zerop (car entry)))))
14060                (if yes (string-match yes group) t)
14061                (or (null no) (not (string-match no group))))
14062           (progn
14063             (gnus-summary-read-group group nil t nil t)
14064             (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
14065                  (gnus-summary-exit))))
14066       (setq newsrc (cdr newsrc)))
14067     ;; Exit Emacs.
14068     (switch-to-buffer gnus-group-buffer)
14069     (gnus-group-save-newsrc)))
14070
14071 (defun gnus-apply-kill-file ()
14072   "Apply a kill file to the current newsgroup.
14073 Returns the number of articles marked as read."
14074   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
14075           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
14076       (gnus-apply-kill-file-internal)
14077     0))
14078
14079 (defun gnus-kill-save-kill-buffer ()
14080   (save-excursion
14081     (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
14082       (if (get-file-buffer file)
14083           (progn
14084             (set-buffer (get-file-buffer file))
14085             (and (buffer-modified-p) (save-buffer))
14086             (kill-buffer (current-buffer)))))))
14087
14088 (defvar gnus-kill-file-name "KILL"
14089   "Suffix of the kill files.")
14090
14091 (defun gnus-newsgroup-kill-file (newsgroup)
14092   "Return the name of a kill file name for NEWSGROUP.
14093 If NEWSGROUP is nil, return the global kill file name instead."
14094   (cond ((or (null newsgroup)
14095              (string-equal newsgroup ""))
14096          ;; The global KILL file is placed at top of the directory.
14097          (expand-file-name gnus-kill-file-name
14098                            (or gnus-kill-files-directory "~/News")))
14099         ((gnus-use-long-file-name 'not-kill)
14100          ;; Append ".KILL" to newsgroup name.
14101          (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
14102                                    "." gnus-kill-file-name)
14103                            (or gnus-kill-files-directory "~/News")))
14104         (t
14105          ;; Place "KILL" under the hierarchical directory.
14106          (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
14107                                    "/" gnus-kill-file-name)
14108                            (or gnus-kill-files-directory "~/News")))))
14109
14110 \f
14111 ;;;
14112 ;;; Dribble file
14113 ;;;
14114
14115 (defvar gnus-dribble-ignore nil)
14116 (defvar gnus-dribble-eval-file nil)
14117
14118 (defun gnus-dribble-file-name ()
14119   "Return the dribble file for the current .newsrc."
14120   (concat
14121    (if gnus-dribble-directory
14122        (concat (file-name-as-directory gnus-dribble-directory)
14123                (file-name-nondirectory gnus-current-startup-file))
14124      gnus-current-startup-file)
14125    "-dribble"))
14126
14127 (defun gnus-dribble-enter (string)
14128   "Enter STRING into the dribble buffer."
14129   (if (and (not gnus-dribble-ignore)
14130            gnus-dribble-buffer
14131            (buffer-name gnus-dribble-buffer))
14132       (let ((obuf (current-buffer)))
14133         (set-buffer gnus-dribble-buffer)
14134         (insert string "\n")
14135         (set-window-point (get-buffer-window (current-buffer)) (point-max))
14136         (set-buffer obuf))))
14137
14138 (defun gnus-dribble-read-file ()
14139   "Read the dribble file from disk."
14140   (let ((dribble-file (gnus-dribble-file-name)))
14141     (save-excursion
14142       (set-buffer (setq gnus-dribble-buffer
14143                         (get-buffer-create
14144                          (file-name-nondirectory dribble-file))))
14145       (gnus-add-current-to-buffer-list)
14146       (erase-buffer)
14147       (setq buffer-file-name dribble-file)
14148       (auto-save-mode t)
14149       (buffer-disable-undo (current-buffer))
14150       (bury-buffer (current-buffer))
14151       (set-buffer-modified-p nil)
14152       (let ((auto (make-auto-save-file-name))
14153             (gnus-dribble-ignore t))
14154         (when (or (file-exists-p auto) (file-exists-p dribble-file))
14155           ;; Load whichever file is newest -- the auto save file
14156           ;; or the "real" file.
14157           (if (file-newer-than-file-p auto dribble-file)
14158               (insert-file-contents auto)
14159             (insert-file-contents dribble-file))
14160           (unless (zerop (buffer-size))
14161             (set-buffer-modified-p t))
14162           ;; Set the file modes to reflect the .newsrc file modes.
14163           (save-buffer)
14164           (when (file-exists-p gnus-current-startup-file)
14165             (set-file-modes dribble-file
14166                             (file-modes gnus-current-startup-file)))
14167           ;; Possibly eval the file later.
14168           (when (gnus-y-or-n-p
14169                  "Auto-save file exists.  Do you want to read it? ")
14170             (setq gnus-dribble-eval-file t)))))))
14171
14172 (defun gnus-dribble-eval-file ()
14173   (if (not gnus-dribble-eval-file)
14174       ()
14175     (setq gnus-dribble-eval-file nil)
14176     (save-excursion
14177       (let ((gnus-dribble-ignore t))
14178         (set-buffer gnus-dribble-buffer)
14179         (eval-buffer (current-buffer))))))
14180
14181 (defun gnus-dribble-delete-file ()
14182   (if (file-exists-p (gnus-dribble-file-name))
14183       (delete-file (gnus-dribble-file-name)))
14184   (if gnus-dribble-buffer
14185       (save-excursion
14186         (set-buffer gnus-dribble-buffer)
14187         (let ((auto (make-auto-save-file-name)))
14188           (if (file-exists-p auto)
14189               (delete-file auto))
14190           (erase-buffer)
14191           (set-buffer-modified-p nil)))))
14192
14193 (defun gnus-dribble-save ()
14194   (if (and gnus-dribble-buffer
14195            (buffer-name gnus-dribble-buffer))
14196       (save-excursion
14197         (set-buffer gnus-dribble-buffer)
14198         (save-buffer))))
14199
14200 (defun gnus-dribble-clear ()
14201   (save-excursion
14202     (if (gnus-buffer-exists-p gnus-dribble-buffer)
14203         (progn
14204           (set-buffer gnus-dribble-buffer)
14205           (erase-buffer)
14206           (set-buffer-modified-p nil)
14207           (setq buffer-saved-size (buffer-size))))))
14208
14209 ;;;
14210 ;;; Server Communication
14211 ;;;
14212
14213 (defun gnus-start-news-server (&optional confirm)
14214   "Open a method for getting news.
14215 If CONFIRM is non-nil, the user will be asked for an NNTP server."
14216   (let (how)
14217     (if gnus-current-select-method
14218         ;; Stream is already opened.
14219         nil
14220       ;; Open NNTP server.
14221       (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
14222       (if confirm
14223           (progn
14224             ;; Read server name with completion.
14225             (setq gnus-nntp-server
14226                   (completing-read "NNTP server: "
14227                                    (mapcar (lambda (server) (list server))
14228                                            (cons (list gnus-nntp-server)
14229                                                  gnus-secondary-servers))
14230                                    nil nil gnus-nntp-server))))
14231
14232       (if (and gnus-nntp-server
14233                (stringp gnus-nntp-server)
14234                (not (string= gnus-nntp-server "")))
14235           (setq gnus-select-method
14236                 (cond ((or (string= gnus-nntp-server "")
14237                            (string= gnus-nntp-server "::"))
14238                        (list 'nnspool (system-name)))
14239                       ((string-match "^:" gnus-nntp-server)
14240                        (list 'nnmh gnus-nntp-server
14241                              (list 'nnmh-directory
14242                                    (file-name-as-directory
14243                                     (expand-file-name
14244                                      (concat "~/" (substring
14245                                                    gnus-nntp-server 1)))))
14246                              (list 'nnmh-get-new-mail nil)))
14247                       (t
14248                        (list 'nntp gnus-nntp-server)))))
14249
14250       (setq how (car gnus-select-method))
14251       (cond ((eq how 'nnspool)
14252              (require 'nnspool)
14253              (gnus-message 5 "Looking up local news spool..."))
14254             ((eq how 'nnmh)
14255              (require 'nnmh)
14256              (gnus-message 5 "Looking up mh spool..."))
14257             (t
14258              (require 'nntp)))
14259       (setq gnus-current-select-method gnus-select-method)
14260       (run-hooks 'gnus-open-server-hook)
14261       (or
14262        ;; gnus-open-server-hook might have opened it
14263        (gnus-server-opened gnus-select-method)
14264        (gnus-open-server gnus-select-method)
14265        (gnus-y-or-n-p
14266         (format
14267          "%s (%s) open error: '%s'.     Continue? "
14268          (car gnus-select-method) (cadr gnus-select-method)
14269          (gnus-status-message gnus-select-method)))
14270        (progn
14271          (gnus-message 1 "Couldn't open server on %s"
14272                        (nth 1 gnus-select-method))
14273          (ding)
14274          nil)))))
14275
14276 (defun gnus-check-group (group)
14277   "Try to make sure that the server where GROUP exists is alive."
14278   (let ((method (gnus-find-method-for-group group)))
14279     (or (gnus-server-opened method)
14280         (gnus-open-server method))))
14281
14282 (defun gnus-check-server (&optional method)
14283   "Check whether the connection to METHOD is down.
14284 If METHOD is nil, use `gnus-select-method'.
14285 If it is down, start it up (again)."
14286   (let ((method (or method gnus-select-method)))
14287     ;; Transform virtual server names into select methods.
14288     (when (stringp method)
14289       (setq method (gnus-server-to-method method)))
14290     (if (gnus-server-opened method)
14291         ;; The stream is already opened.
14292         t
14293       ;; Open the server.
14294       (gnus-message 5 "Opening %s server on %s..." (car method) (nth 1 method))
14295       (run-hooks 'gnus-open-server-hook)
14296       (prog1
14297           (gnus-open-server method)
14298         (message "")))))
14299
14300 (defun gnus-get-function (method function)
14301   "Return a function symbol based on METHOD and FUNCTION."
14302   ;; Translate server names into methods.
14303   (unless method
14304     (error "Attempted use of a nil select method"))
14305   (when (stringp method)
14306     (setq method (gnus-server-to-method method)))
14307   (let ((func (intern (format "%s-%s" (car method) function))))
14308     ;; If the functions isn't bound, we require the backend in
14309     ;; question.
14310     (unless (fboundp func)
14311       (require (car method))
14312       (unless (fboundp func)
14313         ;; This backend doesn't implement this function.
14314         (error "No such function: %s" func)))
14315     func))
14316
14317 ;;; Interface functions to the backends.
14318
14319 (defun gnus-open-server (method)
14320   "Open a connection to METHOD."
14321   (let ((elem (assoc method gnus-opened-servers)))
14322     ;; If this method was previously denied, we just return nil.
14323     (if (eq (nth 1 elem) 'denied)
14324         (progn
14325           (gnus-message 1 "Denied server")
14326           nil)
14327       ;; Open the server.
14328       (let ((result
14329              (funcall (gnus-get-function method 'open-server)
14330                       (nth 1 method) (nthcdr 2 method))))
14331         ;; If this hasn't been opened before, we add it to the list.
14332         (unless elem
14333           (setq elem (list method nil)
14334                 gnus-opened-servers (cons elem gnus-opened-servers)))
14335         ;; Set the status of this server.
14336         (setcar (cdr elem) (if result 'ok 'denied))
14337         ;; Return the result from the "open" call.
14338         result))))
14339
14340 (defun gnus-close-server (method)
14341   "Close the connection to METHOD."
14342   (funcall (gnus-get-function method 'close-server) (nth 1 method)))
14343
14344 (defun gnus-request-list (method)
14345   "Request the active file from METHOD."
14346   (funcall (gnus-get-function method 'request-list) (nth 1 method)))
14347
14348 (defun gnus-request-list-newsgroups (method)
14349   "Request the newsgroups file from METHOD."
14350   (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
14351
14352 (defun gnus-request-newgroups (date method)
14353   "Request all new groups since DATE from METHOD."
14354   (funcall (gnus-get-function method 'request-newgroups)
14355            date (nth 1 method)))
14356
14357 (defun gnus-server-opened (method)
14358   "Check whether a connection to METHOD has been opened."
14359   (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
14360
14361 (defun gnus-status-message (method)
14362   "Return the status message from METHOD.
14363 If METHOD is a string, it is interpreted as a group name.   The method
14364 this group uses will be queried."
14365   (let ((method (if (stringp method) (gnus-find-method-for-group method)
14366                   method)))
14367     (funcall (gnus-get-function method 'status-message) (nth 1 method))))
14368
14369 (defun gnus-request-group (group &optional dont-check method)
14370   "Request GROUP.  If DONT-CHECK, no information is required."
14371   (let ((method (or method (gnus-find-method-for-group group))))
14372     (funcall (gnus-get-function method 'request-group)
14373              (gnus-group-real-name group) (nth 1 method) dont-check)))
14374
14375 (defun gnus-request-asynchronous (group &optional articles)
14376   "Request that GROUP behave asynchronously.
14377 ARTICLES is the `data' of the group."
14378   (let ((method (gnus-find-method-for-group group)))
14379     (funcall (gnus-get-function method 'request-asynchronous)
14380              (gnus-group-real-name group) (nth 1 method) articles)))
14381
14382 (defun gnus-list-active-group (group)
14383   "Request active information on GROUP."
14384   (let ((method (gnus-find-method-for-group group))
14385         (func 'list-active-group))
14386     (when (gnus-check-backend-function func group)
14387       (funcall (gnus-get-function method func)
14388                (gnus-group-real-name group) (nth 1 method)))))
14389
14390 (defun gnus-request-group-description (group)
14391   "Request a description of GROUP."
14392   (let ((method (gnus-find-method-for-group group))
14393         (func 'request-group-description))
14394     (when (gnus-check-backend-function func group)
14395       (funcall (gnus-get-function method func)
14396                (gnus-group-real-name group) (nth 1 method)))))
14397
14398 (defun gnus-close-group (group)
14399   "Request the GROUP be closed."
14400   (let ((method (gnus-find-method-for-group group)))
14401     (funcall (gnus-get-function method 'close-group)
14402              (gnus-group-real-name group) (nth 1 method))))
14403
14404 (defun gnus-retrieve-headers (articles group &optional fetch-old)
14405   "Request headers for ARTICLES in GROUP.
14406 If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
14407   (let ((method (gnus-find-method-for-group group)))
14408     (if (and gnus-use-cache (numberp (car articles)))
14409         (gnus-cache-retrieve-headers articles group fetch-old)
14410       (funcall (gnus-get-function method 'retrieve-headers)
14411                articles (gnus-group-real-name group) (nth 1 method)
14412                fetch-old))))
14413
14414 (defun gnus-retrieve-groups (groups method)
14415   "Request active information on GROUPS from METHOD."
14416   (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
14417
14418 (defun gnus-request-type (group &optional article)
14419   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
14420   (let ((method (gnus-find-method-for-group group)))
14421     (if (not (gnus-check-backend-function 'request-type (car method)))
14422         'unknown
14423       (funcall (gnus-get-function method 'request-type)
14424                (gnus-group-real-name group) article))))
14425
14426 (defun gnus-request-update-mark (group article mark)
14427   "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
14428   (let ((method (gnus-find-method-for-group group)))
14429     (if (not (gnus-check-backend-function 'request-update-mark (car method)))
14430         mark
14431       (funcall (gnus-get-function method 'request-update-mark)
14432                (gnus-group-real-name group) article mark))))
14433
14434 (defun gnus-request-article (article group &optional buffer)
14435   "Request the ARTICLE in GROUP.
14436 ARTICLE can either be an article number or an article Message-ID.
14437 If BUFFER, insert the article in that group."
14438   (let ((method (gnus-find-method-for-group group)))
14439     (funcall (gnus-get-function method 'request-article)
14440              article (gnus-group-real-name group) (nth 1 method) buffer)))
14441
14442 (defun gnus-request-head (article group)
14443   "Request the head of ARTICLE in GROUP."
14444   (let ((method (gnus-find-method-for-group group)))
14445     (funcall (gnus-get-function method 'request-head)
14446              article (gnus-group-real-name group) (nth 1 method))))
14447
14448 (defun gnus-request-body (article group)
14449   "Request the body of ARTICLE in GROUP."
14450   (let ((method (gnus-find-method-for-group group)))
14451     (funcall (gnus-get-function method 'request-body)
14452              article (gnus-group-real-name group) (nth 1 method))))
14453
14454 (defun gnus-request-post (method)
14455   "Post the current buffer using METHOD."
14456   (funcall (gnus-get-function method 'request-post) (nth 1 method)))
14457
14458 (defun gnus-request-scan (group method)
14459   "Request a SCAN being performed in GROUP from METHOD.
14460 If GROUP is nil, all groups on METHOD are scanned."
14461   (let ((method (if group (gnus-find-method-for-group group) method)))
14462     (funcall (gnus-get-function method 'request-scan)
14463              (and group (gnus-group-real-name group)) (nth 1 method))))
14464
14465 (defsubst gnus-request-update-info (info method)
14466   "Request that METHOD update INFO."
14467   (when (gnus-check-backend-function 'request-update-info (car method))
14468     (funcall (gnus-get-function method 'request-update-info)
14469              (gnus-group-real-name (gnus-info-group info))
14470              info (nth 1 method))))
14471
14472 (defun gnus-request-expire-articles (articles group &optional force)
14473   (let ((method (gnus-find-method-for-group group)))
14474     (funcall (gnus-get-function method 'request-expire-articles)
14475              articles (gnus-group-real-name group) (nth 1 method)
14476              force)))
14477
14478 (defun gnus-request-move-article
14479   (article group server accept-function &optional last)
14480   (let ((method (gnus-find-method-for-group group)))
14481     (funcall (gnus-get-function method 'request-move-article)
14482              article (gnus-group-real-name group)
14483              (nth 1 method) accept-function last)))
14484
14485 (defun gnus-request-accept-article (group &optional last method)
14486   ;; Make sure there's a newline at the end of the article.
14487   (goto-char (point-max))
14488   (unless (bolp)
14489     (insert "\n"))
14490   (let ((func (if (symbolp group) group
14491                 (car (or method (gnus-find-method-for-group group))))))
14492     (funcall (intern (format "%s-request-accept-article" func))
14493              (if (stringp group) (gnus-group-real-name group) group)
14494              last)))
14495
14496 (defun gnus-request-replace-article (article group buffer)
14497   (let ((func (car (gnus-find-method-for-group group))))
14498     (funcall (intern (format "%s-request-replace-article" func))
14499              article (gnus-group-real-name group) buffer)))
14500
14501 (defun gnus-request-associate-buffer (group)
14502   (let ((method (gnus-find-method-for-group group)))
14503     (funcall (gnus-get-function method 'request-associate-buffer)
14504              (gnus-group-real-name group))))
14505
14506 (defun gnus-request-restore-buffer (article group)
14507   "Request a new buffer restored to the state of ARTICLE."
14508   (let ((method (gnus-find-method-for-group group)))
14509     (funcall (gnus-get-function method 'request-restore-buffer)
14510              article (gnus-group-real-name group) (nth 1 method))))
14511
14512 (defun gnus-request-create-group (group &optional method)
14513   (let ((method (or method (gnus-find-method-for-group group))))
14514     (funcall (gnus-get-function method 'request-create-group)
14515              (gnus-group-real-name group) (nth 1 method))))
14516
14517 (defun gnus-request-delete-group (group &optional force)
14518   (let ((method (gnus-find-method-for-group group)))
14519     (funcall (gnus-get-function method 'request-delete-group)
14520              (gnus-group-real-name group) force (nth 1 method))))
14521
14522 (defun gnus-request-rename-group (group new-name)
14523   (let ((method (gnus-find-method-for-group group)))
14524     (funcall (gnus-get-function method 'request-rename-group)
14525              (gnus-group-real-name group)
14526              (gnus-group-real-name new-name) (nth 1 method))))
14527
14528 (defun gnus-member-of-valid (symbol group)
14529   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
14530   (memq symbol (assoc
14531                 (symbol-name (car (gnus-find-method-for-group group)))
14532                 gnus-valid-select-methods)))
14533
14534 (defun gnus-method-option-p (method option)
14535   "Return non-nil if select METHOD has OPTION as a parameter."
14536   (memq option (assoc (format "%s" (car method))
14537                       gnus-valid-select-methods)))
14538
14539 (defun gnus-server-extend-method (group method)
14540   ;; This function "extends" a virtual server.  If the server is
14541   ;; "hello", and the select method is ("hello" (my-var "something"))
14542   ;; in the group "alt.alt", this will result in a new virtual server
14543   ;; called "hello+alt.alt".
14544   (let ((entry
14545          (gnus-copy-sequence
14546           (if (equal (car method) "native") gnus-select-method
14547             (cdr (assoc (car method) gnus-server-alist))))))
14548     (setcar (cdr entry) (concat (nth 1 entry) "+" group))
14549     (nconc entry (cdr method))))
14550
14551 (defun gnus-find-method-for-group (group &optional info)
14552   "Find the select method that GROUP uses."
14553   (or gnus-override-method
14554       (and (not group)
14555            gnus-select-method)
14556       (let ((info (or info (gnus-get-info group)))
14557             method)
14558         (if (or (not info)
14559                 (not (setq method (gnus-info-method info))))
14560             (setq method gnus-select-method)
14561           (setq method
14562                 (cond ((stringp method)
14563                        (gnus-server-to-method method))
14564                       ((stringp (car method))
14565                        (gnus-server-extend-method group method))
14566                       (t
14567                        method))))
14568         (gnus-server-add-address method))))
14569
14570 (defun gnus-check-backend-function (func group)
14571   "Check whether GROUP supports function FUNC."
14572   (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
14573                   group)))
14574     (fboundp (intern (format "%s-%s" method func)))))
14575
14576 (defun gnus-methods-using (feature)
14577   "Find all methods that have FEATURE."
14578   (let ((valids gnus-valid-select-methods)
14579         outs)
14580     (while valids
14581       (if (memq feature (car valids))
14582           (setq outs (cons (car valids) outs)))
14583       (setq valids (cdr valids)))
14584     outs))
14585
14586 ;;;
14587 ;;; Active & Newsrc File Handling
14588 ;;;
14589
14590 (defun gnus-setup-news (&optional rawfile level)
14591   "Setup news information.
14592 If RAWFILE is non-nil, the .newsrc file will also be read.
14593 If LEVEL is non-nil, the news will be set up at level LEVEL."
14594   (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
14595     ;; Clear some variables to re-initialize news information.
14596     (if init (setq gnus-newsrc-alist nil
14597                    gnus-active-hashtb nil))
14598
14599     ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
14600     (if init (gnus-read-newsrc-file rawfile))
14601
14602     ;; If we don't read the complete active file, we fill in the
14603     ;; hashtb here.
14604     (if (or (null gnus-read-active-file)
14605             (eq gnus-read-active-file 'some))
14606         (gnus-update-active-hashtb-from-killed))
14607
14608     ;; Read the active file and create `gnus-active-hashtb'.
14609     ;; If `gnus-read-active-file' is nil, then we just create an empty
14610     ;; hash table.  The partial filling out of the hash table will be
14611     ;; done in `gnus-get-unread-articles'.
14612     (and gnus-read-active-file
14613          (not level)
14614          (gnus-read-active-file))
14615
14616     (or gnus-active-hashtb
14617         (setq gnus-active-hashtb (make-vector 4095 0)))
14618
14619     ;; Initialize the cache.
14620     (when gnus-use-cache
14621       (gnus-cache-open))
14622
14623     ;; Possibly eval the dribble file.
14624     (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
14625
14626     (gnus-update-format-specifications)
14627
14628     ;; Find new newsgroups and treat them.
14629     (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level)
14630              (gnus-check-server gnus-select-method))
14631         (gnus-find-new-newsgroups))
14632
14633     ;; Find the number of unread articles in each non-dead group.
14634     (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
14635       (gnus-get-unread-articles level))
14636
14637     (if (and init gnus-check-bogus-newsgroups
14638              gnus-read-active-file (not level)
14639              (gnus-server-opened gnus-select-method))
14640         (gnus-check-bogus-newsgroups))))
14641
14642 (defun gnus-find-new-newsgroups (&optional arg)
14643   "Search for new newsgroups and add them.
14644 Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
14645 The `-n' option line from .newsrc is respected.
14646 If ARG (the prefix), use the `ask-server' method to query
14647 the server for new groups."
14648   (interactive "P")
14649   (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups)))
14650                        (null gnus-read-active-file)
14651                        (eq gnus-read-active-file 'some))
14652                    'ask-server gnus-check-new-newsgroups)))
14653     (unless (gnus-check-first-time-used)
14654       (if (or (consp check)
14655               (eq check 'ask-server))
14656           (gnus-ask-server-for-new-groups)
14657         (let ((groups 0)
14658               group new-newsgroups)
14659           (gnus-message 5 "Looking for new newsgroups...")
14660           (or gnus-have-read-active-file (gnus-read-active-file))
14661           (setq gnus-newsrc-last-checked-date (current-time-string))
14662           (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed))
14663           ;; Go though every newsgroup in `gnus-active-hashtb' and compare
14664           ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
14665           (mapatoms
14666            (lambda (sym)
14667              (if (or (null (setq group (symbol-name sym)))
14668                      (not (boundp sym))
14669                      (null (symbol-value sym))
14670                      (gnus-gethash group gnus-killed-hashtb)
14671                      (gnus-gethash group gnus-newsrc-hashtb))
14672                  ()
14673                (let ((do-sub (gnus-matches-options-n group)))
14674                  (cond
14675                   ((eq do-sub 'subscribe)
14676                    (setq groups (1+ groups))
14677                    (gnus-sethash group group gnus-killed-hashtb)
14678                    (funcall gnus-subscribe-options-newsgroup-method group))
14679                   ((eq do-sub 'ignore)
14680                    nil)
14681                   (t
14682                    (setq groups (1+ groups))
14683                    (gnus-sethash group group gnus-killed-hashtb)
14684                    (if gnus-subscribe-hierarchical-interactive
14685                        (setq new-newsgroups (cons group new-newsgroups))
14686                      (funcall gnus-subscribe-newsgroup-method group)))))))
14687            gnus-active-hashtb)
14688           (if new-newsgroups
14689               (gnus-subscribe-hierarchical-interactive new-newsgroups))
14690           ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
14691           (if (> groups 0)
14692               (gnus-message 6 "%d new newsgroup%s arrived."
14693                             groups (if (> groups 1) "s have" " has"))
14694             (gnus-message 6 "No new newsgroups.")))))))
14695
14696 (defun gnus-matches-options-n (group)
14697   ;; Returns `subscribe' if the group is to be unconditionally
14698   ;; subscribed, `ignore' if it is to be ignored, and nil if there is
14699   ;; no match for the group.
14700
14701   ;; First we check the two user variables.
14702   (cond
14703    ((and gnus-options-subscribe
14704          (string-match gnus-options-subscribe group))
14705     'subscribe)
14706    ((and gnus-auto-subscribed-groups
14707          (string-match gnus-auto-subscribed-groups group))
14708     'subscribe)
14709    ((and gnus-options-not-subscribe
14710          (string-match gnus-options-not-subscribe group))
14711     'ignore)
14712    ;; Then we go through the list that was retrieved from the .newsrc
14713    ;; file.  This list has elements on the form
14714    ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
14715    ;; is in the reverse order of the options line) is returned.
14716    (t
14717     (let ((regs gnus-newsrc-options-n))
14718       (while (and regs
14719                   (not (string-match (car (car regs)) group)))
14720         (setq regs (cdr regs)))
14721       (and regs (cdr (car regs)))))))
14722
14723 (defun gnus-ask-server-for-new-groups ()
14724   (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
14725          (methods (cons gnus-select-method
14726                         (cons
14727                          gnus-message-archive-method
14728                          (append
14729                           (and (consp gnus-check-new-newsgroups)
14730                                gnus-check-new-newsgroups)
14731                           gnus-secondary-select-methods))))
14732          (groups 0)
14733          (new-date (current-time-string))
14734          group new-newsgroups got-new method hashtb
14735          gnus-override-subscribe-method)
14736     ;; Go through both primary and secondary select methods and
14737     ;; request new newsgroups.
14738     (while (setq method (gnus-server-get-method nil (pop methods)))
14739       (setq gnus-override-subscribe-method method)
14740       (when (and (gnus-check-server method)
14741                  (gnus-request-newgroups date method))
14742         (save-excursion
14743           (setq got-new t)
14744           (setq hashtb (gnus-make-hashtable 100))
14745           (set-buffer nntp-server-buffer)
14746           ;; Enter all the new groups into a hashtable.
14747           (gnus-active-to-gnus-format method hashtb 'ignore)))
14748       ;; Now all new groups from `method' are in `hashtb'.
14749       (mapatoms
14750        (lambda (group-sym)
14751          (if (or (null (setq group (symbol-name group-sym)))
14752                  (null (symbol-value group-sym))
14753                  (gnus-gethash group gnus-newsrc-hashtb)
14754                  (member group gnus-zombie-list)
14755                  (member group gnus-killed-list))
14756              ;; The group is already known.
14757              ()
14758            ;; Make this group active.
14759            (when (symbol-value group-sym)
14760              (gnus-set-active group (symbol-value group-sym)))
14761            ;; Check whether we want it or not.
14762            (let ((do-sub (gnus-matches-options-n group)))
14763              (cond
14764               ((eq do-sub 'subscribe)
14765                (incf groups)
14766                (gnus-sethash group group gnus-killed-hashtb)
14767                (funcall gnus-subscribe-options-newsgroup-method group))
14768               ((eq do-sub 'ignore)
14769                nil)
14770               (t
14771                (incf groups)
14772                (gnus-sethash group group gnus-killed-hashtb)
14773                (if gnus-subscribe-hierarchical-interactive
14774                    (push group new-newsgroups)
14775                  (funcall gnus-subscribe-newsgroup-method group)))))))
14776        hashtb)
14777       (when new-newsgroups
14778         (gnus-subscribe-hierarchical-interactive new-newsgroups)))
14779     ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
14780     (when (> groups 0)
14781       (gnus-message 6 "%d new newsgroup%s arrived."
14782                     groups (if (> groups 1) "s have" " has")))
14783     (and got-new (setq gnus-newsrc-last-checked-date new-date))
14784     got-new))
14785
14786 (defun gnus-check-first-time-used ()
14787   (if (or (> (length gnus-newsrc-alist) 1)
14788           (file-exists-p gnus-startup-file)
14789           (file-exists-p (concat gnus-startup-file ".el"))
14790           (file-exists-p (concat gnus-startup-file ".eld")))
14791       nil
14792     (gnus-message 6 "First time user; subscribing you to default groups")
14793     (or gnus-have-read-active-file (gnus-read-active-file))
14794     (setq gnus-newsrc-last-checked-date (current-time-string))
14795     (let ((groups gnus-default-subscribed-newsgroups)
14796           group)
14797       (if (eq groups t)
14798           nil
14799         (setq groups (or groups gnus-backup-default-subscribed-newsgroups))
14800         (mapatoms
14801          (lambda (sym)
14802            (if (null (setq group (symbol-name sym)))
14803                ()
14804              (let ((do-sub (gnus-matches-options-n group)))
14805                (cond
14806                 ((eq do-sub 'subscribe)
14807                  (gnus-sethash group group gnus-killed-hashtb)
14808                  (funcall gnus-subscribe-options-newsgroup-method group))
14809                 ((eq do-sub 'ignore)
14810                  nil)
14811                 (t
14812                  (setq gnus-killed-list (cons group gnus-killed-list)))))))
14813          gnus-active-hashtb)
14814         (while groups
14815           (if (gnus-active (car groups))
14816               (gnus-group-change-level
14817                (car groups) gnus-level-default-subscribed gnus-level-killed))
14818           (setq groups (cdr groups)))
14819         (gnus-group-make-help-group)
14820         (and gnus-novice-user
14821              (gnus-message 7 "`A k' to list killed groups"))))))
14822
14823 (defun gnus-subscribe-group (group previous &optional method)
14824   (gnus-group-change-level
14825    (if method
14826        (list t group gnus-level-default-subscribed nil nil method)
14827      group)
14828    gnus-level-default-subscribed gnus-level-killed previous t))
14829
14830 ;; `gnus-group-change-level' is the fundamental function for changing
14831 ;; subscription levels of newsgroups.  This might mean just changing
14832 ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
14833 ;; again, which subscribes/unsubscribes a group, which is equally
14834 ;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
14835 ;; from 8-9 to 1-7 means that you remove the group from the list of
14836 ;; killed (or zombie) groups and add them to the (kinda) subscribed
14837 ;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
14838 ;; which is trivial.
14839 ;; ENTRY can either be a string (newsgroup name) or a list (if
14840 ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
14841 ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
14842 ;; entries.
14843 ;; LEVEL is the new level of the group, OLDLEVEL is the old level and
14844 ;; PREVIOUS is the group (in hashtb entry format) to insert this group
14845 ;; after.
14846 (defun gnus-group-change-level (entry level &optional oldlevel
14847                                       previous fromkilled)
14848   (let (group info active num)
14849     ;; Glean what info we can from the arguments
14850     (if (consp entry)
14851         (if fromkilled (setq group (nth 1 entry))
14852           (setq group (car (nth 2 entry))))
14853       (setq group entry))
14854     (if (and (stringp entry)
14855              oldlevel
14856              (< oldlevel gnus-level-zombie))
14857         (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
14858     (if (and (not oldlevel)
14859              (consp entry))
14860         (setq oldlevel (car (cdr (nth 2 entry)))))
14861     (if (stringp previous)
14862         (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
14863
14864     (if (and (>= oldlevel gnus-level-zombie)
14865              (gnus-gethash group gnus-newsrc-hashtb))
14866         ;; We are trying to subscribe a group that is already
14867         ;; subscribed.
14868         ()                              ; Do nothing.
14869
14870       (or (gnus-ephemeral-group-p group)
14871           (gnus-dribble-enter
14872            (format "(gnus-group-change-level %S %S %S %S %S)"
14873                    group level oldlevel (car (nth 2 previous)) fromkilled)))
14874
14875       ;; Then we remove the newgroup from any old structures, if needed.
14876       ;; If the group was killed, we remove it from the killed or zombie
14877       ;; list.  If not, and it is in fact going to be killed, we remove
14878       ;; it from the newsrc hash table and assoc.
14879       (cond ((>= oldlevel gnus-level-zombie)
14880              (if (= oldlevel gnus-level-zombie)
14881                  (setq gnus-zombie-list (delete group gnus-zombie-list))
14882                (setq gnus-killed-list (delete group gnus-killed-list))))
14883             (t
14884              (if (and (>= level gnus-level-zombie)
14885                       entry)
14886                  (progn
14887                    (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
14888                    (if (nth 3 entry)
14889                        (setcdr (gnus-gethash (car (nth 3 entry))
14890                                              gnus-newsrc-hashtb)
14891                                (cdr entry)))
14892                    (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
14893
14894       ;; Finally we enter (if needed) the list where it is supposed to
14895       ;; go, and change the subscription level.  If it is to be killed,
14896       ;; we enter it into the killed or zombie list.
14897       (cond ((>= level gnus-level-zombie)
14898              ;; Remove from the hash table.
14899              (gnus-sethash group nil gnus-newsrc-hashtb)
14900              ;; We do not enter foreign groups into the list of dead
14901              ;; groups.
14902              (unless (gnus-group-foreign-p group)
14903                (if (= level gnus-level-zombie)
14904                    (setq gnus-zombie-list (cons group gnus-zombie-list))
14905                  (setq gnus-killed-list (cons group gnus-killed-list)))))
14906             (t
14907              ;; If the list is to be entered into the newsrc assoc, and
14908              ;; it was killed, we have to create an entry in the newsrc
14909              ;; hashtb format and fix the pointers in the newsrc assoc.
14910              (if (>= oldlevel gnus-level-zombie)
14911                  (progn
14912                    (if (listp entry)
14913                        (progn
14914                          (setq info (cdr entry))
14915                          (setq num (car entry)))
14916                      (setq active (gnus-active group))
14917                      (setq num
14918                            (if active (- (1+ (cdr active)) (car active)) t))
14919                      ;; Check whether the group is foreign.  If so, the
14920                      ;; foreign select method has to be entered into the
14921                      ;; info.
14922                      (let ((method (or gnus-override-subscribe-method
14923                                        (gnus-group-method-name group))))
14924                        (if (eq method gnus-select-method)
14925                            (setq info (list group level nil))
14926                          (setq info (list group level nil nil method)))))
14927                    (or previous
14928                        (setq previous
14929                              (let ((p gnus-newsrc-alist))
14930                                (while (cdr (cdr p))
14931                                  (setq p (cdr p)))
14932                                p)))
14933                    (setq entry (cons info (cdr (cdr previous))))
14934                    (if (cdr previous)
14935                        (progn
14936                          (setcdr (cdr previous) entry)
14937                          (gnus-sethash group (cons num (cdr previous))
14938                                        gnus-newsrc-hashtb))
14939                      (setcdr previous entry)
14940                      (gnus-sethash group (cons num previous)
14941                                    gnus-newsrc-hashtb))
14942                    (if (cdr entry)
14943                        (setcdr (gnus-gethash (car (car (cdr entry)))
14944                                              gnus-newsrc-hashtb)
14945                                entry)))
14946                ;; It was alive, and it is going to stay alive, so we
14947                ;; just change the level and don't change any pointers or
14948                ;; hash table entries.
14949                (setcar (cdr (car (cdr (cdr entry)))) level))))
14950       (when gnus-group-change-level-function
14951         (funcall gnus-group-change-level-function group level oldlevel)))))
14952
14953 (defun gnus-kill-newsgroup (newsgroup)
14954   "Obsolete function.  Kills a newsgroup."
14955   (gnus-group-change-level
14956    (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
14957
14958 (defun gnus-check-bogus-newsgroups (&optional confirm)
14959   "Remove bogus newsgroups.
14960 If CONFIRM is non-nil, the user has to confirm the deletion of every
14961 newsgroup."
14962   (let ((newsrc (cdr gnus-newsrc-alist))
14963         bogus group entry info)
14964     (gnus-message 5 "Checking bogus newsgroups...")
14965     (unless gnus-have-read-active-file
14966       (gnus-read-active-file))
14967     (when (member gnus-select-method gnus-have-read-active-file)
14968       ;; Find all bogus newsgroup that are subscribed.
14969       (while newsrc
14970         (setq info (pop newsrc)
14971               group (gnus-info-group info))
14972         (unless (or (gnus-active group) ; Active
14973                     (gnus-info-method info) ; Foreign
14974                     (and confirm
14975                          (not (gnus-y-or-n-p
14976                                (format "Remove bogus newsgroup: %s " group)))))
14977           ;; Found a bogus newsgroup.
14978           (push group bogus)))
14979       ;; Remove all bogus subscribed groups by first killing them, and
14980       ;; then removing them from the list of killed groups.
14981       (while bogus
14982         (when (setq entry (gnus-gethash (setq group (pop bogus))
14983                                         gnus-newsrc-hashtb))
14984           (gnus-group-change-level entry gnus-level-killed)
14985           (setq gnus-killed-list (delete group gnus-killed-list))))
14986       ;; Then we remove all bogus groups from the list of killed and
14987       ;; zombie groups.  They are are removed without confirmation.
14988       (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
14989             killed)
14990         (while dead-lists
14991           (setq killed (symbol-value (car dead-lists)))
14992           (while killed
14993             (unless (gnus-active (setq group (pop killed)))
14994               ;; The group is bogus.
14995               ;; !!!Slow as hell.
14996               (set (car dead-lists)
14997                    (delete group (symbol-value (car dead-lists))))))
14998           (setq dead-lists (cdr dead-lists))))
14999       (gnus-message 5 "Checking bogus newsgroups...done"))))
15000
15001 (defun gnus-check-duplicate-killed-groups ()
15002   "Remove duplicates from the list of killed groups."
15003   (interactive)
15004   (let ((killed gnus-killed-list))
15005     (while killed
15006       (gnus-message 9 "%d" (length killed))
15007       (setcdr killed (delete (car killed) (cdr killed)))
15008       (setq killed (cdr killed)))))
15009
15010 ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
15011 ;; and compute how many unread articles there are in each group.
15012 (defun gnus-get-unread-articles (&optional level)
15013   (let* ((newsrc (cdr gnus-newsrc-alist))
15014          (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
15015          (foreign-level
15016           (min
15017            (cond ((and gnus-activate-foreign-newsgroups
15018                        (not (numberp gnus-activate-foreign-newsgroups)))
15019                   (1+ gnus-level-subscribed))
15020                  ((numberp gnus-activate-foreign-newsgroups)
15021                   gnus-activate-foreign-newsgroups)
15022                  (t 0))
15023            level))
15024          info group active virtuals method fmethod)
15025     (gnus-message 5 "Checking new news...")
15026
15027     (while newsrc
15028       (setq info (car newsrc)
15029             group (gnus-info-group info)
15030             active (gnus-active group))
15031
15032       ;; Check newsgroups.  If the user doesn't want to check them, or
15033       ;; they can't be checked (for instance, if the news server can't
15034       ;; be reached) we just set the number of unread articles in this
15035       ;; newsgroup to t.  This means that Gnus thinks that there are
15036       ;; unread articles, but it has no idea how many.
15037       (if (and (setq method (gnus-info-method info))
15038                (not (gnus-server-equal
15039                      gnus-select-method
15040                      (setq fmethod (gnus-server-get-method nil method))))
15041                (not (gnus-secondary-method-p method)))
15042           ;; These groups are foreign.  Check the level.
15043           (if (<= (gnus-info-level info) foreign-level)
15044               (setq active (gnus-activate-group (gnus-info-group info) 'scan)))
15045
15046         ;; These groups are native or secondary.
15047         (if (<= (gnus-info-level info) level)
15048             (or gnus-read-active-file
15049                 (setq active (gnus-activate-group
15050                               (gnus-info-group info) 'scan)))))
15051
15052       (if active
15053           (gnus-get-unread-articles-in-group info active t)
15054         ;; The group couldn't be reached, so we nix out the number of
15055         ;; unread articles and stuff.
15056         (gnus-set-active group nil)
15057         (setcar (gnus-gethash group gnus-newsrc-hashtb) t))
15058
15059       (setq newsrc (cdr newsrc)))
15060
15061     (gnus-message 5 "Checking new news...done")))
15062
15063 ;; Create a hash table out of the newsrc alist.  The `car's of the
15064 ;; alist elements are used as keys.
15065 (defun gnus-make-hashtable-from-newsrc-alist ()
15066   (let ((alist gnus-newsrc-alist)
15067         (ohashtb gnus-newsrc-hashtb)
15068         prev)
15069     (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
15070     (setq alist
15071           (setq prev (setq gnus-newsrc-alist
15072                            (if (equal (car (car gnus-newsrc-alist))
15073                                       "dummy.group")
15074                                gnus-newsrc-alist
15075                              (cons (list "dummy.group" 0 nil) alist)))))
15076     (while alist
15077       (gnus-sethash
15078        (car (car alist))
15079        (cons (and ohashtb (car (gnus-gethash (car (car alist)) ohashtb)))
15080              prev)
15081        gnus-newsrc-hashtb)
15082       (setq prev alist
15083             alist (cdr alist)))))
15084
15085 (defun gnus-make-hashtable-from-killed ()
15086   "Create a hash table from the killed and zombie lists."
15087   (let ((lists '(gnus-killed-list gnus-zombie-list))
15088         list)
15089     (setq gnus-killed-hashtb
15090           (gnus-make-hashtable
15091            (+ (length gnus-killed-list) (length gnus-zombie-list))))
15092     (while lists
15093       (setq list (symbol-value (car lists)))
15094       (setq lists (cdr lists))
15095       (while list
15096         (gnus-sethash (car list) (car list) gnus-killed-hashtb)
15097         (setq list (cdr list))))))
15098
15099 (defun gnus-get-unread-articles-in-group (info active &optional update)
15100   ;; Allow the backend to update the info in the group.
15101   (when update
15102     (gnus-request-update-info
15103      info (gnus-find-method-for-group (gnus-info-group info))))
15104   (let* ((range (gnus-info-read info))
15105          (num 0)
15106          (marked (gnus-info-marks info)))
15107     ;; If a cache is present, we may have to alter the active info.
15108     (and gnus-use-cache
15109          (gnus-cache-possibly-alter-active (gnus-info-group info) active))
15110     ;; Modify the list of read articles according to what articles
15111     ;; are available; then tally the unread articles and add the
15112     ;; number to the group hash table entry.
15113     (cond
15114      ((zerop (cdr active))
15115       (setq num 0))
15116      ((not range)
15117       (setq num (- (1+ (cdr active)) (car active))))
15118      ((not (listp (cdr range)))
15119       ;; Fix a single (num . num) range according to the
15120       ;; active hash table.
15121       ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
15122       (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
15123       (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
15124       ;; Compute number of unread articles.
15125       (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
15126      (t
15127       ;; The read list is a list of ranges.  Fix them according to
15128       ;; the active hash table.
15129       ;; First peel off any elements that are below the lower
15130       ;; active limit.
15131       (while (and (cdr range)
15132                   (>= (car active)
15133                       (or (and (atom (car (cdr range))) (car (cdr range)))
15134                           (car (car (cdr range))))))
15135         (if (numberp (car range))
15136             (setcar range
15137                     (cons (car range)
15138                           (or (and (numberp (car (cdr range)))
15139                                    (car (cdr range)))
15140                               (cdr (car (cdr range))))))
15141           (setcdr (car range)
15142                   (or (and (numberp (nth 1 range)) (nth 1 range))
15143                       (cdr (car (cdr range))))))
15144         (setcdr range (cdr (cdr range))))
15145       ;; Adjust the first element to be the same as the lower limit.
15146       (if (and (not (atom (car range)))
15147                (< (cdr (car range)) (car active)))
15148           (setcdr (car range) (1- (car active))))
15149       ;; Then we want to peel off any elements that are higher
15150       ;; than the upper active limit.
15151       (let ((srange range))
15152         ;; Go past all legal elements.
15153         (while (and (cdr srange)
15154                     (<= (or (and (atom (car (cdr srange)))
15155                                  (car (cdr srange)))
15156                             (car (car (cdr srange)))) (cdr active)))
15157           (setq srange (cdr srange)))
15158         (if (cdr srange)
15159             ;; Nuke all remaining illegal elements.
15160             (setcdr srange nil))
15161
15162         ;; Adjust the final element.
15163         (if (and (not (atom (car srange)))
15164                  (> (cdr (car srange)) (cdr active)))
15165             (setcdr (car srange) (cdr active))))
15166       ;; Compute the number of unread articles.
15167       (while range
15168         (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
15169                                     (cdr (car range))))
15170                             (or (and (atom (car range)) (car range))
15171                                 (car (car range))))))
15172         (setq range (cdr range)))
15173       (setq num (max 0 (- (cdr active) num)))))
15174     ;; Set the number of unread articles.
15175     (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)
15176     num))
15177
15178 (defun gnus-activate-group (group &optional scan)
15179   ;; Check whether a group has been activated or not.
15180   ;; If SCAN, request a scan of that group as well.
15181   (let ((method (gnus-find-method-for-group group))
15182         active)
15183     (and (gnus-check-server method)
15184          ;; We escape all bugs and quit here to make it possible to
15185          ;; continue if a group is so out-there that it reports bugs
15186          ;; and stuff.
15187          (progn
15188            (and scan
15189                 (gnus-check-backend-function 'request-scan (car method))
15190                 (gnus-request-scan group method))
15191            t)
15192          (condition-case ()
15193              (gnus-request-group group)
15194         ;   (error nil)
15195            (quit nil))
15196          (save-excursion
15197            (set-buffer nntp-server-buffer)
15198            (goto-char (point-min))
15199            ;; Parse the result we got from `gnus-request-group'.
15200            (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
15201                 (progn
15202                   (goto-char (match-beginning 1))
15203                   (gnus-set-active
15204                    group (setq active (cons (read (current-buffer))
15205                                             (read (current-buffer)))))
15206                   ;; Return the new active info.
15207                   active))))))
15208
15209 (defun gnus-update-read-articles (group unread)
15210   "Update the list of read and ticked articles in GROUP using the
15211 UNREAD and TICKED lists.
15212 Note: UNSELECTED has to be sorted over `<'.
15213 Returns whether the updating was successful."
15214   (let* ((active (or gnus-newsgroup-active (gnus-active group)))
15215          (entry (gnus-gethash group gnus-newsrc-hashtb))
15216          (info (nth 2 entry))
15217          (marked (gnus-info-marks info))
15218          (prev 1)
15219          (unread (sort (copy-sequence unread) '<))
15220          read)
15221     (if (or (not info) (not active))
15222         ;; There is no info on this group if it was, in fact,
15223         ;; killed.  Gnus stores no information on killed groups, so
15224         ;; there's nothing to be done.
15225         ;; One could store the information somewhere temporarily,
15226         ;; perhaps...  Hmmm...
15227         ()
15228       ;; Remove any negative articles numbers.
15229       (while (and unread (< (car unread) 0))
15230         (setq unread (cdr unread)))
15231       ;; Remove any expired article numbers
15232       (while (and unread (< (car unread) (car active)))
15233         (setq unread (cdr unread)))
15234       ;; Compute the ranges of read articles by looking at the list of
15235       ;; unread articles.
15236       (while unread
15237         (if (/= (car unread) prev)
15238             (setq read (cons (if (= prev (1- (car unread))) prev
15239                                (cons prev (1- (car unread)))) read)))
15240         (setq prev (1+ (car unread)))
15241         (setq unread (cdr unread)))
15242       (when (<= prev (cdr active))
15243         (setq read (cons (cons prev (cdr active)) read)))
15244       ;; Enter this list into the group info.
15245       (gnus-info-set-read
15246        info (if (> (length read) 1) (nreverse read) read))
15247       ;; Set the number of unread articles in gnus-newsrc-hashtb.
15248       (gnus-get-unread-articles-in-group info (gnus-active group))
15249       t)))
15250
15251 (defun gnus-make-articles-unread (group articles)
15252   "Mark ARTICLES in GROUP as unread."
15253   (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
15254                           (gnus-gethash (gnus-group-real-name group)
15255                                         gnus-newsrc-hashtb))))
15256          (ranges (gnus-info-read info))
15257          news article)
15258     (while articles
15259       (when (gnus-member-of-range
15260              (setq article (pop articles)) ranges)
15261         (setq news (cons article news))))
15262     (when news
15263       (gnus-info-set-read
15264        info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
15265       (gnus-group-update-group group t))))
15266
15267 ;; Enter all dead groups into the hashtb.
15268 (defun gnus-update-active-hashtb-from-killed ()
15269   (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
15270         (lists (list gnus-killed-list gnus-zombie-list))
15271         killed)
15272     (while lists
15273       (setq killed (car lists))
15274       (while killed
15275         (gnus-sethash (car killed) nil hashtb)
15276         (setq killed (cdr killed)))
15277       (setq lists (cdr lists)))))
15278
15279 ;; Get the active file(s) from the backend(s).
15280 (defun gnus-read-active-file ()
15281   (gnus-group-set-mode-line)
15282   (let ((methods (nconc (copy-sequence
15283                          (if (gnus-check-server gnus-select-method)
15284                              ;; The native server is available.
15285                              (cons gnus-select-method 
15286                                    gnus-secondary-select-methods)
15287                            ;; The native server is down, so we just do the
15288                            ;; secondary ones.
15289                            gnus-secondary-select-methods))
15290                         (list gnus-message-archive-method)))
15291         list-type)
15292     (setq gnus-have-read-active-file nil)
15293     (save-excursion
15294       (set-buffer nntp-server-buffer)
15295       (while methods
15296         (let* ((method (gnus-server-get-method nil (car methods)))
15297                (where (nth 1 method))
15298                (mesg (format "Reading active file%s via %s..."
15299                              (if (and where (not (zerop (length where))))
15300                                  (concat " from " where) "")
15301                              (car method))))
15302           (gnus-message 5 mesg)
15303           (if (not (gnus-check-server method))
15304               ()
15305             ;; Request that the backend scan its incoming messages.
15306             (and (gnus-check-backend-function 'request-scan (car method))
15307                  (gnus-request-scan nil method))
15308             (cond
15309              ((and (eq gnus-read-active-file 'some)
15310                    (gnus-check-backend-function 'retrieve-groups (car method)))
15311               (let ((newsrc (cdr gnus-newsrc-alist))
15312                     (gmethod (gnus-server-get-method nil method))
15313                     groups)
15314                 (while newsrc
15315                   (and (gnus-server-equal
15316                         (gnus-find-method-for-group
15317                          (car (car newsrc)) (car newsrc))
15318                         gmethod)
15319                        (setq groups (cons (gnus-group-real-name
15320                                            (car (car newsrc))) groups)))
15321                   (setq newsrc (cdr newsrc)))
15322                 (gnus-check-server method)
15323                 (setq list-type (gnus-retrieve-groups groups method))
15324                 (cond
15325                  ((not list-type)
15326                   (gnus-message
15327                    1 "Cannot read partial active file from %s server."
15328                    (car method))
15329                   (ding)
15330                   (sit-for 2))
15331                  ((eq list-type 'active)
15332                   (gnus-active-to-gnus-format method gnus-active-hashtb))
15333                  (t
15334                   (gnus-groups-to-gnus-format method gnus-active-hashtb)))))
15335              (t
15336               (if (not (gnus-request-list method))
15337                   (progn
15338                     (unless (equal method gnus-message-archive-method)
15339                       (gnus-message 1 "Cannot read active file from %s server."
15340                                     (car method))
15341                       (ding)))
15342                 (gnus-active-to-gnus-format method)
15343                 ;; We mark this active file as read.
15344                 (setq gnus-have-read-active-file
15345                       (cons method gnus-have-read-active-file))
15346                 (gnus-message 5 "%sdone" mesg))))))
15347         (setq methods (cdr methods))))))
15348
15349 ;; Read an active file and place the results in `gnus-active-hashtb'.
15350 (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors)
15351   (unless method
15352     (setq method gnus-select-method))
15353   (let ((cur (current-buffer))
15354         (hashtb (or hashtb
15355                     (if (and gnus-active-hashtb
15356                              (not (equal method gnus-select-method)))
15357                         gnus-active-hashtb
15358                       (setq gnus-active-hashtb
15359                             (if (equal method gnus-select-method)
15360                                 (gnus-make-hashtable
15361                                  (count-lines (point-min) (point-max)))
15362                               (gnus-make-hashtable 4096))))))
15363         (flag-hashtb (gnus-make-hashtable 60)))
15364     ;; Delete unnecessary lines.
15365     (goto-char (point-min))
15366     (while (search-forward "\nto." nil t)
15367       (delete-region (1+ (match-beginning 0))
15368                      (progn (forward-line 1) (point))))
15369     (or (string= gnus-ignored-newsgroups "")
15370         (progn
15371           (goto-char (point-min))
15372           (delete-matching-lines gnus-ignored-newsgroups)))
15373     ;; Make the group names readable as a lisp expression even if they
15374     ;; contain special characters.
15375     ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
15376     (goto-char (point-max))
15377     (while (re-search-backward "[][';?()#]" nil t)
15378       (insert ?\\))
15379     ;; If these are groups from a foreign select method, we insert the
15380     ;; group prefix in front of the group names.
15381     (and method (not (gnus-server-equal
15382                       (gnus-server-get-method nil method)
15383                       (gnus-server-get-method nil gnus-select-method)))
15384          (let ((prefix (gnus-group-prefixed-name "" method)))
15385            (goto-char (point-min))
15386            (while (and (not (eobp))
15387                        (progn (insert prefix)
15388                               (zerop (forward-line 1)))))))
15389     ;; Store the active file in a hash table.
15390     (goto-char (point-min))
15391     (if (string-match "%[oO]" gnus-group-line-format)
15392         ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
15393         ;; If we want information on moderated groups, we use this
15394         ;; loop...
15395         (let* ((mod-hashtb (make-vector 7 0))
15396                (m (intern "m" mod-hashtb))
15397                group max min)
15398           (while (not (eobp))
15399             (condition-case nil
15400                 (progn
15401                   (narrow-to-region (point) (gnus-point-at-eol))
15402                   (setq group (let ((obarray hashtb)) (read cur)))
15403                   (if (and (numberp (setq max (read cur)))
15404                            (numberp (setq min (read cur)))
15405                            (progn
15406                              (skip-chars-forward " \t")
15407                              (not
15408                               (or (= (following-char) ?=)
15409                                   (= (following-char) ?x)
15410                                   (= (following-char) ?j)))))
15411                       (set group (cons min max))
15412                     (set group nil))
15413                   ;; Enter moderated groups into a list.
15414                   (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
15415                       (setq gnus-moderated-list
15416                             (cons (symbol-name group) gnus-moderated-list))))
15417               (error
15418                (and group
15419                     (symbolp group)
15420                     (set group nil))))
15421             (widen)
15422             (forward-line 1)))
15423       ;; And if we do not care about moderation, we use this loop,
15424       ;; which is faster.
15425       (let (group max min)
15426         (while (not (eobp))
15427           (condition-case ()
15428               (progn
15429                 (narrow-to-region (point) (gnus-point-at-eol))
15430                 ;; group gets set to a symbol interned in the hash table
15431                 ;; (what a hack!!) - jwz
15432                 (setq group (let ((obarray hashtb)) (read cur)))
15433                 (if (and (numberp (setq max (read cur)))
15434                          (numberp (setq min (read cur)))
15435                          (progn
15436                            (skip-chars-forward " \t")
15437                            (not
15438                             (or (= (following-char) ?=)
15439                                 (= (following-char) ?x)
15440                                 (= (following-char) ?j)))))
15441                     (set group (cons min max))
15442                   (set group nil)))
15443             (error
15444              (progn
15445                (and group
15446                     (symbolp group)
15447                     (set group nil))
15448                (or ignore-errors
15449                    (gnus-message 3 "Warning - illegal active: %s"
15450                                  (buffer-substring
15451                                   (gnus-point-at-bol) (gnus-point-at-eol)))))))
15452           (widen)
15453           (forward-line 1))))))
15454
15455 (defun gnus-groups-to-gnus-format (method &optional hashtb)
15456   ;; Parse a "groups" active file.
15457   (let ((cur (current-buffer))
15458         (hashtb (or hashtb
15459                     (if (and method gnus-active-hashtb)
15460                         gnus-active-hashtb
15461                       (setq gnus-active-hashtb
15462                             (gnus-make-hashtable
15463                              (count-lines (point-min) (point-max)))))))
15464         (prefix (and method
15465                      (not (gnus-server-equal
15466                            (gnus-server-get-method nil method)
15467                            (gnus-server-get-method nil gnus-select-method)))
15468                      (gnus-group-prefixed-name "" method))))
15469
15470     (goto-char (point-min))
15471     ;; We split this into to separate loops, one with the prefix
15472     ;; and one without to speed the reading up somewhat.
15473     (if prefix
15474         (let (min max opoint group)
15475           (while (not (eobp))
15476             (condition-case ()
15477                 (progn
15478                   (read cur) (read cur)
15479                   (setq min (read cur)
15480                         max (read cur)
15481                         opoint (point))
15482                   (skip-chars-forward " \t")
15483                   (insert prefix)
15484                   (goto-char opoint)
15485                   (set (let ((obarray hashtb)) (read cur))
15486                        (cons min max)))
15487               (error (and group (symbolp group) (set group nil))))
15488             (forward-line 1)))
15489       (let (min max group)
15490         (while (not (eobp))
15491           (condition-case ()
15492               (if (= (following-char) ?2)
15493                   (progn
15494                     (read cur) (read cur)
15495                     (setq min (read cur)
15496                           max (read cur))
15497                     (set (setq group (let ((obarray hashtb)) (read cur)))
15498                          (cons min max))))
15499             (error (and group (symbolp group) (set group nil))))
15500           (forward-line 1))))))
15501
15502 (defun gnus-read-newsrc-file (&optional force)
15503   "Read startup file.
15504 If FORCE is non-nil, the .newsrc file is read."
15505   ;; Reset variables that might be defined in the .newsrc.eld file.
15506   (let ((variables gnus-variable-list))
15507     (while variables
15508       (set (car variables) nil)
15509       (setq variables (cdr variables))))
15510   (let* ((newsrc-file gnus-current-startup-file)
15511          (quick-file (concat newsrc-file ".el")))
15512     (save-excursion
15513       ;; We always load the .newsrc.eld file.  If always contains
15514       ;; much information that can not be gotten from the .newsrc
15515       ;; file (ticked articles, killed groups, foreign methods, etc.)
15516       (gnus-read-newsrc-el-file quick-file)
15517
15518       (if (or force
15519               (and (file-newer-than-file-p newsrc-file quick-file)
15520                    (file-newer-than-file-p newsrc-file
15521                                            (concat quick-file "d")))
15522               (not gnus-newsrc-alist))
15523           ;; We read the .newsrc file.  Note that if there if a
15524           ;; .newsrc.eld file exists, it has already been read, and
15525           ;; the `gnus-newsrc-hashtb' has been created.  While reading
15526           ;; the .newsrc file, Gnus will only use the information it
15527           ;; can find there for changing the data already read -
15528           ;; ie. reading the .newsrc file will not trash the data
15529           ;; already read (except for read articles).
15530           (save-excursion
15531             (gnus-message 5 "Reading %s..." newsrc-file)
15532             (set-buffer (find-file-noselect newsrc-file))
15533             (buffer-disable-undo (current-buffer))
15534             (gnus-newsrc-to-gnus-format)
15535             (kill-buffer (current-buffer))
15536             (gnus-message 5 "Reading %s...done" newsrc-file)))
15537
15538       ;; Read any slave files.
15539       (or gnus-slave
15540           (gnus-master-read-slave-newsrc)))))
15541
15542 (defun gnus-read-newsrc-el-file (file)
15543   (let ((ding-file (concat file "d")))
15544     ;; We always, always read the .eld file.
15545     (gnus-message 5 "Reading %s..." ding-file)
15546     (let (gnus-newsrc-assoc)
15547       (condition-case nil
15548           (load ding-file t t t)
15549         (error
15550          (gnus-message 1 "Error in %s" ding-file)
15551          (ding)))
15552       (when gnus-newsrc-assoc
15553         (setq gnus-newsrc-alist gnus-newsrc-assoc)))
15554     (gnus-make-hashtable-from-newsrc-alist)
15555     (when (file-newer-than-file-p file ding-file)
15556       ;; Old format quick file
15557       (gnus-message 5 "Reading %s..." file)
15558       ;; The .el file is newer than the .eld file, so we read that one
15559       ;; as well.
15560       (gnus-read-old-newsrc-el-file file))))
15561
15562 ;; Parse the old-style quick startup file
15563 (defun gnus-read-old-newsrc-el-file (file)
15564   (let (newsrc killed marked group m)
15565     (prog1
15566         (let ((gnus-killed-assoc nil)
15567               gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
15568           (prog1
15569               (condition-case nil
15570                   (load file t t t)
15571                 (error nil))
15572             (setq newsrc gnus-newsrc-assoc
15573                   killed gnus-killed-assoc
15574                   marked gnus-marked-assoc)))
15575       (setq gnus-newsrc-alist nil)
15576       (while newsrc
15577         (setq group (car newsrc))
15578         (let ((info (gnus-get-info (car group))))
15579           (if info
15580               (progn
15581                 (gnus-info-set-read info (cdr (cdr group)))
15582                 (gnus-info-set-level
15583                  info (if (nth 1 group) gnus-level-default-subscribed
15584                         gnus-level-default-unsubscribed))
15585                 (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
15586             (setq gnus-newsrc-alist
15587                   (cons
15588                    (setq info
15589                          (list (car group)
15590                                (if (nth 1 group) gnus-level-default-subscribed
15591                                  gnus-level-default-unsubscribed)
15592                                (cdr (cdr group))))
15593                    gnus-newsrc-alist)))
15594           (if (setq m (assoc (car group) marked))
15595               (gnus-info-set-marks
15596                info (cons (list (cons 'tick (gnus-compress-sequence
15597                                              (sort (cdr m) '<) t)))
15598                           nil))))
15599         (setq newsrc (cdr newsrc)))
15600       (setq newsrc killed)
15601       (while newsrc
15602         (setcar newsrc (car (car newsrc)))
15603         (setq newsrc (cdr newsrc)))
15604       (setq gnus-killed-list killed))
15605     ;; The .el file version of this variable does not begin with
15606     ;; "options", while the .eld version does, so we just add it if it
15607     ;; isn't there.
15608     (and
15609      gnus-newsrc-options
15610      (progn
15611        (and (not (string-match "^ *options" gnus-newsrc-options))
15612             (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
15613        (and (not (string-match "\n$" gnus-newsrc-options))
15614             (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
15615        ;; Finally, if we read some options lines, we parse them.
15616        (or (string= gnus-newsrc-options "")
15617            (gnus-newsrc-parse-options gnus-newsrc-options))))
15618
15619     (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
15620     (gnus-make-hashtable-from-newsrc-alist)))
15621
15622 (defun gnus-make-newsrc-file (file)
15623   "Make server dependent file name by catenating FILE and server host name."
15624   (let* ((file (expand-file-name file nil))
15625          (real-file (concat file "-" (nth 1 gnus-select-method))))
15626     (if (or (file-exists-p real-file)
15627             (file-exists-p (concat real-file ".el"))
15628             (file-exists-p (concat real-file ".eld")))
15629         real-file file)))
15630
15631 (defun gnus-newsrc-to-gnus-format ()
15632   (setq gnus-newsrc-options "")
15633   (setq gnus-newsrc-options-n nil)
15634
15635   (or gnus-active-hashtb
15636       (setq gnus-active-hashtb (make-vector 4095 0)))
15637   (let ((buf (current-buffer))
15638         (already-read (> (length gnus-newsrc-alist) 1))
15639         group subscribed options-symbol newsrc Options-symbol
15640         symbol reads num1)
15641     (goto-char (point-min))
15642     ;; We intern the symbol `options' in the active hashtb so that we
15643     ;; can `eq' against it later.
15644     (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
15645     (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
15646
15647     (while (not (eobp))
15648       ;; We first read the first word on the line by narrowing and
15649       ;; then reading into `gnus-active-hashtb'.  Most groups will
15650       ;; already exist in that hashtb, so this will save some string
15651       ;; space.
15652       (narrow-to-region
15653        (point)
15654        (progn (skip-chars-forward "^ \t!:\n") (point)))
15655       (goto-char (point-min))
15656       (setq symbol
15657             (and (/= (point-min) (point-max))
15658                  (let ((obarray gnus-active-hashtb)) (read buf))))
15659       (widen)
15660       ;; Now, the symbol we have read is either `options' or a group
15661       ;; name.  If it is an options line, we just add it to a string.
15662       (cond
15663        ((or (eq symbol options-symbol)
15664             (eq symbol Options-symbol))
15665         (setq gnus-newsrc-options
15666               ;; This concating is quite inefficient, but since our
15667               ;; thorough studies show that approx 99.37% of all
15668               ;; .newsrc files only contain a single options line, we
15669               ;; don't give a damn, frankly, my dear.
15670               (concat gnus-newsrc-options
15671                       (buffer-substring
15672                        (gnus-point-at-bol)
15673                        ;; Options may continue on the next line.
15674                        (or (and (re-search-forward "^[^ \t]" nil 'move)
15675                                 (progn (beginning-of-line) (point)))
15676                            (point)))))
15677         (forward-line -1))
15678        (symbol
15679         ;; Group names can be just numbers.  
15680         (when (numberp symbol) 
15681           (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
15682         (or (boundp symbol) (set symbol nil))
15683         ;; It was a group name.
15684         (setq subscribed (= (following-char) ?:)
15685               group (symbol-name symbol)
15686               reads nil)
15687         (if (eolp)
15688             ;; If the line ends here, this is clearly a buggy line, so
15689             ;; we put point a the beginning of line and let the cond
15690             ;; below do the error handling.
15691             (beginning-of-line)
15692           ;; We skip to the beginning of the ranges.
15693           (skip-chars-forward "!: \t"))
15694         ;; We are now at the beginning of the list of read articles.
15695         ;; We read them range by range.
15696         (while
15697             (cond
15698              ((looking-at "[0-9]+")
15699               ;; We narrow and read a number instead of buffer-substring/
15700               ;; string-to-int because it's faster.  narrow/widen is
15701               ;; faster than save-restriction/narrow, and save-restriction
15702               ;; produces a garbage object.
15703               (setq num1 (progn
15704                            (narrow-to-region (match-beginning 0) (match-end 0))
15705                            (read buf)))
15706               (widen)
15707               ;; If the next character is a dash, then this is a range.
15708               (if (= (following-char) ?-)
15709                   (progn
15710                     ;; We read the upper bound of the range.
15711                     (forward-char 1)
15712                     (if (not (looking-at "[0-9]+"))
15713                         ;; This is a buggy line, by we pretend that
15714                         ;; it's kinda OK.  Perhaps the user should be
15715                         ;; dinged?
15716                         (setq reads (cons num1 reads))
15717                       (setq reads
15718                             (cons
15719                              (cons num1
15720                                    (progn
15721                                      (narrow-to-region (match-beginning 0)
15722                                                        (match-end 0))
15723                                      (read buf)))
15724                              reads))
15725                       (widen)))
15726                 ;; It was just a simple number, so we add it to the
15727                 ;; list of ranges.
15728                 (setq reads (cons num1 reads)))
15729               ;; If the next char in ?\n, then we have reached the end
15730               ;; of the line and return nil.
15731               (/= (following-char) ?\n))
15732              ((= (following-char) ?\n)
15733               ;; End of line, so we end.
15734               nil)
15735              (t
15736               ;; Not numbers and not eol, so this might be a buggy
15737               ;; line...
15738               (or (eobp)
15739                   ;; If it was eob instead of ?\n, we allow it.
15740                   (progn
15741                     ;; The line was buggy.
15742                     (setq group nil)
15743                     (gnus-message 3 "Mangled line: %s"
15744                                   (buffer-substring (gnus-point-at-bol)
15745                                                     (gnus-point-at-eol)))
15746                     (ding)
15747                     (sit-for 1)))
15748               nil))
15749           ;; Skip past ", ".  Spaces are illegal in these ranges, but
15750           ;; we allow them, because it's a common mistake to put a
15751           ;; space after the comma.
15752           (skip-chars-forward ", "))
15753
15754         ;; We have already read .newsrc.eld, so we gently update the
15755         ;; data in the hash table with the information we have just
15756         ;; read.
15757         (when group
15758           (let ((info (gnus-get-info group))
15759                 level)
15760             (if info
15761                 ;; There is an entry for this file in the alist.
15762                 (progn
15763                   (gnus-info-set-read info (nreverse reads))
15764                   ;; We update the level very gently.  In fact, we
15765                   ;; only change it if there's been a status change
15766                   ;; from subscribed to unsubscribed, or vice versa.
15767                   (setq level (gnus-info-level info))
15768                   (cond ((and (<= level gnus-level-subscribed)
15769                               (not subscribed))
15770                          (setq level (if reads
15771                                          gnus-level-default-unsubscribed
15772                                        (1+ gnus-level-default-unsubscribed))))
15773                         ((and (> level gnus-level-subscribed) subscribed)
15774                          (setq level gnus-level-default-subscribed)))
15775                   (gnus-info-set-level info level))
15776               ;; This is a new group.
15777               (setq info (list group
15778                                (if subscribed
15779                                    gnus-level-default-subscribed
15780                                  (if reads
15781                                      (1+ gnus-level-subscribed)
15782                                    gnus-level-default-unsubscribed))
15783                                (nreverse reads))))
15784             (setq newsrc (cons info newsrc))))))
15785       (forward-line 1))
15786
15787     (setq newsrc (nreverse newsrc))
15788
15789     (if (not already-read)
15790         ()
15791       ;; We now have two newsrc lists - `newsrc', which is what we
15792       ;; have read from .newsrc, and `gnus-newsrc-alist', which is
15793       ;; what we've read from .newsrc.eld.  We have to merge these
15794       ;; lists.  We do this by "attaching" any (foreign) groups in the
15795       ;; gnus-newsrc-alist to the (native) group that precedes them.
15796       (let ((rc (cdr gnus-newsrc-alist))
15797             (prev gnus-newsrc-alist)
15798             entry mentry)
15799         (while rc
15800           (or (null (nth 4 (car rc)))   ; It's a native group.
15801               (assoc (car (car rc)) newsrc) ; It's already in the alist.
15802               (if (setq entry (assoc (car (car prev)) newsrc))
15803                   (setcdr (setq mentry (memq entry newsrc))
15804                           (cons (car rc) (cdr mentry)))
15805                 (setq newsrc (cons (car rc) newsrc))))
15806           (setq prev rc
15807                 rc (cdr rc)))))
15808
15809     (setq gnus-newsrc-alist newsrc)
15810     ;; We make the newsrc hashtb.
15811     (gnus-make-hashtable-from-newsrc-alist)
15812
15813     ;; Finally, if we read some options lines, we parse them.
15814     (or (string= gnus-newsrc-options "")
15815         (gnus-newsrc-parse-options gnus-newsrc-options))))
15816
15817 ;; Parse options lines to find "options -n !all rec.all" and stuff.
15818 ;; The return value will be a list on the form
15819 ;; ((regexp1 . ignore)
15820 ;;  (regexp2 . subscribe)...)
15821 ;; When handling new newsgroups, groups that match a `ignore' regexp
15822 ;; will be ignored, and groups that match a `subscribe' regexp will be
15823 ;; subscribed.  A line like
15824 ;; options -n !all rec.all
15825 ;; will lead to a list that looks like
15826 ;; (("^rec\\..+" . subscribe)
15827 ;;  ("^.+" . ignore))
15828 ;; So all "rec.*" groups will be subscribed, while all the other
15829 ;; groups will be ignored.  Note that "options -n !all rec.all" is very
15830 ;; different from "options -n rec.all !all".
15831 (defun gnus-newsrc-parse-options (options)
15832   (let (out eol)
15833     (save-excursion
15834       (gnus-set-work-buffer)
15835       (insert (regexp-quote options))
15836       ;; First we treat all continuation lines.
15837       (goto-char (point-min))
15838       (while (re-search-forward "\n[ \t]+" nil t)
15839         (replace-match " " t t))
15840       ;; Then we transform all "all"s into ".+"s.
15841       (goto-char (point-min))
15842       (while (re-search-forward "\\ball\\b" nil t)
15843         (replace-match ".+" t t))
15844       (goto-char (point-min))
15845       ;; We remove all other options than the "-n" ones.
15846       (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
15847         (replace-match " ")
15848         (forward-char -1))
15849       (goto-char (point-min))
15850
15851       ;; We are only interested in "options -n" lines - we
15852       ;; ignore the other option lines.
15853       (while (re-search-forward "[ \t]-n" nil t)
15854         (setq eol
15855               (or (save-excursion
15856                     (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
15857                          (- (point) 2)))
15858                   (gnus-point-at-eol)))
15859         ;; Search for all "words"...
15860         (while (re-search-forward "[^ \t,\n]+" eol t)
15861           (if (= (char-after (match-beginning 0)) ?!)
15862               ;; If the word begins with a bang (!), this is a "not"
15863               ;; spec.  We put this spec (minus the bang) and the
15864               ;; symbol `ignore' into the list.
15865               (setq out (cons (cons (concat
15866                                      "^" (buffer-substring
15867                                           (1+ (match-beginning 0))
15868                                           (match-end 0)))
15869                                     'ignore) out))
15870             ;; There was no bang, so this is a "yes" spec.
15871             (setq out (cons (cons (concat "^" (match-string 0))
15872                                   'subscribe) out)))))
15873
15874       (setq gnus-newsrc-options-n out))))
15875
15876 (defun gnus-save-newsrc-file (&optional force)
15877   "Save .newsrc file."
15878   ;; Note: We cannot save .newsrc file if all newsgroups are removed
15879   ;; from the variable gnus-newsrc-alist.
15880   (when (and (or gnus-newsrc-alist gnus-killed-list)
15881              gnus-current-startup-file)
15882     (save-excursion
15883       (if (and (or gnus-use-dribble-file gnus-slave)
15884                (not force)
15885                (or (not gnus-dribble-buffer)
15886                    (not (buffer-name gnus-dribble-buffer))
15887                    (zerop (save-excursion
15888                             (set-buffer gnus-dribble-buffer)
15889                             (buffer-size)))))
15890           (gnus-message 4 "(No changes need to be saved)")
15891         (run-hooks 'gnus-save-newsrc-hook)
15892         (if gnus-slave
15893             (gnus-slave-save-newsrc)
15894           ;; Save .newsrc.
15895           (when gnus-save-newsrc-file
15896             (gnus-message 5 "Saving %s..." gnus-current-startup-file)
15897             (gnus-gnus-to-newsrc-format)
15898             (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
15899           ;; Save .newsrc.eld.
15900           (set-buffer (get-buffer-create " *Gnus-newsrc*"))
15901           (make-local-variable 'version-control)
15902           (setq version-control 'never)
15903           (setq buffer-file-name
15904                 (concat gnus-current-startup-file ".eld"))
15905           (gnus-add-current-to-buffer-list)
15906           (buffer-disable-undo (current-buffer))
15907           (erase-buffer)
15908           (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
15909           (gnus-gnus-to-quick-newsrc-format)
15910           (run-hooks 'gnus-save-quick-newsrc-hook)
15911           (save-buffer)
15912           (kill-buffer (current-buffer))
15913           (gnus-message
15914            5 "Saving %s.eld...done" gnus-current-startup-file))
15915         (gnus-dribble-delete-file)))))
15916
15917 (defun gnus-gnus-to-quick-newsrc-format ()
15918   "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
15919   (insert ";; Gnus startup file.\n")
15920   (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
15921   (insert ";; to read .newsrc.\n")
15922   (insert "(setq gnus-newsrc-file-version "
15923           (prin1-to-string gnus-version) ")\n")
15924   (let ((variables
15925          (if gnus-save-killed-list gnus-variable-list
15926            ;; Remove the `gnus-killed-list' from the list of variables
15927            ;; to be saved, if required.
15928            (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
15929         ;; Peel off the "dummy" group.
15930         (gnus-newsrc-alist (cdr gnus-newsrc-alist))
15931         variable)
15932     ;; Insert the variables into the file.
15933     (while variables
15934       (when (and (boundp (setq variable (pop variables)))
15935                  (symbol-value variable))
15936         (insert "(setq " (symbol-name variable) " '"
15937                 (prin1-to-string (symbol-value variable)) ")\n")))))
15938
15939 (defun gnus-gnus-to-newsrc-format ()
15940   ;; Generate and save the .newsrc file.
15941   (let ((newsrc (cdr gnus-newsrc-alist))
15942         info ranges range)
15943     (save-excursion
15944       (set-buffer (create-file-buffer gnus-current-startup-file))
15945       (setq buffer-file-name gnus-current-startup-file)
15946       (buffer-disable-undo (current-buffer))
15947       (erase-buffer)
15948       ;; Write options.
15949       (if gnus-newsrc-options (insert gnus-newsrc-options))
15950       ;; Write subscribed and unsubscribed.
15951       (while newsrc
15952         (setq info (car newsrc))
15953         (if (not (gnus-info-method info))
15954             ;; Don't write foreign groups to .newsrc.
15955             (progn
15956               (insert (gnus-info-group info)
15957                       (if (> (gnus-info-level info) gnus-level-subscribed)
15958                           "!" ":"))
15959               (if (setq ranges (gnus-info-read info))
15960                   (progn
15961                     (insert " ")
15962                     (if (not (listp (cdr ranges)))
15963                         (if (= (car ranges) (cdr ranges))
15964                             (insert (int-to-string (car ranges)))
15965                           (insert (int-to-string (car ranges)) "-"
15966                                   (int-to-string (cdr ranges))))
15967                       (while ranges
15968                         (setq range (car ranges)
15969                               ranges (cdr ranges))
15970                         (if (or (atom range) (= (car range) (cdr range)))
15971                             (insert (int-to-string
15972                                      (or (and (atom range) range)
15973                                          (car range))))
15974                           (insert (int-to-string (car range)) "-"
15975                                   (int-to-string (cdr range))))
15976                         (if ranges (insert ","))))))
15977               (insert "\n")))
15978         (setq newsrc (cdr newsrc)))
15979       (make-local-variable 'version-control)
15980       (setq version-control 'never)
15981       ;; It has been reported that sometime the modtime on the .newsrc
15982       ;; file seems to be off.  We really do want to overwrite it, so
15983       ;; we clear the modtime here before saving.  It's a bit odd,
15984       ;; though...
15985       ;; sometimes the modtime clear isn't sufficient.  most brute force:
15986       ;; delete the silly thing entirely first.  but this fails to provide
15987       ;; such niceties as .newsrc~ creation.
15988       (if gnus-modtime-botch
15989           (delete-file gnus-startup-file)
15990         (clear-visited-file-modtime))
15991       (run-hooks 'gnus-save-standard-newsrc-hook)
15992       (save-buffer)
15993       (kill-buffer (current-buffer)))))
15994
15995
15996 ;;; Slave functions.
15997
15998 (defun gnus-slave-save-newsrc ()
15999   (save-excursion
16000     (set-buffer gnus-dribble-buffer)
16001     (let ((slave-name
16002            (make-temp-name (concat gnus-current-startup-file "-slave-"))))
16003       (write-region (point-min) (point-max) slave-name nil 'nomesg))))
16004
16005 (defun gnus-master-read-slave-newsrc ()
16006   (let ((slave-files
16007          (directory-files
16008           (file-name-directory gnus-current-startup-file)
16009           t (concat
16010              "^" (regexp-quote
16011                   (concat
16012                    (file-name-nondirectory gnus-current-startup-file)
16013                    "-slave-")))
16014           t))
16015         file)
16016     (if (not slave-files)
16017         ()                              ; There are no slave files to read.
16018       (gnus-message 7 "Reading slave newsrcs...")
16019       (save-excursion
16020         (set-buffer (get-buffer-create " *gnus slave*"))
16021         (buffer-disable-undo (current-buffer))
16022         (setq slave-files
16023               (sort (mapcar (lambda (file)
16024                               (list (nth 5 (file-attributes file)) file))
16025                             slave-files)
16026                     (lambda (f1 f2)
16027                       (or (< (car (car f1)) (car (car f2)))
16028                           (< (nth 1 (car f1)) (nth 1 (car f2)))))))
16029         (while slave-files
16030           (erase-buffer)
16031           (setq file (nth 1 (car slave-files)))
16032           (insert-file-contents file)
16033           (if (condition-case ()
16034                   (progn
16035                     (eval-buffer (current-buffer))
16036                     t)
16037                 (error
16038                  (gnus-message 3 "Possible error in %s" file)
16039                  (ding)
16040                  (sit-for 2)
16041                  nil))
16042               (or gnus-slave ; Slaves shouldn't delete these files.
16043                   (condition-case ()
16044                       (delete-file file)
16045                     (error nil))))
16046           (setq slave-files (cdr slave-files))))
16047       (gnus-message 7 "Reading slave newsrcs...done"))))
16048
16049
16050 ;;; Group description.
16051
16052 (defun gnus-read-all-descriptions-files ()
16053   (let ((methods (cons gnus-select-method 
16054                        (cons gnus-message-archive-method
16055                              gnus-secondary-select-methods))))
16056     (while methods
16057       (gnus-read-descriptions-file (car methods))
16058       (setq methods (cdr methods)))
16059     t))
16060
16061 (defun gnus-read-descriptions-file (&optional method)
16062   (let ((method (or method gnus-select-method)))
16063     ;; We create the hashtable whether we manage to read the desc file
16064     ;; to avoid trying to re-read after a failed read.
16065     (or gnus-description-hashtb
16066         (setq gnus-description-hashtb
16067               (gnus-make-hashtable (length gnus-active-hashtb))))
16068     ;; Mark this method's desc file as read.
16069     (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
16070                   gnus-description-hashtb)
16071
16072     (gnus-message 5 "Reading descriptions file via %s..." (car method))
16073     (cond
16074      ((not (gnus-check-server method))
16075       (gnus-message 1 "Couldn't open server")
16076       nil)
16077      ((not (gnus-request-list-newsgroups method))
16078       (gnus-message 1 "Couldn't read newsgroups descriptions")
16079       nil)
16080      (t
16081       (let (group)
16082         (save-excursion
16083           (save-restriction
16084             (set-buffer nntp-server-buffer)
16085             (goto-char (point-min))
16086             (if (or (search-forward "\n.\n" nil t)
16087                     (goto-char (point-max)))
16088                 (progn
16089                   (beginning-of-line)
16090                   (narrow-to-region (point-min) (point))))
16091             (goto-char (point-min))
16092             (while (not (eobp))
16093               ;; If we get an error, we set group to 0, which is not a
16094               ;; symbol...
16095               (setq group
16096                     (condition-case ()
16097                         (let ((obarray gnus-description-hashtb))
16098                           ;; Group is set to a symbol interned in this
16099                           ;; hash table.
16100                           (read nntp-server-buffer))
16101                       (error 0)))
16102               (skip-chars-forward " \t")
16103               ;; ...  which leads to this line being effectively ignored.
16104               (and (symbolp group)
16105                    (set group (buffer-substring
16106                                (point) (progn (end-of-line) (point)))))
16107               (forward-line 1))))
16108         (gnus-message 5 "Reading descriptions file...done")
16109         t)))))
16110
16111 (defun gnus-group-get-description (group)
16112   "Get the description of a group by sending XGTITLE to the server."
16113   (when (gnus-request-group-description group)
16114     (save-excursion
16115       (set-buffer nntp-server-buffer)
16116       (goto-char (point-min))
16117       (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
16118         (match-string 1)))))
16119
16120 ;;;
16121 ;;; Buffering of read articles.
16122 ;;;
16123
16124 (defvar gnus-backlog-buffer " *Gnus Backlog*")
16125 (defvar gnus-backlog-articles nil)
16126 (defvar gnus-backlog-hashtb nil)
16127
16128 (defun gnus-backlog-buffer ()
16129   "Return the backlog buffer."
16130   (or (get-buffer gnus-backlog-buffer)
16131       (save-excursion
16132         (set-buffer (get-buffer-create gnus-backlog-buffer))
16133         (buffer-disable-undo (current-buffer))
16134         (setq buffer-read-only t)
16135         (gnus-add-current-to-buffer-list)
16136         (get-buffer gnus-backlog-buffer))))
16137
16138 (defun gnus-backlog-setup ()
16139   "Initialize backlog variables."
16140   (unless gnus-backlog-hashtb
16141     (setq gnus-backlog-hashtb (make-vector 1023 0))))
16142
16143 (defun gnus-backlog-shutdown ()
16144   "Clear all backlog variables and buffers."
16145   (when (get-buffer gnus-backlog-buffer)
16146     (kill-buffer gnus-backlog-buffer))
16147   (setq gnus-backlog-hashtb nil
16148         gnus-backlog-articles nil))
16149
16150 (defun gnus-backlog-enter-article (group number buffer)
16151   (gnus-backlog-setup)
16152   (let ((ident (intern (concat group ":" (int-to-string number))
16153                        gnus-backlog-hashtb))
16154         b)
16155     (if (memq ident gnus-backlog-articles)
16156         () ; It's already kept.
16157       ;; Remove the oldest article, if necessary.
16158       (and (numberp gnus-keep-backlog)
16159            (>= (length gnus-backlog-articles) gnus-keep-backlog)
16160            (gnus-backlog-remove-oldest-article))
16161       (setq gnus-backlog-articles (cons ident gnus-backlog-articles))
16162       ;; Insert the new article.
16163       (save-excursion
16164         (set-buffer (gnus-backlog-buffer))
16165         (let (buffer-read-only)
16166           (goto-char (point-max))
16167           (or (bolp) (insert "\n"))
16168           (setq b (point))
16169           (insert-buffer-substring buffer)
16170           ;; Tag the beginning of the article with the ident.
16171           (put-text-property b (1+ b) 'gnus-backlog ident))))))
16172
16173 (defun gnus-backlog-remove-oldest-article ()
16174   (save-excursion
16175     (set-buffer (gnus-backlog-buffer))
16176     (goto-char (point-min))
16177     (if (zerop (buffer-size))
16178         () ; The buffer is empty.
16179       (let ((ident (get-text-property (point) 'gnus-backlog))
16180             buffer-read-only)
16181         ;; Remove the ident from the list of articles.
16182         (when ident
16183           (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
16184         ;; Delete the article itself.
16185         (delete-region
16186          (point) (next-single-property-change
16187                   (1+ (point)) 'gnus-backlog nil (point-max)))))))
16188
16189 (defun gnus-backlog-request-article (group number buffer)
16190   (gnus-backlog-setup)
16191   (let ((ident (intern (concat group ":" (int-to-string number))
16192                        gnus-backlog-hashtb))
16193         beg end)
16194     (when (memq ident gnus-backlog-articles)
16195       ;; It was in the backlog.
16196       (save-excursion
16197         (set-buffer (gnus-backlog-buffer))
16198         (if (not (setq beg (text-property-any
16199                             (point-min) (point-max) 'gnus-backlog
16200                             ident)))
16201             ;; It wasn't in the backlog after all.
16202             (progn
16203               (setq gnus-backlog-articles (delq ident gnus-backlog-articles))
16204               nil)
16205           ;; Find the end (i. e., the beginning of the next article).
16206           (setq end
16207                 (next-single-property-change
16208                  (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
16209       (let ((buffer-read-only nil))
16210         (erase-buffer)
16211         (insert-buffer-substring gnus-backlog-buffer beg end)
16212         t))))
16213
16214 ;; Allow redefinition of Gnus functions.
16215
16216 (gnus-ems-redefine)
16217
16218 (provide 'gnus)
16219
16220 ;;; gnus.el ends here