*** 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-goto-missing-group-function nil)
1531
1532 (defvar gnus-override-subscribe-method nil)
1533
1534 (defvar gnus-group-goto-next-group-function nil
1535   "Function to override finding the next group after listing groups.")
1536
1537 (defconst gnus-article-mark-lists
1538   '((marked . tick) (replied . reply)
1539     (expirable . expire) (killed . killed)
1540     (bookmarks . bookmark) (dormant . dormant)
1541     (scored . score) (saved . save)
1542     (cached . cache)))
1543
1544 ;; Avoid highlighting in kill files.
1545 (defvar gnus-summary-inhibit-highlight nil)
1546 (defvar gnus-newsgroup-selected-overlay nil)
1547
1548 (defvar gnus-inhibit-hiding nil)
1549 (defvar gnus-group-indentation "")
1550 (defvar gnus-inhibit-limiting nil)
1551
1552 (defvar gnus-article-mode-map nil)
1553 (defvar gnus-dribble-buffer nil)
1554 (defvar gnus-headers-retrieved-by nil)
1555 (defvar gnus-article-reply nil)
1556 (defvar gnus-override-method nil)
1557 (defvar gnus-article-check-size nil)
1558
1559 (defvar gnus-nocem-hashtb nil)
1560
1561 (defvar gnus-current-score-file nil)
1562 (defvar gnus-newsgroup-adaptive-score-file nil)
1563 (defvar gnus-scores-exclude-files nil)
1564
1565 (defvar gnus-opened-servers nil)
1566
1567 (defvar gnus-current-move-group nil)
1568
1569 (defvar gnus-newsgroup-dependencies nil)
1570 (defvar gnus-newsgroup-async nil)
1571 (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
1572
1573 (defvar gnus-newsgroup-adaptive nil)
1574
1575 (defvar gnus-summary-display-table nil)
1576 (defvar gnus-summary-display-article-function nil)
1577
1578 (defvar gnus-summary-highlight-line-function nil
1579   "Function called after highlighting a summary line.")
1580
1581 (defvar gnus-group-line-format-alist
1582   `((?M gnus-tmp-marked-mark ?c)
1583     (?S gnus-tmp-subscribed ?c)
1584     (?L gnus-tmp-level ?d)
1585     (?N (cond ((eq number t) "*" )
1586               ((numberp number) 
1587                (int-to-string
1588                 (+ number
1589                    (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1590                    (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
1591               (t number)) ?s)
1592     (?R gnus-tmp-number-of-read ?s)
1593     (?t gnus-tmp-number-total ?d)
1594     (?y gnus-tmp-number-of-unread ?s)
1595     (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
1596     (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
1597     (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
1598            (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
1599     (?g gnus-tmp-group ?s)
1600     (?G gnus-tmp-qualified-group ?s)
1601     (?c (gnus-short-group-name gnus-tmp-group) ?s)
1602     (?D gnus-tmp-newsgroup-description ?s)
1603     (?o gnus-tmp-moderated ?c)
1604     (?O gnus-tmp-moderated-string ?s)
1605     (?p gnus-tmp-process-marked ?c)
1606     (?s gnus-tmp-news-server ?s)
1607     (?n gnus-tmp-news-method ?s)
1608     (?P gnus-group-indentation ?s)
1609     (?z gnus-tmp-news-method-string ?s)
1610     (?u gnus-tmp-user-defined ?s)))
1611
1612 (defvar gnus-summary-line-format-alist
1613   `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
1614     (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
1615     (?s gnus-tmp-subject-or-nil ?s)
1616     (?n gnus-tmp-name ?s)
1617     (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
1618         ?s)
1619     (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
1620             gnus-tmp-from) ?s)
1621     (?F gnus-tmp-from ?s)
1622     (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
1623     (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
1624     (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
1625     (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
1626     (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
1627     (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
1628     (?L gnus-tmp-lines ?d)
1629     (?I gnus-tmp-indentation ?s)
1630     (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
1631     (?R gnus-tmp-replied ?c)
1632     (?\[ gnus-tmp-opening-bracket ?c)
1633     (?\] gnus-tmp-closing-bracket ?c)
1634     (?\> (make-string gnus-tmp-level ? ) ?s)
1635     (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
1636     (?i gnus-tmp-score ?d)
1637     (?z gnus-tmp-score-char ?c)
1638     (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
1639     (?U gnus-tmp-unread ?c)
1640     (?t (gnus-summary-number-of-articles-in-thread
1641          (and (boundp 'thread) (car thread)) gnus-tmp-level)
1642         ?d)
1643     (?e (gnus-summary-number-of-articles-in-thread
1644          (and (boundp 'thread) (car thread)) gnus-tmp-level t)
1645         ?c)
1646     (?u gnus-tmp-user-defined ?s))
1647   "An alist of format specifications that can appear in summary lines,
1648 and what variables they correspond with, along with the type of the
1649 variable (string, integer, character, etc).")
1650
1651 (defvar gnus-summary-dummy-line-format-alist
1652   (` ((?S gnus-tmp-subject ?s)
1653       (?N gnus-tmp-number ?d)
1654       (?u gnus-tmp-user-defined ?s))))
1655
1656 (defvar gnus-summary-mode-line-format-alist
1657   (` ((?G gnus-tmp-group-name ?s)
1658       (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
1659       (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
1660       (?A gnus-tmp-article-number ?d)
1661       (?Z gnus-tmp-unread-and-unselected ?s)
1662       (?V gnus-version ?s)
1663       (?U gnus-tmp-unread ?d)
1664       (?S gnus-tmp-subject ?s)
1665       (?e gnus-tmp-unselected ?d)
1666       (?u gnus-tmp-user-defined ?s)
1667       (?d (length gnus-newsgroup-dormant) ?d)
1668       (?t (length gnus-newsgroup-marked) ?d)
1669       (?r (length gnus-newsgroup-reads) ?d)
1670       (?E gnus-newsgroup-expunged-tally ?d)
1671       (?s (gnus-current-score-file-nondirectory) ?s))))
1672
1673 (defvar gnus-article-mode-line-format-alist
1674   gnus-summary-mode-line-format-alist)
1675
1676 (defvar gnus-group-mode-line-format-alist
1677   (` ((?S gnus-tmp-news-server ?s)
1678       (?M gnus-tmp-news-method ?s)
1679       (?u gnus-tmp-user-defined ?s))))
1680
1681 (defvar gnus-have-read-active-file nil)
1682
1683 (defconst gnus-maintainer
1684   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1685   "The mail address of the Gnus maintainers.")
1686
1687 (defconst gnus-version "September Gnus v0.37"
1688   "Version number for this version of Gnus.")
1689
1690 (defvar gnus-info-nodes
1691   '((gnus-group-mode            "(gnus)The Group Buffer")
1692     (gnus-summary-mode          "(gnus)The Summary Buffer")
1693     (gnus-article-mode          "(gnus)The Article Buffer"))
1694   "Assoc list of major modes and related Info nodes.")
1695
1696 (defvar gnus-group-buffer "*Group*")
1697 (defvar gnus-summary-buffer "*Summary*")
1698 (defvar gnus-article-buffer "*Article*")
1699 (defvar gnus-server-buffer "*Server*")
1700
1701 (defvar gnus-work-buffer " *gnus work*")
1702
1703 (defvar gnus-original-article-buffer " *Original Article*")
1704 (defvar gnus-original-article nil)
1705
1706 (defvar gnus-buffer-list nil
1707   "Gnus buffers that should be killed on exit.")
1708
1709 (defvar gnus-server-alist nil
1710   "List of available servers.")
1711
1712 (defvar gnus-slave nil
1713   "Whether this Gnus is a slave or not.")
1714
1715 (defvar gnus-variable-list
1716   '(gnus-newsrc-options gnus-newsrc-options-n
1717     gnus-newsrc-last-checked-date
1718     gnus-newsrc-alist gnus-server-alist
1719     gnus-killed-list gnus-zombie-list
1720     gnus-topic-topology gnus-topic-alist
1721     gnus-format-specs)
1722   "Gnus variables saved in the quick startup file.")
1723
1724 (defvar gnus-newsrc-options nil
1725   "Options line in the .newsrc file.")
1726
1727 (defvar gnus-newsrc-options-n nil
1728   "List of regexps representing groups to be subscribed/ignored unconditionally.")
1729
1730 (defvar gnus-newsrc-last-checked-date nil
1731   "Date Gnus last asked server for new newsgroups.")
1732
1733 (defvar gnus-topic-topology nil
1734   "The complete topic hierarchy.")
1735
1736 (defvar gnus-topic-alist nil
1737   "The complete topic-group alist.")
1738
1739 (defvar gnus-newsrc-alist nil
1740   "Assoc list of read articles.
1741 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1742
1743 (defvar gnus-newsrc-hashtb nil
1744   "Hashtable of gnus-newsrc-alist.")
1745
1746 (defvar gnus-killed-list nil
1747   "List of killed newsgroups.")
1748
1749 (defvar gnus-killed-hashtb nil
1750   "Hash table equivalent of gnus-killed-list.")
1751
1752 (defvar gnus-zombie-list nil
1753   "List of almost dead newsgroups.")
1754
1755 (defvar gnus-description-hashtb nil
1756   "Descriptions of newsgroups.")
1757
1758 (defvar gnus-list-of-killed-groups nil
1759   "List of newsgroups that have recently been killed by the user.")
1760
1761 (defvar gnus-active-hashtb nil
1762   "Hashtable of active articles.")
1763
1764 (defvar gnus-moderated-list nil
1765   "List of moderated newsgroups.")
1766
1767 (defvar gnus-group-marked nil)
1768
1769 (defvar gnus-current-startup-file nil
1770   "Startup file for the current host.")
1771
1772 (defvar gnus-last-search-regexp nil
1773   "Default regexp for article search command.")
1774
1775 (defvar gnus-last-shell-command nil
1776   "Default shell command on article.")
1777
1778 (defvar gnus-current-select-method nil
1779   "The current method for selecting a newsgroup.")
1780
1781 (defvar gnus-group-list-mode nil)
1782
1783 (defvar gnus-article-internal-prepare-hook nil)
1784
1785 (defvar gnus-newsgroup-name nil)
1786 (defvar gnus-newsgroup-begin nil)
1787 (defvar gnus-newsgroup-end nil)
1788 (defvar gnus-newsgroup-last-rmail nil)
1789 (defvar gnus-newsgroup-last-mail nil)
1790 (defvar gnus-newsgroup-last-folder nil)
1791 (defvar gnus-newsgroup-last-file nil)
1792 (defvar gnus-newsgroup-auto-expire nil)
1793 (defvar gnus-newsgroup-active nil)
1794
1795 (defvar gnus-newsgroup-data nil)
1796 (defvar gnus-newsgroup-data-reverse nil)
1797 (defvar gnus-newsgroup-limit nil)
1798 (defvar gnus-newsgroup-limits nil)
1799
1800 (defvar gnus-newsgroup-unreads nil
1801   "List of unread articles in the current newsgroup.")
1802
1803 (defvar gnus-newsgroup-unselected nil
1804   "List of unselected unread articles in the current newsgroup.")
1805
1806 (defvar gnus-newsgroup-reads nil
1807   "Alist of read articles and article marks in the current newsgroup.")
1808
1809 (defvar gnus-newsgroup-expunged-tally nil)
1810
1811 (defvar gnus-newsgroup-marked nil
1812   "List of ticked articles in the current newsgroup (a subset of unread art).")
1813
1814 (defvar gnus-newsgroup-killed nil
1815   "List of ranges of articles that have been through the scoring process.")
1816
1817 (defvar gnus-newsgroup-cached nil
1818   "List of articles that come from the article cache.")
1819
1820 (defvar gnus-newsgroup-saved nil
1821   "List of articles that have been saved.")
1822
1823 (defvar gnus-newsgroup-kill-headers nil)
1824
1825 (defvar gnus-newsgroup-replied nil
1826   "List of articles that have been replied to in the current newsgroup.")
1827
1828 (defvar gnus-newsgroup-expirable nil
1829   "List of articles in the current newsgroup that can be expired.")
1830
1831 (defvar gnus-newsgroup-processable nil
1832   "List of articles in the current newsgroup that can be processed.")
1833
1834 (defvar gnus-newsgroup-bookmarks nil
1835   "List of articles in the current newsgroup that have bookmarks.")
1836
1837 (defvar gnus-newsgroup-dormant nil
1838   "List of dormant articles in the current newsgroup.")
1839
1840 (defvar gnus-newsgroup-scored nil
1841   "List of scored articles in the current newsgroup.")
1842
1843 (defvar gnus-newsgroup-headers nil
1844   "List of article headers in the current newsgroup.")
1845
1846 (defvar gnus-newsgroup-threads nil)
1847
1848 (defvar gnus-newsgroup-prepared nil
1849   "Whether the current group has been prepared properly.")
1850
1851 (defvar gnus-newsgroup-ancient nil
1852   "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
1853
1854 (defvar gnus-newsgroup-sparse nil)
1855
1856 (defvar gnus-current-article nil)
1857 (defvar gnus-article-current nil)
1858 (defvar gnus-current-headers nil)
1859 (defvar gnus-have-all-headers nil)
1860 (defvar gnus-last-article nil)
1861 (defvar gnus-newsgroup-history nil)
1862 (defvar gnus-current-kill-article nil)
1863
1864 ;; Save window configuration.
1865 (defvar gnus-prev-winconf nil)
1866
1867 (defvar gnus-summary-mark-positions nil)
1868 (defvar gnus-group-mark-positions nil)
1869
1870 (defvar gnus-reffed-article-number nil)
1871
1872 ;;; Let the byte-compiler know that we know about this variable.
1873 (defvar rmail-default-rmail-file)
1874
1875 (defvar gnus-cache-removable-articles nil)
1876
1877 (defvar gnus-dead-summary nil)
1878
1879 (defconst gnus-summary-local-variables
1880   '(gnus-newsgroup-name
1881     gnus-newsgroup-begin gnus-newsgroup-end
1882     gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
1883     gnus-newsgroup-last-folder gnus-newsgroup-last-file
1884     gnus-newsgroup-auto-expire gnus-newsgroup-unreads
1885     gnus-newsgroup-unselected gnus-newsgroup-marked
1886     gnus-newsgroup-reads gnus-newsgroup-saved
1887     gnus-newsgroup-replied gnus-newsgroup-expirable
1888     gnus-newsgroup-processable gnus-newsgroup-killed
1889     gnus-newsgroup-bookmarks gnus-newsgroup-dormant
1890     gnus-newsgroup-headers gnus-newsgroup-threads
1891     gnus-newsgroup-prepared gnus-summary-highlight-line-function
1892     gnus-current-article gnus-current-headers gnus-have-all-headers
1893     gnus-last-article gnus-article-internal-prepare-hook
1894     gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
1895     gnus-newsgroup-scored gnus-newsgroup-kill-headers
1896     gnus-newsgroup-async 
1897     gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
1898     gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
1899     gnus-newsgroup-history gnus-newsgroup-ancient
1900     gnus-newsgroup-sparse
1901     (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
1902     gnus-newsgroup-adaptive-score-file
1903     (gnus-newsgroup-expunged-tally . 0)
1904     gnus-cache-removeable-articles gnus-newsgroup-cached
1905     gnus-newsgroup-data gnus-newsgroup-data-reverse
1906     gnus-newsgroup-limit gnus-newsgroup-limits)
1907   "Variables that are buffer-local to the summary buffers.")
1908
1909 (defconst gnus-bug-message
1910   "Sending a bug report to the Gnus Towers.
1911 ========================================
1912
1913 The buffer below is a mail buffer.  When you press `C-c C-c', it will
1914 be sent to the Gnus Bug Exterminators.
1915
1916 At the bottom of the buffer you'll see lots of variable settings.
1917 Please do not delete those.  They will tell the Bug People what your
1918 environment is, so that it will be easier to locate the bugs.
1919
1920 If you have found a bug that makes Emacs go \"beep\", set
1921 debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
1922 and include the backtrace in your bug report.
1923
1924 Please describe the bug in annoying, painstaking detail.
1925
1926 Thank you for your help in stamping out bugs.
1927 ")
1928
1929 ;;; End of variables.
1930
1931 ;; Define some autoload functions Gnus might use.
1932 (eval-and-compile
1933
1934   ;; This little mapcar goes through the list below and marks the
1935   ;; symbols in question as autoloaded functions.
1936   (mapcar
1937    (lambda (package)
1938      (let ((interactive (nth 1 (memq ':interactive package))))
1939        (mapcar
1940         (lambda (function)
1941           (let (keymap)
1942             (when (consp function)
1943               (setq keymap (car (memq 'keymap function)))
1944               (setq function (car function)))
1945             (autoload function (car package) nil interactive keymap)))
1946         (if (eq (nth 1 package) ':interactive)
1947             (cdddr package)
1948           (cdr package)))))
1949    '(("metamail" metamail-buffer)
1950      ("info" Info-goto-node)
1951      ("hexl" hexl-hex-string-to-integer)
1952      ("pp" pp pp-to-string pp-eval-expression)
1953      ("mail-extr" mail-extract-address-components)
1954      ("nnmail" nnmail-split-fancy nnmail-article-group)
1955      ("nnvirtual" nnvirtual-catchup-group)
1956      ("timezone" timezone-make-date-arpa-standard timezone-fix-time
1957       timezone-make-sortable-date timezone-make-time-string)
1958      ("sendmail" mail-position-on-field mail-setup)
1959      ("rmailout" rmail-output)
1960      ("rnewspost" news-mail-other-window news-reply-yank-original
1961       news-caesar-buffer-body)
1962      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
1963       rmail-show-message)
1964      ("gnus-soup" :interactive t
1965       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
1966       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1967      ("nnsoup" nnsoup-pack-replies)
1968      ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
1969       gnus-Folder-save-name gnus-folder-save-name)
1970      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
1971      ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
1972       gnus-server-make-menu-bar gnus-article-make-menu-bar
1973       gnus-browse-make-menu-bar gnus-highlight-selected-summary
1974       gnus-summary-highlight-line gnus-carpal-setup-buffer
1975       gnus-group-highlight-line
1976       gnus-article-add-button gnus-insert-next-page-button
1977       gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu)
1978      ("gnus-vis" :interactive t
1979       gnus-article-push-button gnus-article-press-button
1980       gnus-article-highlight gnus-article-highlight-some
1981       gnus-article-highlight-headers gnus-article-highlight-signature
1982       gnus-article-add-buttons gnus-article-add-buttons-to-head
1983       gnus-article-next-button gnus-article-prev-button)
1984      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
1985       gnus-demon-add-disconnection gnus-demon-add-handler
1986       gnus-demon-remove-handler)
1987      ("gnus-demon" :interactive t
1988       gnus-demon-init gnus-demon-cancel)
1989      ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
1990       gnus-tree-open gnus-tree-close)
1991      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close)
1992      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
1993      ("gnus-srvr" gnus-browse-foreign-server)
1994      ("gnus-cite" :interactive t
1995       gnus-article-highlight-citation gnus-article-hide-citation-maybe
1996       gnus-article-hide-citation gnus-article-fill-cited-article)
1997      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
1998       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
1999       gnus-execute gnus-expunge)
2000      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
2001       gnus-cache-possibly-remove-articles gnus-cache-request-article
2002       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
2003       gnus-cache-enter-remove-article gnus-cached-article-p
2004       gnus-cache-open gnus-cache-close)
2005      ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
2006       gnus-cache-remove-article)
2007      ("gnus-score" :interactive t
2008       gnus-summary-increase-score gnus-summary-lower-score
2009       gnus-score-flush-cache gnus-score-close
2010       gnus-score-raise-same-subject-and-select
2011       gnus-score-raise-same-subject gnus-score-default
2012       gnus-score-raise-thread gnus-score-lower-same-subject-and-select
2013       gnus-score-lower-same-subject gnus-score-lower-thread
2014       gnus-possibly-score-headers)
2015      ("gnus-score"
2016       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
2017       gnus-current-score-file-nondirectory gnus-score-adaptive
2018       gnus-score-find-trace gnus-score-file-name)
2019      ("gnus-edit" :interactive t gnus-score-customize)
2020      ("gnus-topic" :interactive t gnus-topic-mode)
2021      ("gnus-topic" gnus-topic-remove-group)
2022      ("gnus-salt" :interactive t gnus-pick-mode)
2023      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
2024      ("gnus-uu" :interactive t
2025       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
2026       gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
2027       gnus-uu-mark-by-regexp gnus-uu-mark-all
2028       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
2029       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
2030       gnus-uu-decode-unshar-and-save gnus-uu-decode-save
2031       gnus-uu-decode-binhex gnus-uu-decode-uu-view
2032       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
2033       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
2034       gnus-uu-decode-binhex-view)
2035      ("gnus-msg" (gnus-summary-send-map keymap)
2036       gnus-mail-yank-original gnus-mail-send-and-exit
2037       gnus-sendmail-setup-mail gnus-article-mail
2038       gnus-inews-message-id gnus-new-mail gnus-mail-reply)
2039      ("gnus-msg" :interactive t
2040       gnus-group-post-news gnus-group-mail gnus-summary-post-news
2041       gnus-summary-followup gnus-summary-followup-with-original
2042       gnus-summary-followup-and-reply
2043       gnus-summary-followup-and-reply-with-original
2044       gnus-summary-cancel-article gnus-summary-supersede-article
2045       gnus-post-news gnus-inews-news gnus-cancel-news
2046       gnus-summary-reply gnus-summary-reply-with-original
2047       gnus-summary-mail-forward gnus-summary-mail-other-window
2048       gnus-bug)
2049      ("gnus-picon" :interactive t gnus-article-display-picons
2050       gnus-group-display-picons gnus-picons-article-display-x-face)
2051      ("gnus-vm" gnus-vm-mail-setup)
2052      ("gnus-vm" :interactive t gnus-summary-save-in-vm
2053       gnus-summary-save-article-vm gnus-yank-article))))
2054
2055 \f
2056
2057 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2058 ;; If you want the cursor to go somewhere else, set these two
2059 ;; functions in some startup hook to whatever you want.
2060 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
2061 (defalias 'gnus-group-position-point 'gnus-goto-colon)
2062
2063 ;;; Various macros and substs.
2064
2065 (defun gnus-header-from (header)
2066   (mail-header-from header))
2067
2068 (defmacro gnus-eval-in-buffer-window (buffer &rest forms)
2069   "Pop to BUFFER, evaluate FORMS, and then return to the original window."
2070   `(let ((GnusStartBufferWindow (selected-window)))
2071      (unwind-protect
2072          (progn
2073            (pop-to-buffer ,buffer)
2074            ,@forms)
2075        (select-window GnusStartBufferWindow))))
2076
2077 (defmacro gnus-gethash (string hashtable)
2078   "Get hash value of STRING in HASHTABLE."
2079   `(symbol-value (intern-soft ,string ,hashtable)))
2080
2081 (defmacro gnus-sethash (string value hashtable)
2082   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2083   `(set (intern ,string ,hashtable) ,value))
2084
2085 (defmacro gnus-intern-safe (string hashtable)
2086   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
2087   `(let ((symbol (intern ,string ,hashtable)))
2088      (or (boundp symbol)
2089          (set symbol nil))
2090      symbol))
2091
2092 (defmacro gnus-group-unread (group)
2093   "Get the currently computed number of unread articles in GROUP."
2094   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
2095
2096 (defmacro gnus-group-entry (group)
2097   "Get the newsrc entry for GROUP."
2098   `(gnus-gethash ,group gnus-newsrc-hashtb))
2099
2100 (defmacro gnus-active (group)
2101   "Get active info on GROUP."
2102   `(gnus-gethash ,group gnus-active-hashtb))
2103
2104 (defmacro gnus-set-active (group active)
2105   "Set GROUP's active info."
2106   `(gnus-sethash ,group ,active gnus-active-hashtb))
2107
2108 ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2109 ;;   function `substring' might cut on a middle of multi-octet
2110 ;;   character.
2111 (defun gnus-truncate-string (str width)
2112   (substring str 0 width))
2113
2114 ;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
2115 ;; to limit the length of a string.  This function is necessary since
2116 ;; `(substr "abc" 0 30)' pukes with "Args out of range".
2117 (defsubst gnus-limit-string (str width)
2118   (if (> (length str) width)
2119       (substring str 0 width)
2120     str))
2121
2122 (defsubst gnus-simplify-subject-re (subject)
2123   "Remove \"Re:\" from subject lines."
2124   (if (string-match "^[Rr][Ee]: *" subject)
2125       (substring subject (match-end 0))
2126     subject))
2127
2128 (defsubst gnus-goto-char (point)
2129   (and point (goto-char point)))
2130
2131 (defmacro gnus-buffer-exists-p (buffer)
2132   `(and ,buffer
2133         (funcall (if (stringp ,buffer) 'get-buffer 'buffer-name)
2134                  ,buffer)))
2135
2136 (defmacro gnus-kill-buffer (buffer)
2137   `(let ((buf ,buffer))
2138      (if (gnus-buffer-exists-p buf)
2139          (kill-buffer buf))))
2140
2141 (defsubst gnus-point-at-bol ()
2142   "Return point at the beginning of the line."
2143   (let ((p (point)))
2144     (beginning-of-line)
2145     (prog1
2146         (point)
2147       (goto-char p))))
2148
2149 (defsubst gnus-point-at-eol ()
2150   "Return point at the end of the line."
2151   (let ((p (point)))
2152     (end-of-line)
2153     (prog1
2154         (point)
2155       (goto-char p))))
2156
2157 ;; Delete the current line (and the next N lines.);
2158 (defmacro gnus-delete-line (&optional n)
2159   `(delete-region (progn (beginning-of-line) (point))
2160                   (progn (forward-line ,(or n 1)) (point))))
2161
2162 ;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
2163 (defvar gnus-init-inhibit nil)
2164 (defun gnus-read-init-file (&optional inhibit-next)
2165   (if gnus-init-inhibit
2166       (setq gnus-init-inhibit nil)
2167     (setq gnus-init-inhibit inhibit-next)
2168     (and gnus-init-file
2169          (or (and (file-exists-p gnus-init-file)
2170                   ;; Don't try to load a directory.
2171                   (not (file-directory-p gnus-init-file)))
2172              (file-exists-p (concat gnus-init-file ".el"))
2173              (file-exists-p (concat gnus-init-file ".elc")))
2174          (condition-case var
2175              (load gnus-init-file nil t)
2176            (error
2177             (error "Error in %s: %s" gnus-init-file var))))))
2178
2179 ;; Info access macros.
2180
2181 (defmacro gnus-info-group (info)
2182   `(nth 0 ,info))
2183 (defmacro gnus-info-rank (info)
2184   `(nth 1 ,info))
2185 (defmacro gnus-info-read (info)
2186   `(nth 2 ,info))
2187 (defmacro gnus-info-marks (info)
2188   `(nth 3 ,info))
2189 (defmacro gnus-info-method (info)
2190   `(nth 4 ,info))
2191 (defmacro gnus-info-params (info)
2192   `(nth 5 ,info))
2193
2194 (defmacro gnus-info-level (info)
2195   `(let ((rank (gnus-info-rank ,info)))
2196      (if (consp rank)
2197          (car rank)
2198        rank)))
2199 (defmacro gnus-info-score (info)
2200   `(let ((rank (gnus-info-rank ,info)))
2201      (or (and (consp rank) (cdr rank)) 0)))
2202
2203 (defmacro gnus-info-set-group (info group)
2204   `(setcar ,info ,group))
2205 (defmacro gnus-info-set-rank (info rank)
2206   `(setcar (nthcdr 1 ,info) ,rank))
2207 (defmacro gnus-info-set-read (info read)
2208   `(setcar (nthcdr 2 ,info) ,read))
2209 (defmacro gnus-info-set-marks (info marks)
2210   `(setcar (nthcdr 3 ,info) ,marks))
2211 (defmacro gnus-info-set-method (info method)
2212   `(setcar (nthcdr 4 ,info) ,method))
2213 (defmacro gnus-info-set-params (info params)
2214   `(setcar (nthcdr 5 ,info) ,params))
2215
2216 (defmacro gnus-info-set-level (info level)
2217   `(let ((rank (cdr ,info)))
2218      (if (consp (car rank))
2219          (setcar (car rank) ,level)
2220        (setcar rank ,level))))
2221 (defmacro gnus-info-set-score (info score)
2222   `(let ((rank (cdr ,info)))
2223      (if (consp (car rank))
2224          (setcdr (car rank) ,score)
2225        (setcar rank (cons (car rank) ,score)))))
2226
2227 (defmacro gnus-get-info (group)
2228   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
2229
2230 (defun gnus-byte-code (func)
2231   "Return a form that can be `eval'ed based on FUNC."
2232   (let ((fval (symbol-function func)))
2233     (if (byte-code-function-p fval)
2234         (let ((flist (append fval nil)))
2235           (setcar flist 'byte-code)
2236           flist)
2237       (cons 'progn (cdr (cdr fval))))))
2238
2239 ;;; Load the compatability functions.
2240
2241 (require 'gnus-cus)
2242 (require 'gnus-ems)
2243
2244 \f
2245
2246 ;; Format specs.  The chunks below are the machine-generated forms
2247 ;; that are to be evaled as the result of the default format strings.
2248 ;; We write them in here to get them byte-compiled.  That way the
2249 ;; default actions will be quite fast, while still retaining the full
2250 ;; flexibility of the user-defined format specs.
2251
2252 ;; First we have lots of dummy defvars to let the compiler know these
2253 ;; are really dynamic variables.
2254
2255 (defvar gnus-tmp-unread)
2256 (defvar gnus-tmp-replied)
2257 (defvar gnus-tmp-score-char)
2258 (defvar gnus-tmp-indentation)
2259 (defvar gnus-tmp-opening-bracket)
2260 (defvar gnus-tmp-lines)
2261 (defvar gnus-tmp-name)
2262 (defvar gnus-tmp-closing-bracket)
2263 (defvar gnus-tmp-subject-or-nil)
2264 (defvar gnus-tmp-subject)
2265 (defvar gnus-tmp-marked)
2266 (defvar gnus-tmp-marked-mark)
2267 (defvar gnus-tmp-subscribed)
2268 (defvar gnus-tmp-process-marked)
2269 (defvar gnus-tmp-number-of-unread)
2270 (defvar gnus-tmp-group-name)
2271 (defvar gnus-tmp-group)
2272 (defvar gnus-tmp-article-number)
2273 (defvar gnus-tmp-unread-and-unselected)
2274 (defvar gnus-tmp-news-method)
2275 (defvar gnus-tmp-news-server)
2276 (defvar gnus-tmp-article-number)
2277 (defvar gnus-mouse-face)
2278 (defvar gnus-mouse-face-prop)
2279
2280 (defun gnus-summary-line-format-spec ()
2281   (insert gnus-tmp-unread gnus-tmp-replied
2282           gnus-tmp-score-char gnus-tmp-indentation)
2283   (put-text-property
2284    (point)
2285    (progn
2286      (insert
2287       gnus-tmp-opening-bracket
2288       (format "%4d: %-20s"
2289               gnus-tmp-lines
2290               (if (> (length gnus-tmp-name) 20)
2291                   (substring gnus-tmp-name 0 20)
2292                 gnus-tmp-name))
2293       gnus-tmp-closing-bracket)
2294      (point))
2295    gnus-mouse-face-prop gnus-mouse-face)
2296   (insert " " gnus-tmp-subject-or-nil "\n"))
2297
2298 (defvar gnus-summary-line-format-spec
2299   (gnus-byte-code 'gnus-summary-line-format-spec))
2300
2301 (defun gnus-summary-dummy-line-format-spec ()
2302   (insert "*  ")
2303   (put-text-property
2304    (point)
2305    (progn
2306      (insert ":                          :")
2307      (point))
2308    gnus-mouse-face-prop gnus-mouse-face)
2309   (insert " " gnus-tmp-subject "\n"))
2310
2311 (defvar gnus-summary-dummy-line-format-spec
2312   (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
2313
2314 (defun gnus-group-line-format-spec ()
2315   (insert gnus-tmp-marked-mark gnus-tmp-subscribed
2316           gnus-tmp-process-marked
2317           gnus-group-indentation
2318           (format "%5s: " gnus-tmp-number-of-unread))
2319   (put-text-property
2320    (point)
2321    (progn
2322      (insert gnus-tmp-group "\n")
2323      (1- (point)))
2324    gnus-mouse-face-prop gnus-mouse-face))
2325 (defvar gnus-group-line-format-spec
2326   (gnus-byte-code 'gnus-group-line-format-spec))
2327
2328 (defvar gnus-format-specs
2329   `((version . ,emacs-version)
2330     (group ,gnus-group-line-format ,gnus-group-line-format-spec)
2331     (summary-dummy ,gnus-summary-dummy-line-format
2332                    ,gnus-summary-dummy-line-format-spec)
2333     (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec)))
2334
2335 (defvar gnus-article-mode-line-format-spec nil)
2336 (defvar gnus-summary-mode-line-format-spec nil)
2337 (defvar gnus-group-mode-line-format-spec nil)
2338
2339 ;;; Phew.  All that gruft is over, fortunately.
2340
2341 \f
2342 ;;;
2343 ;;; Gnus Utility Functions
2344 ;;;
2345
2346 (defun gnus-extract-address-components (from)
2347   (let (name address)
2348     ;; First find the address - the thing with the @ in it.  This may
2349     ;; not be accurate in mail addresses, but does the trick most of
2350     ;; the time in news messages.
2351     (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
2352         (setq address (substring from (match-beginning 0) (match-end 0))))
2353     ;; Then we check whether the "name <address>" format is used.
2354     (and address
2355          ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
2356          ;; Linear white space is not required.
2357          (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
2358          (and (setq name (substring from 0 (match-beginning 0)))
2359               ;; Strip any quotes from the name.
2360               (string-match "\".*\"" name)
2361               (setq name (substring name 1 (1- (match-end 0))))))
2362     ;; If not, then "address (name)" is used.
2363     (or name
2364         (and (string-match "(.+)" from)
2365              (setq name (substring from (1+ (match-beginning 0))
2366                                    (1- (match-end 0)))))
2367         (and (string-match "()" from)
2368              (setq name address))
2369         ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
2370         ;; XOVER might not support folded From headers.
2371         (and (string-match "(.*" from)
2372              (setq name (substring from (1+ (match-beginning 0))
2373                                    (match-end 0)))))
2374     ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
2375     (list (or name from) (or address from))))
2376
2377 (defun gnus-fetch-field (field)
2378   "Return the value of the header FIELD of current article."
2379   (save-excursion
2380     (save-restriction
2381       (let ((case-fold-search t))
2382         (nnheader-narrow-to-headers)
2383         (mail-fetch-field field)))))
2384
2385 (defun gnus-goto-colon ()
2386   (beginning-of-line)
2387   (search-forward ":" (gnus-point-at-eol) t))
2388
2389 ;;;###autoload
2390 (defun gnus-update-format (var)
2391   "Update the format specification near point."
2392   (interactive
2393    (list
2394     (save-excursion
2395       (eval-defun nil)
2396       ;; Find the end of the current word.
2397       (re-search-forward "[ \t\n]" nil t)
2398       ;; Search backward.
2399       (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
2400         (match-string 1)))))
2401   (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
2402                               (match-string 1 var))))
2403          (entry (assq type gnus-format-specs))
2404          value spec)
2405     (when entry
2406       (setq gnus-format-specs (delq entry gnus-format-specs)))
2407     (set
2408      (intern (format "%s-spec" var))
2409      (gnus-parse-format (setq value (symbol-value (intern var)))
2410                         (symbol-value (intern (format "%s-alist" var)))
2411                         (not (string-match "mode" var))))
2412     (setq spec (symbol-value (intern (format "%s-spec" var))))
2413     (push (list type value spec) gnus-format-specs)
2414
2415     (pop-to-buffer "*Gnus Format*")
2416     (erase-buffer)
2417     (lisp-interaction-mode)
2418     (insert (pp-to-string spec))))
2419
2420
2421 (defun gnus-update-format-specifications (&optional force)
2422   "Update all (necessary) format specifications."
2423   ;; Make the indentation array.
2424   (gnus-make-thread-indent-array)
2425
2426   ;; See whether all the stored info needs to be flushed.
2427   (when (or force
2428             (not (equal emacs-version
2429                         (cdr (assq 'version gnus-format-specs)))))
2430     (setq gnus-format-specs nil))
2431
2432   ;; Go through all the formats and see whether they need updating.
2433   (let ((types '(summary summary-dummy group
2434                          summary-mode group-mode article-mode))
2435         new-format entry type val)
2436     (while (setq type (pop types))
2437       (setq new-format (symbol-value
2438                         (intern (format "gnus-%s-line-format" type))))
2439       (setq entry (cdr (assq type gnus-format-specs)))
2440       (if (and entry
2441                (equal (car entry) new-format))
2442           ;; Use the old format.
2443           (set (intern (format "gnus-%s-line-format-spec" type))
2444                (cadr entry))
2445         ;; This is a new format.
2446         (setq val
2447               (if (not (stringp new-format))
2448                   ;; This is a function call or something.
2449                   new-format
2450                 ;; This is a "real" format.
2451                 (gnus-parse-format
2452                  new-format
2453                  (symbol-value
2454                   (intern (format "gnus-%s-line-format-alist"
2455                                   (if (eq type 'article-mode)
2456                                       'summary-mode type))))
2457                  (not (string-match "mode$" (symbol-name type))))))
2458         ;; Enter the new format spec into the list.
2459         (if entry
2460             (progn
2461               (setcar (cdr entry) val)
2462               (setcar entry new-format))
2463           (push (list type new-format val) gnus-format-specs))
2464         (set (intern (format "gnus-%s-line-format-spec" type)) val))))
2465
2466   (gnus-update-group-mark-positions)
2467   (gnus-update-summary-mark-positions)
2468
2469   ;; See whether we need to read the description file.
2470   (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
2471            (not gnus-description-hashtb)
2472            gnus-read-active-file)
2473       (gnus-read-all-descriptions-files)))
2474
2475 (defun gnus-update-summary-mark-positions ()
2476   "Compute where the summary marks are to go."
2477   (save-excursion
2478     (let ((gnus-replied-mark 129)
2479           (gnus-score-below-mark 130)
2480           (gnus-score-over-mark 130)
2481           (thread nil)
2482           (gnus-visual nil)
2483           pos)
2484       (gnus-set-work-buffer)
2485       (gnus-summary-insert-line
2486        [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
2487       (goto-char (point-min))
2488       (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
2489                                          (- (point) 2)))))
2490       (goto-char (point-min))
2491       (setq pos (cons (cons 'replied (and (search-forward "\201" nil t)
2492                                           (- (point) 2))) pos))
2493       (goto-char (point-min))
2494       (setq pos (cons (cons 'score (and (search-forward "\202" nil t)
2495                                         (- (point) 2))) pos))
2496       (setq gnus-summary-mark-positions pos))))
2497
2498 (defun gnus-update-group-mark-positions ()
2499   (save-excursion
2500     (let ((gnus-process-mark 128)
2501           (gnus-group-marked '("dummy.group")))
2502       (gnus-set-active "dummy.group" '(0 . 0))
2503       (gnus-set-work-buffer)
2504       (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
2505       (goto-char (point-min))
2506       (setq gnus-group-mark-positions
2507             (list (cons 'process (and (search-forward "\200" nil t)
2508                                       (- (point) 2))))))))
2509
2510 (defvar gnus-mouse-face-0 'highlight)
2511 (defvar gnus-mouse-face-1 'highlight)
2512 (defvar gnus-mouse-face-2 'highlight)
2513 (defvar gnus-mouse-face-3 'highlight)
2514 (defvar gnus-mouse-face-4 'highlight)
2515
2516 (defun gnus-mouse-face-function (form type)
2517   `(put-text-property
2518     (point) (progn ,@form (point))
2519     gnus-mouse-face-prop
2520     ,(if (equal type 0)
2521          'gnus-mouse-face
2522        `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
2523
2524 (defvar gnus-face-0 'bold)
2525 (defvar gnus-face-1 'italic)
2526 (defvar gnus-face-2 'bold-italic)
2527 (defvar gnus-face-3 'bold)
2528 (defvar gnus-face-4 'bold)
2529
2530 (defun gnus-face-face-function (form type)
2531   `(put-text-property
2532     (point) (progn ,@form (point))
2533     'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
2534
2535 (defun gnus-max-width-function (el max-width)
2536   (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
2537   (if (symbolp el)
2538       `(if (> (length ,el) ,max-width)
2539            (substring ,el 0 ,max-width)
2540          ,el)
2541     `(let ((val (eval ,el)))
2542        (if (numberp val)
2543            (setq val (int-to-string val)))
2544        (if (> (length val) ,max-width)
2545            (substring val 0 ,max-width)
2546          val))))
2547
2548 (defun gnus-parse-format (format spec-alist &optional insert)
2549   ;; This function parses the FORMAT string with the help of the
2550   ;; SPEC-ALIST and returns a list that can be eval'ed to return the
2551   ;; string.  If the FORMAT string contains the specifiers %( and %)
2552   ;; the text between them will have the mouse-face text property.
2553   (if (string-match
2554        "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
2555        format)
2556       (gnus-parse-complex-format format spec-alist)
2557     ;; This is a simple format.
2558     (gnus-parse-simple-format format spec-alist insert)))
2559
2560 (defun gnus-parse-complex-format (format spec-alist)
2561   (save-excursion
2562     (gnus-set-work-buffer)
2563     (insert format)
2564     (goto-char (point-min))
2565     (while (re-search-forward "\"" nil t)
2566       (replace-match "\\\"" nil t))
2567     (goto-char (point-min))
2568     (insert "(\"")
2569     (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
2570       (let ((number (if (match-beginning 1)
2571                         (match-string 1) "0"))
2572             (delim (aref (match-string 2) 0)))
2573         (if (or (= delim ?\() (= delim ?\{))
2574             (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
2575                                    " " number " \""))
2576           (replace-match "\")\""))))
2577     (goto-char (point-max))
2578     (insert "\")")
2579     (goto-char (point-min))
2580     (let ((form (read (current-buffer))))
2581       (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
2582
2583 (defun gnus-complex-form-to-spec (form spec-alist)
2584   (delq nil
2585         (mapcar
2586          (lambda (sform)
2587            (if (stringp sform)
2588                (gnus-parse-simple-format sform spec-alist t)
2589              (funcall (intern (format "gnus-%s-face-function"
2590                                       (car sform)))
2591                       (gnus-complex-form-to-spec
2592                        (cdr (cdr sform)) spec-alist)
2593                       (nth 1 sform))))
2594          form)))
2595
2596 (defun gnus-parse-simple-format (format spec-alist &optional insert)
2597   ;; This function parses the FORMAT string with the help of the
2598   ;; SPEC-ALIST and returns a list that can be eval'ed to return a
2599   ;; string.
2600   (let ((max-width 0)
2601         spec flist fstring newspec elem beg result dontinsert)
2602     (save-excursion
2603       (gnus-set-work-buffer)
2604       (insert format)
2605       (goto-char (point-min))
2606       (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
2607                                 nil t)
2608         (if (= (setq spec (string-to-char (match-string 2))) ?%)
2609               (setq newspec "%"
2610                     beg (1+ (match-beginning 0)))
2611           ;; First check if there are any specs that look anything like
2612           ;; "%12,12A", ie. with a "max width specification".  These have
2613           ;; to be treated specially.
2614           (if (setq beg (match-beginning 1))
2615               (setq max-width
2616                     (string-to-int
2617                      (buffer-substring
2618                       (1+ (match-beginning 1)) (match-end 1))))
2619             (setq max-width 0)
2620             (setq beg (match-beginning 2)))
2621           ;; Find the specification from `spec-alist'.
2622           (unless (setq elem (cdr (assq spec spec-alist)))
2623             (setq elem '("*" ?s)))
2624           ;; Treat user defined format specifiers specially.
2625           (when (eq (car elem) 'gnus-tmp-user-defined)
2626             (setq elem
2627                   (list
2628                    (list (intern (concat "gnus-user-format-function-"
2629                                          (match-string 3)))
2630                          'gnus-tmp-header) ?s))
2631             (delete-region (match-beginning 3) (match-end 3)))
2632           (if (not (zerop max-width))
2633               (let ((el (car elem)))
2634                 (cond ((= (car (cdr elem)) ?c)
2635                        (setq el (list 'char-to-string el)))
2636                       ((= (car (cdr elem)) ?d)
2637                        (setq el (list 'int-to-string el))))
2638                 (setq flist (cons (gnus-max-width-function el max-width)
2639                                   flist))
2640                 (setq newspec ?s))
2641             (progn
2642               (setq flist (cons (car elem) flist))
2643               (setq newspec (car (cdr elem))))))
2644         ;; Remove the old specification (and possibly a ",12" string).
2645         (delete-region beg (match-end 2))
2646         ;; Insert the new specification.
2647         (goto-char beg)
2648         (insert newspec))
2649       (setq fstring (buffer-substring 1 (point-max))))
2650     ;; Do some postprocessing to increase efficiency.
2651     (setq
2652      result
2653      (cond
2654       ;; Emptyness.
2655       ((string= fstring "")
2656        nil)
2657       ;; Not a format string.
2658       ((not (string-match "%" fstring))
2659        (list fstring))
2660       ;; A format string with just a single string spec.
2661       ((string= fstring "%s")
2662        (list (car flist)))
2663       ;; A single character.
2664       ((string= fstring "%c")
2665        (list (car flist)))
2666       ;; A single number.
2667       ((string= fstring "%d")
2668        (setq dontinsert)
2669        (if insert
2670            (list `(princ ,(car flist)))
2671          (list `(int-to-string ,(car flist)))))
2672       ;; Just lots of chars and strings.
2673       ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
2674        (nreverse flist))
2675       ;; A single string spec at the beginning of the spec.
2676       ((string-match "\\`%[sc][^%]+\\'" fstring)
2677        (list (car flist) (substring fstring 2)))
2678       ;; A single string spec in the middle of the spec.
2679       ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
2680        (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
2681       ;; A single string spec in the end of the spec.
2682       ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
2683        (list (match-string 1 fstring) (car flist)))
2684       ;; A more complex spec.
2685       (t
2686        (list (cons 'format (cons fstring (nreverse flist)))))))
2687
2688     (if insert
2689         (when result
2690           (if dontinsert
2691               result
2692             (cons 'insert result)))
2693       (cond ((stringp result)
2694              result)
2695             ((consp result)
2696              (cons 'concat result))
2697             (t "")))))
2698
2699 (defun gnus-eval-format (format &optional alist props)
2700   "Eval the format variable FORMAT, using ALIST.
2701 If PROPS, insert the result."
2702   (let ((form (gnus-parse-format format alist props)))
2703     (if props
2704         (add-text-properties (point) (progn (eval form) (point)) props)
2705       (eval form))))
2706
2707 (defun gnus-remove-text-with-property (prop)
2708   "Delete all text in the current buffer with text property PROP."
2709   (save-excursion
2710     (goto-char (point-min))
2711     (while (not (eobp))
2712       (while (get-text-property (point) prop)
2713         (delete-char 1))
2714       (goto-char (next-single-property-change (point) prop nil (point-max))))))
2715
2716 (defun gnus-set-work-buffer ()
2717   (if (get-buffer gnus-work-buffer)
2718       (progn
2719         (set-buffer gnus-work-buffer)
2720         (erase-buffer))
2721     (set-buffer (get-buffer-create gnus-work-buffer))
2722     (kill-all-local-variables)
2723     (buffer-disable-undo (current-buffer))
2724     (gnus-add-current-to-buffer-list)))
2725
2726 ;; Article file names when saving.
2727
2728 (defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
2729   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2730 If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
2731 Otherwise, it is like ~/News/news/group/num."
2732   (let ((default
2733           (expand-file-name
2734            (concat (if (gnus-use-long-file-name 'not-save)
2735                        (gnus-capitalize-newsgroup newsgroup)
2736                      (gnus-newsgroup-directory-form newsgroup))
2737                    "/" (int-to-string (mail-header-number headers)))
2738            (or gnus-article-save-directory "~/News"))))
2739     (if (and last-file
2740              (string-equal (file-name-directory default)
2741                            (file-name-directory last-file))
2742              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2743         default
2744       (or last-file default))))
2745
2746 (defun gnus-numeric-save-name (newsgroup headers &optional last-file)
2747   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2748 If variable `gnus-use-long-file-name' is non-nil, it is
2749 ~/News/news.group/num.  Otherwise, it is like ~/News/news/group/num."
2750   (let ((default
2751           (expand-file-name
2752            (concat (if (gnus-use-long-file-name 'not-save)
2753                        newsgroup
2754                      (gnus-newsgroup-directory-form newsgroup))
2755                    "/" (int-to-string (mail-header-number headers)))
2756            (or gnus-article-save-directory "~/News"))))
2757     (if (and last-file
2758              (string-equal (file-name-directory default)
2759                            (file-name-directory last-file))
2760              (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
2761         default
2762       (or last-file default))))
2763
2764 (defun gnus-Plain-save-name (newsgroup headers &optional last-file)
2765   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2766 If variable `gnus-use-long-file-name' is non-nil, it is
2767 ~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
2768   (or last-file
2769       (expand-file-name
2770        (if (gnus-use-long-file-name 'not-save)
2771            (gnus-capitalize-newsgroup newsgroup)
2772          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2773        (or gnus-article-save-directory "~/News"))))
2774
2775 (defun gnus-plain-save-name (newsgroup headers &optional last-file)
2776   "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
2777 If variable `gnus-use-long-file-name' is non-nil, it is
2778 ~/News/news.group.  Otherwise, it is like ~/News/news/group/news."
2779   (or last-file
2780       (expand-file-name
2781        (if (gnus-use-long-file-name 'not-save)
2782            newsgroup
2783          (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
2784        (or gnus-article-save-directory "~/News"))))
2785
2786 ;; For subscribing new newsgroup
2787
2788 (defun gnus-subscribe-hierarchical-interactive (groups)
2789   (let ((groups (sort groups 'string<))
2790         prefixes prefix start ans group starts)
2791     (while groups
2792       (setq prefixes (list "^"))
2793       (while (and groups prefixes)
2794         (while (not (string-match (car prefixes) (car groups)))
2795           (setq prefixes (cdr prefixes)))
2796         (setq prefix (car prefixes))
2797         (setq start (1- (length prefix)))
2798         (if (and (string-match "[^\\.]\\." (car groups) start)
2799                  (cdr groups)
2800                  (setq prefix
2801                        (concat "^" (substring (car groups) 0 (match-end 0))))
2802                  (string-match prefix (car (cdr groups))))
2803             (progn
2804               (setq prefixes (cons prefix prefixes))
2805               (message "Descend hierarchy %s? ([y]nsq): "
2806                        (substring prefix 1 (1- (length prefix))))
2807               (setq ans (read-char))
2808               (cond ((= ans ?n)
2809                      (while (and groups
2810                                  (string-match prefix
2811                                                (setq group (car groups))))
2812                        (setq gnus-killed-list
2813                              (cons group gnus-killed-list))
2814                        (gnus-sethash group group gnus-killed-hashtb)
2815                        (setq groups (cdr groups)))
2816                      (setq starts (cdr starts)))
2817                     ((= ans ?s)
2818                      (while (and groups
2819                                  (string-match prefix
2820                                                (setq group (car groups))))
2821                        (gnus-sethash group group gnus-killed-hashtb)
2822                        (gnus-subscribe-alphabetically (car groups))
2823                        (setq groups (cdr groups)))
2824                      (setq starts (cdr starts)))
2825                     ((= ans ?q)
2826                      (while groups
2827                        (setq group (car groups))
2828                        (setq gnus-killed-list (cons group gnus-killed-list))
2829                        (gnus-sethash group group gnus-killed-hashtb)
2830                        (setq groups (cdr groups))))
2831                     (t nil)))
2832           (message "Subscribe %s? ([n]yq)" (car groups))
2833           (setq ans (read-char))
2834           (setq group (car groups))
2835           (cond ((= ans ?y)
2836                  (gnus-subscribe-alphabetically (car groups))
2837                  (gnus-sethash group group gnus-killed-hashtb))
2838                 ((= ans ?q)
2839                  (while groups
2840                    (setq group (car groups))
2841                    (setq gnus-killed-list (cons group gnus-killed-list))
2842                    (gnus-sethash group group gnus-killed-hashtb)
2843                    (setq groups (cdr groups))))
2844                 (t
2845                  (setq gnus-killed-list (cons group gnus-killed-list))
2846                  (gnus-sethash group group gnus-killed-hashtb)))
2847           (setq groups (cdr groups)))))))
2848
2849 (defun gnus-subscribe-randomly (newsgroup)
2850   "Subscribe new NEWSGROUP by making it the first newsgroup."
2851   (gnus-subscribe-newsgroup newsgroup))
2852
2853 (defun gnus-subscribe-alphabetically (newgroup)
2854   "Subscribe new NEWSGROUP and insert it in alphabetical order."
2855   (let ((groups (cdr gnus-newsrc-alist))
2856         before)
2857     (while (and (not before) groups)
2858       (if (string< newgroup (car (car groups)))
2859           (setq before (car (car groups)))
2860         (setq groups (cdr groups))))
2861     (gnus-subscribe-newsgroup newgroup before)))
2862
2863 (defun gnus-subscribe-hierarchically (newgroup)
2864   "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
2865   ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
2866   (save-excursion
2867     (set-buffer (find-file-noselect gnus-current-startup-file))
2868     (let ((groupkey newgroup)
2869           before)
2870       (while (and (not before) groupkey)
2871         (goto-char (point-min))
2872         (let ((groupkey-re
2873                (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
2874           (while (and (re-search-forward groupkey-re nil t)
2875                       (progn
2876                         (setq before (match-string 1))
2877                         (string< before newgroup)))))
2878         ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
2879         (setq groupkey
2880               (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
2881                   (substring groupkey (match-beginning 1) (match-end 1)))))
2882       (gnus-subscribe-newsgroup newgroup before))))
2883
2884 (defun gnus-subscribe-interactively (group)
2885   "Subscribe the new GROUP interactively.
2886 It is inserted in hierarchical newsgroup order if subscribed.  If not,
2887 it is killed."
2888   (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
2889       (gnus-subscribe-hierarchically group)
2890     (push group gnus-killed-list)))
2891
2892 (defun gnus-subscribe-zombies (group)
2893   "Make the new GROUP into a zombie group."
2894   (push group gnus-zombie-list))
2895
2896 (defun gnus-subscribe-killed (group)
2897   "Make the new GROUP a killed group."
2898   (push group gnus-killed-list))
2899
2900 (defun gnus-subscribe-newsgroup (newsgroup &optional next)
2901   "Subscribe new NEWSGROUP.
2902 If NEXT is non-nil, it is inserted before NEXT.  Otherwise it is made
2903 the first newsgroup."
2904   ;; We subscribe the group by changing its level to `subscribed'.
2905   (gnus-group-change-level
2906    newsgroup gnus-level-default-subscribed
2907    gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
2908   (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
2909
2910 ;; For directories
2911
2912 (defun gnus-newsgroup-directory-form (newsgroup)
2913   "Make hierarchical directory name from NEWSGROUP name."
2914   (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
2915         (len (length newsgroup))
2916         idx)
2917     ;; If this is a foreign group, we don't want to translate the
2918     ;; entire name.
2919     (if (setq idx (string-match ":" newsgroup))
2920         (aset newsgroup idx ?/)
2921       (setq idx 0))
2922     ;; Replace all occurrences of `.' with `/'.
2923     (while (< idx len)
2924       (if (= (aref newsgroup idx) ?.)
2925           (aset newsgroup idx ?/))
2926       (setq idx (1+ idx)))
2927     newsgroup))
2928
2929 (defun gnus-newsgroup-savable-name (group)
2930   ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
2931   ;; with dots.
2932   (nnheader-replace-chars-in-string group ?/ ?.))
2933
2934 (defun gnus-make-directory (dir)
2935   "Make DIRECTORY recursively."
2936   ;; Why don't we use `(make-directory dir 'parents)'?  That's just one
2937   ;; of the many mysteries of the universe.
2938   (let* ((dir (expand-file-name dir default-directory))
2939          dirs err)
2940     (if (string-match "/$" dir)
2941         (setq dir (substring dir 0 (match-beginning 0))))
2942     ;; First go down the path until we find a directory that exists.
2943     (while (not (file-exists-p dir))
2944       (setq dirs (cons dir dirs))
2945       (string-match "/[^/]+$" dir)
2946       (setq dir (substring dir 0 (match-beginning 0))))
2947     ;; Then create all the subdirs.
2948     (while (and dirs (not err))
2949       (condition-case ()
2950           (make-directory (car dirs))
2951         (error (setq err t)))
2952       (setq dirs (cdr dirs)))
2953     ;; We return whether we were successful or not.
2954     (not dirs)))
2955
2956 (defun gnus-capitalize-newsgroup (newsgroup)
2957   "Capitalize NEWSGROUP name."
2958   (and (not (zerop (length newsgroup)))
2959        (concat (char-to-string (upcase (aref newsgroup 0)))
2960                (substring newsgroup 1))))
2961
2962 ;; Various... things.
2963
2964 (defun gnus-simplify-subject (subject &optional re-only)
2965   "Remove `Re:' and words in parentheses.
2966 If RE-ONLY is non-nil, strip leading `Re:'s only."
2967   (let ((case-fold-search t))           ;Ignore case.
2968     ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
2969     (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
2970       (setq subject (substring subject (match-end 0))))
2971     ;; Remove uninteresting prefixes.
2972     (if (and (not re-only)
2973              gnus-simplify-ignored-prefixes
2974              (string-match gnus-simplify-ignored-prefixes subject))
2975         (setq subject (substring subject (match-end 0))))
2976     ;; Remove words in parentheses from end.
2977     (unless re-only
2978       (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
2979         (setq subject (substring subject 0 (match-beginning 0)))))
2980     ;; Return subject string.
2981     subject))
2982
2983 ;; Remove any leading "re:"s, any trailing paren phrases, and simplify
2984 ;; all whitespace.
2985 ;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
2986 (defun gnus-simplify-buffer-fuzzy ()
2987   (goto-char (point-min))
2988   (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*" nil t)
2989   (goto-char (match-beginning 0))
2990   (while (or
2991           (looking-at "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*")
2992           (looking-at "^[[].*:[ \t].*[]]$"))
2993     (goto-char (point-min))
2994     (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
2995                               nil t)
2996       (replace-match "" t t))
2997     (goto-char (point-min))
2998     (while (re-search-forward "^[[].*:[ \t].*[]]$" nil t)
2999       (goto-char (match-end 0))
3000       (delete-char -1)
3001       (delete-region
3002        (progn (goto-char (match-beginning 0)))
3003        (re-search-forward ":"))))
3004   (goto-char (point-min))
3005   (while (re-search-forward "[ \t\n]*[[{(][^()]*[]})][ \t]*$" nil t)
3006     (replace-match "" t t))
3007   (goto-char (point-min))
3008   (while (re-search-forward "[ \t]+" nil t)
3009     (replace-match " " t t))
3010   (goto-char (point-min))
3011   (while (re-search-forward "[ \t]+$" nil t)
3012     (replace-match "" t t))
3013   (goto-char (point-min))
3014   (while (re-search-forward "^[ \t]+" nil t)
3015     (replace-match "" t t))
3016   (goto-char (point-min))
3017   (if gnus-simplify-subject-fuzzy-regexp
3018       (if (listp gnus-simplify-subject-fuzzy-regexp)
3019           (let ((list gnus-simplify-subject-fuzzy-regexp))
3020             (while list
3021               (goto-char (point-min))
3022               (while (re-search-forward (car list) nil t)
3023                 (replace-match "" t t))
3024               (setq list (cdr list))))
3025         (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
3026           (replace-match "" t t)))))
3027
3028 (defun gnus-simplify-subject-fuzzy (subject)
3029   "Siplify a subject string fuzzily."
3030   (save-excursion
3031     (gnus-set-work-buffer)
3032     (let ((case-fold-search t))
3033       (insert subject)
3034       (inline (gnus-simplify-buffer-fuzzy))
3035       (buffer-string))))
3036
3037 ;; Add the current buffer to the list of buffers to be killed on exit.
3038 (defun gnus-add-current-to-buffer-list ()
3039   (or (memq (current-buffer) gnus-buffer-list)
3040       (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
3041
3042 (defun gnus-string> (s1 s2)
3043   (not (or (string< s1 s2)
3044            (string= s1 s2))))
3045
3046 ;;; General various misc type functions.
3047
3048 (defun gnus-clear-system ()
3049   "Clear all variables and buffers."
3050   ;; Clear Gnus variables.
3051   (let ((variables gnus-variable-list))
3052     (while variables
3053       (set (car variables) nil)
3054       (setq variables (cdr variables))))
3055   ;; Clear other internal variables.
3056   (setq gnus-list-of-killed-groups nil
3057         gnus-have-read-active-file nil
3058         gnus-newsrc-alist nil
3059         gnus-newsrc-hashtb nil
3060         gnus-killed-list nil
3061         gnus-zombie-list nil
3062         gnus-killed-hashtb nil
3063         gnus-active-hashtb nil
3064         gnus-moderated-list nil
3065         gnus-description-hashtb nil
3066         gnus-newsgroup-headers nil
3067         gnus-newsgroup-name nil
3068         gnus-server-alist nil
3069         gnus-opened-servers nil
3070         gnus-current-select-method nil)
3071   ;; Reset any score variables.
3072   (and gnus-use-scoring (gnus-score-close))
3073   ;; Kill the startup file.
3074   (and gnus-current-startup-file
3075        (get-file-buffer gnus-current-startup-file)
3076        (kill-buffer (get-file-buffer gnus-current-startup-file)))
3077   ;; Save any cache buffers.
3078   (and gnus-use-cache (gnus-cache-save-buffers))
3079   ;; Clear the dribble buffer.
3080   (gnus-dribble-clear)
3081   ;; Close down NoCeM.
3082   (and gnus-use-nocem (gnus-nocem-close))
3083   ;; Shut down the demons.
3084   (and gnus-use-demon (gnus-demon-cancel))
3085   ;; Kill global KILL file buffer.
3086   (if (get-file-buffer (gnus-newsgroup-kill-file nil))
3087       (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
3088   (gnus-kill-buffer nntp-server-buffer)
3089   ;; Backlog.
3090   (and gnus-keep-backlog (gnus-backlog-shutdown))
3091   ;; Kill Gnus buffers.
3092   (while gnus-buffer-list
3093     (gnus-kill-buffer (car gnus-buffer-list))
3094     (setq gnus-buffer-list (cdr gnus-buffer-list))))
3095
3096 (defun gnus-windows-old-to-new (setting)
3097   ;; First we take care of the really, really old Gnus 3 actions.
3098   (if (symbolp setting)
3099       (setq setting
3100             (cond ((memq setting '(SelectArticle))
3101                    'article)
3102                   ((memq setting '(SelectSubject ExpandSubject))
3103                    'summary)
3104                   ((memq setting '(SelectNewsgroup ExitNewsgroup))
3105                    'group)
3106                   (t setting))))
3107   (if (or (listp setting)
3108           (not (and gnus-window-configuration
3109                     (memq setting '(group summary article)))))
3110       setting
3111     (let* ((setting (if (eq setting 'group)
3112                         (if (assq 'newsgroup gnus-window-configuration)
3113                             'newsgroup
3114                           'newsgroups) setting))
3115            (elem (car (cdr (assq setting gnus-window-configuration))))
3116            (total (apply '+ elem))
3117            (types '(group summary article))
3118            (pbuf (if (eq setting 'newsgroups) 'group 'summary))
3119            (i 0)
3120            perc
3121            out)
3122       (while (< i 3)
3123         (or (not (numberp (nth i elem)))
3124             (zerop (nth i elem))
3125             (progn
3126               (setq perc  (/ (float (nth 0 elem)) total))
3127               (setq out (cons (if (eq pbuf (nth i types))
3128                                   (vector (nth i types) perc 'point)
3129                                 (vector (nth i types) perc))
3130                               out))))
3131         (setq i (1+ i)))
3132       (list (nreverse out)))))
3133
3134 (defun gnus-add-configuration (conf)
3135   "Add the window configuration CONF to `gnus-buffer-configuration'."
3136   (setq gnus-buffer-configuration
3137         (cons conf (delq (assq (car conf) gnus-buffer-configuration)
3138                          gnus-buffer-configuration))))
3139
3140 (defvar gnus-frame-list nil)
3141
3142 (defun gnus-configure-frame (split &optional window)
3143   "Split WINDOW according to SPLIT."
3144   (unless window
3145     (setq window (get-buffer-window (current-buffer))))
3146   (select-window window)
3147   ;; This might be an old-stylee buffer config.
3148   (when (vectorp split)
3149     (setq split (append split nil)))
3150   (when (or (consp (car split))
3151             (vectorp (car split)))
3152     (push 1.0 split)
3153     (push 'vertical split))
3154   ;; The SPLIT might be something that is to be evaled to
3155   ;; return a new SPLIT.
3156   (while (and (not (assq (car split) gnus-window-to-buffer))
3157               (gnus-functionp (car split)))
3158     (setq split (eval split)))
3159   (let* ((type (car split))
3160          (subs (cddr split))
3161          (len (if (eq type 'horizontal) (window-width) (window-height)))
3162          (total 0)
3163          (window-min-width (or gnus-window-min-width window-min-width))
3164          (window-min-height (or gnus-window-min-height window-min-height))
3165          s result new-win rest comp-subs size sub)
3166     (cond
3167      ;; Nothing to do here.
3168      ((null split))
3169      ;; Don't switch buffers.
3170      ((null type)
3171       (and (memq 'point split) window))
3172      ;; This is a buffer to be selected.
3173      ((not (memq type '(frame horizontal vertical)))
3174       (let ((buffer (cond ((stringp type) type)
3175                           (t (cdr (assq type gnus-window-to-buffer)))))
3176             buf)
3177         (unless buffer
3178           (error "Illegal buffer type: %s" type))
3179         (unless (setq buf (get-buffer (if (symbolp buffer)
3180                                           (symbol-value buffer) buffer)))
3181           (setq buf (get-buffer-create (if (symbolp buffer)
3182                                            (symbol-value buffer) buffer))))
3183         (switch-to-buffer buf)
3184         ;; We return the window if it has the `point' spec.
3185         (and (memq 'point split) window)))
3186      ;; This is a frame split.
3187      ((eq type 'frame)
3188       (unless gnus-frame-list
3189         (setq gnus-frame-list (list (window-frame
3190                                      (get-buffer-window (current-buffer))))))
3191       (let ((i 0)
3192             params frame fresult)
3193         (while (< i (length subs))
3194           ;; Frame parameter is gotten from the sub-split.
3195           (setq params (cadr (elt subs i)))
3196           ;; It should be a list.
3197           (unless (listp params)
3198             (setq params nil))
3199           ;; Create a new frame?
3200           (unless (setq frame (elt gnus-frame-list i))
3201             (nconc gnus-frame-list (list (setq frame (make-frame params)))))
3202           ;; Is the old frame still alive?
3203           (unless (frame-live-p frame)
3204             (setcar (nthcdr i gnus-frame-list)
3205                     (setq frame (make-frame params))))
3206           ;; Select the frame in question and do more splits there.
3207           (select-frame frame)
3208           (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
3209           (incf i))
3210         ;; Select the frame that has the selected buffer.
3211         (when fresult
3212           (select-frame (window-frame fresult)))))
3213      ;; This is a normal split.
3214      (t
3215       (when (> (length subs) 0)
3216         ;; First we have to compute the sizes of all new windows.
3217         (while subs
3218           (setq sub (append (pop subs) nil))
3219           (while (and (not (assq (car sub) gnus-window-to-buffer))
3220                       (gnus-functionp (car sub)))
3221             (setq sub (eval sub)))
3222           (when sub
3223             (push sub comp-subs)
3224             (setq size (cadar comp-subs))
3225             (cond ((equal size 1.0)
3226                    (setq rest (car comp-subs))
3227                    (setq s 0))
3228                   ((floatp size)
3229                    (setq s (floor (* size len))))
3230                   ((integerp size)
3231                    (setq s size))
3232                   (t
3233                    (error "Illegal size: %s" size)))
3234             ;; Try to make sure that we are inside the safe limits.
3235             (cond ((zerop s))
3236                   ((eq type 'horizontal)
3237                    (setq s (max s window-min-width)))
3238                   ((eq type 'vertical)
3239                    (setq s (max s window-min-height))))
3240             (setcar (cdar comp-subs) s)
3241             (incf total s)))
3242         ;; Take care of the "1.0" spec.
3243         (if rest
3244             (setcar (cdr rest) (- len total))
3245           (error "No 1.0 specs in %s" split))
3246         ;; The we do the actual splitting in a nice recursive
3247         ;; fashion.
3248         (setq comp-subs (nreverse comp-subs))
3249         (while comp-subs
3250           (if (null (cdr comp-subs))
3251               (setq new-win window)
3252             (setq new-win
3253                   (split-window window (cadar comp-subs)
3254                                 (eq type 'horizontal))))
3255           (setq result (or (gnus-configure-frame
3256                             (car comp-subs) window) result))
3257           (select-window new-win)
3258           (setq window new-win)
3259           (setq comp-subs (cdr comp-subs))))
3260       ;; Return the proper window, if any.
3261       (when result
3262         (select-window result))))))
3263
3264 (defvar gnus-frame-split-p nil)
3265
3266 (defun gnus-configure-windows (setting &optional force)
3267   (setq setting (gnus-windows-old-to-new setting))
3268   (let ((split (if (symbolp setting)
3269                    (car (cdr (assq setting gnus-buffer-configuration)))
3270                  setting))
3271         (in-buf (current-buffer))
3272         rule val w height hor ohor heights sub jump-buffer
3273         rel total to-buf all-visible)
3274
3275     (setq gnus-frame-split-p nil)
3276
3277     (unless split
3278       (error "No such setting: %s" setting))
3279
3280     (if (and (not force)
3281              (setq all-visible (gnus-all-windows-visible-p split)))
3282         ;; All the windows mentioned are already visible, so we just
3283         ;; put point in the assigned buffer, and do not touch the
3284         ;; winconf.
3285         (select-window all-visible)
3286
3287       ;; Either remove all windows or just remove all Gnus windows.
3288       (let ((frame (selected-frame)))
3289         (unwind-protect
3290             (if gnus-use-full-window
3291                 ;; We want to remove all other windows.
3292                 (if (not gnus-frame-split-p)
3293                     ;; This is not a `frame' split, so we ignore the
3294                     ;; other frames.  
3295                     (delete-other-windows)
3296                   ;; This is a `frame' split, so we delete all windows
3297                   ;; on all frames.
3298                   (mapcar 
3299                    (lambda (frame)
3300                      (unless (eq (cdr (assq 'minibuffer
3301                                             (frame-parameters frame)))
3302                                  'only)
3303                        (select-frame frame)
3304                        (delete-other-windows)))
3305                    (frame-list)))
3306               ;; Just remove some windows.
3307               (gnus-remove-some-windows)
3308               (switch-to-buffer nntp-server-buffer))
3309           (select-frame frame)))
3310
3311       (switch-to-buffer nntp-server-buffer)
3312       (gnus-configure-frame split (get-buffer-window (current-buffer))))))
3313
3314 (defun gnus-all-windows-visible-p (split)
3315   (when (vectorp split)
3316     (setq split (append split nil)))
3317   (when (or (consp (car split))
3318             (vectorp (car split)))
3319     (push 1.0 split)
3320     (push 'vertical split))
3321   ;; The SPLIT might be something that is to be evaled to
3322   ;; return a new SPLIT.
3323   (while (and (not (assq (car split) gnus-window-to-buffer))
3324               (gnus-functionp (car split)))
3325     (setq split (eval split)))
3326   (let* ((type (elt split 0)))
3327     (cond
3328      ((null split)
3329       t)
3330      ((not (or (eq type 'horizontal) (eq type 'vertical) (eq type 'frame)))
3331       (let ((buffer (cond ((stringp type) type)
3332                           (t (cdr (assq type gnus-window-to-buffer)))))
3333             win buf)
3334         (unless buffer
3335           (error "Illegal buffer type: %s" type))
3336         (when (setq buf (get-buffer (if (symbolp buffer) (symbol-value buffer)
3337                                       buffer)))
3338           (setq win (get-buffer-window buf t)))
3339         (when win
3340           (if (memq 'point split)
3341               win
3342             t))))
3343      (t
3344       (when (eq type 'frame)
3345         (setq gnus-frame-split-p t))
3346       (let ((n (mapcar 'gnus-all-windows-visible-p
3347                        (cdr (cdr split))))
3348             (win t))
3349         (while n
3350           (cond ((windowp (car n))
3351                  (setq win (car n)))
3352                 ((null (car n))
3353                  (setq win nil)))
3354           (setq n (cdr n)))
3355         win)))))
3356
3357 (defun gnus-window-top-edge (&optional window)
3358   (nth 1 (window-edges window)))
3359
3360 (defun gnus-remove-some-windows ()
3361   (let ((buffers gnus-window-to-buffer)
3362         buf bufs lowest-buf lowest)
3363     (save-excursion
3364       ;; Remove windows on all known Gnus buffers.
3365       (while buffers
3366         (setq buf (cdr (car buffers)))
3367         (if (symbolp buf)
3368             (setq buf (and (boundp buf) (symbol-value buf))))
3369         (and buf
3370              (get-buffer-window buf)
3371              (progn
3372                (setq bufs (cons buf bufs))
3373                (pop-to-buffer buf)
3374                (if (or (not lowest)
3375                        (< (gnus-window-top-edge) lowest))
3376                    (progn
3377                      (setq lowest (gnus-window-top-edge))
3378                      (setq lowest-buf buf)))))
3379         (setq buffers (cdr buffers)))
3380       ;; Remove windows on *all* summary buffers.
3381       (let (wins)
3382         (walk-windows
3383          (lambda (win)
3384            (let ((buf (window-buffer win)))
3385              (if (string-match  "^\\*Summary" (buffer-name buf))
3386                  (progn
3387                    (setq bufs (cons buf bufs))
3388                    (pop-to-buffer buf)
3389                    (if (or (not lowest)
3390                            (< (gnus-window-top-edge) lowest))
3391                        (progn
3392                          (setq lowest-buf buf)
3393                          (setq lowest (gnus-window-top-edge))))))))))
3394       (and lowest-buf
3395            (progn
3396              (pop-to-buffer lowest-buf)
3397              (switch-to-buffer nntp-server-buffer)))
3398       (while bufs
3399         (and (not (eq (car bufs) lowest-buf))
3400              (delete-windows-on (car bufs)))
3401         (setq bufs (cdr bufs))))))
3402
3403 (defun gnus-version ()
3404   "Version numbers of this version of Gnus."
3405   (interactive)
3406   (let ((methods gnus-valid-select-methods)
3407         (mess gnus-version)
3408         meth)
3409     ;; Go through all the legal select methods and add their version
3410     ;; numbers to the total version string.  Only the backends that are
3411     ;; currently in use will have their message numbers taken into
3412     ;; consideration.
3413     (while methods
3414       (setq meth (intern (concat (car (car methods)) "-version")))
3415       (and (boundp meth)
3416            (stringp (symbol-value meth))
3417            (setq mess (concat mess "; " (symbol-value meth))))
3418       (setq methods (cdr methods)))
3419     (gnus-message 2 mess)))
3420
3421 (defun gnus-info-find-node ()
3422   "Find Info documentation of Gnus."
3423   (interactive)
3424   ;; Enlarge info window if needed.
3425   (let ((mode major-mode)
3426         gnus-info-buffer)
3427     (Info-goto-node (car (cdr (assq mode gnus-info-nodes))))
3428     (setq gnus-info-buffer (current-buffer))
3429     (gnus-configure-windows 'info)))
3430
3431 (defun gnus-days-between (date1 date2)
3432   ;; Return the number of days between date1 and date2.
3433   (- (gnus-day-number date1) (gnus-day-number date2)))
3434
3435 (defun gnus-day-number (date)
3436   (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
3437                      (timezone-parse-date date))))
3438     (timezone-absolute-from-gregorian
3439      (nth 1 dat) (nth 2 dat) (car dat))))
3440
3441 (defun gnus-encode-date (date)
3442   "Convert DATE to internal time."
3443   (let* ((parse (timezone-parse-date date))
3444          (date (mapcar (lambda (d) (and d (string-to-int d))) parse))
3445          (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
3446     (encode-time (caddr time) (cadr time) (car time)
3447                  (caddr date) (cadr date) (car date) (nth 4 date))))
3448
3449 (defun gnus-time-minus (t1 t2)
3450   "Subtract two internal times."
3451   (let ((borrow (< (cadr t1) (cadr t2))))
3452     (list (- (car t1) (car t2) (if borrow 1 0))
3453           (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
3454
3455 (defun gnus-file-newer-than (file date)
3456   (let ((fdate (nth 5 (file-attributes file))))
3457     (or (> (car fdate) (car date))
3458         (and (= (car fdate) (car date))
3459              (> (nth 1 fdate) (nth 1 date))))))
3460
3461 (defmacro gnus-define-keys (keymap &rest plist)
3462   "Define all keys in PLIST in KEYMAP."
3463   `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
3464
3465 (defun gnus-define-keys-1 (keymap plist)
3466   (when (null keymap)
3467     (error "Can't set keys in a null keymap"))
3468   (cond ((symbolp keymap)
3469          (setq keymap (symbol-value keymap)))
3470         ((listp keymap)
3471          (set (car keymap) nil)
3472          (define-prefix-command (car keymap))
3473          (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
3474          (setq keymap (symbol-value (car keymap)))))
3475   (let (key)
3476     (while plist
3477       (when (symbolp (setq key (pop plist)))
3478         (setq key (symbol-value key)))
3479       (define-key keymap key (pop plist)))))
3480
3481 (defun gnus-group-read-only-p (&optional group)
3482   "Check whether GROUP supports editing or not.
3483 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
3484 that that variable is buffer-local to the summary buffers."
3485   (let ((group (or group gnus-newsgroup-name)))
3486     (not (gnus-check-backend-function 'request-replace-article group))))
3487
3488 (defun gnus-group-total-expirable-p (group)
3489   "Check whether GROUP is total-expirable or not."
3490   (let ((params (gnus-info-params (gnus-get-info group))))
3491     (or (memq 'total-expire params)
3492         (cdr (assq 'total-expire params)) ; (total-expire . t)
3493         (and gnus-total-expirable-newsgroups ; Check var.
3494              (string-match gnus-total-expirable-newsgroups group)))))
3495
3496 (defun gnus-group-auto-expirable-p (group)
3497   "Check whether GROUP is total-expirable or not."
3498   (let ((params (gnus-info-params (gnus-get-info group))))
3499     (or (memq 'auto-expire params)
3500         (cdr (assq 'auto-expire params)) ; (auto-expire . t)
3501         (and gnus-auto-expirable-newsgroups ; Check var.
3502              (string-match gnus-auto-expirable-newsgroups group)))))
3503
3504 (defun gnus-virtual-group-p (group)
3505   "Say whether GROUP is virtual or not."
3506   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
3507                         gnus-valid-select-methods)))
3508
3509 (defsubst gnus-simplify-subject-fully (subject)
3510   "Simplify a subject string according to the user's wishes."
3511   (cond
3512    ((null gnus-summary-gather-subject-limit)
3513     (gnus-simplify-subject-re subject))
3514    ((eq gnus-summary-gather-subject-limit 'fuzzy)
3515     (gnus-simplify-subject-fuzzy subject))
3516    ((numberp gnus-summary-gather-subject-limit)
3517     (gnus-limit-string (gnus-simplify-subject-re subject)
3518                        gnus-summary-gather-subject-limit))
3519    (t
3520     subject)))
3521
3522 (defsubst gnus-subject-equal (s1 s2 &optional simple-first)
3523   "Check whether two subjects are equal.  If optional argument
3524 simple-first is t, first argument is already simplified."
3525   (cond
3526    ((null simple-first)
3527     (equal (gnus-simplify-subject-fully s1)
3528            (gnus-simplify-subject-fully s2)))
3529    (t
3530     (equal s1
3531            (gnus-simplify-subject-fully s2)))))
3532
3533 ;; Returns a list of writable groups.
3534 (defun gnus-writable-groups ()
3535   (let ((alist gnus-newsrc-alist)
3536         groups)
3537     (while alist
3538       (or (gnus-group-read-only-p (car (car alist)))
3539           (setq groups (cons (car (car alist)) groups)))
3540       (setq alist (cdr alist)))
3541     (nreverse groups)))
3542
3543 ;; Two silly functions to ensure that all `y-or-n-p' questions clear
3544 ;; the echo area.
3545 (defun gnus-y-or-n-p (prompt)
3546   (prog1
3547       (y-or-n-p prompt)
3548     (message "")))
3549
3550 (defun gnus-yes-or-no-p (prompt)
3551   (prog1
3552       (yes-or-no-p prompt)
3553     (message "")))
3554
3555 ;; Check whether to use long file names.
3556 (defun gnus-use-long-file-name (symbol)
3557   ;; The variable has to be set...
3558   (and gnus-use-long-file-name
3559        ;; If it isn't a list, then we return t.
3560        (or (not (listp gnus-use-long-file-name))
3561            ;; If it is a list, and the list contains `symbol', we
3562            ;; return nil.
3563            (not (memq symbol gnus-use-long-file-name)))))
3564
3565 ;; I suspect there's a better way, but I haven't taken the time to do
3566 ;; it yet. -erik selberg@cs.washington.edu
3567 (defun gnus-dd-mmm (messy-date)
3568   "Return a string like DD-MMM from a big messy string"
3569   (let ((datevec (timezone-parse-date messy-date)))
3570     (format "%2s-%s"
3571             (or (aref datevec 2) "??")
3572             (capitalize
3573              (or (car
3574                   (nth (1- (string-to-number (aref datevec 1)))
3575                        timezone-months-assoc))
3576                  "???")))))
3577
3578 ;; Make a hash table (default and minimum size is 255).
3579 ;; Optional argument HASHSIZE specifies the table size.
3580 (defun gnus-make-hashtable (&optional hashsize)
3581   (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
3582
3583 ;; Make a number that is suitable for hashing; bigger than MIN and one
3584 ;; less than 2^x.
3585 (defun gnus-create-hash-size (min)
3586   (let ((i 1))
3587     (while (< i min)
3588       (setq i (* 2 i)))
3589     (1- i)))
3590
3591 ;; Show message if message has a lower level than `gnus-verbose'.
3592 ;; Guideline for numbers:
3593 ;; 1 - error messages, 3 - non-serious error messages, 5 - messages
3594 ;; for things that take a long time, 7 - not very important messages
3595 ;; on stuff, 9 - messages inside loops.
3596 (defun gnus-message (level &rest args)
3597   (if (<= level gnus-verbose)
3598       (apply 'message args)
3599     ;; We have to do this format thingy here even if the result isn't
3600     ;; shown - the return value has to be the same as the return value
3601     ;; from `message'.
3602     (apply 'format args)))
3603
3604 (defun gnus-functionp (form)
3605   "Return non-nil if FORM is funcallable."
3606   (or (and (symbolp form) (fboundp form))
3607       (and (listp form) (eq (car form) 'lambda))))
3608
3609 ;; Generate a unique new group name.
3610 (defun gnus-generate-new-group-name (leaf)
3611   (let ((name leaf)
3612         (num 0))
3613     (while (gnus-gethash name gnus-newsrc-hashtb)
3614       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3615     name))
3616
3617 ;; Find out whether the gnus-visual TYPE is wanted.
3618 (defun gnus-visual-p (&optional type class)
3619   (and gnus-visual                      ; Has to be non-nil, at least.
3620        (if (not type)                   ; We don't care about type.
3621            gnus-visual
3622          (if (listp gnus-visual)        ; It's a list, so we check it.
3623              (or (memq type gnus-visual)
3624                  (memq class gnus-visual))
3625            t))))
3626
3627 (defun gnus-parent-id (references)
3628   "Return the last Message-ID in REFERENCES."
3629   (when (and references
3630              (string-match "\\(<[^<>]+>\\)[ \t\n]*\\'" references))
3631     (substring references (match-beginning 1) (match-end 1))))
3632
3633 (defun gnus-split-references (references)
3634   "Return a list of Message-IDs in REFERENCES."
3635   (let ((beg 0)
3636         ids)
3637     (while (string-match "<[^>]+>" references beg)
3638       (push (substring references (match-beginning 0) (setq beg (match-end 0)))
3639             ids))
3640     (nreverse ids)))
3641
3642 (defun gnus-ephemeral-group-p (group)
3643   "Say whether GROUP is ephemeral or not."
3644   (assoc 'quit-config (gnus-find-method-for-group group)))
3645
3646 (defun gnus-group-quit-config (group)
3647   "Return the quit-config of GROUP."
3648   (nth 1 (assoc 'quit-config (gnus-find-method-for-group group))))
3649
3650 (defun gnus-simplify-mode-line ()
3651   "Make mode lines a bit simpler."
3652   (setq mode-line-modified "-- ")
3653   (when (listp mode-line-format)
3654     (make-local-variable 'mode-line-format)
3655     (setq mode-line-format (copy-sequence mode-line-format))
3656     (when (equal (nth 3 mode-line-format) "   ")
3657       (setcar (nthcdr 3 mode-line-format) " "))))
3658
3659 ;;; List and range functions
3660
3661 (defun gnus-last-element (list)
3662   "Return last element of LIST."
3663   (while (cdr list)
3664     (setq list (cdr list)))
3665   (car list))
3666
3667 (defun gnus-copy-sequence (list)
3668   "Do a complete, total copy of a list."
3669   (if (and (consp list) (not (consp (cdr list))))
3670       (cons (car list) (cdr list))
3671     (mapcar (lambda (elem) (if (consp elem)
3672                                (if (consp (cdr elem))
3673                                    (gnus-copy-sequence elem)
3674                                  (cons (car elem) (cdr elem)))
3675                              elem))
3676             list)))
3677
3678 (defun gnus-set-difference (list1 list2)
3679   "Return a list of elements of LIST1 that do not appear in LIST2."
3680   (let ((list1 (copy-sequence list1)))
3681     (while list2
3682       (setq list1 (delq (car list2) list1))
3683       (setq list2 (cdr list2)))
3684     list1))
3685
3686 (defun gnus-sorted-complement (list1 list2)
3687   "Return a list of elements of LIST1 that do not appear in LIST2.
3688 Both lists have to be sorted over <."
3689   (let (out)
3690     (if (or (null list1) (null list2))
3691         (or list1 list2)
3692       (while (and list1 list2)
3693         (cond ((= (car list1) (car list2))
3694                (setq list1 (cdr list1)
3695                      list2 (cdr list2)))
3696               ((< (car list1) (car list2))
3697                (setq out (cons (car list1) out))
3698                (setq list1 (cdr list1)))
3699               (t
3700                (setq out (cons (car list2) out))
3701                (setq list2 (cdr list2)))))
3702       (nconc (nreverse out) (or list1 list2)))))
3703
3704 (defun gnus-intersection (list1 list2)
3705   (let ((result nil))
3706     (while list2
3707       (if (memq (car list2) list1)
3708           (setq result (cons (car list2) result)))
3709       (setq list2 (cdr list2)))
3710     result))
3711
3712 (defun gnus-sorted-intersection (list1 list2)
3713   ;; LIST1 and LIST2 have to be sorted over <.
3714   (let (out)
3715     (while (and list1 list2)
3716       (cond ((= (car list1) (car list2))
3717              (setq out (cons (car list1) out)
3718                    list1 (cdr list1)
3719                    list2 (cdr list2)))
3720             ((< (car list1) (car list2))
3721              (setq list1 (cdr list1)))
3722             (t
3723              (setq list2 (cdr list2)))))
3724     (nreverse out)))
3725
3726 (defun gnus-set-sorted-intersection (list1 list2)
3727   ;; LIST1 and LIST2 have to be sorted over <.
3728   ;; This function modifies LIST1.
3729   (let* ((top (cons nil list1))
3730          (prev top))
3731     (while (and list1 list2)
3732       (cond ((= (car list1) (car list2))
3733              (setq prev list1
3734                    list1 (cdr list1)
3735                    list2 (cdr list2)))
3736             ((< (car list1) (car list2))
3737              (setcdr prev (cdr list1))
3738              (setq list1 (cdr list1)))
3739             (t
3740              (setq list2 (cdr list2)))))
3741     (setcdr prev nil)
3742     (cdr top)))
3743
3744 (defun gnus-compress-sequence (numbers &optional always-list)
3745   "Convert list of numbers to a list of ranges or a single range.
3746 If ALWAYS-LIST is non-nil, this function will always release a list of
3747 ranges."
3748   (let* ((first (car numbers))
3749          (last (car numbers))
3750          result)
3751     (if (null numbers)
3752         nil
3753       (if (not (listp (cdr numbers)))
3754           numbers
3755         (while numbers
3756           (cond ((= last (car numbers)) nil) ;Omit duplicated number
3757                 ((= (1+ last) (car numbers)) ;Still in sequence
3758                  (setq last (car numbers)))
3759                 (t                      ;End of one sequence
3760                  (setq result
3761                        (cons (if (= first last) first
3762                                (cons first last)) result))
3763                  (setq first (car numbers))
3764                  (setq last  (car numbers))))
3765           (setq numbers (cdr numbers)))
3766         (if (and (not always-list) (null result))
3767             (if (= first last) (list first) (cons first last))
3768           (nreverse (cons (if (= first last) first (cons first last))
3769                           result)))))))
3770
3771 (defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
3772 (defun gnus-uncompress-range (ranges)
3773   "Expand a list of ranges into a list of numbers.
3774 RANGES is either a single range on the form `(num . num)' or a list of
3775 these ranges."
3776   (let (first last result)
3777     (cond
3778      ((null ranges)
3779       nil)
3780      ((not (listp (cdr ranges)))
3781       (setq first (car ranges))
3782       (setq last (cdr ranges))
3783       (while (<= first last)
3784         (setq result (cons first result))
3785         (setq first (1+ first)))
3786       (nreverse result))
3787      (t
3788       (while ranges
3789         (if (atom (car ranges))
3790             (if (numberp (car ranges))
3791                 (setq result (cons (car ranges) result)))
3792           (setq first (car (car ranges)))
3793           (setq last  (cdr (car ranges)))
3794           (while (<= first last)
3795             (setq result (cons first result))
3796             (setq first (1+ first))))
3797         (setq ranges (cdr ranges)))
3798       (nreverse result)))))
3799
3800 (defun gnus-add-to-range (ranges list)
3801   "Return a list of ranges that has all articles from both RANGES and LIST.
3802 Note: LIST has to be sorted over `<'."
3803   (if (not ranges)
3804       (gnus-compress-sequence list t)
3805     (setq list (copy-sequence list))
3806     (or (listp (cdr ranges))
3807         (setq ranges (list ranges)))
3808     (let ((out ranges)
3809           ilist lowest highest temp)
3810       (while (and ranges list)
3811         (setq ilist list)
3812         (setq lowest (or (and (atom (car ranges)) (car ranges))
3813                          (car (car ranges))))
3814         (while (and list (cdr list) (< (car (cdr list)) lowest))
3815           (setq list (cdr list)))
3816         (if (< (car ilist) lowest)
3817             (progn
3818               (setq temp list)
3819               (setq list (cdr list))
3820               (setcdr temp nil)
3821               (setq out (nconc (gnus-compress-sequence ilist t) out))))
3822         (setq highest (or (and (atom (car ranges)) (car ranges))
3823                           (cdr (car ranges))))
3824         (while (and list (<= (car list) highest))
3825           (setq list (cdr list)))
3826         (setq ranges (cdr ranges)))
3827       (if list
3828           (setq out (nconc (gnus-compress-sequence list t) out)))
3829       (setq out (sort out (lambda (r1 r2)
3830                             (< (or (and (atom r1) r1) (car r1))
3831                                (or (and (atom r2) r2) (car r2))))))
3832       (setq ranges out)
3833       (while ranges
3834         (if (atom (car ranges))
3835             (if (cdr ranges)
3836                 (if (atom (car (cdr ranges)))
3837                     (if (= (1+ (car ranges)) (car (cdr ranges)))
3838                         (progn
3839                           (setcar ranges (cons (car ranges)
3840                                                (car (cdr ranges))))
3841                           (setcdr ranges (cdr (cdr ranges)))))
3842                   (if (= (1+ (car ranges)) (car (car (cdr ranges))))
3843                       (progn
3844                         (setcar (car (cdr ranges)) (car ranges))
3845                         (setcar ranges (car (cdr ranges)))
3846                         (setcdr ranges (cdr (cdr ranges)))))))
3847           (if (cdr ranges)
3848               (if (atom (car (cdr ranges)))
3849                   (if (= (1+ (cdr (car ranges))) (car (cdr ranges)))
3850                       (progn
3851                         (setcdr (car ranges) (car (cdr ranges)))
3852                         (setcdr ranges (cdr (cdr ranges)))))
3853                 (if (= (1+ (cdr (car ranges))) (car (car (cdr ranges))))
3854                     (progn
3855                       (setcdr (car ranges) (cdr (car (cdr ranges))))
3856                       (setcdr ranges (cdr (cdr ranges))))))))
3857         (setq ranges (cdr ranges)))
3858       out)))
3859
3860 (defun gnus-remove-from-range (ranges list)
3861   "Return a list of ranges that has all articles from LIST removed from RANGES.
3862 Note: LIST has to be sorted over `<'."
3863   ;; !!! This function shouldn't look like this, but I've got a headache.
3864   (gnus-compress-sequence
3865    (gnus-sorted-complement
3866     (gnus-uncompress-range ranges) list)))
3867
3868 (defun gnus-member-of-range (number ranges)
3869   (if (not (listp (cdr ranges)))
3870       (and (>= number (car ranges))
3871            (<= number (cdr ranges)))
3872     (let ((not-stop t))
3873       (while (and ranges
3874                   (if (numberp (car ranges))
3875                       (>= number (car ranges))
3876                     (>= number (car (car ranges))))
3877                   not-stop)
3878         (if (if (numberp (car ranges))
3879                 (= number (car ranges))
3880               (and (>= number (car (car ranges)))
3881                    (<= number (cdr (car ranges)))))
3882             (setq not-stop nil))
3883         (setq ranges (cdr ranges)))
3884       (not not-stop))))
3885
3886 (defun gnus-range-length (range)
3887   "Return the length RANGE would have if uncompressed."
3888   (length (gnus-uncompress-range range)))
3889
3890 (defun gnus-sublist-p (list sublist)
3891   "Test whether all elements in SUBLIST are members of LIST."
3892   (let ((sublistp t))
3893     (while sublist
3894       (unless (memq (pop sublist) list)
3895         (setq sublistp nil
3896               sublist nil)))
3897     sublistp))
3898
3899 \f
3900 ;;;
3901 ;;; Gnus group mode
3902 ;;;
3903
3904 (defvar gnus-group-mode-map nil)
3905 (put 'gnus-group-mode 'mode-class 'special)
3906
3907 (unless gnus-group-mode-map
3908   (setq gnus-group-mode-map (make-keymap))
3909   (suppress-keymap gnus-group-mode-map)
3910
3911   (gnus-define-keys
3912    gnus-group-mode-map
3913    " " gnus-group-read-group
3914    "=" gnus-group-select-group
3915    "\M- " gnus-group-unhidden-select-group
3916    "\r" gnus-group-select-group
3917    "\M-\r" gnus-group-quick-select-group
3918    "j" gnus-group-jump-to-group
3919    "n" gnus-group-next-unread-group
3920    "p" gnus-group-prev-unread-group
3921    "\177" gnus-group-prev-unread-group
3922    "N" gnus-group-next-group
3923    "P" gnus-group-prev-group
3924    "\M-n" gnus-group-next-unread-group-same-level
3925    "\M-p" gnus-group-prev-unread-group-same-level
3926    "," gnus-group-best-unread-group
3927    "." gnus-group-first-unread-group
3928    "u" gnus-group-unsubscribe-current-group
3929    "U" gnus-group-unsubscribe-group
3930    "c" gnus-group-catchup-current
3931    "C" gnus-group-catchup-current-all
3932    "l" gnus-group-list-groups
3933    "L" gnus-group-list-all-groups
3934    "m" gnus-group-mail
3935    "g" gnus-group-get-new-news
3936    "\M-g" gnus-group-get-new-news-this-group
3937    "R" gnus-group-restart
3938    "r" gnus-group-read-init-file
3939    "B" gnus-group-browse-foreign-server
3940    "b" gnus-group-check-bogus-groups
3941    "F" gnus-find-new-newsgroups
3942    "\C-c\C-d" gnus-group-describe-group
3943    "\M-d" gnus-group-describe-all-groups
3944    "\C-c\C-a" gnus-group-apropos
3945    "\C-c\M-\C-a" gnus-group-description-apropos
3946    "a" gnus-group-post-news
3947    "\ek" gnus-group-edit-local-kill
3948    "\eK" gnus-group-edit-global-kill
3949    "\C-k" gnus-group-kill-group
3950    "\C-y" gnus-group-yank-group
3951    "\C-w" gnus-group-kill-region
3952    "\C-x\C-t" gnus-group-transpose-groups
3953    "\C-c\C-l" gnus-group-list-killed
3954    "\C-c\C-x" gnus-group-expire-articles
3955    "\C-c\M-\C-x" gnus-group-expire-all-groups
3956    "V" gnus-version
3957    "s" gnus-group-save-newsrc
3958    "z" gnus-group-suspend
3959    "Z" gnus-group-clear-dribble
3960    "q" gnus-group-exit
3961    "Q" gnus-group-quit
3962    "?" gnus-group-describe-briefly
3963    "\C-c\C-i" gnus-info-find-node
3964    "\M-e" gnus-group-edit-group-method
3965    "^" gnus-group-enter-server-mode
3966    gnus-mouse-2 gnus-mouse-pick-group
3967    "<" beginning-of-buffer
3968    ">" end-of-buffer
3969    "\C-c\C-b" gnus-bug
3970    "\C-c\C-s" gnus-group-sort-groups
3971    "t" gnus-topic-mode
3972    "\C-c\M-g" gnus-activate-all-groups
3973    "\M-&" gnus-group-universal-argument
3974    "#" gnus-group-mark-group
3975    "\M-#" gnus-group-unmark-group)
3976
3977   (gnus-define-keys
3978    (gnus-group-mark-map "M" gnus-group-mode-map)
3979    "m" gnus-group-mark-group
3980    "u" gnus-group-unmark-group
3981    "w" gnus-group-mark-region
3982    "m" gnus-group-mark-buffer
3983    "r" gnus-group-mark-regexp
3984    "U" gnus-group-unmark-all-groups)
3985
3986   (gnus-define-keys
3987    (gnus-group-group-map "G" gnus-group-mode-map)
3988    "d" gnus-group-make-directory-group
3989    "h" gnus-group-make-help-group
3990    "a" gnus-group-make-archive-group
3991    "k" gnus-group-make-kiboze-group
3992    "m" gnus-group-make-group
3993    "E" gnus-group-edit-group
3994    "e" gnus-group-edit-group-method
3995    "p" gnus-group-edit-group-parameters
3996    "v" gnus-group-add-to-virtual
3997    "V" gnus-group-make-empty-virtual
3998    "D" gnus-group-enter-directory
3999    "f" gnus-group-make-doc-group
4000    "r" gnus-group-rename-group
4001    "\177" gnus-group-delete-group)
4002
4003    (gnus-define-keys
4004     (gnus-group-soup-map "s" gnus-group-group-map)
4005     "b" gnus-group-brew-soup
4006     "w" gnus-soup-save-areas
4007     "s" gnus-soup-send-replies
4008     "p" gnus-soup-pack-packet
4009     "r" nnsoup-pack-replies)
4010
4011    (gnus-define-keys
4012     (gnus-group-sort-map "S" gnus-group-group-map)
4013     "s" gnus-group-sort-groups
4014     "a" gnus-group-sort-groups-by-alphabet
4015     "u" gnus-group-sort-groups-by-unread
4016     "l" gnus-group-sort-groups-by-level
4017     "v" gnus-group-sort-groups-by-score
4018     "r" gnus-group-sort-groups-by-rank
4019     "m" gnus-group-sort-groups-by-method)
4020
4021    (gnus-define-keys
4022     (gnus-group-list-map "A" gnus-group-mode-map)
4023     "k" gnus-group-list-killed
4024     "z" gnus-group-list-zombies
4025     "s" gnus-group-list-groups
4026     "u" gnus-group-list-all-groups
4027     "A" gnus-group-list-active
4028     "a" gnus-group-apropos
4029     "d" gnus-group-description-apropos
4030     "m" gnus-group-list-matching
4031     "M" gnus-group-list-all-matching
4032     "l" gnus-group-list-level)
4033
4034    (gnus-define-keys
4035     (gnus-group-score-map "W" gnus-group-mode-map)
4036     "f" gnus-score-flush-cache)
4037
4038    (gnus-define-keys
4039     (gnus-group-help-map "H" gnus-group-mode-map)
4040     "f" gnus-group-fetch-faq)
4041
4042    (gnus-define-keys
4043     (gnus-group-sub-map "S" gnus-group-mode-map)
4044     "l" gnus-group-set-current-level
4045     "t" gnus-group-unsubscribe-current-group
4046     "s" gnus-group-unsubscribe-group
4047     "k" gnus-group-kill-group
4048     "y" gnus-group-yank-group
4049     "w" gnus-group-kill-region
4050     "\C-k" gnus-group-kill-level
4051     "z" gnus-group-kill-all-zombies))
4052
4053 (defun gnus-group-mode ()
4054   "Major mode for reading news.
4055
4056 All normal editing commands are switched off.
4057 \\<gnus-group-mode-map>
4058 The group buffer lists (some of) the groups available.  For instance,
4059 `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
4060 lists all zombie groups.
4061
4062 Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
4063 to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
4064
4065 For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
4066
4067 The following commands are available:
4068
4069 \\{gnus-group-mode-map}"
4070   (interactive)
4071   (when (and menu-bar-mode
4072              (gnus-visual-p 'group-menu 'menu))
4073     (gnus-group-make-menu-bar))
4074   (kill-all-local-variables)
4075   (gnus-simplify-mode-line)
4076   (setq major-mode 'gnus-group-mode)
4077   (setq mode-name "Group")
4078   (gnus-group-set-mode-line)
4079   (setq mode-line-process nil)
4080   (use-local-map gnus-group-mode-map)
4081   (buffer-disable-undo (current-buffer))
4082   (setq truncate-lines t)
4083   (setq buffer-read-only t)
4084   (run-hooks 'gnus-group-mode-hook))
4085
4086 (defun gnus-mouse-pick-group (e)
4087   "Enter the group under the mouse pointer."
4088   (interactive "e")
4089   (mouse-set-point e)
4090   (gnus-group-read-group nil))
4091
4092 ;; Look at LEVEL and find out what the level is really supposed to be.
4093 ;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
4094 ;; will depend on whether `gnus-group-use-permanent-levels' is used.
4095 (defun gnus-group-default-level (&optional level number-or-nil)
4096   (cond
4097    (gnus-group-use-permanent-levels
4098     (setq gnus-group-default-list-level
4099           (or level gnus-group-default-list-level))
4100     (or gnus-group-default-list-level gnus-level-subscribed))
4101    (number-or-nil
4102     level)
4103    (t
4104     (or level gnus-group-default-list-level gnus-level-subscribed))))
4105
4106 ;;;###autoload
4107 (defun gnus-slave-no-server (&optional arg)
4108   "Read network news as a slave, without connecting to local server"
4109   (interactive "P")
4110   (gnus-no-server arg t))
4111
4112 ;;;###autoload
4113 (defun gnus-no-server (&optional arg slave)
4114   "Read network news.
4115 If ARG is a positive number, Gnus will use that as the
4116 startup level.  If ARG is nil, Gnus will be started at level 2.
4117 If ARG is non-nil and not a positive number, Gnus will
4118 prompt the user for the name of an NNTP server to use.
4119 As opposed to `gnus', this command will not connect to the local server."
4120   (interactive "P")
4121   (make-local-variable 'gnus-group-use-permanent-levels)
4122   (setq gnus-group-use-permanent-levels t)
4123   (gnus (or arg (1- gnus-level-default-subscribed)) t slave))
4124
4125 ;;;###autoload
4126 (defun gnus-slave (&optional arg)
4127   "Read news as a slave."
4128   (interactive "P")
4129   (gnus arg nil 'slave))
4130
4131 ;;;###autoload
4132 (defun gnus-other-frame (&optional arg)
4133   "Pop up a frame to read news."
4134   (interactive "P")
4135   (if (get-buffer gnus-group-buffer)
4136       (let ((pop-up-frames t))
4137         (gnus arg))
4138     (select-frame (make-frame))
4139     (gnus arg)))
4140
4141 ;;;###autoload
4142 (defun gnus (&optional arg dont-connect slave)
4143   "Read network news.
4144 If ARG is non-nil and a positive number, Gnus will use that as the
4145 startup level.  If ARG is non-nil and not a positive number, Gnus will
4146 prompt the user for the name of an NNTP server to use."
4147   (interactive "P")
4148
4149   (if (get-buffer gnus-group-buffer)
4150       (progn
4151         (switch-to-buffer gnus-group-buffer)
4152         (gnus-group-get-new-news))
4153
4154     (gnus-clear-system)
4155     (nnheader-init-server-buffer)
4156     (gnus-read-init-file)
4157     (setq gnus-slave slave)
4158
4159     (gnus-group-setup-buffer)
4160     (let ((buffer-read-only nil))
4161       (erase-buffer)
4162       (if (not gnus-inhibit-startup-message)
4163           (progn
4164             (gnus-group-startup-message)
4165             (sit-for 0))))
4166
4167     (let ((level (and (numberp arg) (> arg 0) arg))
4168           did-connect)
4169       (unwind-protect
4170           (progn
4171             (or dont-connect
4172                 (setq did-connect
4173                       (gnus-start-news-server (and arg (not level))))))
4174         (if (and (not dont-connect)
4175                  (not did-connect))
4176             (gnus-group-quit)
4177           (run-hooks 'gnus-startup-hook)
4178           ;; NNTP server is successfully open.
4179
4180           ;; Find the current startup file name.
4181           (setq gnus-current-startup-file
4182                 (gnus-make-newsrc-file gnus-startup-file))
4183
4184           ;; Read the dribble file.
4185           (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
4186
4187           (gnus-summary-make-display-table)
4188           ;; Do the actual startup.
4189           (gnus-setup-news nil level)
4190           ;; Generate the group buffer.
4191           (gnus-group-list-groups level)
4192           (gnus-group-first-unread-group)
4193           (gnus-configure-windows 'group)
4194           (gnus-group-set-mode-line))))))
4195
4196 (defun gnus-unload ()
4197   "Unload all Gnus features."
4198   (interactive)
4199   (or (boundp 'load-history)
4200       (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
4201   (let ((history load-history)
4202         feature)
4203     (while history
4204       (and (string-match "^\\(gnus\\|nn\\)" (caar history))
4205            (setq feature (cdr (assq 'provide (car history))))
4206            (unload-feature feature 'force))
4207       (setq history (cdr history)))))
4208
4209 (defun gnus-compile ()
4210   "Byte-compile the user-defined format specs."
4211   (interactive)
4212   (let ((entries gnus-format-specs)
4213         entry gnus-tmp-func)
4214     (save-excursion
4215       (gnus-message 7 "Compiling format specs...")
4216
4217       (while entries
4218         (setq entry (pop entries))
4219         (if (eq (car entry) 'version)
4220             (setq gnus-format-specs (delq entry gnus-format-specs))
4221           (when (and (listp (caddr entry))
4222                      (not (eq 'byte-code (caaddr entry))))
4223             (fset 'gnus-tmp-func
4224                   `(lambda () ,(caddr entry)))
4225             (byte-compile 'gnus-tmp-func)
4226             (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
4227
4228       (push (cons 'version emacs-version) gnus-format-specs)
4229
4230       (gnus-message 7 "Compiling user specs...done"))))
4231
4232 (defun gnus-indent-rigidly (start end arg)
4233   "Indent rigidly using only spaces and no tabs."
4234   (save-excursion
4235     (save-restriction
4236       (narrow-to-region start end)
4237       (indent-rigidly start end arg)
4238       (goto-char (point-min))
4239       (while (search-forward "\t" nil t)
4240         (replace-match "        " t t)))))
4241
4242 (defun gnus-group-startup-message (&optional x y)
4243   "Insert startup message in current buffer."
4244   ;; Insert the message.
4245   (erase-buffer)
4246   (insert
4247    (format "              %s
4248           _    ___ _             _
4249           _ ___ __ ___  __    _ ___
4250           __   _     ___    __  ___
4251               _           ___     _
4252              _  _ __             _
4253              ___   __            _
4254                    __           _
4255                     _      _   _
4256                    _      _    _
4257                       _  _    _
4258                   __  ___
4259                  _   _ _     _
4260                 _   _
4261               _    _
4262              _    _
4263             _
4264           __
4265
4266 "
4267            ""))
4268   ;; And then hack it.
4269   (gnus-indent-rigidly (point-min) (point-max)
4270                        (/ (max (- (window-width) (or x 46)) 0) 2))
4271   (goto-char (point-min))
4272   (forward-line 1)
4273   (let* ((pheight (count-lines (point-min) (point-max)))
4274          (wheight (window-height))
4275          (rest (- wheight pheight)))
4276     (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
4277   ;; Fontify some.
4278   (goto-char (point-min))
4279   (and (search-forward "Praxis" nil t)
4280        (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
4281   (goto-char (point-min))
4282   (let* ((mode-string (gnus-group-set-mode-line)))
4283     (setq mode-line-buffer-identification
4284           (list (concat gnus-version (substring (car mode-string) 4))))
4285     (set-buffer-modified-p t)))
4286
4287 (defun gnus-group-setup-buffer ()
4288   (or (get-buffer gnus-group-buffer)
4289       (progn
4290         (switch-to-buffer gnus-group-buffer)
4291         (gnus-add-current-to-buffer-list)
4292         (gnus-group-mode)
4293         (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
4294
4295 (defun gnus-group-list-groups (&optional level unread lowest)
4296   "List newsgroups with level LEVEL or lower that have unread articles.
4297 Default is all subscribed groups.
4298 If argument UNREAD is non-nil, groups with no unread articles are also
4299 listed."
4300   (interactive (list (if current-prefix-arg
4301                          (prefix-numeric-value current-prefix-arg)
4302                        (or
4303                         (gnus-group-default-level nil t)
4304                         gnus-group-default-list-level
4305                         gnus-level-subscribed))))
4306   (or level
4307       (setq level (car gnus-group-list-mode)
4308             unread (cdr gnus-group-list-mode)))
4309   (setq level (gnus-group-default-level level))
4310   (gnus-group-setup-buffer)             ;May call from out of group buffer
4311   (gnus-update-format-specifications)
4312   (let ((case-fold-search nil)
4313         (props (text-properties-at (gnus-point-at-bol)))
4314         (group (gnus-group-group-name)))
4315     (funcall gnus-group-prepare-function level unread lowest)
4316     (if (zerop (buffer-size))
4317         (gnus-message 5 gnus-no-groups-message)
4318       (goto-char (point-max))
4319       (when (or (not gnus-group-goto-next-group-function)
4320                 (not (funcall gnus-group-goto-next-group-function 
4321                               group props)))
4322         (if (not group)
4323             ;; Go to the first group with unread articles.
4324             (gnus-group-search-forward t)
4325           ;; Find the right group to put point on.  If the current group
4326           ;; has disappeared in the new listing, try to find the next
4327           ;; one.        If no next one can be found, just leave point at the
4328           ;; first newsgroup in the buffer.
4329           (if (not (gnus-goto-char
4330                     (text-property-any
4331                      (point-min) (point-max)
4332                      'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
4333               (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
4334                 (while (and newsrc
4335                             (not (gnus-goto-char
4336                                   (text-property-any
4337                                    (point-min) (point-max) 'gnus-group
4338                                    (gnus-intern-safe
4339                                     (car (car newsrc)) gnus-active-hashtb)))))
4340                   (setq newsrc (cdr newsrc)))
4341                 (or newsrc (progn (goto-char (point-max))
4342                                   (forward-line -1)))))))
4343       ;; Adjust cursor point.
4344       (gnus-group-position-point))))
4345
4346 (defun gnus-group-list-level (level &optional all)
4347   "List groups on LEVEL.
4348 If ALL (the prefix), also list groups that have no unread articles."
4349   (interactive "nList groups on level: \nP")
4350   (gnus-group-list-groups level all level))
4351
4352 (defun gnus-group-prepare-flat (level &optional all lowest regexp)
4353   "List all newsgroups with unread articles of level LEVEL or lower.
4354 If ALL is non-nil, list groups that have no unread articles.
4355 If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
4356 If REGEXP, only list groups matching REGEXP."
4357   (set-buffer gnus-group-buffer)
4358   (let ((buffer-read-only nil)
4359         (newsrc (cdr gnus-newsrc-alist))
4360         (lowest (or lowest 1))
4361         info clevel unread group params)
4362     (erase-buffer)
4363     (if (< lowest gnus-level-zombie)
4364         ;; List living groups.
4365         (while newsrc
4366           (setq info (car newsrc)
4367                 group (gnus-info-group info)
4368                 params (gnus-info-params info)
4369                 newsrc (cdr newsrc)
4370                 unread (car (gnus-gethash group gnus-newsrc-hashtb)))
4371           (and unread                   ; This group might be bogus
4372                (or (not regexp)
4373                    (string-match regexp group))
4374                (<= (setq clevel (gnus-info-level info)) level)
4375                (>= clevel lowest)
4376                (or all                  ; We list all groups?
4377                    (and gnus-group-list-inactive-groups
4378                         (eq unread t))  ; We list unactivated groups
4379                    (> unread 0)         ; We list groups with unread articles
4380                    (and gnus-list-groups-with-ticked-articles
4381                         (cdr (assq 'tick (gnus-info-marks info))))
4382                                         ; And groups with tickeds
4383                    ;; Check for permanent visibility.
4384                    (and gnus-permanently-visible-groups
4385                         (string-match gnus-permanently-visible-groups
4386                                       group))
4387                    (memq 'visible params)
4388                    (cdr (assq 'visible params)))
4389                (gnus-group-insert-group-line
4390                 group (gnus-info-level info)
4391                 (gnus-info-marks info) unread (gnus-info-method info)))))
4392
4393     ;; List dead groups.
4394     (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
4395          (gnus-group-prepare-flat-list-dead
4396           (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
4397           gnus-level-zombie ?Z
4398           regexp))
4399     (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
4400          (gnus-group-prepare-flat-list-dead
4401           (setq gnus-killed-list (sort gnus-killed-list 'string<))
4402           gnus-level-killed ?K regexp))
4403
4404     (gnus-group-set-mode-line)
4405     (setq gnus-group-list-mode (cons level all))
4406     (run-hooks 'gnus-group-prepare-hook)))
4407
4408 (defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
4409   ;; List zombies and killed lists somewhat faster, which was
4410   ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
4411   ;; this by ignoring the group format specification altogether.
4412   (let (group beg)
4413     (if regexp
4414         ;; This loop is used when listing groups that match some
4415         ;; regexp.
4416         (while groups
4417           (setq group (pop groups))
4418           (when (string-match regexp group)
4419             (add-text-properties
4420              (point) (prog1 (1+ (point))
4421                        (insert " " mark "     *: " group "\n"))
4422              (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4423                    'gnus-unread t
4424                    'gnus-level level))))
4425       ;; This loop is used when listing all groups.
4426       (while groups
4427         (add-text-properties
4428          (point) (prog1 (1+ (point))
4429                    (insert " " mark "     *: "
4430                            (setq group (pop groups)) "\n"))
4431          (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
4432                'gnus-unread t
4433                'gnus-level level))))))
4434
4435 (defmacro gnus-group-real-name (group)
4436   "Find the real name of a foreign newsgroup."
4437   `(let ((gname ,group))
4438      (if (string-match ":[^:]+$" gname)
4439          (substring gname (1+ (match-beginning 0)))
4440        gname)))
4441
4442 (defsubst gnus-server-add-address (method)
4443   (let ((method-name (symbol-name (car method))))
4444     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
4445              (not (assq (intern (concat method-name "-address")) method)))
4446         (append method (list (list (intern (concat method-name "-address"))
4447                                    (nth 1 method))))
4448       method)))
4449
4450 (defsubst gnus-server-get-method (group method)
4451   ;; Input either a server name, and extended server name, or a
4452   ;; select method, and return a select method.
4453   (cond ((stringp method)
4454          (gnus-server-to-method method))
4455         ((and (stringp (car method)) group)
4456          (gnus-server-extend-method group method))
4457         (t
4458          (gnus-server-add-address method))))
4459
4460 (defun gnus-server-to-method (server)
4461   "Map virtual server names to select methods."
4462   (or (and (equal server "native") gnus-select-method)
4463       (cdr (assoc server gnus-server-alist))))
4464
4465 (defmacro gnus-server-equal (ss1 ss2)
4466   "Say whether two servers are equal."
4467   `(let ((s1 ,ss1)
4468          (s2 ,ss2))
4469      (or (equal s1 s2)
4470          (and (= (length s1) (length s2))
4471               (progn
4472                 (while (and s1 (member (car s1) s2))
4473                   (setq s1 (cdr s1)))
4474                 (null s1))))))
4475
4476 (defun gnus-group-prefixed-name (group method)
4477   "Return the whole name from GROUP and METHOD."
4478   (and (stringp method) (setq method (gnus-server-to-method method)))
4479   (concat (format "%s" (car method))
4480           (if (and
4481                (assoc (format "%s" (car method)) (gnus-methods-using 'address))
4482                (not (string= (nth 1 method) "")))
4483               (concat "+" (nth 1 method)))
4484           ":" group))
4485
4486 (defun gnus-group-real-prefix (group)
4487   "Return the prefix of the current group name."
4488   (if (string-match "^[^:]+:" group)
4489       (substring group 0 (match-end 0))
4490     ""))
4491
4492 (defun gnus-group-method-name (group)
4493   "Return the method used for selecting GROUP."
4494   (let ((prefix (gnus-group-real-prefix group)))
4495     (if (equal prefix "")
4496         gnus-select-method
4497       (if (string-match "^[^\\+]+\\+" prefix)
4498           (list (intern (substring prefix 0 (1- (match-end 0))))
4499                 (substring prefix (match-end 0) (1- (length prefix))))
4500         (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
4501
4502 (defsubst gnus-secondary-method-p (method)
4503   "Return whether METHOD is a secondary select method."
4504   (let ((methods gnus-secondary-select-methods)
4505         (gmethod (gnus-server-get-method nil method)))
4506     (while (and methods
4507                 (not (equal (gnus-server-get-method nil (car methods))
4508                             gmethod)))
4509       (setq methods (cdr methods)))
4510     methods))
4511
4512 (defun gnus-group-foreign-p (group)
4513   "Say whether a group is foreign or not."
4514   (and (not (gnus-group-native-p group))
4515        (not (gnus-group-secondary-p group))))
4516
4517 (defun gnus-group-native-p (group)
4518   "Say whether the group is native or not."
4519   (not (string-match ":" group)))
4520
4521 (defun gnus-group-secondary-p (group)
4522   "Say whether the group is secondary or not."
4523   (gnus-secondary-method-p (gnus-find-method-for-group group)))
4524
4525 (defun gnus-group-get-parameter (group &optional symbol)
4526   "Returns the group parameters for GROUP.
4527 If SYMBOL, return the value of that symbol in the group parameters."
4528   (let ((params (gnus-info-params (gnus-get-info group))))
4529     (if symbol
4530         (gnus-group-parameter-value params symbol)
4531       params)))
4532
4533 (defun gnus-group-parameter-value (params symbol)
4534   "Return the value of SYMBOL in group PARAMS."
4535   (or (car (memq symbol params))        ; It's either a simple symbol
4536       (cdr (assq symbol params))))      ; or a cons.
4537
4538 (defun gnus-group-add-parameter (group param)
4539   "Add parameter PARAM to GROUP."
4540   (let ((info (gnus-get-info group)))
4541     (if (not info)
4542         () ; This is a dead group.  We just ignore it.
4543       ;; Cons the new param to the old one and update.
4544       (gnus-group-set-info (cons param (gnus-info-params info))
4545                            group 'params))))
4546
4547 (defun gnus-group-add-score (group &optional score)
4548   "Add SCORE to the GROUP score.
4549 If SCORE is nil, add 1 to the score of GROUP."
4550   (let ((info (gnus-get-info group)))
4551     (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))
4552
4553 (defun gnus-summary-bubble-group ()
4554   "Increase the score of the current group.
4555 This is a handy function to add to `gnus-summary-exit-hook' to
4556 increase the score of each group you read."
4557   (gnus-group-add-score gnus-newsgroup-name))
4558
4559 (defun gnus-group-set-info (info &optional method-only-group part)
4560   (let* ((entry (gnus-gethash
4561                  (or method-only-group (gnus-info-group info))
4562                  gnus-newsrc-hashtb))
4563          (part-info info)
4564          (info (if method-only-group (nth 2 entry) info)))
4565     (when method-only-group
4566       (unless entry
4567         (error "Trying to change non-existent group %s" method-only-group))
4568       ;; We have received parts of the actual group info - either the
4569       ;; select method or the group parameters.  We first check
4570       ;; whether we have to extend the info, and if so, do that.
4571       (let ((len (length info))
4572             (total (if (eq part 'method) 5 6)))
4573         (when (< len total)
4574           (setcdr (nthcdr (1- len) info)
4575                   (make-list (- total len) nil)))
4576         ;; Then we enter the new info.
4577         (setcar (nthcdr (1- total) info) part-info)))
4578     (unless entry
4579       ;; This is a new group, so we just create it.
4580       (save-excursion
4581         (set-buffer gnus-group-buffer)
4582         (if (gnus-info-method info)
4583             ;; It's a foreign group...
4584             (gnus-group-make-group
4585              (gnus-group-real-name (gnus-info-group info))
4586              (prin1-to-string (car (gnus-info-method info)))
4587              (nth 1 (gnus-info-method info)))
4588           ;; It's a native group.
4589           (gnus-group-make-group (gnus-info-group info)))
4590         (gnus-message 6 "Note: New group created")
4591         (setq entry
4592               (gnus-gethash (gnus-group-prefixed-name
4593                              (gnus-group-real-name (gnus-info-group info))
4594                              (or (gnus-info-method info) gnus-select-method))
4595                             gnus-newsrc-hashtb))))
4596     ;; Whether it was a new group or not, we now have the entry, so we
4597     ;; can do the update.
4598     (if entry
4599         (progn
4600           (setcar (nthcdr 2 entry) info)
4601           (when (and (not (eq (car entry) t))
4602                      (gnus-active (gnus-info-group info)))
4603             (let ((marked (gnus-info-marks info)))
4604               (setcar entry (length (gnus-list-of-unread-articles
4605                                      (car info)))))))
4606       (error "No such group: %s" (gnus-info-group info)))))
4607
4608 (defun gnus-group-set-method-info (group select-method)
4609   (gnus-group-set-info select-method group 'method))
4610
4611 (defun gnus-group-set-params-info (group params)
4612   (gnus-group-set-info params group 'params))
4613
4614 (defun gnus-group-update-group-line ()
4615   "Update the current line in the group buffer."
4616   (let* ((buffer-read-only nil)
4617          (group (gnus-group-group-name))
4618          (gnus-group-indentation (gnus-group-group-indentation))
4619          (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
4620     (and entry
4621          (not (gnus-ephemeral-group-p group))
4622          (gnus-dribble-enter
4623           (concat "(gnus-group-set-info '"
4624                   (prin1-to-string (nth 2 entry)) ")")))
4625     (gnus-delete-line)
4626     (gnus-group-insert-group-line-info group)
4627     (forward-line -1)
4628     (gnus-group-position-point)))
4629
4630 (defun gnus-group-insert-group-line-info (group)
4631   "Insert GROUP on the current line."
4632   (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
4633         active info)
4634     (if entry
4635         (progn
4636           ;; (Un)subscribed group.
4637           (setq info (nth 2 entry))
4638           (gnus-group-insert-group-line
4639            group (gnus-info-level info) (gnus-info-marks info)
4640            (or (car entry) t) (gnus-info-method info)))
4641       ;; This group is dead.
4642       (gnus-group-insert-group-line
4643        group
4644        (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
4645        nil
4646        (if (setq active (gnus-active group))
4647            (- (1+ (cdr active)) (car active)) 0)
4648        nil))))
4649
4650 (defun gnus-group-insert-group-line
4651   (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number
4652                   gnus-tmp-method)
4653   "Insert a group line in the group buffer."
4654   (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
4655          (gnus-tmp-number-total
4656           (if gnus-tmp-active
4657               (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
4658             0))
4659          (gnus-tmp-number-of-unread
4660           (if (numberp number) (int-to-string (max 0 number))
4661             "*"))
4662          (gnus-tmp-number-of-read
4663           (if (numberp number)
4664               (int-to-string (max 0 (- gnus-tmp-number-total number)))
4665             "*"))
4666          (gnus-tmp-subscribed
4667           (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
4668                 ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
4669                 ((= gnus-tmp-level gnus-level-zombie) ?Z)
4670                 (t ?K)))
4671          (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
4672          (gnus-tmp-newsgroup-description
4673           (if gnus-description-hashtb
4674               (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
4675             ""))
4676          (gnus-tmp-moderated
4677           (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
4678          (gnus-tmp-moderated-string
4679           (if (eq gnus-tmp-moderated ?m) "(m)" ""))
4680          (gnus-tmp-method
4681           (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
4682          (gnus-tmp-news-server (or (car (cdr gnus-tmp-method)) ""))
4683          (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
4684          (gnus-tmp-news-method-string
4685           (if gnus-tmp-method
4686               (format "(%s:%s)" (car gnus-tmp-method)
4687                       (car (cdr gnus-tmp-method))) ""))
4688          (gnus-tmp-marked-mark
4689           (if (and (numberp number)
4690                    (zerop number)
4691                    (cdr (assq 'tick gnus-tmp-marked)))
4692               ?* ? ))
4693          (gnus-tmp-process-marked
4694           (if (member gnus-tmp-group gnus-group-marked)
4695               gnus-process-mark ? ))
4696          (buffer-read-only nil)
4697          header gnus-tmp-header)                        ; passed as parameter to user-funcs.
4698     (beginning-of-line)
4699     (add-text-properties
4700      (point)
4701      (prog1 (1+ (point))
4702        ;; Insert the text.
4703        (eval gnus-group-line-format-spec))
4704      `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
4705        gnus-unread ,(if (numberp number)
4706                         (string-to-int gnus-tmp-number-of-unread)
4707                       t)
4708        gnus-marked ,gnus-tmp-marked-mark
4709        gnus-indentation ,gnus-group-indentation
4710        gnus-level ,gnus-tmp-level))
4711     (when (gnus-visual-p 'group-highlight 'highlight)
4712       (forward-line -1)
4713       (run-hooks 'gnus-group-update-hook)
4714       (forward-line))
4715     ;; Allow XEmacs to remove front-sticky text properties.
4716     (gnus-group-remove-excess-properties)))
4717
4718 (defun gnus-group-update-group (group &optional visible-only)
4719   "Update all lines where GROUP appear.
4720 If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
4721 already."
4722   (save-excursion
4723     (set-buffer gnus-group-buffer)
4724     ;; The buffer may be narrowed.
4725     (save-restriction
4726       (widen)
4727       (let ((ident (gnus-intern-safe group gnus-active-hashtb))
4728             (loc (point-min))
4729             found buffer-read-only visible)
4730         ;; Enter the current status into the dribble buffer.
4731         (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
4732           (if (and entry (not (gnus-ephemeral-group-p group)))
4733               (gnus-dribble-enter
4734                (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
4735                        ")"))))
4736         ;; Find all group instances.  If topics are in use, each group
4737         ;; may be listed in more than once.
4738         (while (setq loc (text-property-any
4739                           loc (point-max) 'gnus-group ident))
4740           (setq found t)
4741           (goto-char loc)
4742           (let ((gnus-group-indentation (gnus-group-group-indentation)))
4743             (gnus-delete-line)
4744             (gnus-group-insert-group-line-info group))
4745           (setq loc (1+ loc)))
4746         (unless (or found visible-only)
4747           ;; No such line in the buffer, find out where it's supposed to
4748           ;; go, and insert it there (or at the end of the buffer).
4749           (if gnus-goto-missing-group-function
4750               (funcall gnus-goto-missing-group-function group)
4751             (let ((entry (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb)))))
4752               (while (and entry (car entry)
4753                           (not
4754                            (gnus-goto-char
4755                             (text-property-any
4756                              (point-min) (point-max)
4757                              'gnus-group (gnus-intern-safe
4758                                           (car (car entry))
4759                                           gnus-active-hashtb)))))
4760                 (setq entry (cdr entry)))
4761               (or entry (goto-char (point-max)))))
4762           ;; Finally insert the line.
4763           (let ((gnus-group-indentation (gnus-group-group-indentation)))
4764             (gnus-group-insert-group-line-info group)))
4765         (gnus-group-set-mode-line)))))
4766
4767 (defun gnus-group-set-mode-line ()
4768   (when (memq 'group gnus-updated-mode-lines)
4769     (let* ((gformat (or gnus-group-mode-line-format-spec
4770                         (setq gnus-group-mode-line-format-spec
4771                               (gnus-parse-format
4772                                gnus-group-mode-line-format
4773                                gnus-group-mode-line-format-alist))))
4774            (gnus-tmp-news-server (car (cdr gnus-select-method)))
4775            (gnus-tmp-news-method (car gnus-select-method))
4776            (max-len 60)
4777            gnus-tmp-header                      ;Dummy binding for user-defined formats
4778            ;; Get the resulting string.
4779            (mode-string (eval gformat)))
4780       ;; If the line is too long, we chop it off.
4781       (when (> (length mode-string) max-len)
4782         (setq mode-string (substring mode-string 0 (- max-len 4))))
4783       (prog1
4784           (setq mode-line-buffer-identification (list mode-string))
4785         (set-buffer-modified-p t)))))
4786
4787 (defun gnus-group-group-name ()
4788   "Get the name of the newsgroup on the current line."
4789   (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
4790     (and group (symbol-name group))))
4791
4792 (defun gnus-group-group-level ()
4793   "Get the level of the newsgroup on the current line."
4794   (get-text-property (gnus-point-at-bol) 'gnus-level))
4795
4796 (defun gnus-group-group-indentation ()
4797   "Get the indentation of the newsgroup on the current line."
4798   (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) ""))
4799
4800 (defun gnus-group-group-unread ()
4801   "Get the number of unread articles of the newsgroup on the current line."
4802   (get-text-property (gnus-point-at-bol) 'gnus-unread))
4803
4804 (defun gnus-group-search-forward (&optional backward all level first-too)
4805   "Find the next newsgroup with unread articles.
4806 If BACKWARD is non-nil, find the previous newsgroup instead.
4807 If ALL is non-nil, just find any newsgroup.
4808 If LEVEL is non-nil, find group with level LEVEL, or higher if no such
4809 group exists.
4810 If FIRST-TOO, the current line is also eligible as a target."
4811   (let ((way (if backward -1 1))
4812         (low gnus-level-killed)
4813         (beg (point))
4814         pos found lev)
4815     (if (and backward (progn (beginning-of-line)) (bobp))
4816         nil
4817       (or first-too (forward-line way))
4818       (while (and
4819               (not (eobp))
4820               (not (setq
4821                     found
4822                     (and (or all
4823                              (and
4824                               (let ((unread
4825                                      (get-text-property (point) 'gnus-unread)))
4826                                 (and (numberp unread) (> unread 0)))
4827                               (setq lev (get-text-property (point)
4828                                                            'gnus-level))
4829                               (<= lev gnus-level-subscribed)))
4830                          (or (not level)
4831                              (and (setq lev (get-text-property (point)
4832                                                                'gnus-level))
4833                                   (or (= lev level)
4834                                       (and (< lev low)
4835                                            (< level lev)
4836                                            (progn
4837                                              (setq low lev)
4838                                              (setq pos (point))
4839                                              nil))))))))
4840               (zerop (forward-line way)))))
4841     (if found
4842         (progn (gnus-group-position-point) t)
4843       (goto-char (or pos beg))
4844       (and pos t))))
4845
4846 ;;; Gnus group mode commands
4847
4848 ;; Group marking.
4849
4850 (defun gnus-group-mark-group (n &optional unmark no-advance)
4851   "Mark the current group."
4852   (interactive "p")
4853   (let ((buffer-read-only nil)
4854         group)
4855     (while
4856         (and (> n 0)
4857              (setq group (gnus-group-group-name))
4858              (progn
4859                (beginning-of-line)
4860                (forward-char
4861                 (or (cdr (assq 'process gnus-group-mark-positions)) 2))
4862                (delete-char 1)
4863                (if unmark
4864                    (progn
4865                      (insert " ")
4866                      (setq gnus-group-marked (delete group gnus-group-marked)))
4867                  (insert "#")
4868                  (setq gnus-group-marked
4869                        (cons group (delete group gnus-group-marked))))
4870                t)
4871              (or no-advance (zerop (gnus-group-next-group 1))))
4872       (setq n (1- n)))
4873     (gnus-summary-position-point)
4874     n))
4875
4876 (defun gnus-group-unmark-group (n)
4877   "Remove the mark from the current group."
4878   (interactive "p")
4879   (gnus-group-mark-group n 'unmark)
4880   (gnus-group-position-point))
4881
4882 (defun gnus-group-unmark-all-groups ()
4883   "Unmark all groups."
4884   (let ((groups gnus-group-marked))
4885     (save-excursion
4886       (while groups
4887         (gnus-group-remove-mark (pop groups)))))
4888   (gnus-group-position-point))
4889
4890 (defun gnus-group-mark-region (unmark beg end)
4891   "Mark all groups between point and mark.
4892 If UNMARK, remove the mark instead."
4893   (interactive "P\nr")
4894   (let ((num (count-lines beg end)))
4895     (save-excursion
4896       (goto-char beg)
4897       (- num (gnus-group-mark-group num unmark)))))
4898
4899 (defun gnus-group-mark-buffer (&optional unmark)
4900   "Mark all groups in the buffer.
4901 If UNMARK, remove the mark instead."
4902   (interactive "P")
4903   (gnus-group-mark-region unmark (point-min) (point-max)))
4904
4905 (defun gnus-group-mark-regexp (regexp)
4906   "Mark all groups that match some regexp."
4907   (interactive "sMark (regexp): ")
4908   (let ((alist (cdr gnus-newsrc-alist))
4909         group)
4910     (while alist
4911       (when (string-match regexp (setq group (gnus-info-group (pop alist))))
4912         (gnus-group-set-mark group))))
4913   (gnus-group-position-point))
4914
4915 (defun gnus-group-remove-mark (group)
4916   "Remove the process mark from GROUP and move point there.
4917 Return nil if the group isn't displayed."
4918   (if (gnus-group-goto-group group)
4919       (save-excursion
4920         (gnus-group-mark-group 1 'unmark t)
4921         t)
4922     (setq gnus-group-marked
4923           (delete group gnus-group-marked))
4924     nil))
4925
4926 (defun gnus-group-set-mark (group)
4927   "Set the process mark on GROUP."
4928   (if (gnus-group-goto-group group)
4929       (save-excursion
4930         (gnus-group-mark-group 1 nil t))
4931     (setq gnus-group-marked
4932           (cons group (delete group gnus-group-marked)))))
4933
4934 (defun gnus-group-universal-argument (arg &optional groups func)
4935   "Perform any command on all groups accoring to the process/prefix convention."
4936   (interactive "P")
4937   (let ((groups (or groups (gnus-group-process-prefix arg)))
4938         group func)
4939     (if (eq (setq func (or func
4940                            (key-binding
4941                             (read-key-sequence
4942                              (substitute-command-keys
4943                               "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
4944             'undefined)
4945         (progn
4946           (message "Undefined key")
4947           (ding))
4948       (while groups
4949         (gnus-group-remove-mark (setq group (pop groups)))
4950         (command-execute func))))
4951   (gnus-group-position-point))
4952
4953 (defun gnus-group-process-prefix (n)
4954   "Return a list of groups to work on.
4955 Take into consideration N (the prefix) and the list of marked groups."
4956   (cond
4957    (n
4958     (setq n (prefix-numeric-value n))
4959     ;; There is a prefix, so we return a list of the N next
4960     ;; groups.
4961     (let ((way (if (< n 0) -1 1))
4962           (n (abs n))
4963           group groups)
4964       (save-excursion
4965         (while (and (> n 0)
4966                     (setq group (gnus-group-group-name)))
4967           (setq groups (cons group groups))
4968           (setq n (1- n))
4969           (gnus-group-next-group way)))
4970       (nreverse groups)))
4971    ((and (boundp 'transient-mark-mode)
4972          transient-mark-mode
4973          mark-active)
4974     ;; Work on the region between point and mark.
4975     (let ((max (max (point) (mark)))
4976           groups)
4977       (save-excursion
4978         (goto-char (min (point) (mark)))
4979         (while
4980             (and
4981              (push (gnus-group-group-name) groups)
4982              (zerop (gnus-group-next-group 1))
4983              (< (point) max)))
4984         (nreverse groups))))
4985    (gnus-group-marked
4986     ;; No prefix, but a list of marked articles.
4987     (reverse gnus-group-marked))
4988    (t
4989     ;; Neither marked articles or a prefix, so we return the
4990     ;; current group.
4991     (let ((group (gnus-group-group-name)))