Synch to No Gnus 200507290604.
[elisp/gnus.git-] / lisp / gnus.el
1 ;;; gnus.el --- a newsreader for GNU Emacs
2
3 ;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997,
4 ;; 1998, 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
5
6 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
7 ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
8 ;;      Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
9 ;;      Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
10 ;; Keywords: news, mail
11
12 ;; This file is part of GNU Emacs.
13
14 ;; GNU Emacs is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; any later version.
18
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
22 ;; GNU General Public License for more details.
23
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
28
29 ;;; Commentary:
30
31 ;;; Code:
32
33 (eval '(run-hooks 'gnus-load-hook))
34
35 (eval-when-compile (require 'cl))
36 (eval-when-compile (require 'static))
37
38 (require 'wid-edit)
39 (require 'nnheader)
40
41 (require 'gnus-vers)
42
43 (defgroup gnus nil
44   "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
45   :group 'news
46   :group 'mail)
47
48 (defgroup gnus-format nil
49   "Dealing with formatting issues."
50   :group 'gnus)
51
52 (defgroup gnus-charset nil
53   "Group character set issues."
54   :link '(custom-manual "(gnus)Charsets")
55   :version "21.1"
56   :group 'gnus)
57
58 (defgroup gnus-cache nil
59   "Cache interface."
60   :link '(custom-manual "(gnus)Article Caching")
61   :group 'gnus)
62
63 (defgroup gnus-registry nil
64   "Article Registry."
65   :group 'gnus)
66
67 (defgroup gnus-start nil
68   "Starting your favorite newsreader."
69   :group 'gnus)
70
71 (defgroup gnus-start-server nil
72   "Server options at startup."
73   :group 'gnus-start)
74
75 ;; These belong to gnus-group.el.
76 (defgroup gnus-group nil
77   "Group buffers."
78   :link '(custom-manual "(gnus)Group Buffer")
79   :group 'gnus)
80
81 (defgroup gnus-group-foreign nil
82   "Foreign groups."
83   :link '(custom-manual "(gnus)Foreign Groups")
84   :group 'gnus-group)
85
86 (defgroup gnus-group-new nil
87   "Automatic subscription of new groups."
88   :group 'gnus-group)
89
90 (defgroup gnus-group-levels nil
91   "Group levels."
92   :link '(custom-manual "(gnus)Group Levels")
93   :group 'gnus-group)
94
95 (defgroup gnus-group-select nil
96   "Selecting a Group."
97   :link '(custom-manual "(gnus)Selecting a Group")
98   :group 'gnus-group)
99
100 (defgroup gnus-group-listing nil
101   "Showing slices of the group list."
102   :link '(custom-manual "(gnus)Listing Groups")
103   :group 'gnus-group)
104
105 (defgroup gnus-group-visual nil
106   "Sorting the group buffer."
107   :link '(custom-manual "(gnus)Group Buffer Format")
108   :group 'gnus-group
109   :group 'gnus-visual)
110
111 (defgroup gnus-group-various nil
112   "Various group options."
113   :link '(custom-manual "(gnus)Scanning New Messages")
114   :group 'gnus-group)
115
116 ;; These belong to gnus-sum.el.
117 (defgroup gnus-summary nil
118   "Summary buffers."
119   :link '(custom-manual "(gnus)Summary Buffer")
120   :group 'gnus)
121
122 (defgroup gnus-summary-exit nil
123   "Leaving summary buffers."
124   :link '(custom-manual "(gnus)Exiting the Summary Buffer")
125   :group 'gnus-summary)
126
127 (defgroup gnus-summary-marks nil
128   "Marks used in summary buffers."
129   :link '(custom-manual "(gnus)Marking Articles")
130   :group 'gnus-summary)
131
132 (defgroup gnus-thread nil
133   "Ordering articles according to replies."
134   :link '(custom-manual "(gnus)Threading")
135   :group 'gnus-summary)
136
137 (defgroup gnus-summary-format nil
138   "Formatting of the summary buffer."
139   :link '(custom-manual "(gnus)Summary Buffer Format")
140   :group 'gnus-summary)
141
142 (defgroup gnus-summary-choose nil
143   "Choosing Articles."
144   :link '(custom-manual "(gnus)Choosing Articles")
145   :group 'gnus-summary)
146
147 (defgroup gnus-summary-maneuvering nil
148   "Summary movement commands."
149   :link '(custom-manual "(gnus)Summary Maneuvering")
150   :group 'gnus-summary)
151
152 (defgroup gnus-picon nil
153   "Show pictures of people, domains, and newsgroups."
154   :group 'gnus-visual)
155
156 (defgroup gnus-summary-mail nil
157   "Mail group commands."
158   :link '(custom-manual "(gnus)Mail Group Commands")
159   :group 'gnus-summary)
160
161 (defgroup gnus-summary-sort nil
162   "Sorting the summary buffer."
163   :link '(custom-manual "(gnus)Sorting the Summary Buffer")
164   :group 'gnus-summary)
165
166 (defgroup gnus-summary-visual nil
167   "Highlighting and menus in the summary buffer."
168   :link '(custom-manual "(gnus)Summary Highlighting")
169   :group 'gnus-visual
170   :group 'gnus-summary)
171
172 (defgroup gnus-summary-various nil
173   "Various summary buffer options."
174   :link '(custom-manual "(gnus)Various Summary Stuff")
175   :group 'gnus-summary)
176
177 (defgroup gnus-summary-pick nil
178   "Pick mode in the summary buffer."
179   :link '(custom-manual "(gnus)Pick and Read")
180   :prefix "gnus-pick-"
181   :group 'gnus-summary)
182
183 (defgroup gnus-summary-tree nil
184   "Tree display of threads in the summary buffer."
185   :link '(custom-manual "(gnus)Tree Display")
186   :prefix "gnus-tree-"
187   :group 'gnus-summary)
188
189 ;; Belongs to gnus-uu.el
190 (defgroup gnus-extract-view nil
191   "Viewing extracted files."
192   :link '(custom-manual "(gnus)Viewing Files")
193   :group 'gnus-extract)
194
195 ;; Belongs to gnus-score.el
196 (defgroup gnus-score nil
197   "Score and kill file handling."
198   :group 'gnus)
199
200 (defgroup gnus-score-kill nil
201   "Kill files."
202   :group 'gnus-score)
203
204 (defgroup gnus-score-adapt nil
205   "Adaptive score files."
206   :group 'gnus-score)
207
208 (defgroup gnus-score-default nil
209   "Default values for score files."
210   :group 'gnus-score)
211
212 (defgroup gnus-score-expire nil
213   "Expiring score rules."
214   :group 'gnus-score)
215
216 (defgroup gnus-score-decay nil
217   "Decaying score rules."
218   :group 'gnus-score)
219
220 (defgroup gnus-score-files nil
221   "Score and kill file names."
222   :group 'gnus-score
223   :group 'gnus-files)
224
225 (defgroup gnus-score-various nil
226   "Various scoring and killing options."
227   :group 'gnus-score)
228
229 ;; Other
230 (defgroup gnus-visual nil
231   "Options controlling the visual fluff."
232   :group 'gnus
233   :group 'faces)
234
235 (defgroup gnus-agent nil
236   "Offline support for Gnus."
237   :group 'gnus)
238
239 (defgroup gnus-files nil
240   "Files used by Gnus."
241   :group 'gnus)
242
243 (defgroup gnus-dribble-file nil
244   "Auto save file."
245   :link '(custom-manual "(gnus)Auto Save")
246   :group 'gnus-files)
247
248 (defgroup gnus-newsrc nil
249   "Storing Gnus state."
250   :group 'gnus-files)
251
252 (defgroup gnus-server nil
253   "Options related to newsservers and other servers used by Gnus."
254   :group 'gnus)
255
256 (defgroup gnus-server-visual nil
257   "Highlighting and menus in the server buffer."
258   :group 'gnus-visual
259   :group 'gnus-server)
260
261 (defgroup gnus-message '((message custom-group))
262   "Composing replies and followups in Gnus."
263   :group 'gnus)
264
265 (defgroup gnus-meta nil
266   "Meta variables controlling major portions of Gnus.
267 In general, modifying these variables does not take affect until Gnus
268 is restarted, and sometimes reloaded."
269   :group 'gnus)
270
271 (defgroup gnus-various nil
272   "Other Gnus options."
273   :link '(custom-manual "(gnus)Various Various")
274   :group 'gnus)
275
276 (defgroup gnus-mime nil
277   "Variables for controlling the Gnus MIME interface."
278   :group 'gnus)
279
280 (defgroup gnus-exit nil
281   "Exiting Gnus."
282   :link '(custom-manual "(gnus)Exiting Gnus")
283   :group 'gnus)
284
285 (defgroup gnus-fun nil
286   "Frivolous Gnus extensions."
287   :link '(custom-manual "(gnus)Exiting Gnus")
288   :group 'gnus)
289
290 (defcustom gnus-inhibit-startup-message nil
291   "If non-nil, the startup message will not be displayed.
292 This variable is used before `.gnus.el' is loaded, so it should
293 be set in `.emacs' instead."
294   :group 'gnus-start
295   :type 'boolean)
296
297 (defcustom gnus-play-startup-jingle nil
298   "If non-nil, play the Gnus jingle at startup."
299   :group 'gnus-start
300   :type 'boolean)
301
302 (unless (fboundp 'gnus-group-remove-excess-properties)
303   (defalias 'gnus-group-remove-excess-properties 'ignore))
304
305 (unless (featurep 'gnus-xmas)
306   (defalias 'gnus-make-overlay 'make-overlay)
307   (defalias 'gnus-delete-overlay 'delete-overlay)
308   (defalias 'gnus-overlay-put 'overlay-put)
309   (defalias 'gnus-move-overlay 'move-overlay)
310   (defalias 'gnus-overlay-buffer 'overlay-buffer)
311   (defalias 'gnus-overlay-start 'overlay-start)
312   (defalias 'gnus-overlay-end 'overlay-end)
313   (defalias 'gnus-extent-detached-p 'ignore)
314   (defalias 'gnus-extent-start-open 'ignore)
315   (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
316   (defalias 'gnus-character-to-event 'identity)
317   (defalias 'gnus-assq-delete-all 'assq-delete-all)
318   (defalias 'gnus-add-text-properties 'add-text-properties)
319   (defalias 'gnus-put-text-property 'put-text-property)
320   (defvar gnus-mode-line-image-cache t)
321   (if (fboundp 'find-image)
322       (defun gnus-mode-line-buffer-identification (line)
323         (let ((str (car-safe line))
324               (load-path (mm-image-load-path)))
325           (if (and (stringp str)
326                    (string-match "^Gnus:" str))
327               (progn (add-text-properties
328                       0 5
329                       (list 'display
330                             (if (eq t gnus-mode-line-image-cache)
331                                 (setq gnus-mode-line-image-cache
332                                       (find-image
333                                        '((:type xpm :file "gnus-pointer.xpm"
334                                                 :ascent center)
335                                          (:type xbm :file "gnus-pointer.xbm"
336                                                 :ascent center))))
337                               gnus-mode-line-image-cache)
338                             'help-echo (format
339                                         "This is %s, %s."
340                                         gnus-version (gnus-emacs-version)))
341                       str)
342                      (list str))
343             line)))
344     (defalias 'gnus-mode-line-buffer-identification 'identity))
345   (defalias 'gnus-characterp 'numberp)
346   (defalias 'gnus-deactivate-mark 'deactivate-mark)
347   (defalias 'gnus-window-edges 'window-edges)
348   (defalias 'gnus-key-press-event-p 'numberp)
349   ;;(defalias 'gnus-decode-rfc1522 'ignore)
350   )
351
352 ;; We define these group faces here to avoid the display
353 ;; update forced when creating new faces.
354
355 (defface gnus-group-news-1
356   '((((class color)
357       (background dark))
358      (:foreground "PaleTurquoise" :bold t))
359     (((class color)
360       (background light))
361      (:foreground "ForestGreen" :bold t))
362     (t
363      ()))
364   "Level 1 newsgroup face."
365   :group 'gnus-group)
366 ;; backward-compatibility alias
367 (put 'gnus-group-news-1-face 'face-alias 'gnus-group-news-1)
368
369 (defface gnus-group-news-1-empty
370   '((((class color)
371       (background dark))
372      (:foreground "PaleTurquoise"))
373     (((class color)
374       (background light))
375      (:foreground "ForestGreen"))
376     (t
377      ()))
378   "Level 1 empty newsgroup face."
379   :group 'gnus-group)
380 ;; backward-compatibility alias
381 (put 'gnus-group-news-1-empty-face 'face-alias 'gnus-group-news-1-empty)
382
383 (defface gnus-group-news-2
384   '((((class color)
385       (background dark))
386      (:foreground "turquoise" :bold t))
387     (((class color)
388       (background light))
389      (:foreground "CadetBlue4" :bold t))
390     (t
391      ()))
392   "Level 2 newsgroup face."
393   :group 'gnus-group)
394 ;; backward-compatibility alias
395 (put 'gnus-group-news-2-face 'face-alias 'gnus-group-news-2)
396
397 (defface gnus-group-news-2-empty
398   '((((class color)
399       (background dark))
400      (:foreground "turquoise"))
401     (((class color)
402       (background light))
403      (:foreground "CadetBlue4"))
404     (t
405      ()))
406   "Level 2 empty newsgroup face."
407   :group 'gnus-group)
408 ;; backward-compatibility alias
409 (put 'gnus-group-news-2-empty-face 'face-alias 'gnus-group-news-2-empty)
410
411 (defface gnus-group-news-3
412   '((((class color)
413       (background dark))
414      (:bold t))
415     (((class color)
416       (background light))
417      (:bold t))
418     (t
419      ()))
420   "Level 3 newsgroup face."
421   :group 'gnus-group)
422 ;; backward-compatibility alias
423 (put 'gnus-group-news-3-face 'face-alias 'gnus-group-news-3)
424
425 (defface gnus-group-news-3-empty
426   '((((class color)
427       (background dark))
428      ())
429     (((class color)
430       (background light))
431      ())
432     (t
433      ()))
434   "Level 3 empty newsgroup face."
435   :group 'gnus-group)
436 ;; backward-compatibility alias
437 (put 'gnus-group-news-3-empty-face 'face-alias 'gnus-group-news-3-empty)
438
439 (defface gnus-group-news-4
440   '((((class color)
441       (background dark))
442      (:bold t))
443     (((class color)
444       (background light))
445      (:bold t))
446     (t
447      ()))
448   "Level 4 newsgroup face."
449   :group 'gnus-group)
450 ;; backward-compatibility alias
451 (put 'gnus-group-news-4-face 'face-alias 'gnus-group-news-4)
452
453 (defface gnus-group-news-4-empty
454   '((((class color)
455       (background dark))
456      ())
457     (((class color)
458       (background light))
459      ())
460     (t
461      ()))
462   "Level 4 empty newsgroup face."
463   :group 'gnus-group)
464 ;; backward-compatibility alias
465 (put 'gnus-group-news-4-empty-face 'face-alias 'gnus-group-news-4-empty)
466
467 (defface gnus-group-news-5
468   '((((class color)
469       (background dark))
470      (:bold t))
471     (((class color)
472       (background light))
473      (:bold t))
474     (t
475      ()))
476   "Level 5 newsgroup face."
477   :group 'gnus-group)
478 ;; backward-compatibility alias
479 (put 'gnus-group-news-5-face 'face-alias 'gnus-group-news-5)
480
481 (defface gnus-group-news-5-empty
482   '((((class color)
483       (background dark))
484      ())
485     (((class color)
486       (background light))
487      ())
488     (t
489      ()))
490   "Level 5 empty newsgroup face."
491   :group 'gnus-group)
492 ;; backward-compatibility alias
493 (put 'gnus-group-news-5-empty-face 'face-alias 'gnus-group-news-5-empty)
494
495 (defface gnus-group-news-6
496   '((((class color)
497       (background dark))
498      (:bold t))
499     (((class color)
500       (background light))
501      (:bold t))
502     (t
503      ()))
504   "Level 6 newsgroup face."
505   :group 'gnus-group)
506 ;; backward-compatibility alias
507 (put 'gnus-group-news-6-face 'face-alias 'gnus-group-news-6)
508
509 (defface gnus-group-news-6-empty
510   '((((class color)
511       (background dark))
512      ())
513     (((class color)
514       (background light))
515      ())
516     (t
517      ()))
518   "Level 6 empty newsgroup face."
519   :group 'gnus-group)
520 ;; backward-compatibility alias
521 (put 'gnus-group-news-6-empty-face 'face-alias 'gnus-group-news-6-empty)
522
523 (defface gnus-group-news-low
524   '((((class color)
525       (background dark))
526      (:foreground "DarkTurquoise" :bold t))
527     (((class color)
528       (background light))
529      (:foreground "DarkGreen" :bold t))
530     (t
531      ()))
532   "Low level newsgroup face."
533   :group 'gnus-group)
534 ;; backward-compatibility alias
535 (put 'gnus-group-news-low-face 'face-alias 'gnus-group-news-low)
536
537 (defface gnus-group-news-low-empty
538   '((((class color)
539       (background dark))
540      (:foreground "DarkTurquoise"))
541     (((class color)
542       (background light))
543      (:foreground "DarkGreen"))
544     (t
545      ()))
546   "Low level empty newsgroup face."
547   :group 'gnus-group)
548 ;; backward-compatibility alias
549 (put 'gnus-group-news-low-empty-face 'face-alias 'gnus-group-news-low-empty)
550
551 (defface gnus-group-mail-1
552   '((((class color)
553       (background dark))
554      (:foreground "aquamarine1" :bold t))
555     (((class color)
556       (background light))
557      (:foreground "DeepPink3" :bold t))
558     (t
559      (:bold t)))
560   "Level 1 mailgroup face."
561   :group 'gnus-group)
562 ;; backward-compatibility alias
563 (put 'gnus-group-mail-1-face 'face-alias 'gnus-group-mail-1)
564
565 (defface gnus-group-mail-1-empty
566   '((((class color)
567       (background dark))
568      (:foreground "aquamarine1"))
569     (((class color)
570       (background light))
571      (:foreground "DeepPink3"))
572     (t
573      (:italic t :bold t)))
574   "Level 1 empty mailgroup face."
575   :group 'gnus-group)
576 ;; backward-compatibility alias
577 (put 'gnus-group-mail-1-empty-face 'face-alias 'gnus-group-mail-1-empty)
578
579 (defface gnus-group-mail-2
580   '((((class color)
581       (background dark))
582      (:foreground "aquamarine2" :bold t))
583     (((class color)
584       (background light))
585      (:foreground "HotPink3" :bold t))
586     (t
587      (:bold t)))
588   "Level 2 mailgroup face."
589   :group 'gnus-group)
590 ;; backward-compatibility alias
591 (put 'gnus-group-mail-2-face 'face-alias 'gnus-group-mail-2)
592
593 (defface gnus-group-mail-2-empty
594   '((((class color)
595       (background dark))
596      (:foreground "aquamarine2"))
597     (((class color)
598       (background light))
599      (:foreground "HotPink3"))
600     (t
601      (:bold t)))
602   "Level 2 empty mailgroup face."
603   :group 'gnus-group)
604 ;; backward-compatibility alias
605 (put 'gnus-group-mail-2-empty-face 'face-alias 'gnus-group-mail-2-empty)
606
607 (defface gnus-group-mail-3
608   '((((class color)
609       (background dark))
610      (:foreground "aquamarine3" :bold t))
611     (((class color)
612       (background light))
613      (:foreground "magenta4" :bold t))
614     (t
615      (:bold t)))
616   "Level 3 mailgroup face."
617   :group 'gnus-group)
618 ;; backward-compatibility alias
619 (put 'gnus-group-mail-3-face 'face-alias 'gnus-group-mail-3)
620
621 (defface gnus-group-mail-3-empty
622   '((((class color)
623       (background dark))
624      (:foreground "aquamarine3"))
625     (((class color)
626       (background light))
627      (:foreground "magenta4"))
628     (t
629      ()))
630   "Level 3 empty mailgroup face."
631   :group 'gnus-group)
632 ;; backward-compatibility alias
633 (put 'gnus-group-mail-3-empty-face 'face-alias 'gnus-group-mail-3-empty)
634
635 (defface gnus-group-mail-low
636   '((((class color)
637       (background dark))
638      (:foreground "aquamarine4" :bold t))
639     (((class color)
640       (background light))
641      (:foreground "DeepPink4" :bold t))
642     (t
643      (:bold t)))
644   "Low level mailgroup face."
645   :group 'gnus-group)
646 ;; backward-compatibility alias
647 (put 'gnus-group-mail-low-face 'face-alias 'gnus-group-mail-low)
648
649 (defface gnus-group-mail-low-empty
650   '((((class color)
651       (background dark))
652      (:foreground "aquamarine4"))
653     (((class color)
654       (background light))
655      (:foreground "DeepPink4"))
656     (t
657      (:bold t)))
658   "Low level empty mailgroup face."
659   :group 'gnus-group)
660 ;; backward-compatibility alias
661 (put 'gnus-group-mail-low-empty-face 'face-alias 'gnus-group-mail-low-empty)
662
663 ;; Summary mode faces.
664
665 (defface gnus-summary-selected '((t (:underline t)))
666   "Face used for selected articles."
667   :group 'gnus-summary)
668 ;; backward-compatibility alias
669 (put 'gnus-summary-selected-face 'face-alias 'gnus-summary-selected)
670
671 (defface gnus-summary-cancelled
672   '((((class color))
673      (:foreground "yellow" :background "black")))
674   "Face used for cancelled articles."
675   :group 'gnus-summary)
676 ;; backward-compatibility alias
677 (put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled)
678
679 (defface gnus-summary-high-ticked
680   '((((class color)
681       (background dark))
682      (:foreground "pink" :bold t))
683     (((class color)
684       (background light))
685      (:foreground "firebrick" :bold t))
686     (t
687      (:bold t)))
688   "Face used for high interest ticked articles."
689   :group 'gnus-summary)
690 ;; backward-compatibility alias
691 (put 'gnus-summary-high-ticked-face 'face-alias 'gnus-summary-high-ticked)
692
693 (defface gnus-summary-low-ticked
694   '((((class color)
695       (background dark))
696      (:foreground "pink" :italic t))
697     (((class color)
698       (background light))
699      (:foreground "firebrick" :italic t))
700     (t
701      (:italic t)))
702   "Face used for low interest ticked articles."
703   :group 'gnus-summary)
704 ;; backward-compatibility alias
705 (put 'gnus-summary-low-ticked-face 'face-alias 'gnus-summary-low-ticked)
706
707 (defface gnus-summary-normal-ticked
708   '((((class color)
709       (background dark))
710      (:foreground "pink"))
711     (((class color)
712       (background light))
713      (:foreground "firebrick"))
714     (t
715      ()))
716   "Face used for normal interest ticked articles."
717   :group 'gnus-summary)
718 ;; backward-compatibility alias
719 (put 'gnus-summary-normal-ticked-face 'face-alias 'gnus-summary-normal-ticked)
720
721 (defface gnus-summary-high-ancient
722   '((((class color)
723       (background dark))
724      (:foreground "SkyBlue" :bold t))
725     (((class color)
726       (background light))
727      (:foreground "RoyalBlue" :bold t))
728     (t
729      (:bold t)))
730   "Face used for high interest ancient articles."
731   :group 'gnus-summary)
732 ;; backward-compatibility alias
733 (put 'gnus-summary-high-ancient-face 'face-alias 'gnus-summary-high-ancient)
734
735 (defface gnus-summary-low-ancient
736   '((((class color)
737       (background dark))
738      (:foreground "SkyBlue" :italic t))
739     (((class color)
740       (background light))
741      (:foreground "RoyalBlue" :italic t))
742     (t
743      (:italic t)))
744   "Face used for low interest ancient articles."
745   :group 'gnus-summary)
746 ;; backward-compatibility alias
747 (put 'gnus-summary-low-ancient-face 'face-alias 'gnus-summary-low-ancient)
748
749 (defface gnus-summary-normal-ancient
750   '((((class color)
751       (background dark))
752      (:foreground "SkyBlue"))
753     (((class color)
754       (background light))
755      (:foreground "RoyalBlue"))
756     (t
757      ()))
758   "Face used for normal interest ancient articles."
759   :group 'gnus-summary)
760 ;; backward-compatibility alias
761 (put 'gnus-summary-normal-ancient-face 'face-alias 'gnus-summary-normal-ancient)
762
763 (defface gnus-summary-high-undownloaded
764    '((((class color)
765        (background light))
766       (:bold t :foreground "cyan4"))
767      (((class color) (background dark))
768       (:bold t :foreground "LightGray"))
769      (t (:inverse-video t :bold t)))
770   "Face used for high interest uncached articles."
771   :group 'gnus-summary)
772 ;; backward-compatibility alias
773 (put 'gnus-summary-high-undownloaded-face 'face-alias 'gnus-summary-high-undownloaded)
774
775 (defface gnus-summary-low-undownloaded
776    '((((class color)
777        (background light))
778       (:italic t :foreground "cyan4" :bold nil))
779      (((class color) (background dark))
780       (:italic t :foreground "LightGray" :bold nil))
781      (t (:inverse-video t :italic t)))
782   "Face used for low interest uncached articles."
783   :group 'gnus-summary)
784 ;; backward-compatibility alias
785 (put 'gnus-summary-low-undownloaded-face 'face-alias 'gnus-summary-low-undownloaded)
786
787 (defface gnus-summary-normal-undownloaded
788    '((((class color)
789        (background light))
790       (:foreground "cyan4" :bold nil))
791      (((class color) (background dark))
792       (:foreground "LightGray" :bold nil))
793      (t (:inverse-video t)))
794   "Face used for normal interest uncached articles."
795   :group 'gnus-summary)
796 ;; backward-compatibility alias
797 (put 'gnus-summary-normal-undownloaded-face 'face-alias 'gnus-summary-normal-undownloaded)
798
799 (defface gnus-summary-high-unread
800   '((t
801      (:bold t)))
802   "Face used for high interest unread articles."
803   :group 'gnus-summary)
804 ;; backward-compatibility alias
805 (put 'gnus-summary-high-unread-face 'face-alias 'gnus-summary-high-unread)
806
807 (defface gnus-summary-low-unread
808   '((t
809      (:italic t)))
810   "Face used for low interest unread articles."
811   :group 'gnus-summary)
812 ;; backward-compatibility alias
813 (put 'gnus-summary-low-unread-face 'face-alias 'gnus-summary-low-unread)
814
815 (defface gnus-summary-normal-unread
816   '((t
817      ()))
818   "Face used for normal interest unread articles."
819   :group 'gnus-summary)
820 ;; backward-compatibility alias
821 (put 'gnus-summary-normal-unread-face 'face-alias 'gnus-summary-normal-unread)
822
823 (defface gnus-summary-incorporated
824   '((t
825      ()))
826   "Face used for incorporated articles."
827   :group 'gnus-summary)
828 ;; backward-compatibility alias
829 (put 'gnus-summary-incorporated-face 'face-alias 'gnus-summary-incorporated)
830
831 (defface gnus-summary-high-read
832   '((((class color)
833       (background dark))
834      (:foreground "PaleGreen"
835                   :bold t))
836     (((class color)
837       (background light))
838      (:foreground "DarkGreen"
839                   :bold t))
840     (t
841      (:bold t)))
842   "Face used for high interest read articles."
843   :group 'gnus-summary)
844 ;; backward-compatibility alias
845 (put 'gnus-summary-high-read-face 'face-alias 'gnus-summary-high-read)
846
847 (defface gnus-summary-low-read
848   '((((class color)
849       (background dark))
850      (:foreground "PaleGreen"
851                   :italic t))
852     (((class color)
853       (background light))
854      (:foreground "DarkGreen"
855                   :italic t))
856     (t
857      (:italic t)))
858   "Face used for low interest read articles."
859   :group 'gnus-summary)
860 ;; backward-compatibility alias
861 (put 'gnus-summary-low-read-face 'face-alias 'gnus-summary-low-read)
862
863 (defface gnus-summary-normal-read
864   '((((class color)
865       (background dark))
866      (:foreground "PaleGreen"))
867     (((class color)
868       (background light))
869      (:foreground "DarkGreen"))
870     (t
871      ()))
872   "Face used for normal interest read articles."
873   :group 'gnus-summary)
874 ;; backward-compatibility alias
875 (put 'gnus-summary-normal-read-face 'face-alias 'gnus-summary-normal-read)
876
877
878 ;;;
879 ;;; Gnus buffers
880 ;;;
881
882 (defvar gnus-buffers nil)
883
884 (defun gnus-get-buffer-create (name)
885   "Do the same as `get-buffer-create', but store the created buffer."
886   (or (get-buffer name)
887       (car (push (get-buffer-create name) gnus-buffers))))
888
889 (defun gnus-add-buffer ()
890   "Add the current buffer to the list of Gnus buffers."
891   (push (current-buffer) gnus-buffers))
892
893 (defmacro gnus-kill-buffer (buffer)
894   "Kill BUFFER and remove from the list of Gnus buffers."
895   `(let ((buf ,buffer))
896      (when (gnus-buffer-exists-p buf)
897        (setq gnus-buffers (delete (get-buffer buf) gnus-buffers))
898        (kill-buffer buf))))
899
900 (defun gnus-buffers ()
901   "Return a list of live Gnus buffers."
902   (while (and gnus-buffers
903               (not (buffer-name (car gnus-buffers))))
904     (pop gnus-buffers))
905   (let ((buffers gnus-buffers))
906     (while (cdr buffers)
907       (if (buffer-name (cadr buffers))
908           (pop buffers)
909         (setcdr buffers (cddr buffers)))))
910   gnus-buffers)
911
912 ;;; Splash screen.
913
914 (defvar gnus-group-buffer "*Group*")
915
916 (eval-and-compile
917   (autoload 'gnus-play-jingle "gnus-audio"))
918
919 (defface gnus-splash
920   '((((class color)
921       (background dark))
922      (:foreground "#888888"))
923     (((class color)
924       (background light))
925      (:foreground "#888888"))
926     (t
927      ()))
928   "Face for the splash screen."
929   :group 'gnus)
930 ;; backward-compatibility alias
931 (put 'gnus-splash-face 'face-alias 'gnus-splash)
932
933 (defun gnus-splash ()
934   (save-excursion
935     (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
936     (let ((buffer-read-only nil))
937       (erase-buffer)
938       (unless gnus-inhibit-startup-message
939         (gnus-group-startup-message)
940         (sit-for 0)
941         (when gnus-play-startup-jingle
942           (gnus-play-jingle))))))
943
944 (defun gnus-indent-rigidly (start end arg)
945   "Indent rigidly using only spaces and no tabs."
946   (save-excursion
947     (save-restriction
948       (narrow-to-region start end)
949       (let ((tab-width 8))
950         (indent-rigidly start end arg)
951         ;; We translate tabs into spaces -- not everybody uses
952         ;; an 8-character tab.
953         (goto-char (point-min))
954         (while (search-forward "\t" nil t)
955           (replace-match "        " t t))))))
956
957 (defvar gnus-simple-splash nil)
958
959 ;;(format "%02x%02x%02x" 114 66 20) "724214"
960
961 (defvar gnus-logo-color-alist
962   '((flame "#cc3300" "#ff2200")
963     (pine "#c0cc93" "#f8ffb8")
964     (moss "#a1cc93" "#d2ffb8")
965     (irish "#04cc90" "#05ff97")
966     (sky "#049acc" "#05deff")
967     (tin "#6886cc" "#82b6ff")
968     (velvet "#7c68cc" "#8c82ff")
969     (grape "#b264cc" "#cf7df")
970     (labia "#cc64c2" "#fd7dff")
971     (berry "#cc6485" "#ff7db5")
972     (dino "#724214" "#1e3f03")
973     (oort "#cccccc" "#888888")
974     (storm "#666699" "#99ccff")
975     (pdino "#9999cc" "#99ccff")
976     (purp "#9999cc" "#666699")
977     (no "#ff0000" "#ffff00")
978     (neutral "#b4b4b4" "#878787")
979     (september "#bf9900" "#ffcc00"))
980   "Color alist used for the Gnus logo.")
981
982 (defcustom gnus-logo-color-style 'no
983   "*Color styles used for the Gnus logo."
984   :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
985                            gnus-logo-color-alist))
986   :group 'gnus-xmas)
987
988 (defvar gnus-logo-colors
989   (cdr (assq gnus-logo-color-style gnus-logo-color-alist))
990   "Colors used for the Gnus logo.")
991
992 (defun gnus-group-startup-message (&optional x y)
993   "Insert startup message in current buffer."
994   ;; Insert the message.
995   (erase-buffer)
996   (cond
997    ((and (fboundp 'find-image)
998          (display-graphic-p)
999          (let* ((bg (face-background 'default))
1000                 (fg (face-foreground 'gnus-splash))
1001                 (data-directory (nnheader-find-etc-directory "images/gnus"))
1002                 (image (find-image
1003                         `((:type xpm :file "gnus.xpm"
1004                                  :color-symbols
1005                                  (("thing" . ,(car gnus-logo-colors))
1006                                   ("shadow" . ,(cadr gnus-logo-colors))
1007                                   ("oort" . "#eeeeee")
1008                                   ("background" . ,bg)))
1009                           (:type pbm :file "gnus.pbm"
1010                                  ;; Account for the pbm's blackground.
1011                                  :background ,bg :foreground ,fg)
1012                           (:type xbm :file "gnus.xbm"
1013                                  ;; Account for the xbm's blackground.
1014                                  :background ,bg :foreground ,fg)))))
1015            (when image
1016              (insert
1017               (propertize
1018                (concat gnus-product-name " " gnus-version-number
1019                        (if (zerop (string-to-number gnus-revision-number))
1020                            ""
1021                          (concat " (r" gnus-revision-number ")"))
1022                        " based on " gnus-original-product-name " v"
1023                        gnus-original-version-number)
1024                'face `(variable-pitch :background ,bg :foreground ,fg)))
1025              (let ((fill-column (window-width)))
1026                (center-region (point-min) (point)))
1027              (let ((size (image-size image)))
1028                (insert-char ?\n (max 1 (round (- (window-height)
1029                                                  (or y (cdr size))) 2)))
1030                (insert
1031                 (propertize " " 'display
1032                             `(space :align-to
1033                                     ,(max 0 (round (- (window-width)
1034                                                       (or x (car size))) 2)))))
1035                (insert-image image))
1036              (setq gnus-simple-splash nil)
1037              t))))
1038    (t
1039     (insert "
1040           _    ___ _             _
1041           _ ___ __ ___  __    _ ___
1042           __   _     ___    __  ___
1043               _           ___     _
1044              _  _ __             _
1045              ___   __            _
1046                    __           _
1047                     _      _   _
1048                    _      _    _
1049                       _  _    _
1050                   __  ___
1051                  _   _ _     _
1052                 _   _
1053               _    _
1054              _    _
1055             _
1056           __
1057
1058 "
1059             )
1060     (goto-char (point-min))
1061     (insert gnus-product-name " " gnus-version-number
1062             (if (zerop (string-to-number gnus-revision-number))
1063                 ""
1064               (concat " (r" gnus-revision-number ")"))
1065             " based on " gnus-original-product-name " v"
1066             gnus-original-version-number)
1067     (insert-char ?\  (prog1
1068                          (max 0 (/ (- (window-width) (point)) 2))
1069                        (goto-char (point-min))))
1070     (forward-line 1)
1071     ;; And then hack it.
1072     (gnus-indent-rigidly (point) (point-max)
1073                          (/ (max (- (window-width) (or x 46)) 0) 2))
1074     (goto-char (point-min))
1075     (forward-line 1)
1076     (let* ((pheight (count-lines (point-min) (point-max)))
1077            (wheight (window-height))
1078            (rest (- wheight pheight)))
1079       (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
1080     ;; Fontify some.
1081     (put-text-property (point-min) (point-max) 'face 'gnus-splash)
1082     (setq gnus-simple-splash t)))
1083   (goto-char (point-min))
1084   (setq mode-line-buffer-identification (concat " " gnus-version))
1085   (set-buffer-modified-p t))
1086
1087 (eval-when (load)
1088   (let ((command (format "%s" this-command)))
1089     (when (string-match "gnus" command)
1090       (if (string-match "gnus-other-frame" command)
1091           (gnus-get-buffer-create gnus-group-buffer)
1092         (gnus-splash)))))
1093
1094 ;;; Do the rest.
1095
1096 (require 'gnus-util)
1097 (require 'nnheader)
1098
1099 (defcustom gnus-parameters nil
1100   "Alist of group parameters.
1101
1102 For example:
1103    ((\"mail\\\\..*\"  (gnus-show-threads nil)
1104                   (gnus-use-scoring nil)
1105                   (gnus-summary-line-format
1106                         \"%U%R%z%I%(%[%d:%ub%-23,23f%]%) %s\\n\")
1107                   (gcc-self . t)
1108                   (display . all))
1109      (\"mail\\\\.me\" (gnus-use-scoring  t))
1110      (\"list\\\\..*\" (total-expire . t)
1111                   (broken-reply-to . t)))"
1112   :version "22.1"
1113   :group 'gnus-group-various
1114   :type '(repeat (cons regexp
1115                        (repeat sexp))))
1116
1117 (defvar gnus-group-parameters-more nil)
1118
1119 (defmacro gnus-define-group-parameter (param &rest rest)
1120   "Define a group parameter PARAM.
1121 REST is a plist of following:
1122 :type               One of `bool', `list' or nil.
1123 :function           The name of the function.
1124 :function-document  The documentation of the function.
1125 :parameter-type     The type for customizing the parameter.
1126 :parameter-document The documentation for the parameter.
1127 :variable           The name of the variable.
1128 :variable-document  The documentation for the variable.
1129 :variable-group     The group for customizing the variable.
1130 :variable-type      The type for customizing the variable.
1131 :variable-default   The default value of the variable."
1132   (let* ((type (plist-get rest :type))
1133          (parameter-type (plist-get rest :parameter-type))
1134          (parameter-document (plist-get rest :parameter-document))
1135          (function (or (plist-get rest :function)
1136                        (intern (format "gnus-parameter-%s" param))))
1137          (function-document (or (plist-get rest :function-document) ""))
1138          (variable (or (plist-get rest :variable)
1139                        (intern (format "gnus-parameter-%s-alist" param))))
1140          (variable-document (or (plist-get rest :variable-document) ""))
1141          (variable-group (plist-get rest :variable-group))
1142          (variable-type (or (plist-get rest :variable-type)
1143                             `(quote (repeat
1144                                      (list (regexp :tag "Group")
1145                                            ,(car (cdr parameter-type)))))))
1146          (variable-default (plist-get rest :variable-default)))
1147     (list
1148      'progn
1149      `(defcustom ,variable ,variable-default
1150         ,variable-document
1151         :group 'gnus-group-parameter
1152         :group ',variable-group
1153         :type ,variable-type)
1154      `(setq gnus-group-parameters-more
1155             (delq (assq ',param gnus-group-parameters-more)
1156                   gnus-group-parameters-more))
1157      `(add-to-list 'gnus-group-parameters-more
1158                    (list ',param
1159                          ,parameter-type
1160                          ,parameter-document))
1161      (if (eq type 'bool)
1162          `(defun ,function (name)
1163             ,function-document
1164             (let ((params (gnus-group-find-parameter name))
1165                   val)
1166               (cond
1167                ((memq ',param params)
1168                 t)
1169                ((setq val (assq ',param params))
1170                 (cdr val))
1171                ((stringp ,variable)
1172                 (string-match ,variable name))
1173                (,variable
1174                 (let ((alist ,variable)
1175                       elem value)
1176                   (while (setq elem (pop alist))
1177                     (when (and name
1178                                (string-match (car elem) name))
1179                       (setq alist nil
1180                             value (cdr elem))))
1181                   (if (consp value) (car value) value))))))
1182        `(defun ,function (name)
1183           ,function-document
1184           (and name
1185                (or (gnus-group-find-parameter name ',param ,(and type t))
1186                    (let ((alist ,variable)
1187                          elem value)
1188                      (while (setq elem (pop alist))
1189                        (when (and name
1190                                   (string-match (car elem) name))
1191                          (setq alist nil
1192                                value (cdr elem))))
1193                      ,(if type
1194                           'value
1195                         '(if (consp value) (car value) value))))))))))
1196
1197 (defcustom gnus-home-directory "~/"
1198   "Directory variable that specifies the \"home\" directory.
1199 All other Gnus file and directory variables are initialized from this variable."
1200   :group 'gnus-files
1201   :type 'directory)
1202
1203 (defcustom gnus-directory (or (getenv "SAVEDIR")
1204                               (nnheader-concat gnus-home-directory "News/"))
1205   "*Directory variable from which all other Gnus file variables are derived.
1206
1207 Note that Gnus is mostly loaded when the `.gnus.el' file is read.
1208 This means that other directory variables that are initialized from
1209 this variable won't be set properly if you set this variable in `.gnus.el'.
1210 Set this variable in `.emacs' instead."
1211   :group 'gnus-files
1212   :type 'directory)
1213
1214 (defcustom gnus-default-directory nil
1215   "*Default directory for all Gnus buffers."
1216   :group 'gnus-files
1217   :type '(choice (const :tag "current" nil)
1218                  directory))
1219
1220 ;; Site dependent variables.  These variables should be defined in
1221 ;; paths.el.
1222
1223 (defvar gnus-default-nntp-server nil
1224   "Specify a default NNTP server.
1225 This variable should be defined in paths.el, and should never be set
1226 by the user.
1227 If you want to change servers, you should use `gnus-select-method'.
1228 See the documentation to that variable.")
1229
1230 ;; Don't touch this variable.
1231 (defvar gnus-nntp-service "nntp"
1232   "NNTP service name (\"nntp\" or 119).
1233 This is an obsolete variable, which is scarcely used.  If you use an
1234 nntp server for your newsgroup and want to change the port number
1235 used to 899, you would say something along these lines:
1236
1237  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
1238
1239 (defcustom gnus-nntpserver-file "/etc/nntpserver"
1240   "A file with only the name of the nntp server in it."
1241   :group 'gnus-files
1242   :group 'gnus-server
1243   :type 'file)
1244
1245 (defun gnus-getenv-nntpserver ()
1246   "Find default nntp server.
1247 Check the NNTPSERVER environment variable and the
1248 `gnus-nntpserver-file' file."
1249   (or (getenv "NNTPSERVER")
1250       (and (file-readable-p gnus-nntpserver-file)
1251            (with-temp-buffer
1252              (insert-file-contents gnus-nntpserver-file)
1253              (when (re-search-forward "[^ \t\n\r]+" nil t)
1254                (match-string 0))))))
1255
1256 (defcustom gnus-select-method
1257   (condition-case nil
1258       (nconc
1259        (list 'nntp (or (condition-case nil
1260                            (gnus-getenv-nntpserver)
1261                          (error nil))
1262                        (when (and gnus-default-nntp-server
1263                                   (not (string= gnus-default-nntp-server "")))
1264                          gnus-default-nntp-server)
1265                        "news"))
1266        (if (or (null gnus-nntp-service)
1267                (equal gnus-nntp-service "nntp"))
1268            nil
1269          (list gnus-nntp-service)))
1270     (error nil))
1271   "Default method for selecting a newsgroup.
1272 This variable should be a list, where the first element is how the
1273 news is to be fetched, the second is the address.
1274
1275 For instance, if you want to get your news via \"flab.flab.edu\" using
1276 NNTP, you could say:
1277
1278 \(setq gnus-select-method '(nntp \"flab.flab.edu\"))
1279
1280 If you want to use your local spool, say:
1281
1282 \(setq gnus-select-method (list 'nnspool (system-name)))
1283
1284 If you use this variable, you must set `gnus-nntp-server' to nil.
1285
1286 There is a lot more to know about select methods and virtual servers -
1287 see the manual for details."
1288   :group 'gnus-server
1289   :type 'gnus-select-method)
1290
1291 (defcustom gnus-message-archive-method "archive"
1292   "*Method used for archiving messages you've sent.
1293 This should be a mail method."
1294   :group 'gnus-server
1295   :group 'gnus-message
1296   :type '(choice (const :tag "Default archive method" "archive")
1297                  gnus-select-method))
1298
1299 (defcustom gnus-message-archive-group nil
1300   "*Name of the group in which to save the messages you've written.
1301 This can either be a string; a list of strings; or an alist
1302 of regexps/functions/forms to be evaluated to return a string (or a list
1303 of strings).  The functions are called with the name of the current
1304 group (or nil) as a parameter.
1305
1306 If you want to save your mail in one group and the news articles you
1307 write in another group, you could say something like:
1308
1309  \(setq gnus-message-archive-group
1310         '((if (message-news-p)
1311               \"misc-news\"
1312             \"misc-mail\")))
1313
1314 Normally the group names returned by this variable should be
1315 unprefixed -- which implicitly means \"store on the archive server\".
1316 However, you may wish to store the message on some other server.  In
1317 that case, just return a fully prefixed name of the group --
1318 \"nnml+private:mail.misc\", for instance."
1319   :group 'gnus-message
1320   :type '(choice (const :tag "none" nil)
1321                  function
1322                  sexp
1323                  string))
1324
1325 (defcustom gnus-secondary-servers nil
1326   "List of NNTP servers that the user can choose between interactively.
1327 To make Gnus query you for a server, you have to give `gnus' a
1328 non-numeric prefix - `C-u M-x gnus', in short."
1329   :group 'gnus-server
1330   :type '(repeat string))
1331
1332 (defcustom gnus-nntp-server nil
1333   "*The name of the host running the NNTP server.
1334 This variable is semi-obsolete.  Use the `gnus-select-method'
1335 variable instead."
1336   :group 'gnus-server
1337   :type '(choice (const :tag "disable" nil)
1338                  string))
1339
1340 (defcustom gnus-secondary-select-methods nil
1341   "A list of secondary methods that will be used for reading news.
1342 This is a list where each element is a complete select method (see
1343 `gnus-select-method').
1344
1345 If, for instance, you want to read your mail with the nnml back end,
1346 you could set this variable:
1347
1348 \(setq gnus-secondary-select-methods '((nnml \"\")))"
1349   :group 'gnus-server
1350   :type '(repeat gnus-select-method))
1351
1352 (defvar gnus-backup-default-subscribed-newsgroups
1353   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
1354   "Default default new newsgroups the first time Gnus is run.
1355 Should be set in paths.el, and shouldn't be touched by the user.")
1356
1357 (defcustom gnus-local-domain nil
1358   "Local domain name without a host name.
1359 The DOMAINNAME environment variable is used instead if it is defined.
1360 If the function `system-name' returns the full Internet name, there is
1361 no need to set this variable."
1362   :group 'gnus-message
1363   :type '(choice (const :tag "default" nil)
1364                  string))
1365
1366 (defvar gnus-local-organization nil
1367   "String with a description of what organization (if any) the user belongs to.
1368 Obsolete variable; use `message-user-organization' instead.")
1369
1370 ;; Customization variables
1371
1372 (defcustom gnus-refer-article-method nil
1373   "Preferred method for fetching an article by Message-ID.
1374 If you are reading news from the local spool (with nnspool), fetching
1375 articles by Message-ID is painfully slow.  By setting this method to an
1376 nntp method, you might get acceptable results.
1377
1378 The value of this variable must be a valid select method as discussed
1379 in the documentation of `gnus-select-method'.
1380
1381 It can also be a list of select methods, as well as the special symbol
1382 `current', which means to use the current select method.  If it is a
1383 list, Gnus will try all the methods in the list until it finds a match."
1384   :group 'gnus-server
1385   :type '(choice (const :tag "default" nil)
1386                  (const current)
1387                  (const :tag "Google" (nnweb "refer" (nnweb-type google)))
1388                  gnus-select-method
1389                  (repeat :menu-tag "Try multiple"
1390                          :tag "Multiple"
1391                          :value (current (nnweb "refer" (nnweb-type google)))
1392                          (choice :tag "Method"
1393                                  (const current)
1394                                  (const :tag "Google"
1395                                         (nnweb "refer" (nnweb-type google)))
1396                                  gnus-select-method))))
1397
1398 (defcustom gnus-group-faq-directory
1399   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
1400     "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
1401     "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
1402     "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
1403     "/ftp@ftp.pasteur.fr:/pub/FAQ/"
1404     "/ftp@rtfm.mit.edu:/pub/usenet/"
1405     "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
1406     "/ftp@ftp.sunet.se:/pub/usenet/"
1407     "/ftp@nctuccca.nctu.edu.tw:/pub/Documents/rtfm/usenet-by-group/"
1408     "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
1409     "/ftp@ftp.hk.super.net:/mirror/faqs/")
1410   "*Directory where the group FAQs are stored.
1411 This will most commonly be on a remote machine, and the file will be
1412 fetched by ange-ftp.
1413
1414 This variable can also be a list of directories.  In that case, the
1415 first element in the list will be used by default.  The others can
1416 be used when being prompted for a site.
1417
1418 Note that Gnus uses an aol machine as the default directory.  If this
1419 feels fundamentally unclean, just think of it as a way to finally get
1420 something of value back from them.
1421
1422 If the default site is too slow, try one of these:
1423
1424    North America: mirrors.aol.com                /pub/rtfm/usenet
1425                   ftp.seas.gwu.edu               /pub/rtfm
1426                   rtfm.mit.edu                   /pub/usenet
1427    Europe:        ftp.uni-paderborn.de           /pub/FAQ
1428                   src.doc.ic.ac.uk               /usenet/news-FAQS
1429                   ftp.sunet.se                   /pub/usenet
1430                   ftp.pasteur.fr                 /pub/FAQ
1431    Asia:          nctuccca.nctu.edu.tw           /pub/Documents/rtfm/usenet-by-group/
1432                   hwarang.postech.ac.kr          /pub/usenet
1433                   ftp.hk.super.net               /mirror/faqs"
1434   :group 'gnus-group-various
1435   :type '(choice directory
1436                  (repeat directory)))
1437
1438 (defcustom gnus-group-charter-alist
1439   '(("no" . (concat "http://no.news-admin.org/charter/" name ".txt"))
1440     ("de" . (concat "http://purl.net/charta/" name ".html"))
1441     ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name))
1442     ("england" . (concat "http://england.news-admin.org/charters/" name))
1443     ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html"))
1444     ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-"
1445                         (gnus-replace-in-string name "europa\\." "") ".html"))
1446     ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name))
1447     ("aus" . (concat "http://aus.news-admin.org/groupinfo.cgi/" name))
1448     ("pl" . (concat "http://www.usenet.pl/opisy/" name))
1449     ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name))
1450     ("at" . (concat "http://www.usenet.at/chartas/" name "/charta"))
1451     ("uk" . (concat "http://www.usenet.org.uk/" name ".html"))
1452     ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html"))
1453     ("se" . (concat "http://www.usenet-se.net/Reglementen/"
1454                     (gnus-replace-in-string name "\\." "_") ".html"))
1455     ("milw" . (concat "http://usenet.mil.wi.us/"
1456                       (gnus-replace-in-string name "milw\\." "") "-charter"))
1457     ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html"))
1458     ("netins" . (concat "http://www.netins.net/usenet/charter/"
1459                         (gnus-replace-in-string name "\\." "-") "-charter.html")))
1460   "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter.
1461 When FORM is evaluated `name' is bound to the name of the group."
1462   :version "22.1"
1463   :group 'gnus-group-various
1464   :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form"))))
1465
1466 (defcustom gnus-group-fetch-control-use-browse-url nil
1467   "*Non-nil means that control messages are displayed using `browse-url'.
1468 Otherwise they are fetched with ange-ftp and displayed in an ephemeral
1469 group."
1470   :version "22.1"
1471   :group 'gnus-group-various
1472   :type 'boolean)
1473
1474 (defcustom gnus-use-cross-reference t
1475   "*Non-nil means that cross referenced articles will be marked as read.
1476 If nil, ignore cross references.  If t, mark articles as read in
1477 subscribed newsgroups.  If neither t nor nil, mark as read in all
1478 newsgroups."
1479   :group 'gnus-server
1480   :type '(choice (const :tag "off" nil)
1481                  (const :tag "subscribed" t)
1482                  (sexp :format "all"
1483                        :value always)))
1484
1485 (defcustom gnus-process-mark ?#
1486   "*Process mark."
1487   :group 'gnus-group-visual
1488   :group 'gnus-summary-marks
1489   :type 'character)
1490
1491 (defcustom gnus-large-newsgroup 200
1492   "*The number of articles which indicates a large newsgroup.
1493 If the number of articles in a newsgroup is greater than this value,
1494 confirmation is required for selecting the newsgroup.
1495 If it is nil, no confirmation is required."
1496   :group 'gnus-group-select
1497   :type '(choice (const :tag "No limit" nil)
1498                  integer))
1499
1500 (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
1501   "*Non-nil means that the default name of a file to save articles in is the group name.
1502 If it's nil, the directory form of the group name is used instead.
1503
1504 If this variable is a list, and the list contains the element
1505 `not-score', long file names will not be used for score files; if it
1506 contains the element `not-save', long file names will not be used for
1507 saving; and if it contains the element `not-kill', long file names
1508 will not be used for kill files.
1509
1510 Note that the default for this variable varies according to what system
1511 type you're using.  On `usg-unix-v' and `xenix' this variable defaults
1512 to nil while on all other systems it defaults to t."
1513   :group 'gnus-start
1514   :type '(radio (sexp :format "Non-nil\n"
1515                       :match (lambda (widget value)
1516                                (and value (not (listp value))))
1517                       :value t)
1518                 (const nil)
1519                 (checklist (const :format "%v " not-score)
1520                            (const :format "%v " not-save)
1521                            (const not-kill))))
1522
1523 (defcustom gnus-kill-files-directory gnus-directory
1524   "*Name of the directory where kill files will be stored (default \"~/News\")."
1525   :group 'gnus-score-files
1526   :group 'gnus-score-kill
1527   :type 'directory)
1528
1529 (defcustom gnus-save-score nil
1530   "*If non-nil, save group scoring info."
1531   :group 'gnus-score-various
1532   :group 'gnus-start
1533   :type 'boolean)
1534
1535 (defcustom gnus-use-undo t
1536   "*If non-nil, allow undoing in Gnus group mode buffers."
1537   :group 'gnus-meta
1538   :type 'boolean)
1539
1540 (defcustom gnus-use-adaptive-scoring nil
1541   "*If non-nil, use some adaptive scoring scheme.
1542 If a list, then the values `word' and `line' are meaningful.  The
1543 former will perform adaption on individual words in the subject
1544 header while `line' will perform adaption on several headers."
1545   :group 'gnus-meta
1546   :group 'gnus-score-adapt
1547   :type '(set (const word) (const line)))
1548
1549 (defcustom gnus-use-cache 'passive
1550   "*If nil, Gnus will ignore the article cache.
1551 If `passive', it will allow entering (and reading) articles
1552 explicitly entered into the cache.  If anything else, use the
1553 cache to the full extent of the law."
1554   :group 'gnus-meta
1555   :group 'gnus-cache
1556   :type '(choice (const :tag "off" nil)
1557                  (const :tag "passive" passive)
1558                  (const :tag "active" t)))
1559
1560 (defcustom gnus-use-trees nil
1561   "*If non-nil, display a thread tree buffer."
1562   :group 'gnus-meta
1563   :type 'boolean)
1564
1565 (defcustom gnus-keep-backlog 20
1566   "*If non-nil, Gnus will keep read articles for later re-retrieval.
1567 If it is a number N, then Gnus will only keep the last N articles
1568 read.  If it is neither nil nor a number, Gnus will keep all read
1569 articles.  This is not a good idea."
1570   :group 'gnus-meta
1571   :type '(choice (const :tag "off" nil)
1572                  integer
1573                  (sexp :format "all"
1574                        :value t)))
1575
1576 (defcustom gnus-use-nocem nil
1577   "*If non-nil, Gnus will read NoCeM cancel messages."
1578   :group 'gnus-meta
1579   :type 'boolean)
1580
1581 (defcustom gnus-suppress-duplicates nil
1582   "*If non-nil, Gnus will mark duplicate copies of the same article as read."
1583   :group 'gnus-meta
1584   :type 'boolean)
1585
1586 (defcustom gnus-use-scoring t
1587   "*If non-nil, enable scoring."
1588   :group 'gnus-meta
1589   :type 'boolean)
1590
1591 (defcustom gnus-summary-prepare-exit-hook
1592   '(gnus-summary-expire-articles)
1593   "*A hook called when preparing to exit from the summary buffer.
1594 It calls `gnus-summary-expire-articles' by default."
1595   :group 'gnus-summary-exit
1596   :type 'hook)
1597
1598 (defcustom gnus-novice-user t
1599   "*Non-nil means that you are a Usenet novice.
1600 If non-nil, verbose messages may be displayed and confirmations may be
1601 required."
1602   :group 'gnus-meta
1603   :type 'boolean)
1604
1605 (defcustom gnus-expert-user nil
1606   "*Non-nil means that you will never be asked for confirmation about anything.
1607 That doesn't mean *anything* anything; particularly destructive
1608 commands will still require prompting."
1609   :group 'gnus-meta
1610   :type 'boolean)
1611
1612 (defcustom gnus-interactive-catchup t
1613   "*If non-nil, require your confirmation when catching up a group."
1614   :group 'gnus-group-select
1615   :type 'boolean)
1616
1617 (defcustom gnus-interactive-exit t
1618   "*If non-nil, require your confirmation when exiting Gnus."
1619   :group 'gnus-exit
1620   :type 'boolean)
1621
1622 (defcustom gnus-extract-address-components 'gnus-extract-address-components
1623   "Function for extracting address components from a From header.
1624 Three pre-defined functions exist: `gnus-extract-address-components',
1625 which is the default, quite fast, and too simplistic solution,
1626 `mail-extract-address-components', which works much better, but is
1627 slower, and `std11-extract-address-components'."
1628   :group 'gnus-summary-format
1629   :type '(radio (function-item gnus-extract-address-components)
1630                 (function-item mail-extract-address-components)
1631                 (function-item std11-extract-address-components)
1632                 (function :tag "Other")))
1633
1634 (defcustom gnus-carpal nil
1635   "*If non-nil, display clickable icons."
1636   :group 'gnus-meta
1637   :type 'boolean)
1638
1639 (defcustom gnus-shell-command-separator ";"
1640   "String used to separate shell commands."
1641   :group 'gnus-files
1642   :type 'string)
1643
1644 (defcustom gnus-valid-select-methods
1645   '(("nntp" post address prompt-address physical-address)
1646     ("nnspool" post address)
1647     ("nnvirtual" post-mail virtual prompt-address)
1648     ("nnmbox" mail respool address)
1649     ("nnml" post-mail respool address)
1650     ("nnmh" mail respool address)
1651     ("nndir" post-mail prompt-address physical-address)
1652     ("nneething" none address prompt-address physical-address)
1653     ("nndoc" none address prompt-address)
1654     ("nnbabyl" mail address respool)
1655     ("nnkiboze" post virtual)
1656     ("nnsoup" post-mail address)
1657     ("nndraft" post-mail)
1658     ("nnfolder" mail respool address)
1659     ("nngateway" post-mail address prompt-address physical-address)
1660     ("nnweb" none)
1661     ("nngoogle" post)
1662     ("nnslashdot" post)
1663     ("nnultimate" none)
1664     ("nnrss" none)
1665     ("nnwfm" none)
1666     ("nnwarchive" none)
1667     ("nnlistserv" none)
1668     ("nnagent" post-mail)
1669     ("nnimap" post-mail address prompt-address physical-address)
1670     ("nnmaildir" mail respool address)
1671     ("nnnil" none))
1672   "*An alist of valid select methods.
1673 The first element of each list lists should be a string with the name
1674 of the select method.  The other elements may be the category of
1675 this method (i. e., `post', `mail', `none' or whatever) or other
1676 properties that this method has (like being respoolable).
1677 If you implement a new select method, all you should have to change is
1678 this variable.  I think."
1679   :group 'gnus-server
1680   :type '(repeat (group (string :tag "Name")
1681                         (radio-button-choice (const :format "%v " post)
1682                                              (const :format "%v " mail)
1683                                              (const :format "%v " none)
1684                                              (const post-mail))
1685                         (checklist :inline t
1686                                    (const :format "%v " address)
1687                                    (const :format "%v " prompt-address)
1688                                    (const :format "%v " physical-address)
1689                                    (const :format "%v " virtual)
1690                                    (const respool)))))
1691
1692 (defun gnus-redefine-select-method-widget ()
1693   "Recomputes the select-method widget based on the value of
1694 `gnus-valid-select-methods'."
1695   (define-widget 'gnus-select-method 'list
1696     "Widget for entering a select method."
1697     :value '(nntp "")
1698     :tag "Select Method"
1699     :args `((choice :tag "Method"
1700                     ,@(mapcar (lambda (entry)
1701                                 (list 'const :format "%v\n"
1702                                       (intern (car entry))))
1703                               gnus-valid-select-methods)
1704                     (symbol :tag "other"))
1705             (string :tag "Address")
1706             (repeat :tag "Options"
1707                     :inline t
1708                     (list :format "%v"
1709                           variable
1710                           (sexp :tag "Value"))))))
1711
1712 (gnus-redefine-select-method-widget)
1713
1714 (defcustom gnus-updated-mode-lines '(group article summary tree)
1715   "List of buffers that should update their mode lines.
1716 The list may contain the symbols `group', `article', `tree' and
1717 `summary'.  If the corresponding symbol is present, Gnus will keep
1718 that mode line updated with information that may be pertinent.
1719 If this variable is nil, screen refresh may be quicker."
1720   :group 'gnus-various
1721   :type '(set (const group)
1722               (const article)
1723               (const summary)
1724               (const tree)))
1725
1726 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1727 (defcustom gnus-mode-non-string-length nil
1728   "*Max length of mode-line non-string contents.
1729 If this is nil, Gnus will take space as is needed, leaving the rest
1730 of the mode line intact.  Note that the default of nil is unlikely
1731 to be desirable; see the manual for further details."
1732   :group 'gnus-various
1733   :type '(choice (const nil)
1734                  integer))
1735
1736 ;; There should be special validation for this.
1737 (define-widget 'gnus-email-address 'string
1738   "An email address.")
1739
1740 (gnus-define-group-parameter
1741  to-address
1742  :function-document
1743  "Return GROUP's to-address."
1744  :variable-document
1745  "*Alist of group regexps and correspondent to-addresses."
1746  :variable-group gnus-group-parameter
1747  :parameter-type '(gnus-email-address :tag "To Address")
1748  :parameter-document "\
1749 This will be used when doing followups and posts.
1750
1751 This is primarily useful in mail groups that represent closed
1752 mailing lists--mailing lists where it's expected that everybody that
1753 writes to the mailing list is subscribed to it.  Since using this
1754 parameter ensures that the mail only goes to the mailing list itself,
1755 it means that members won't receive two copies of your followups.
1756
1757 Using `to-address' will actually work whether the group is foreign or
1758 not.  Let's say there's a group on the server that is called
1759 `fa.4ad-l'.  This is a real newsgroup, but the server has gotten the
1760 articles from a mail-to-news gateway.  Posting directly to this group
1761 is therefore impossible--you have to send mail to the mailing list
1762 address instead.
1763
1764 The gnus-group-split mail splitting mechanism will behave as if this
1765 address was listed in gnus-group-split Addresses (see below).")
1766
1767 (gnus-define-group-parameter
1768  to-list
1769  :function-document
1770  "Return GROUP's to-list."
1771  :variable-document
1772  "*Alist of group regexps and correspondent to-lists."
1773  :variable-group gnus-group-parameter
1774  :parameter-type '(gnus-email-address :tag "To List")
1775  :parameter-document "\
1776 This address will be used when doing a `a' in the group.
1777
1778 It is totally ignored when doing a followup--except that if it is
1779 present in a news group, you'll get mail group semantics when doing
1780 `f'.
1781
1782 The gnus-group-split mail splitting mechanism will behave as if this
1783 address was listed in gnus-group-split Addresses (see below).")
1784
1785 (gnus-define-group-parameter
1786  subscribed
1787  :type bool
1788  :function-document
1789  "Return GROUP's subscription status."
1790  :variable-document
1791  "*Groups which are automatically considered subscribed."
1792  :variable-group gnus-group-parameter
1793  :parameter-type '(const :tag "Subscribed" t)
1794  :parameter-document "\
1795 Gnus assumed that you are subscribed to the To/List address.
1796
1797 When constructing a list of subscribed groups using
1798 `gnus-find-subscribed-addresses', Gnus includes the To address given
1799 above, or the list address (if the To address has not been set).")
1800
1801 (gnus-define-group-parameter
1802  auto-expire
1803  :type bool
1804  :function gnus-group-auto-expirable-p
1805  :function-document
1806  "Check whether GROUP is auto-expirable or not."
1807  :variable gnus-auto-expirable-newsgroups
1808  :variable-default nil
1809  :variable-document
1810  "*Groups in which to automatically mark read articles as expirable.
1811 If non-nil, this should be a regexp that should match all groups in
1812 which to perform auto-expiry.  This only makes sense for mail groups."
1813  :variable-group nnmail-expire
1814  :variable-type '(choice (const nil)
1815                          regexp)
1816  :parameter-type '(const :tag "Automatic Expire" t)
1817  :parameter-document
1818  "All articles that are read will be marked as expirable.")
1819
1820 (gnus-define-group-parameter
1821  total-expire
1822  :type bool
1823  :function gnus-group-total-expirable-p
1824  :function-document
1825  "Check whether GROUP is total-expirable or not."
1826  :variable gnus-total-expirable-newsgroups
1827  :variable-default nil
1828  :variable-document
1829  "*Groups in which to perform expiry of all read articles.
1830 Use with extreme caution.  All groups that match this regexp will be
1831 expiring - which means that all read articles will be deleted after
1832 \(say) one week.         (This only goes for mail groups and the like, of
1833 course.)"
1834  :variable-group nnmail-expire
1835  :variable-type '(choice (const nil)
1836                          regexp)
1837  :parameter-type '(const :tag "Total Expire" t)
1838  :parameter-document
1839  "All read articles will be put through the expiry process
1840
1841 This happens even if they are not marked as expirable.
1842 Use with caution.")
1843
1844 (gnus-define-group-parameter
1845  charset
1846  :function-document
1847  "Return the default charset of GROUP."
1848  :variable gnus-group-charset-alist
1849  :variable-default
1850  '(("\\(^\\|:\\)hk\\>\\|\\(^\\|:\\)tw\\>\\|\\<big5\\>" cn-big5)
1851    ("\\(^\\|:\\)cn\\>\\|\\<chinese\\>" cn-gb-2312)
1852    ("\\(^\\|:\\)fj\\>\\|\\(^\\|:\\)japan\\>" iso-2022-jp-2)
1853    ("\\(^\\|:\\)tnn\\>\\|\\(^\\|:\\)pin\\>\\|\\(^\\|:\\)sci.lang.japan" iso-2022-7bit)
1854    ("\\(^\\|:\\)relcom\\>" koi8-r)
1855    ("\\(^\\|:\\)fido7\\>" koi8-r)
1856    ("\\(^\\|:\\)\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
1857    ("\\(^\\|:\\)israel\\>" iso-8859-1)
1858    ("\\(^\\|:\\)han\\>" euc-kr)
1859    ("\\(^\\|:\\)alt.chinese.text.big5\\>" chinese-big5)
1860    ("\\(^\\|:\\)soc.culture.vietnamese\\>" vietnamese-viqr)
1861    ("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1))
1862  :variable-document
1863  "Alist of regexps (to match group names) and default charsets to be used when reading."
1864  :variable-group gnus-charset
1865  :variable-type '(repeat (list (regexp :tag "Group")
1866                                (symbol :tag "Charset")))
1867  :parameter-type '(symbol :tag "Charset")
1868  :parameter-document "\
1869 The default charset to use in the group.")
1870
1871 (gnus-define-group-parameter
1872  post-method
1873  :type list
1874  :function-document
1875  "Return a posting method for GROUP."
1876  :variable gnus-post-method-alist
1877  :variable-document
1878  "Alist of regexps (to match group names) and method to be used when
1879 posting an article."
1880  :variable-group gnus-group-foreign
1881  :parameter-type
1882  '(choice :tag "Posting Method"
1883           (const :tag "Use native server" native)
1884           (const :tag "Use current server" current)
1885           (list :convert-widget
1886                 (lambda (widget)
1887                   (list 'sexp :tag "Methods"
1888                         :value gnus-select-method))))
1889  :parameter-document
1890  "Posting method for this group.")
1891
1892 (gnus-define-group-parameter
1893  large-newsgroup-initial
1894  :type integer
1895  :function-document
1896  "Return GROUP's initial input of the number of articles."
1897  :variable-document
1898  "*Alist of group regexps and its initial input of the number of articles."
1899  :variable-group gnus-group-parameter
1900  :parameter-type '(choice :tag "Initial Input for Large Newsgroup"
1901                           (const :tag "All" nil)
1902                           (integer))
1903  :parameter-document "\
1904
1905 This number will be prompted as the initial value of the number of
1906 articles to list when the group is a large newsgroup (see
1907 `gnus-large-newsgroup').  If it is nil, the default value is the
1908 total number of articles in the group.")
1909
1910 ;; The Gnus registry's ignored groups
1911 (gnus-define-group-parameter
1912  registry-ignore
1913  :type list
1914  :function-document
1915  "Whether this group should be ignored by the registry."
1916  :variable gnus-registry-ignored-groups
1917  :variable-default nil
1918  :variable-document
1919  "*Groups in which the registry should be turned off."
1920  :variable-group gnus-registry
1921  :variable-type '(repeat
1922                   (list
1923                    (regexp :tag "Group Name Regular Expression")
1924                    (boolean :tag "Ignored")))
1925
1926  :parameter-type '(boolean :tag "Group Ignored by the Registry")
1927  :parameter-document
1928  "Whether the Gnus Registry should ignore this group.")
1929
1930 ;; group parameters for spam processing added by Ted Zlatanov <tzz@lifelogs.com>
1931 (defcustom gnus-install-group-spam-parameters t
1932   "*Disable the group parameters for spam detection.
1933 Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report."
1934   :version "22.1"
1935   :type 'boolean
1936   :group 'gnus-start)
1937
1938 (when gnus-install-group-spam-parameters
1939   (defvar gnus-group-spam-classification-spam t
1940     "Spam group classification (requires spam.el).
1941 This group contains spam messages.  On summary entry, unread messages
1942 will be marked as spam.  On summary exit, the specified spam
1943 processors will be invoked on spam-marked messages, then those
1944 messages will be expired, so the spam processor will only see a
1945 spam-marked message once.")
1946
1947   (defvar gnus-group-spam-classification-ham 'ask
1948     "The ham value for the spam group parameter (requires spam.el).
1949 On summary exit, the specified ham processors will be invoked on
1950 ham-marked messages.  Exercise caution, since the ham processor will
1951 see the same message more than once because there is no ham message
1952 registry.")
1953
1954   (gnus-define-group-parameter
1955    spam-contents
1956    :type list
1957    :function-document
1958    "The spam type (spam, ham, or neither) of the group."
1959    :variable gnus-spam-newsgroup-contents
1960    :variable-default nil
1961    :variable-document
1962    "*Group classification (spam, ham, or neither).  Only
1963 meaningful when spam.el is loaded.  If non-nil, this should be a
1964 list of group name regexps associated with a classification for
1965 each one.  In spam groups, new articles are marked as spam on
1966 summary entry.  There is other behavior associated with ham and
1967 no classification when spam.el is loaded - see the manual."
1968    :variable-group spam
1969    :variable-type '(repeat
1970                     (list :tag "Group contents spam/ham classification"
1971                           (regexp :tag "Group")
1972                           (choice
1973                            (variable-item gnus-group-spam-classification-spam)
1974                            (variable-item gnus-group-spam-classification-ham)
1975                            (const :tag "Unclassified" nil))))
1976
1977    :parameter-type '(list :tag "Group contents spam/ham classification"
1978                           (choice :tag "Group contents classification for spam sorting"
1979                                   (variable-item gnus-group-spam-classification-spam)
1980                                   (variable-item gnus-group-spam-classification-ham)
1981                                   (const :tag "Unclassified" nil)))
1982    :parameter-document
1983    "The spam classification (spam, ham, or neither) of this group.
1984 When a spam group is entered, all unread articles are marked as
1985 spam.  There is other behavior associated with ham and no
1986 classification when spam.el is loaded - see the manual.")
1987
1988   (gnus-define-group-parameter
1989    spam-resend-to
1990    :type list
1991    :function-document
1992    "The address to get spam resent (through spam-report-resend)."
1993    :variable gnus-spam-resend-to
1994    :variable-default nil
1995    :variable-document
1996    "The address to get spam resent (through spam-report-resend)."
1997    :variable-group spam
1998    :variable-type '(repeat
1999                     (list :tag "Group address for resending spam"
2000                           (regexp :tag "Group")
2001                           (string :tag "E-mail address for resending spam (requires the spam-use-resend exit processor)")))
2002    :parameter-type 'string :tag "E-mail address for resending spam (requires the spam-use-resend exit processor)"
2003    :parameter-document
2004    "The address to get spam resent (through spam-report-resend).")
2005
2006   (gnus-define-group-parameter
2007    ham-resend-to
2008    :type list
2009    :function-document
2010    "The address to get ham resent (through spam-report-resend)."
2011    :variable gnus-ham-resend-to
2012    :variable-default nil
2013    :variable-document
2014    "The address to get ham resent (through spam-report-resend)."
2015    :variable-group spam
2016    :variable-type '(repeat
2017                     (list :tag "Group address for resending ham"
2018                           (regexp :tag "Group")
2019                           (string :tag "E-mail address for resending ham (requires the spam-use-resend exit processor)")))
2020    :parameter-type 'string :tag "E-mail address for resending ham (requires the spam-use-resend exit processor)"
2021    :parameter-document
2022    "The address to get ham resent (through spam-report-resend).")
2023
2024   (defvar gnus-group-spam-exit-processor-ifile "ifile"
2025     "OBSOLETE: The ifile summary exit spam processor.")
2026
2027   (defvar gnus-group-spam-exit-processor-stat "stat"
2028     "OBSOLETE: The spam-stat summary exit spam processor.")
2029
2030   (defvar gnus-group-spam-exit-processor-bogofilter "bogofilter"
2031     "OBSOLETE: The Bogofilter summary exit spam processor.")
2032
2033   (defvar gnus-group-spam-exit-processor-blacklist "blacklist"
2034     "OBSOLETE: The Blacklist summary exit spam processor.")
2035
2036   (defvar gnus-group-spam-exit-processor-report-gmane "report-gmane"
2037     "OBSOLETE: The Gmane reporting summary exit spam processor.
2038 Only applicable to NNTP groups with articles from Gmane.  See spam-report.el")
2039
2040   (defvar gnus-group-spam-exit-processor-spamoracle "spamoracle-spam"
2041     "OBSOLETE: The spamoracle summary exit spam processor.")
2042
2043   (defvar gnus-group-ham-exit-processor-ifile "ifile-ham"
2044     "OBSOLETE: The ifile summary exit ham processor.
2045 Only applicable to non-spam (unclassified and ham) groups.")
2046
2047   (defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham"
2048     "OBSOLETE: The Bogofilter summary exit ham processor.
2049 Only applicable to non-spam (unclassified and ham) groups.")
2050
2051   (defvar gnus-group-ham-exit-processor-stat "stat-ham"
2052     "OBSOLETE: The spam-stat summary exit ham processor.
2053 Only applicable to non-spam (unclassified and ham) groups.")
2054
2055   (defvar gnus-group-ham-exit-processor-whitelist "whitelist"
2056     "OBSOLETE: The whitelist summary exit ham processor.
2057 Only applicable to non-spam (unclassified and ham) groups.")
2058
2059   (defvar gnus-group-ham-exit-processor-BBDB "bbdb"
2060     "OBSOLETE: The BBDB summary exit ham processor.
2061 Only applicable to non-spam (unclassified and ham) groups.")
2062
2063   (defvar gnus-group-ham-exit-processor-copy "copy"
2064     "OBSOLETE: The ham copy exit ham processor.
2065 Only applicable to non-spam (unclassified and ham) groups.")
2066
2067   (defvar gnus-group-ham-exit-processor-spamoracle "spamoracle-ham"
2068     "OBSOLETE: The spamoracle summary exit ham processor.
2069 Only applicable to non-spam (unclassified and ham) groups.")
2070
2071   (gnus-define-group-parameter
2072    spam-process
2073    :type list
2074    :parameter-type
2075    '(choice
2076      :tag "Spam Summary Exit Processor"
2077      :value nil
2078      (list :tag "Spam Summary Exit Processor Choices"
2079            (set
2080             (const :tag "Spam: Bogofilter"    (spam spam-use-bogofilter))
2081             (const :tag "Spam: Blacklist"     (spam spam-use-blacklist))
2082             (const :tag "Spam: Bsfilter"      (spam spam-use-bsfilter))
2083             (const :tag "Spam: Gmane Report"  (spam spam-use-gmane))
2084             (const :tag "Spam: Resend Message"(spam spam-use-resend))
2085             (const :tag "Spam: ifile"         (spam spam-use-ifile))
2086             (const :tag "Spam: Spam Oracle"   (spam spam-use-spamoracle))
2087             (const :tag "Spam: Spam-stat"     (spam spam-use-stat))
2088             (const :tag "Spam: SpamAssassin"  (spam spam-use-spamassassin))
2089             (const :tag "Spam: CRM114"        (spam spam-use-crm114))
2090             (const :tag "Ham: BBDB"           (ham spam-use-BBDB))
2091             (const :tag "Ham: Bogofilter"     (ham spam-use-bogofilter))
2092             (const :tag "Ham: Bsfilter"       (ham spam-use-bsfilter))
2093             (const :tag "Ham: Copy"           (ham spam-use-ham-copy))
2094             (const :tag "Ham: Resend Message" (ham spam-use-resend))
2095             (const :tag "Ham: ifile"          (ham spam-use-ifile))
2096             (const :tag "Ham: Spam Oracle"    (ham spam-use-spamoracle))
2097             (const :tag "Ham: Spam-stat"      (ham spam-use-stat))
2098             (const :tag "Ham: SpamAssassin"   (ham spam-use-spamassassin))
2099             (const :tag "Ham: CRM114"         (ham spam-use-crm114))
2100             (const :tag "Ham: Whitelist"      (ham spam-use-whitelist))
2101             (variable-item gnus-group-spam-exit-processor-ifile)
2102             (variable-item gnus-group-spam-exit-processor-stat)
2103             (variable-item gnus-group-spam-exit-processor-bogofilter)
2104             (variable-item gnus-group-spam-exit-processor-blacklist)
2105             (variable-item gnus-group-spam-exit-processor-spamoracle)
2106             (variable-item gnus-group-spam-exit-processor-report-gmane)
2107             (variable-item gnus-group-ham-exit-processor-bogofilter)
2108             (variable-item gnus-group-ham-exit-processor-ifile)
2109             (variable-item gnus-group-ham-exit-processor-stat)
2110             (variable-item gnus-group-ham-exit-processor-whitelist)
2111             (variable-item gnus-group-ham-exit-processor-BBDB)
2112             (variable-item gnus-group-ham-exit-processor-spamoracle)
2113             (variable-item gnus-group-ham-exit-processor-copy))))
2114    :function-document
2115    "Which spam or ham processors will be applied when the summary is exited."
2116    :variable gnus-spam-process-newsgroups
2117    :variable-default nil
2118    :variable-document
2119    "*Groups in which to automatically process spam or ham articles with
2120 a backend on summary exit.  If non-nil, this should be a list of group
2121 name regexps that should match all groups in which to do automatic
2122 spam processing, associated with the appropriate processor."
2123    :variable-group spam
2124    :variable-type
2125    '(repeat :tag "Spam/Ham Processors"
2126             (list :tag "Spam Summary Exit Processor Choices"
2127                   (regexp :tag "Group Regexp")
2128                   (set
2129                    :tag "Spam/Ham Summary Exit Processor"
2130                    (const :tag "Spam: Bogofilter"    (spam spam-use-bogofilter))
2131                    (const :tag "Spam: Blacklist"     (spam spam-use-blacklist))
2132                    (const :tag "Spam: Bsfilter"      (spam spam-use-bsfilter))
2133                    (const :tag "Spam: Gmane Report"  (spam spam-use-gmane))
2134                    (const :tag "Spam: Resend Message"(spam spam-use-resend))
2135                    (const :tag "Spam: ifile"         (spam spam-use-ifile))
2136                    (const :tag "Spam: Spam-stat"     (spam spam-use-stat))
2137                    (const :tag "Spam: Spam Oracle"   (spam spam-use-spamoracle))
2138                    (const :tag "Spam: SpamAssassin"  (spam spam-use-spamassassin))
2139                    (const :tag "Spam: CRM114"        (spam spam-use-crm114))
2140                    (const :tag "Ham: BBDB"           (ham spam-use-BBDB))
2141                    (const :tag "Ham: Bogofilter"     (ham spam-use-bogofilter))
2142                    (const :tag "Ham: Bsfilter"       (ham spam-use-bsfilter))
2143                    (const :tag "Ham: Copy"           (ham spam-use-ham-copy))
2144                    (const :tag "Ham: Resend Message" (ham spam-use-resend))
2145                    (const :tag "Ham: ifile"          (ham spam-use-ifile))
2146                    (const :tag "Ham: Spam-stat"      (ham spam-use-stat))
2147                    (const :tag "Ham: Spam Oracle"    (ham spam-use-spamoracle))
2148                    (const :tag "Ham: SpamAssassin"   (ham spam-use-spamassassin))
2149                    (const :tag "Ham: CRM114"         (ham spam-use-crm114))
2150                    (const :tag "Ham: Whitelist"      (ham spam-use-whitelist))
2151                    (variable-item gnus-group-spam-exit-processor-ifile)
2152                    (variable-item gnus-group-spam-exit-processor-stat)
2153                    (variable-item gnus-group-spam-exit-processor-bogofilter)
2154                    (variable-item gnus-group-spam-exit-processor-blacklist)
2155                    (variable-item gnus-group-spam-exit-processor-spamoracle)
2156                    (variable-item gnus-group-spam-exit-processor-report-gmane)
2157                    (variable-item gnus-group-ham-exit-processor-bogofilter)
2158                    (variable-item gnus-group-ham-exit-processor-ifile)
2159                    (variable-item gnus-group-ham-exit-processor-stat)
2160                    (variable-item gnus-group-ham-exit-processor-whitelist)
2161                    (variable-item gnus-group-ham-exit-processor-BBDB)
2162                    (variable-item gnus-group-ham-exit-processor-spamoracle)
2163                    (variable-item gnus-group-ham-exit-processor-copy))))
2164
2165    :parameter-document
2166    "Which spam or ham processors will be applied when the summary is exited.")
2167
2168   (gnus-define-group-parameter
2169    spam-autodetect
2170    :type list
2171    :parameter-type
2172    '(boolean :tag "Spam autodetection")
2173    :function-document
2174    "Should spam be autodetected (with spam-split) in this group?"
2175    :variable gnus-spam-autodetect
2176    :variable-default nil
2177    :variable-document
2178    "*Groups in which spam should be autodetected when they are entered.
2179    Only unseen articles will be examined, unless
2180    spam-autodetect-recheck-messages is set."
2181    :variable-group spam
2182    :variable-type
2183    '(repeat
2184      :tag "Autodetection setting"
2185      (list
2186       (regexp :tag "Group Regexp")
2187       boolean))
2188    :parameter-document
2189    "Spam autodetection.
2190 Only unseen articles will be examined, unless
2191 spam-autodetect-recheck-messages is set.")
2192
2193   (gnus-define-group-parameter
2194    spam-autodetect-methods
2195    :type list
2196    :parameter-type
2197    '(choice :tag "Spam autodetection-specific methods"
2198      (const none)
2199      (const default)
2200      (set :tag "Use specific methods"
2201           (variable-item spam-use-blacklist)
2202           (variable-item spam-use-gmane-xref)
2203           (variable-item spam-use-regex-headers)
2204           (variable-item spam-use-regex-body)
2205           (variable-item spam-use-whitelist)
2206           (variable-item spam-use-BBDB)
2207           (variable-item spam-use-ifile)
2208           (variable-item spam-use-spamoracle)
2209           (variable-item spam-use-crm114)
2210           (variable-item spam-use-spamassassin)
2211           (variable-item spam-use-spamassassin-headers)
2212           (variable-item spam-use-bsfilter)
2213           (variable-item spam-use-bsfilter-headers)
2214           (variable-item spam-use-stat)
2215           (variable-item spam-use-blackholes)
2216           (variable-item spam-use-hashcash)
2217           (variable-item spam-use-bogofilter-headers)
2218           (variable-item spam-use-bogofilter)))
2219    :function-document
2220    "Methods to be used for autodetection in each group"
2221    :variable gnus-spam-autodetect-methods
2222    :variable-default nil
2223    :variable-document
2224    "*Methods for autodetecting spam per group.
2225 Requires the spam-autodetect parameter.  Only unseen articles
2226 will be examined, unless spam-autodetect-recheck-messages is
2227 set."
2228    :variable-group spam
2229    :variable-type
2230    '(repeat
2231      :tag "Autodetection methods"
2232      (list
2233       (regexp :tag "Group Regexp")
2234       (choice
2235        (const none)
2236        (const default)
2237        (set :tag "Use specific methods"
2238         (variable-item spam-use-blacklist)
2239         (variable-item spam-use-gmane-xref)
2240         (variable-item spam-use-regex-headers)
2241         (variable-item spam-use-regex-body)
2242         (variable-item spam-use-whitelist)
2243         (variable-item spam-use-BBDB)
2244         (variable-item spam-use-ifile)
2245         (variable-item spam-use-spamoracle)
2246         (variable-item spam-use-crm114)
2247         (variable-item spam-use-stat)
2248         (variable-item spam-use-blackholes)
2249         (variable-item spam-use-hashcash)
2250         (variable-item spam-use-spamassassin)
2251         (variable-item spam-use-spamassassin-headers)
2252         (variable-item spam-use-bsfilter)
2253         (variable-item spam-use-bsfilter-headers)
2254         (variable-item spam-use-bogofilter-headers)
2255         (variable-item spam-use-bogofilter)))))
2256      :parameter-document
2257    "Spam autodetection methods.
2258 Requires the spam-autodetect parameter.  Only unseen articles
2259 will be examined, unless spam-autodetect-recheck-messages is
2260 set.")
2261
2262   (gnus-define-group-parameter
2263    spam-process-destination
2264    :type list
2265    :parameter-type
2266    '(choice :tag "Destination for spam-processed articles at summary exit"
2267             (string :tag "Move to a group")
2268             (repeat :tag "Move to multiple groups"
2269                     (string :tag "Destination group"))
2270             (const :tag "Expire" nil))
2271    :function-document
2272    "Where spam-processed articles will go at summary exit."
2273    :variable gnus-spam-process-destinations
2274    :variable-default nil
2275    :variable-document
2276    "*Groups in which to explicitly send spam-processed articles to
2277 another group, or expire them (the default).  If non-nil, this should
2278 be a list of group name regexps that should match all groups in which
2279 to do spam-processed article moving, associated with the destination
2280 group or nil for explicit expiration.  This only makes sense for
2281 mail groups."
2282    :variable-group spam
2283    :variable-type
2284    '(repeat
2285      :tag "Spam-processed articles destination"
2286      (list
2287       (regexp :tag "Group Regexp")
2288       (choice
2289        :tag "Destination for spam-processed articles at summary exit"
2290        (string :tag "Move to a group")
2291        (repeat :tag "Move to multiple groups"
2292                (string :tag "Destination group"))
2293        (const :tag "Expire" nil))))
2294    :parameter-document
2295    "Where spam-processed articles will go at summary exit.")
2296
2297   (gnus-define-group-parameter
2298    ham-process-destination
2299    :type list
2300    :parameter-type
2301    '(choice
2302      :tag "Destination for ham articles at summary exit from a spam group"
2303      (string :tag "Move to a group")
2304      (repeat :tag "Move to multiple groups"
2305              (string :tag "Destination group"))
2306      (const :tag "Respool" respool)
2307      (const :tag "Do nothing" nil))
2308    :function-document
2309    "Where ham articles will go at summary exit from a spam group."
2310    :variable gnus-ham-process-destinations
2311    :variable-default nil
2312    :variable-document
2313    "*Groups in which to explicitly send ham articles to
2314 another group, or do nothing (the default).  If non-nil, this should
2315 be a list of group name regexps that should match all groups in which
2316 to do ham article moving, associated with the destination
2317 group or nil for explicit ignoring.  This only makes sense for
2318 mail groups, and only works in spam groups."
2319    :variable-group spam
2320    :variable-type
2321    '(repeat
2322      :tag "Ham articles destination"
2323      (list
2324       (regexp :tag "Group Regexp")
2325       (choice
2326        :tag "Destination for ham articles at summary exit from spam group"
2327        (string :tag "Move to a group")
2328        (repeat :tag "Move to multiple groups"
2329                 (string :tag "Destination group"))
2330        (const :tag "Respool" respool)
2331        (const :tag "Expire" nil))))
2332    :parameter-document
2333    "Where ham articles will go at summary exit from a spam group.")
2334
2335   (gnus-define-group-parameter
2336    ham-marks
2337    :type 'list
2338    :parameter-type '(list :tag "Ham mark choices"
2339                           (set
2340                            (variable-item gnus-del-mark)
2341                            (variable-item gnus-read-mark)
2342                            (variable-item gnus-ticked-mark)
2343                            (variable-item gnus-killed-mark)
2344                            (variable-item gnus-kill-file-mark)
2345                            (variable-item gnus-low-score-mark)))
2346
2347    :parameter-document
2348    "Marks considered ham (positively not spam).  Such articles will be
2349 processed as ham (non-spam) on group exit.  When nil, the global
2350 spam-ham-marks variable takes precedence."
2351    :variable-default '((".*" ((gnus-del-mark
2352                                gnus-read-mark
2353                                gnus-killed-mark
2354                                gnus-kill-file-mark
2355                                gnus-low-score-mark))))
2356    :variable-group spam
2357    :variable-document
2358    "*Groups in which to explicitly set the ham marks to some value.")
2359
2360   (gnus-define-group-parameter
2361    spam-marks
2362    :type 'list
2363    :parameter-type '(list :tag "Spam mark choices"
2364                           (set
2365                            (variable-item gnus-spam-mark)
2366                            (variable-item gnus-killed-mark)
2367                            (variable-item gnus-kill-file-mark)
2368                            (variable-item gnus-low-score-mark)))
2369
2370    :parameter-document
2371    "Marks considered spam.
2372 Such articles will be processed as spam on group exit.  When nil, the global
2373 spam-spam-marks variable takes precedence."
2374    :variable-default '((".*" ((gnus-spam-mark))))
2375    :variable-group spam
2376    :variable-document
2377    "*Groups in which to explicitly set the spam marks to some value."))
2378
2379 (defcustom gnus-group-uncollapsed-levels 1
2380   "Number of group name elements to leave alone when making a short group name."
2381   :group 'gnus-group-visual
2382   :type 'integer)
2383
2384 (defcustom gnus-group-use-permanent-levels nil
2385   "*If non-nil, once you set a level, Gnus will use this level."
2386   :group 'gnus-group-levels
2387   :type 'boolean)
2388
2389 ;; Hooks.
2390
2391 (defcustom gnus-load-hook nil
2392   "A hook run while Gnus is loaded."
2393   :group 'gnus-start
2394   :type 'hook)
2395
2396 (defcustom gnus-apply-kill-hook '(gnus-apply-kill-file)
2397   "A hook called to apply kill files to a group.
2398 This hook is intended to apply a kill file to the selected newsgroup.
2399 The function `gnus-apply-kill-file' is called by default.
2400
2401 Since a general kill file is too heavy to use only for a few
2402 newsgroups, I recommend you to use a lighter hook function.  For
2403 example, if you'd like to apply a kill file to articles which contains
2404 a string `rmgroup' in subject in newsgroup `control', you can use the
2405 following hook:
2406
2407  (setq gnus-apply-kill-hook
2408       (list
2409         (lambda ()
2410           (cond ((string-match \"control\" gnus-newsgroup-name)
2411                  (gnus-kill \"Subject\" \"rmgroup\")
2412                  (gnus-expunge \"X\"))))))"
2413   :group 'gnus-score-kill
2414   :options '(gnus-apply-kill-file)
2415   :type 'hook)
2416
2417 (defcustom gnus-group-change-level-function nil
2418   "Function run when a group level is changed.
2419 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
2420   :group 'gnus-group-levels
2421   :type 'function)
2422
2423 ;;; Face thingies.
2424
2425 (defcustom gnus-visual
2426   '(summary-highlight group-highlight article-highlight
2427                       mouse-face
2428                       summary-menu group-menu article-menu
2429                       tree-highlight menu highlight
2430                       browse-menu server-menu
2431                       page-marker tree-menu binary-menu pick-menu)
2432   "*Enable visual features.
2433 If `visual' is disabled, there will be no menus and few faces.  Most of
2434 the visual customization options below will be ignored.  Gnus will use
2435 less space and be faster as a result.
2436
2437 This variable can also be a list of visual elements to switch on.  For
2438 instance, to switch off all visual things except menus, you can say:
2439
2440    (setq gnus-visual '(menu))
2441
2442 Valid elements include `summary-highlight', `group-highlight',
2443 `article-highlight', `mouse-face', `summary-menu', `group-menu',
2444 `article-menu', `tree-highlight', `menu', `highlight', `browse-menu',
2445 `server-menu', `page-marker', `tree-menu', `binary-menu', and`pick-menu'."
2446   :group 'gnus-meta
2447   :group 'gnus-visual
2448   :type '(set (const summary-highlight)
2449               (const group-highlight)
2450               (const article-highlight)
2451               (const mouse-face)
2452               (const summary-menu)
2453               (const group-menu)
2454               (const article-menu)
2455               (const tree-highlight)
2456               (const menu)
2457               (const highlight)
2458               (const browse-menu)
2459               (const server-menu)
2460               (const page-marker)
2461               (const tree-menu)
2462               (const binary-menu)
2463               (const pick-menu)))
2464
2465 ;; Byte-compiler warning.
2466 (defvar gnus-visual)
2467 ;; Find out whether the gnus-visual TYPE is wanted.
2468 (defun gnus-visual-p (&optional type class)
2469   (and gnus-visual                      ; Has to be non-nil, at least.
2470        (if (not type)                   ; We don't care about type.
2471            gnus-visual
2472          (if (listp gnus-visual)        ; It's a list, so we check it.
2473              (or (memq type gnus-visual)
2474                  (memq class gnus-visual))
2475            t))))
2476
2477 (defcustom gnus-mouse-face
2478   (condition-case ()
2479       (if (gnus-visual-p 'mouse-face 'highlight)
2480           (if (boundp 'gnus-mouse-face)
2481               (or gnus-mouse-face 'highlight)
2482             'highlight)
2483         'default)
2484     (error 'highlight))
2485   "*Face used for group or summary buffer mouse highlighting.
2486 The line beneath the mouse pointer will be highlighted with this
2487 face."
2488   :group 'gnus-visual
2489   :type 'face)
2490
2491 (defcustom gnus-article-save-directory gnus-directory
2492   "*Name of the directory articles will be saved in (default \"~/News\")."
2493   :group 'gnus-article-saving
2494   :type 'directory)
2495
2496 (defvar gnus-plugged t
2497   "Whether Gnus is plugged or not.")
2498
2499 (defcustom gnus-agent-cache t
2500   "Controls use of the agent cache while plugged.
2501 When set, Gnus will prefer using the locally stored content rather
2502 than re-fetching it from the server.  You also need to enable
2503 `gnus-agent' for this to have any affect."
2504   :version "22.1"
2505   :group 'gnus-agent
2506   :type 'boolean)
2507
2508 (defcustom gnus-default-charset 'undecided
2509   "Default charset assumed to be used when viewing non-ASCII characters.
2510 This variable is overridden on a group-to-group basis by the
2511 `gnus-group-charset-alist' variable and is only used on groups not
2512 covered by that variable."
2513   :type 'symbol
2514   :group 'gnus-charset)
2515
2516 ;; Fixme: Doc reference to agent.
2517 (defcustom gnus-agent t
2518   "Whether we want to use the Gnus agent or not.
2519
2520 You may customize gnus-agent to disable its use.  However, some
2521 back ends have started to use the agent as a client-side cache.
2522 Disabling the agent may result in noticeable loss of performance."
2523   :version "22.1"
2524   :group 'gnus-agent
2525   :type 'boolean)
2526
2527 (defcustom gnus-other-frame-function 'gnus
2528   "Function called by the command `gnus-other-frame'."
2529   :group 'gnus-start
2530   :type '(choice (function-item gnus)
2531                  (function-item gnus-no-server)
2532                  (function-item gnus-slave)
2533                  (function-item gnus-slave-no-server)))
2534
2535 (defcustom gnus-other-frame-parameters nil
2536   "Frame parameters used by `gnus-other-frame' to create a Gnus frame.
2537 This should be an alist for Emacs, or a plist for XEmacs."
2538   :group 'gnus-start
2539   :type (if (featurep 'xemacs)
2540             '(repeat (list :inline t :format "%v"
2541                            (symbol :tag "Property")
2542                            (sexp :tag "Value")))
2543           '(repeat (cons :format "%v"
2544                          (symbol :tag "Parameter")
2545                          (sexp :tag "Value")))))
2546
2547 (defcustom gnus-user-agent '(emacs gnus mime config mule)
2548   "Which information should be exposed in the User-Agent header.
2549
2550 Can be a list of symbols or a string.  Valid symbols are `gnus' (show
2551 Gnus version), `emacs' (show Emacs version) and `mime' (show SEMI,
2552 FLIM and APEL versions).  In addition to the Emacs version, you can
2553 add `codename' (show (S)XEmacs codename), `mule' (show Mule version
2554 and also Meadow version if it exists) or either `config' (show system
2555 configuration) or `type' (show system type).  If you set it to a
2556 string, be sure to use a valid format, see RFC 2616."
2557
2558   :version "22.1"
2559   :group 'gnus-message
2560   :type '(choice (list (set :format "%v" :inline t
2561                             (const gnus  :tag "Gnus version")
2562                             (const emacs :tag "Emacs version")
2563                             (choice :tag "system"
2564                                     (const type   :tag "system type")
2565                                     (const config :tag "system configuration"))
2566                             (const codename :tag "Emacs codename")
2567                             (const mime :tag "SEMI and FLIM versions")
2568                             (const mule
2569                                    :tag "Mule version (and Meadow version)")))
2570                  (string :format "%t:\n%v")))
2571
2572 ;; Convert old (< 2005-01-10) symbol type values:
2573 (when (symbolp gnus-user-agent)
2574   (setq gnus-user-agent
2575         (cond ((eq gnus-user-agent 'gnus-mime-edit)
2576                '(emacs gnus mime config mule))
2577               ((eq gnus-user-agent 'emacs-gnus-config)
2578                '(emacs gnus config))
2579               ((eq gnus-user-agent 'emacs-gnus-type)
2580                '(emacs gnus type))
2581               ((eq gnus-user-agent 'emacs-gnus)
2582                '(emacs gnus))
2583               ((eq gnus-user-agent 'gnus)
2584                '(gnus))
2585               (t gnus-user-agent)))
2586   (gnus-message 1 "Converted `gnus-user-agent' to `%s'." gnus-user-agent)
2587   (sit-for 1)
2588   (if (get 'gnus-user-agent 'saved-value)
2589       (customize-save-variable 'gnus-user-agent gnus-user-agent)
2590     (gnus-message 1 "Edit your init file to make this change permanent.")
2591     (sit-for 2)))
2592
2593 \f
2594 ;;; Internal variables
2595
2596 (defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc")
2597 (defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
2598 (defvar gnus-agent-method-p-cache nil
2599   ; Reset each time gnus-agent-covered-methods is changed else
2600   ; gnus-agent-method-p may mis-report a methods status.
2601   )
2602 (defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To")
2603 (defvar gnus-draft-meta-information-header "X-Draft-From")
2604 (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
2605 (defvar gnus-original-article-buffer " *Original Article*")
2606 (defvar gnus-newsgroup-name nil)
2607 (defvar gnus-ephemeral-servers nil)
2608 (defvar gnus-server-method-cache nil)
2609
2610 (defvar gnus-agent-fetching nil
2611   "Whether Gnus agent is in fetching mode.")
2612
2613 (defvar gnus-agent-covered-methods nil
2614   "A list of servers, NOT methods, showing which servers are covered by the agent.")
2615
2616 (defvar gnus-command-method nil
2617   "Dynamically bound variable that says what the current back end is.")
2618
2619 (defvar gnus-current-select-method nil
2620   "The current method for selecting a newsgroup.")
2621
2622 (defvar gnus-tree-buffer "*Tree*"
2623   "Buffer where Gnus thread trees are displayed.")
2624
2625 ;; Dummy variable.
2626 (defvar gnus-use-generic-from nil)
2627
2628 ;; Variable holding the user answers to all method prompts.
2629 (defvar gnus-method-history nil)
2630
2631 ;; Variable holding the user answers to all mail method prompts.
2632 (defvar gnus-mail-method-history nil)
2633
2634 ;; Variable holding the user answers to all group prompts.
2635 (defvar gnus-group-history nil)
2636
2637 (defvar gnus-server-alist nil
2638   "List of available servers.")
2639
2640 (defcustom gnus-cache-directory
2641   (nnheader-concat gnus-directory "cache/")
2642   "*The directory where cached articles will be stored."
2643   :group 'gnus-cache
2644   :type 'directory)
2645
2646 (defvar gnus-predefined-server-alist
2647   `(("cache"
2648      nnspool "cache"
2649      (nnspool-spool-directory ,gnus-cache-directory)
2650      (nnspool-nov-directory ,gnus-cache-directory)
2651      (nnspool-active-file
2652       ,(nnheader-concat gnus-cache-directory "active"))))
2653   "List of predefined (convenience) servers.")
2654
2655 (defvar gnus-topic-indentation "");; Obsolete variable.
2656
2657 (defconst gnus-article-mark-lists
2658   '((marked . tick) (replied . reply)
2659     (expirable . expire) (killed . killed)
2660     (bookmarks . bookmark) (dormant . dormant)
2661     (scored . score) (saved . save)
2662     (cached . cache) (downloadable . download)
2663     (unsendable . unsend) (forwarded . forward)
2664     (recent . recent) (seen . seen)))
2665
2666 (defconst gnus-article-special-mark-lists
2667   '((seen range)
2668     (killed range)
2669     (bookmark tuple)
2670     (score tuple)))
2671
2672 ;; Propagate flags to server, with the following exceptions:
2673 ;; `seen' is private to each gnus installation
2674 ;; `cache' is a internal gnus flag for each gnus installation
2675 ;; `download' is a agent flag private to each gnus installation
2676 ;; `unsend' are for nndraft groups only
2677 ;; `score' is not a proper mark
2678 ;; `bookmark': don't propagated it, or fix the bug in update-mark.
2679 (defconst gnus-article-unpropagated-mark-lists
2680   '(seen cache download unsend score bookmark)
2681   "Marks that shouldn't be propagated to back ends.
2682 Typical marks are those that make no sense in a standalone back end,
2683 such as a mark that says whether an article is stored in the cache
2684 \(which doesn't make sense in a standalone back end).")
2685
2686 (defvar gnus-headers-retrieved-by nil)
2687 (defvar gnus-article-reply nil)
2688 (defvar gnus-override-method nil)
2689 (defvar gnus-opened-servers nil)
2690
2691 (defvar gnus-current-kill-article nil)
2692
2693 (defvar gnus-have-read-active-file nil)
2694
2695 (defconst gnus-maintainer
2696   "semi-gnus-ja@meadowy.org (T-gnus Bugfixing Girls + Boys)"
2697   "The mail address of the T-gnus maintainers.")
2698
2699 (defcustom gnus-info-filename nil
2700   "*Controls language of gnus Info.
2701 If nil and current-language-environment is Japanese, go to gnus-ja.
2702 Otherwise go to corresponding Info.
2703 This variable can be nil, gnus or gnus-ja."
2704   :group 'gnus-start
2705   :type '(choice (const nil)
2706                  (const :tag "English" gnus)
2707                  (const :tag "Japanese" gnus-ja)))
2708
2709 (defvar gnus-info-nodes
2710   '((gnus-group-mode "Group Buffer")
2711     (gnus-summary-mode "Summary Buffer")
2712     (gnus-article-mode "Article Buffer")
2713     (gnus-server-mode "Server Buffer")
2714     (gnus-browse-mode "Browse Foreign Server")
2715     (gnus-tree-mode "Tree Display"))
2716   "Alist of major modes and related Info nodes.")
2717
2718 (defvar gnus-group-buffer "*Group*")
2719 (defvar gnus-summary-buffer "*Summary*")
2720 (defvar gnus-article-buffer "*Article*")
2721 (defvar gnus-server-buffer "*Server*")
2722
2723 (defvar gnus-slave nil
2724   "Whether this Gnus is a slave or not.")
2725
2726 (defvar gnus-batch-mode nil
2727   "Whether this Gnus is running in batch mode or not.")
2728
2729 (defvar gnus-variable-list
2730   '(gnus-newsrc-options gnus-newsrc-options-n
2731                         gnus-newsrc-last-checked-date
2732                         gnus-newsrc-alist gnus-server-alist
2733                         gnus-killed-list gnus-zombie-list
2734                         gnus-topic-topology gnus-topic-alist)
2735   "Gnus variables saved in the quick startup file.")
2736
2737 (defvar gnus-product-variable-file-list
2738   (let ((version (product-version (product-find 'gnus-vers))))
2739     `(("strict-cache"
2740        ((product-version ,version)
2741         (emacs-version)
2742         (correct-string-widths))
2743        binary
2744        gnus-format-specs-compiled)
2745       ("cache"
2746        ((product-version ,version)
2747         (emacs-version)
2748         (correct-string-widths))
2749        ctext
2750        gnus-format-specs)))
2751   "Alist of the methods for checking whether the contents of the T-gnus
2752 quick startup files are valid.  One is for the byte-compiled format
2753 specifications, the other is for the source form.  Each element should
2754 be a list which looks like follows:
2755
2756 \(\"FILE_NAME\"
2757  ((VARIABLE EXPECTED_VALUE_or_NIL)
2758   (VARIABLE EXPECTED_VALUE_or_NIL)
2759   ...)
2760  CODING-SYSTEM_FOR_READING_FILE
2761  SYMBOL_OF_FORMAT_SPECS)")
2762
2763 (defcustom gnus-compile-user-specs t
2764   "If non-nil, the user-defined format specs will be byte-compiled
2765 automatically.
2766 It has an effect on the values of `gnus-*-line-format-spec'."
2767   :group 'gnus
2768   :type 'boolean)
2769
2770 (defvar gnus-newsrc-alist nil
2771   "Assoc list of read articles.
2772 `gnus-newsrc-hashtb' should be kept so that both hold the same information.")
2773
2774 (defvar gnus-registry-alist nil
2775   "Assoc list of registry data.
2776 gnus-registry.el will populate this if it's loaded.")
2777
2778 (defvar gnus-newsrc-hashtb nil
2779   "Hashtable of `gnus-newsrc-alist'.")
2780
2781 (defvar gnus-killed-list nil
2782   "List of killed newsgroups.")
2783
2784 (defvar gnus-killed-hashtb nil
2785   "Hash table equivalent of `gnus-killed-list'.")
2786
2787 (defvar gnus-zombie-list nil
2788   "List of almost dead newsgroups.")
2789
2790 (defvar gnus-description-hashtb nil
2791   "Descriptions of newsgroups.")
2792
2793 (defvar gnus-list-of-killed-groups nil
2794   "List of newsgroups that have recently been killed by the user.")
2795
2796 (defvar gnus-active-hashtb nil
2797   "Hashtable of active articles.")
2798
2799 (defvar gnus-moderated-hashtb nil
2800   "Hashtable of moderated newsgroups.")
2801
2802 ;; Save window configuration.
2803 (defvar gnus-prev-winconf nil)
2804
2805 (defvar gnus-reffed-article-number nil)
2806
2807 ;;; Let the byte-compiler know that we know about this variable.
2808 (defvar rmail-default-rmail-file)
2809
2810 (defvar gnus-dead-summary nil)
2811
2812 (defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$"
2813   "Regexp matching invalid groups.")
2814
2815 (defvar gnus-other-frame-object nil
2816   "A frame object which will be created by `gnus-other-frame'.")
2817
2818 ;;; End of variables.
2819
2820 ;; Define some autoload functions Gnus might use.
2821 (eval-and-compile
2822
2823   ;; This little mapcar goes through the list below and marks the
2824   ;; symbols in question as autoloaded functions.
2825   (mapcar
2826    (lambda (package)
2827      (let ((interactive (nth 1 (memq ':interactive package))))
2828        (mapcar
2829         (lambda (function)
2830           (let (keymap)
2831             (when (consp function)
2832               (setq keymap (car (memq 'keymap function)))
2833               (setq function (car function)))
2834             (unless (fboundp function)
2835               (autoload function (car package) nil interactive keymap))))
2836         (if (eq (nth 1 package) ':interactive)
2837             (nthcdr 3 package)
2838           (cdr package)))))
2839    '(("info" :interactive t Info-goto-node)
2840      ("pp" pp-to-string)
2841      ("ps-print" ps-print-preprint)
2842      ("message" :interactive t
2843       message-send-and-exit message-yank-original)
2844      ("babel" babel-as-string)
2845      ("nnmail" nnmail-split-fancy nnmail-article-group)
2846      ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
2847      ("rmailout" rmail-output rmail-output-to-rmail-file)
2848      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
2849       rmail-show-message rmail-summary-exists
2850       rmail-select-summary rmail-update-summary)
2851      ("gnus-audio" :interactive t gnus-audio-play)
2852      ("gnus-xmas" gnus-xmas-splash)
2853      ("gnus-soup" :interactive t
2854       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
2855       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
2856      ("nnsoup" nnsoup-pack-replies)
2857      ("score-mode" :interactive t gnus-score-mode)
2858      ("gnus-mh" gnus-summary-save-article-folder
2859       gnus-Folder-save-name gnus-folder-save-name)
2860      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
2861      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
2862       gnus-demon-add-rescan gnus-demon-add-scan-timestamps
2863       gnus-demon-add-disconnection gnus-demon-add-handler
2864       gnus-demon-remove-handler)
2865      ("gnus-demon" :interactive t
2866       gnus-demon-init gnus-demon-cancel)
2867      ("gnus-fun" gnus-convert-gray-x-face-to-xpm gnus-display-x-face-in-from
2868       gnus-convert-image-to-gray-x-face gnus-convert-face-to-png
2869       gnus-face-from-file)
2870      ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
2871       gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
2872      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
2873       gnus-nocem-unwanted-article-p)
2874      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info
2875       gnus-server-server-name)
2876      ("gnus-srvr" gnus-browse-foreign-server)
2877      ("gnus-cite" :interactive t
2878       gnus-article-highlight-citation gnus-article-hide-citation-maybe
2879       gnus-article-hide-citation gnus-article-fill-cited-article
2880       gnus-article-hide-citation-in-followups)
2881      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
2882       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
2883       gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score)
2884      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
2885       gnus-cache-possibly-remove-articles gnus-cache-request-article
2886       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
2887       gnus-cache-enter-remove-article gnus-cached-article-p
2888       gnus-cache-open gnus-cache-close gnus-cache-update-article
2889       gnus-cache-articles-in-group)
2890      ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
2891       gnus-cache-remove-article gnus-summary-insert-cached-articles)
2892      ("gnus-score" :interactive t
2893       gnus-summary-increase-score gnus-summary-set-score
2894       gnus-summary-raise-thread gnus-summary-raise-same-subject
2895       gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
2896       gnus-summary-lower-thread gnus-summary-lower-same-subject
2897       gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
2898       gnus-summary-current-score gnus-score-delta-default
2899       gnus-score-flush-cache gnus-score-close
2900       gnus-possibly-score-headers gnus-score-followup-article
2901       gnus-score-followup-thread)
2902      ("gnus-score"
2903       (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
2904       gnus-current-score-file-nondirectory gnus-score-adaptive
2905       gnus-score-find-trace gnus-score-file-name)
2906      ("gnus-cus" :interactive t gnus-custom-mode gnus-group-customize
2907       gnus-score-customize)
2908      ("gnus-topic" :interactive t gnus-topic-mode)
2909      ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters
2910       gnus-subscribe-topics)
2911      ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
2912      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
2913      ("gnus-uu" :interactive t
2914       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
2915       gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
2916       gnus-uu-mark-by-regexp gnus-uu-mark-all
2917       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
2918       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
2919       gnus-uu-decode-unshar-and-save gnus-uu-decode-save
2920       gnus-uu-decode-binhex gnus-uu-decode-uu-view
2921       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
2922       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
2923       gnus-uu-decode-binhex-view gnus-uu-unmark-thread
2924       gnus-uu-mark-over gnus-uu-post-news gnus-uu-invert-processable)
2925      ("gnus-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh
2926       gnus-uu-unmark-thread)
2927      ("gnus-msg" (gnus-summary-send-map keymap)
2928       gnus-article-mail gnus-copy-article-buffer gnus-following-method)
2929      ("gnus-msg" :interactive t
2930       gnus-group-post-news gnus-group-mail gnus-group-news
2931       gnus-summary-post-news gnus-summary-news-other-window
2932       gnus-summary-followup gnus-summary-followup-with-original
2933       gnus-summary-cancel-article gnus-summary-supersede-article
2934       gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
2935       gnus-summary-mail-forward gnus-summary-mail-other-window
2936       gnus-summary-resend-message gnus-summary-resend-bounced-mail
2937       gnus-summary-wide-reply gnus-summary-followup-to-mail
2938       gnus-summary-followup-to-mail-with-original gnus-bug
2939       gnus-summary-wide-reply-with-original gnus-summary-post-forward
2940       gnus-summary-digest-mail-forward gnus-summary-digest-post-forward)
2941      ("gnus-picon" :interactive t gnus-treat-from-picon)
2942      ("smiley" :interactive t smiley-region)
2943      ("gnus-win" gnus-configure-windows gnus-add-configuration)
2944      ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
2945       gnus-list-of-unread-articles gnus-list-of-read-articles
2946       gnus-offer-save-summaries gnus-make-thread-indent-array
2947       gnus-summary-exit gnus-update-read-articles gnus-summary-last-subject
2948       gnus-summary-skip-intangible gnus-summary-article-number
2949       gnus-data-header gnus-data-find gnus-summary-jump-to-other-group)
2950      ("gnus-group" gnus-group-insert-group-line gnus-group-quit
2951       gnus-group-list-groups gnus-group-first-unread-group
2952       gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
2953       gnus-group-setup-buffer gnus-group-get-new-news
2954       gnus-group-make-help-group gnus-group-update-group
2955       gnus-group-iterate gnus-group-group-name)
2956      ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article
2957       gnus-backlog-remove-article)
2958      ("gnus-art" gnus-article-read-summary-keys gnus-article-save
2959       gnus-article-prepare gnus-article-set-window-start
2960       gnus-article-next-page gnus-article-prev-page
2961       gnus-request-article-this-buffer gnus-article-mode
2962       gnus-article-setup-buffer gnus-narrow-to-page
2963       gnus-article-delete-invisible-text gnus-treat-article)
2964      ("gnus-art" :interactive t
2965       gnus-article-hide-headers gnus-article-hide-boring-headers
2966       gnus-article-treat-overstrike
2967       gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
2968       gnus-article-display-x-face
2969       gnus-article-decode-HZ
2970       gnus-article-wash-html
2971       gnus-article-unsplit-urls
2972       gnus-article-hide-pem gnus-article-hide-signature
2973       gnus-article-strip-leading-blank-lines gnus-article-date-local
2974       gnus-article-date-original gnus-article-date-lapsed
2975       gnus-article-show-all-headers
2976       ;; gnus-article-show-all
2977       gnus-article-edit-mode gnus-article-edit-article
2978       gnus-article-edit-done article-decode-encoded-words
2979       gnus-start-date-timer gnus-stop-date-timer)
2980      ("gnus-int" gnus-request-type)
2981      ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
2982       gnus-dribble-enter gnus-read-init-file gnus-dribble-touch
2983       gnus-check-reasonable-setup)
2984      ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article
2985       gnus-dup-enter-articles)
2986      ("gnus-range" gnus-copy-sequence)
2987      ("gnus-eform" gnus-edit-form)
2988      ("gnus-move" :interactive t
2989       gnus-group-move-group-to-server gnus-change-server)
2990      ("gnus-logic" gnus-score-advanced)
2991      ("gnus-undo" gnus-undo-mode gnus-undo-register)
2992      ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
2993       gnus-async-prefetch-article gnus-async-prefetch-remove-group
2994       gnus-async-halt-prefetch)
2995      ("gnus-offline"
2996       gnus-offline-setup)
2997      ("gnus-offline" :interactive t
2998       gnus-offline-toggle-plugged
2999       gnus-offline-set-unplugged-state
3000       gnus-offline-toggle-auto-hangup
3001       gnus-offline-toggle-on/off-send-mail
3002       gnus-offline-toggle-articles-to-fetch
3003       gnus-offline-set-interval-time
3004       gnus-offline-agent-expire)
3005      ("miee" :interactive t gnspool-get-news
3006       mail-spool-send news-spool-post)
3007      ("international/mw32misc" define-process-argument-editing
3008       general-process-argument-editing-function)
3009      ("gnus-agent" gnus-open-agent gnus-agent-get-function
3010       gnus-agent-save-active gnus-agent-method-p
3011       gnus-agent-get-undownloaded-list gnus-agent-fetch-session
3012       gnus-summary-set-agent-mark gnus-agent-save-group-info
3013       gnus-agent-request-article gnus-agent-retrieve-headers)
3014      ("gnus-agent" :interactive t
3015       gnus-unplugged gnus-agentize gnus-agent-batch)
3016      ("gnus-vm" :interactive t gnus-summary-save-in-vm
3017       gnus-summary-save-article-vm)
3018      ("compface" uncompface)
3019      ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue)
3020      ("gnus-mlspl" gnus-group-split gnus-group-split-fancy)
3021      ("gnus-mlspl" :interactive t gnus-group-split-setup
3022       gnus-group-split-update)
3023      ("gnus-delay" gnus-delay-initialize))))
3024
3025 ;; To search articles with Namazu.
3026 (autoload 'gnus-namazu-search "gnus-namazu" nil t)
3027 (autoload 'gnus-namazu-create-index "gnus-namazu" nil t)
3028 (autoload 'gnus-namazu-update-index "gnus-namazu" nil t)
3029 (autoload 'gnus-namazu-update-all-indices "gnus-namazu" nil t)
3030
3031 ;; To make nnir groups.
3032 (autoload 'gnus-group-make-nnir-group "nnir" nil t)
3033
3034 ;; To make shimbun groups.
3035 (autoload 'gnus-group-make-shimbun-group "nnshimbun" nil t)
3036
3037 ;;; gnus-sum.el thingies
3038
3039 (defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n"
3040   "*The format specification of the lines in the summary buffer.
3041
3042 It works along the same lines as a normal formatting string,
3043 with some simple extensions.
3044
3045 %N   Article number, left padded with spaces (string)
3046 %S   Subject (string)
3047 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
3048 %n   Name of the poster (string)
3049 %a   Extracted name of the poster (string)
3050 %A   Extracted address of the poster (string)
3051 %F   Contents of the From: header (string)
3052 %f   Contents of the From: or To: headers (string)
3053 %x   Contents of the Xref: header (string)
3054 %D   Date of the article (string)
3055 %d   Date of the article (string) in DD-MMM format
3056 %o   Date of the article (string) in YYYYMMDD`T'HHMMSS format
3057 %M   Message-id of the article (string)
3058 %r   References of the article (string)
3059 %c   Number of characters in the article (integer)
3060 %k   Pretty-printed version of the above (string)
3061      For example, \"1.2k\" or \"0.4M\".
3062 %L   Number of lines in the article (integer)
3063 %I   Indentation based on thread level (a string of spaces)
3064 %B   A complex trn-style thread tree (string)
3065      The variables `gnus-sum-thread-*' can be used for customization.
3066 %T   A string with two possible values: 80 spaces if the article
3067      is on thread level two or larger and 0 spaces on level one
3068 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
3069 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
3070 %[   Opening bracket (character, \"[\" or \"<\")
3071 %]   Closing bracket (character, \"]\" or \">\")
3072 %>   Spaces of length thread-level (string)
3073 %<   Spaces of length (- 20 thread-level) (string)
3074 %i   Article score (number)
3075 %z   Article zcore (character)
3076 %t   Number of articles under the current thread (number).
3077 %e   Whether the thread is empty or not (character).
3078 %V   Total thread score (number).
3079 %P   The line number (number).
3080 %O   Download mark (character).
3081 %*   If present, indicates desired cursor position
3082      (instead of after first colon).
3083 %u   User defined specifier.  The next character in the format string should
3084      be a letter.  Gnus will call the function gnus-user-format-function-X,
3085      where X is the letter following %u.  The function will be passed the
3086      current header as argument.  The function should return a string, which
3087      will be inserted into the summary just like information from any other
3088      summary specifier.
3089
3090 The %U (status), %R (replied) and %z (zcore) specs have to be handled
3091 with care.  For reasons of efficiency, Gnus will compute what column
3092 these characters will end up in, and \"hard-code\" that.  This means that
3093 it is invalid to have these specs after a variable-length spec.  Well,
3094 you might not be arrested, but your summary buffer will look strange,
3095 which is bad enough.
3096
3097 The smart choice is to have these specs as far to the left as
3098 possible.
3099
3100 This restriction may disappear in later versions of Gnus.
3101
3102 General format specifiers can also be used.
3103 See Info node `(gnus)Formatting Variables'."
3104   :link '(custom-manual "(gnus)Formatting Variables")
3105   :type 'string
3106   :group 'gnus-summary-format)
3107
3108 ;;;
3109 ;;; Skeleton keymaps
3110 ;;;
3111
3112 (defun gnus-suppress-keymap (keymap)
3113   (suppress-keymap keymap)
3114   (let ((keys `([backspace] [delete] "\177" "\M-u"))) ;gnus-mouse-2
3115     (while keys
3116       (define-key keymap (pop keys) 'undefined))))
3117
3118 (defvar gnus-article-mode-map
3119   (let ((keymap (make-sparse-keymap)))
3120     (gnus-suppress-keymap keymap)
3121     keymap))
3122 (defvar gnus-summary-mode-map
3123   (let ((keymap (make-keymap)))
3124     (gnus-suppress-keymap keymap)
3125     keymap))
3126 (defvar gnus-group-mode-map
3127   (let ((keymap (make-keymap)))
3128     (gnus-suppress-keymap keymap)
3129     keymap))
3130
3131 \f
3132
3133 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
3134 ;; If you want the cursor to go somewhere else, set these two
3135 ;; functions in some startup hook to whatever you want.
3136 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
3137 (defalias 'gnus-group-position-point 'gnus-goto-colon)
3138
3139 ;;; Various macros and substs.
3140
3141 (defun gnus-header-from (header)
3142   (mail-header-from header))
3143
3144 (defmacro gnus-gethash (string hashtable)
3145   "Get hash value of STRING in HASHTABLE."
3146   `(symbol-value (intern-soft ,string ,hashtable)))
3147
3148 (defmacro gnus-gethash-safe (string hashtable)
3149   "Get hash value of STRING in HASHTABLE.
3150 Return nil if not defined."
3151   `(let ((sym (intern-soft ,string ,hashtable)))
3152      (and (boundp sym) (symbol-value sym))))
3153
3154 (defmacro gnus-sethash (string value hashtable)
3155   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
3156   `(set (intern ,string ,hashtable) ,value))
3157 (put 'gnus-sethash 'edebug-form-spec '(form form form))
3158
3159 (defmacro gnus-group-unread (group)
3160   "Get the currently computed number of unread articles in GROUP."
3161   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
3162
3163 (defmacro gnus-group-entry (group)
3164   "Get the newsrc entry for GROUP."
3165   `(gnus-gethash ,group gnus-newsrc-hashtb))
3166
3167 (defmacro gnus-active (group)
3168   "Get active info on GROUP."
3169   `(gnus-gethash ,group gnus-active-hashtb))
3170
3171 (defmacro gnus-set-active (group active)
3172   "Set GROUP's active info."
3173   `(gnus-sethash ,group ,active gnus-active-hashtb))
3174
3175 ;; Info access macros.
3176
3177 (defmacro gnus-info-group (info)
3178   `(nth 0 ,info))
3179 (defmacro gnus-info-rank (info)
3180   `(nth 1 ,info))
3181 (defmacro gnus-info-read (info)
3182   `(nth 2 ,info))
3183 (defmacro gnus-info-marks (info)
3184   `(nth 3 ,info))
3185 (defmacro gnus-info-method (info)
3186   `(nth 4 ,info))
3187 (defmacro gnus-info-params (info)
3188   `(nth 5 ,info))
3189
3190 (defmacro gnus-info-level (info)
3191   `(let ((rank (gnus-info-rank ,info)))
3192      (if (consp rank)
3193          (car rank)
3194        rank)))
3195 (defmacro gnus-info-score (info)
3196   `(let ((rank (gnus-info-rank ,info)))
3197      (or (and (consp rank) (cdr rank)) 0)))
3198
3199 (defmacro gnus-info-set-group (info group)
3200   `(setcar ,info ,group))
3201 (defmacro gnus-info-set-rank (info rank)
3202   `(setcar (nthcdr 1 ,info) ,rank))
3203 (defmacro gnus-info-set-read (info read)
3204   `(setcar (nthcdr 2 ,info) ,read))
3205 (defmacro gnus-info-set-marks (info marks &optional extend)
3206   (if extend
3207       `(gnus-info-set-entry ,info ,marks 3)
3208     `(setcar (nthcdr 3 ,info) ,marks)))
3209 (defmacro gnus-info-set-method (info method &optional extend)
3210   (if extend
3211       `(gnus-info-set-entry ,info ,method 4)
3212     `(setcar (nthcdr 4 ,info) ,method)))
3213 (defmacro gnus-info-set-params (info params &optional extend)
3214   (if extend
3215       `(gnus-info-set-entry ,info ,params 5)
3216     `(setcar (nthcdr 5 ,info) ,params)))
3217
3218 (defun gnus-info-set-entry (info entry number)
3219   ;; Extend the info until we have enough elements.
3220   (while (<= (length info) number)
3221     (nconc info (list nil)))
3222   ;; Set the entry.
3223   (setcar (nthcdr number info) entry))
3224
3225 (defmacro gnus-info-set-level (info level)
3226   `(let ((rank (cdr ,info)))
3227      (if (consp (car rank))
3228          (setcar (car rank) ,level)
3229        (setcar rank ,level))))
3230 (defmacro gnus-info-set-score (info score)
3231   `(let ((rank (cdr ,info)))
3232      (if (consp (car rank))
3233          (setcdr (car rank) ,score)
3234        (setcar rank (cons (car rank) ,score)))))
3235
3236 (defmacro gnus-get-info (group)
3237   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
3238
3239 ;;; Load the compatibility functions.
3240
3241 (require 'gnus-ems)
3242
3243 \f
3244 ;;;
3245 ;;; Shutdown
3246 ;;;
3247
3248 (defvar gnus-shutdown-alist nil)
3249
3250 (defun gnus-add-shutdown (function &rest symbols)
3251   "Run FUNCTION whenever one of SYMBOLS is shut down."
3252   (push (cons function symbols) gnus-shutdown-alist))
3253
3254 (defun gnus-shutdown (symbol)
3255   "Shut down everything that waits for SYMBOL."
3256   (dolist (entry gnus-shutdown-alist)
3257     (when (memq symbol (cdr entry))
3258       (funcall (car entry)))))
3259
3260 \f
3261 ;;;
3262 ;;; Gnus Utility Functions
3263 ;;;
3264
3265 (defun gnus-find-subscribed-addresses ()
3266   "Return a regexp matching the addresses of all subscribed mail groups.
3267 It consists of the `to-address' or `to-list' parameter of all groups
3268 with a `subscribed' parameter."
3269   (let (group address addresses)
3270     (dolist (entry (cdr gnus-newsrc-alist))
3271       (setq group (car entry))
3272       (when (gnus-parameter-subscribed group)
3273         (setq address (mail-strip-quoted-names
3274                        (or (gnus-group-fast-parameter group 'to-address)
3275                            (gnus-group-fast-parameter group 'to-list))))
3276         (when address
3277           (add-to-list 'addresses address))))
3278     (when addresses
3279       (list (mapconcat 'regexp-quote addresses "\\|")))))
3280
3281 (defmacro gnus-string-or (&rest strings)
3282   "Return the first element of STRINGS that is a non-blank string.
3283 STRINGS will be evaluated in normal `or' order."
3284   `(gnus-string-or-1 ',strings))
3285
3286 (defun gnus-string-or-1 (strings)
3287   (let (string)
3288     (while strings
3289       (setq string (eval (pop strings)))
3290       (if (string-match "^[ \t]*$" string)
3291           (setq string nil)
3292         (setq strings nil)))
3293     string))
3294
3295 (defun gnus-info-find-node (&optional nodename)
3296   "Find Info documentation of Gnus."
3297   (interactive)
3298   ;; Enlarge info window if needed.
3299   (let (gnus-info-buffer)
3300     (Info-goto-node
3301      (format "(%s)%s"
3302              (or gnus-info-filename
3303                  (get-language-info current-language-environment 'gnus-info)
3304                  "gnus")
3305              (or nodename
3306                  (cadr (assq major-mode gnus-info-nodes))
3307                  (and (eq (current-buffer) (get-buffer gnus-article-buffer))
3308                       (cadr (assq 'gnus-article-mode gnus-info-nodes))))))
3309     (setq gnus-info-buffer (current-buffer))
3310     (gnus-configure-windows 'info)))
3311
3312 ;;;
3313 ;;; gnus-interactive
3314 ;;;
3315
3316 (defvar gnus-current-prefix-symbol nil
3317   "Current prefix symbol.")
3318
3319 (defvar gnus-current-prefix-symbols nil
3320   "List of current prefix symbols.")
3321
3322 (defun gnus-interactive (string &optional params)
3323   "Return a list that can be fed to `interactive'.
3324 See `interactive' for full documentation.
3325
3326 Adds the following specs:
3327
3328 y -- The current symbolic prefix.
3329 Y -- A list of the current symbolic prefix(es).
3330 A -- Article number.
3331 H -- Article header.
3332 g -- Group name."
3333   (let ((i 0)
3334         out c prompt)
3335     (while (< i (length string))
3336       (string-match ".\\([^\n]*\\)\n?" string i)
3337       (setq c (aref string i))
3338       (when (match-end 1)
3339         (setq prompt (match-string 1 string)))
3340       (setq i (match-end 0))
3341       ;; We basically emulate just about everything that
3342       ;; `interactive' does, but add the specs listed above.
3343       (push
3344        (cond
3345         ((= c ?a)
3346          (completing-read prompt obarray 'fboundp t))
3347         ((= c ?b)
3348          (read-buffer prompt (current-buffer) t))
3349         ((= c ?B)
3350          (read-buffer prompt (other-buffer (current-buffer))))
3351         ((= c ?c)
3352          (read-char))
3353         ((= c ?C)
3354          (completing-read prompt obarray 'commandp t))
3355         ((= c ?d)
3356          (point))
3357         ((= c ?D)
3358          (read-file-name prompt nil default-directory 'lambda))
3359         ((= c ?f)
3360          (read-file-name prompt nil nil 'lambda))
3361         ((= c ?F)
3362          (read-file-name prompt))
3363         ((= c ?k)
3364          (read-key-sequence prompt))
3365         ((= c ?K)
3366          (error "Not implemented spec"))
3367         ((= c ?e)
3368          (error "Not implemented spec"))
3369         ((= c ?m)
3370          (mark))
3371         ((= c ?N)
3372          (error "Not implemented spec"))
3373         ((= c ?n)
3374          (string-to-number (read-from-minibuffer prompt)))
3375         ((= c ?p)
3376          (prefix-numeric-value current-prefix-arg))
3377         ((= c ?P)
3378          current-prefix-arg)
3379         ((= c ?r)
3380          'gnus-prefix-nil)
3381         ((= c ?s)
3382          (read-string prompt))
3383         ((= c ?S)
3384          (intern (read-string prompt)))
3385         ((= c ?v)
3386          (read-variable prompt))
3387         ((= c ?x)
3388          (read-minibuffer prompt))
3389         ((= c ?x)
3390          (eval-minibuffer prompt))
3391         ;; And here the new specs come.
3392         ((= c ?y)
3393          gnus-current-prefix-symbol)
3394         ((= c ?Y)
3395          gnus-current-prefix-symbols)
3396         ((= c ?g)
3397          (gnus-group-group-name))
3398         ((= c ?A)
3399          (gnus-summary-skip-intangible)
3400          (or (get-text-property (point) 'gnus-number)
3401              (gnus-summary-last-subject)))
3402         ((= c ?H)
3403          (gnus-data-header (gnus-data-find (gnus-summary-article-number))))
3404         (t
3405          (error "Non-implemented spec")))
3406        out)
3407       (cond
3408        ((= c ?r)
3409         (push (if (< (point) (mark)) (point) (mark)) out)
3410         (push (if (> (point) (mark)) (point) (mark)) out))))
3411     (setq out (delq 'gnus-prefix-nil out))
3412     (nreverse out)))
3413
3414 (defun gnus-symbolic-argument (&optional arg)
3415   "Read a symbolic argument and a command, and then execute command."
3416   (interactive "P")
3417   (let* ((in-command (this-command-keys))
3418          (command in-command)
3419          gnus-current-prefix-symbols
3420          gnus-current-prefix-symbol
3421          syms)
3422     (while (equal in-command command)
3423       (message "%s-" (key-description (this-command-keys)))
3424       (push (intern (char-to-string (read-char))) syms)
3425       (setq command (read-key-sequence nil t)))
3426     (setq gnus-current-prefix-symbols (nreverse syms)
3427           gnus-current-prefix-symbol (car gnus-current-prefix-symbols))
3428     (call-interactively (key-binding command t))))
3429
3430 ;;; More various functions.
3431
3432 (defsubst gnus-check-backend-function (func group)
3433   "Check whether GROUP supports function FUNC.
3434 GROUP can either be a string (a group name) or a select method."
3435   (ignore-errors
3436     (let ((method (if (stringp group)
3437                       (car (gnus-find-method-for-group group))
3438                     group)))
3439       (unless (featurep method)
3440         (require method))
3441       (fboundp (intern (format "%s-%s" method func))))))
3442
3443 (defun gnus-group-read-only-p (&optional group)
3444   "Check whether GROUP supports editing or not.
3445 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
3446 that that variable is buffer-local to the summary buffers."
3447   (let ((group (or group gnus-newsgroup-name)))
3448     (not (gnus-check-backend-function 'request-replace-article group))))
3449
3450 (defun gnus-virtual-group-p (group)
3451   "Say whether GROUP is virtual or not."
3452   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
3453                         gnus-valid-select-methods)))
3454
3455 (defun gnus-news-group-p (group &optional article)
3456   "Return non-nil if GROUP (and ARTICLE) come from a news server."
3457   (cond ((gnus-member-of-valid 'post group) ;Ordinary news group
3458          t)                             ;is news of course.
3459         ((not (gnus-member-of-valid 'post-mail group)) ;Non-combined.
3460          nil)                           ;must be mail then.
3461         ((vectorp article)              ;Has header info.
3462          (eq (gnus-request-type group (mail-header-id article)) 'news))
3463         ((null article)                 ;Hasn't header info
3464          (eq (gnus-request-type group) 'news)) ;(unknown ==> mail)
3465         ((< article 0)                  ;Virtual message
3466          nil)                           ;we don't know, guess mail.
3467         (t                              ;Has positive number
3468          (eq (gnus-request-type group article) 'news)))) ;use it.
3469
3470 ;; Returns a list of writable groups.
3471 (defun gnus-writable-groups ()
3472   (let ((alist gnus-newsrc-alist)
3473         groups group)
3474     (while (setq group (car (pop alist)))
3475       (unless (gnus-group-read-only-p group)
3476         (push group groups)))
3477     (nreverse groups)))
3478
3479 ;; Check whether to use long file names.
3480 (defun gnus-use-long-file-name (symbol)
3481   ;; The variable has to be set...
3482   (and gnus-use-long-file-name
3483        ;; If it isn't a list, then we return t.
3484        (or (not (listp gnus-use-long-file-name))
3485            ;; If it is a list, and the list contains `symbol', we
3486            ;; return nil.
3487            (not (memq symbol gnus-use-long-file-name)))))
3488
3489 ;; Generate a unique new group name.
3490 (defun gnus-generate-new-group-name (leaf)
3491   (let ((name leaf)
3492         (num 0))
3493     (while (gnus-group-entry name)
3494       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
3495     name))
3496
3497 (defun gnus-ephemeral-group-p (group)
3498   "Say whether GROUP is ephemeral or not."
3499   (gnus-group-get-parameter group 'quit-config t))
3500
3501 (defun gnus-group-quit-config (group)
3502   "Return the quit-config of GROUP."
3503   (gnus-group-get-parameter group 'quit-config t))
3504
3505 (defun gnus-kill-ephemeral-group (group)
3506   "Remove ephemeral GROUP from relevant structures."
3507   (gnus-sethash group nil gnus-newsrc-hashtb))
3508
3509 (defun gnus-simplify-mode-line ()
3510   "Make mode lines a bit simpler."
3511   (setq mode-line-modified (cdr gnus-mode-line-modified))
3512   (when (listp mode-line-format)
3513     (make-local-variable 'mode-line-format)
3514     (setq mode-line-format (copy-sequence mode-line-format))
3515     (when (equal (nth 3 mode-line-format) "   ")
3516       (setcar (nthcdr 3 mode-line-format) " "))))
3517
3518 ;;; Servers and groups.
3519
3520 (defsubst gnus-server-add-address (method)
3521   (let ((method-name (symbol-name (car method))))
3522     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
3523              (not (assq (intern (concat method-name "-address")) method))
3524              (memq 'physical-address (assq (car method)
3525                                            gnus-valid-select-methods)))
3526         (append method (list (list (intern (concat method-name "-address"))
3527                                    (nth 1 method))))
3528       method)))
3529
3530 (defsubst gnus-method-to-server (method)
3531   (catch 'server-name
3532     (setq method (or method gnus-select-method))
3533
3534     ;; Perhaps it is already in the cache.
3535     (mapc (lambda (name-method)
3536             (if (equal (cdr name-method) method)
3537                 (throw 'server-name (car name-method))))
3538           gnus-server-method-cache)
3539
3540     (mapc
3541      (lambda (server-alist)
3542        (mapc (lambda (name-method)
3543                (when (gnus-methods-equal-p (cdr name-method) method)
3544                  (unless (member name-method gnus-server-method-cache)
3545                    (push name-method gnus-server-method-cache))
3546                  (throw 'server-name (car name-method))))
3547              server-alist))
3548      (let ((alists (list gnus-server-alist
3549                          gnus-predefined-server-alist)))
3550        (if gnus-select-method
3551            (push (list (cons "native" gnus-select-method)) alists))
3552        alists))
3553
3554     (let* ((name (if (member (cadr method) '(nil ""))
3555                      (format "%s" (car method))
3556                    (format "%s:%s" (car method) (cadr method))))
3557            (name-method (cons name method)))
3558       (unless (member name-method gnus-server-method-cache)
3559         (push name-method gnus-server-method-cache))
3560       name)))
3561
3562 (defsubst gnus-server-to-method (server)
3563   "Map virtual server names to select methods."
3564   (or (and server (listp server) server)
3565       (cdr (assoc server gnus-server-method-cache))
3566       (let ((result
3567              (or
3568               ;; Perhaps this is the native server?
3569               (and (equal server "native") gnus-select-method)
3570               ;; It should be in the server alist.
3571               (cdr (assoc server gnus-server-alist))
3572               ;; It could be in the predefined server alist.
3573               (cdr (assoc server gnus-predefined-server-alist))
3574               ;; If not, we look through all the opened server
3575               ;; to see whether we can find it there.
3576               (let ((opened gnus-opened-servers))
3577                 (while (and opened
3578                             (not (equal server (format "%s:%s" (caaar opened)
3579                                                        (cadaar opened)))))
3580                   (pop opened))
3581                 (caar opened))
3582               ;; It could be a named method, search all servers
3583               (let ((servers gnus-secondary-select-methods))
3584                 (while (and servers
3585                             (not (equal server (format "%s:%s" (caar servers)
3586                                                        (cadar servers)))))
3587                   (pop servers))
3588                 (car servers))
3589               ;; This could be some sort of foreign server that I
3590               ;; simply haven't opened (yet).  Do a brute-force scan
3591               ;; of the entire gnus-newsrc-alist for the server name
3592               ;; of every method.  As a side-effect, loads the
3593               ;; gnus-server-method-cache so this only happens once,
3594               ;; if at all.
3595               (let (match)
3596                 (mapcar
3597                  (lambda (info)
3598                    (let ((info-method (gnus-info-method info)))
3599                      (unless (stringp info-method)
3600                        (let ((info-server (gnus-method-to-server info-method)))
3601                          (when (equal server info-server)
3602                            (setq match info-method))))))
3603                  (cdr gnus-newsrc-alist))
3604                 match))))
3605         (when result
3606           (push (cons server result) gnus-server-method-cache))
3607         result)))
3608
3609 (defsubst gnus-server-get-method (group method)
3610   ;; Input either a server name, and extended server name, or a
3611   ;; select method, and return a select method.
3612   (cond ((stringp method)
3613          (gnus-server-to-method method))
3614         ((equal method gnus-select-method)
3615          gnus-select-method)
3616         ((and (stringp (car method))
3617               group)
3618          (gnus-server-extend-method group method))
3619         ((and method
3620               (not group)
3621               (equal (cadr method) ""))
3622          method)
3623         (t
3624          (gnus-server-add-address method))))
3625
3626 (defmacro gnus-method-equal (ss1 ss2)
3627   "Say whether two servers are equal."
3628   `(let ((s1 ,ss1)
3629          (s2 ,ss2))
3630      (or (equal s1 s2)
3631          (and (= (length s1) (length s2))
3632               (progn
3633                 (while (and s1 (member (car s1) s2))
3634                   (setq s1 (cdr s1)))
3635                 (null s1))))))
3636
3637 (defun gnus-methods-equal-p (m1 m2)
3638   (let ((m1 (or m1 gnus-select-method))
3639         (m2 (or m2 gnus-select-method)))
3640     (or (equal m1 m2)
3641         (and (eq (car m1) (car m2))
3642              (or (not (memq 'address (assoc (symbol-name (car m1))
3643                                             gnus-valid-select-methods)))
3644                  (equal (nth 1 m1) (nth 1 m2)))))))
3645
3646 (defun gnus-server-equal (m1 m2)
3647   "Say whether two methods are equal."
3648   (let ((m1 (cond ((null m1) gnus-select-method)
3649                   ((stringp m1) (gnus-server-to-method m1))
3650                   (t m1)))
3651         (m2 (cond ((null m2) gnus-select-method)
3652                   ((stringp m2) (gnus-server-to-method m2))
3653                   (t m2))))
3654     (gnus-method-equal m1 m2)))
3655
3656 (defun gnus-servers-using-backend (backend)
3657   "Return a list of known servers using BACKEND."
3658   (let ((opened gnus-opened-servers)
3659         out)
3660     (while opened
3661       (when (eq backend (caaar opened))
3662         (push (caar opened) out))
3663       (pop opened))
3664     out))
3665
3666 (defun gnus-archive-server-wanted-p ()
3667   "Say whether the user wants to use the archive server."
3668   (cond
3669    ((or (not gnus-message-archive-method)
3670         (not gnus-message-archive-group))
3671     nil)
3672    ((and gnus-message-archive-method gnus-message-archive-group)
3673     t)
3674    (t
3675     (let ((active (cadr (assq 'nnfolder-active-file
3676                               gnus-message-archive-method))))
3677       (and active
3678            (file-exists-p active))))))
3679
3680 (defsubst gnus-method-to-server-name (method)
3681   (concat
3682    (format "%s" (car method))
3683    (when (and
3684           (or (assoc (format "%s" (car method))
3685                      (gnus-methods-using 'address))
3686               (gnus-server-equal method gnus-message-archive-method))
3687           (nth 1 method)
3688           (not (string= (nth 1 method) "")))
3689      (concat "+" (nth 1 method)))))
3690
3691 (defsubst gnus-method-to-full-server-name (method)
3692   (format "%s+%s" (car method) (nth 1 method)))
3693
3694 (defun gnus-group-prefixed-name (group method &optional full)
3695   "Return the whole name from GROUP and METHOD.
3696 Call with full set to get the fully qualified group name (even if the
3697 server is native)."
3698   (when (stringp method)
3699     (setq method (gnus-server-to-method method)))
3700   (if (or (not method)
3701           (and (not full) (gnus-server-equal method "native"))
3702           ;;;!!! This might not be right.  We'll see...
3703           ;(string-match ":" group)
3704           )
3705       group
3706     (concat (gnus-method-to-server-name method) ":" group)))
3707
3708 (defun gnus-group-guess-prefixed-name (group)
3709   "Guess the whole name from GROUP and METHOD."
3710   (gnus-group-prefixed-name group (gnus-find-method-for-group
3711                                group)))
3712
3713 (defun gnus-group-full-name (group method)
3714   "Return the full name from GROUP and METHOD, even if the method is native."
3715   (gnus-group-prefixed-name group method t))
3716
3717 (defun gnus-group-guess-full-name (group)
3718   "Guess the full name from GROUP, even if the method is native."
3719   (if (gnus-group-prefixed-p group)
3720       group
3721     (gnus-group-full-name group (gnus-find-method-for-group group))))
3722
3723 (defun gnus-group-guess-full-name-from-command-method (group)
3724   "Guess the full name from GROUP, even if the method is native."
3725   (if (gnus-group-prefixed-p group)
3726       group
3727     (gnus-group-full-name group gnus-command-method)))
3728
3729 (defun gnus-group-real-prefix (group)
3730   "Return the prefix of the current group name."
3731   (if (stringp group)
3732       (if (string-match "^[^:]+:" group)
3733           (substring group 0 (match-end 0))
3734         "")
3735     nil))
3736
3737 (defun gnus-group-short-name (group)
3738   "Return the short group name."
3739   (let ((prefix (gnus-group-real-prefix group)))
3740     (if (< 0 (length prefix))
3741         (substring group (length prefix) nil)
3742       group)))
3743
3744 (defun gnus-group-prefixed-p (group)
3745   "Return the prefix of the current group name."
3746   (< 0 (length (gnus-group-real-prefix group))))
3747
3748 (defun gnus-summary-buffer-name (group)
3749   "Return the summary buffer name of GROUP."
3750   (concat "*Summary " (gnus-group-decoded-name group) "*"))
3751
3752 (defun gnus-group-method (group)
3753   "Return the server or method used for selecting GROUP.
3754 You should probably use `gnus-find-method-for-group' instead."
3755   (let ((prefix (gnus-group-real-prefix group)))
3756     (if (equal prefix "")
3757         gnus-select-method
3758       (let ((servers gnus-opened-servers)
3759             (server "")
3760             backend possible found)
3761         (if (string-match "^[^\\+]+\\+" prefix)
3762             (setq backend (intern (substring prefix 0 (1- (match-end 0))))
3763                   server (substring prefix (match-end 0) (1- (length prefix))))
3764           (setq backend (intern (substring prefix 0 (1- (length prefix))))))
3765         (while servers
3766           (when (eq (caaar servers) backend)
3767             (setq possible (caar servers))
3768             (when (equal (cadaar servers) server)
3769               (setq found (caar servers))))
3770           (pop servers))
3771         (or (car (rassoc found gnus-server-alist))
3772             found
3773             (car (rassoc possible gnus-server-alist))
3774             possible
3775             (list backend server))))))
3776
3777 (defsubst gnus-native-method-p (method)
3778   "Return whether METHOD is the native select method."
3779   (gnus-method-equal method gnus-select-method))
3780
3781 (defsubst gnus-secondary-method-p (method)
3782   "Return whether METHOD is a secondary select method."
3783   (let ((methods gnus-secondary-select-methods)
3784         (gmethod (inline (gnus-server-get-method nil method))))
3785     (while (and methods
3786                 (not (gnus-method-equal
3787                       (inline (gnus-server-get-method nil (car methods)))
3788                       gmethod)))
3789       (setq methods (cdr methods)))
3790     methods))
3791
3792 (defun gnus-method-simplify (method)
3793   "Return the shortest uniquely identifying string or method for METHOD."
3794   (cond ((stringp method)
3795          method)
3796         ((gnus-native-method-p method)
3797          nil)
3798         ((gnus-secondary-method-p method)
3799          (format "%s:%s" (nth 0 method) (nth 1 method)))
3800         (t
3801          method)))
3802
3803 (defun gnus-groups-from-server (server)
3804   "Return a list of all groups that are fetched from SERVER."
3805   (let ((alist (cdr gnus-newsrc-alist))
3806         info groups)
3807     (while (setq info (pop alist))
3808       (when (gnus-server-equal (gnus-info-method info) server)
3809         (push (gnus-info-group info) groups)))
3810     (sort groups 'string<)))
3811
3812 (defun gnus-group-foreign-p (group)
3813   "Say whether a group is foreign or not."
3814   (and (not (gnus-group-native-p group))
3815        (not (gnus-group-secondary-p group))))
3816
3817 (defun gnus-group-native-p (group)
3818   "Say whether the group is native or not."
3819   (not (string-match ":" group)))
3820
3821 (defun gnus-group-secondary-p (group)
3822   "Say whether the group is secondary or not."
3823   (gnus-secondary-method-p (gnus-find-method-for-group group)))
3824
3825 (defun gnus-parameters-get-parameter (group)
3826   "Return the group parameters for GROUP from `gnus-parameters'."
3827   (let (params-list)
3828     (dolist (elem gnus-parameters)
3829       (when (string-match (car elem) group)
3830         (setq params-list
3831               (nconc (gnus-expand-group-parameters
3832                       (car elem) (cdr elem) group)
3833                      params-list))))
3834     params-list))
3835
3836 (defun gnus-expand-group-parameter (match value group)
3837   "Use MATCH to expand VALUE in GROUP."
3838   (with-temp-buffer
3839     (insert group)
3840     (goto-char (point-min))
3841     (while (re-search-forward match nil t)
3842       (replace-match value))
3843     (buffer-string)))
3844
3845 (defun gnus-expand-group-parameters (match parameters group)
3846   "Go through PARAMETERS and expand them according to the match data."
3847   (let (new)
3848     (dolist (elem parameters)
3849       (if (and (stringp (cdr elem))
3850                (string-match "\\\\[0-9&]" (cdr elem)))
3851           (push (cons (car elem)
3852                       (gnus-expand-group-parameter match (cdr elem) group))
3853                 new)
3854         (push elem new)))
3855     new))
3856
3857 (defun gnus-group-fast-parameter (group symbol &optional allow-list)
3858   "For GROUP, return the value of SYMBOL.
3859
3860 You should call this in the `gnus-group-buffer' buffer.
3861 The function `gnus-group-find-parameter' will do that for you."
3862   ;; The speed trick:  No cons'ing and quit early.
3863   (let* ((params (funcall gnus-group-get-parameter-function group))
3864          ;; Start easy, check the "real" group parameters.
3865          (simple-results
3866           (gnus-group-parameter-value params symbol allow-list t)))
3867     (if simple-results
3868         ;; Found results; return them.
3869         (car simple-results)
3870       ;; We didn't found it there, try `gnus-parameters'.
3871       (let ((result nil)
3872             (head nil)
3873             (tail gnus-parameters))
3874         ;; A good old-fashioned non-cl loop.
3875         (while tail
3876           (setq head (car tail)
3877                 tail (cdr tail))
3878           ;; The car is regexp matching for matching the group name.
3879           (when (string-match (car head) group)
3880             ;; The cdr is the parameters.
3881             (setq result (gnus-group-parameter-value (cdr head)
3882                                                      symbol allow-list))
3883             (when result
3884               ;; Expand if necessary.
3885               (if (and (stringp result) (string-match "\\\\[0-9&]" result))
3886                   (setq result (gnus-expand-group-parameter (car head)
3887                                                             result group)))
3888               ;; Exit the loop early.
3889               (setq tail nil))))
3890         ;; Done.
3891         result))))
3892
3893 (defun gnus-group-find-parameter (group &optional symbol allow-list)
3894   "Return the group parameters for GROUP.
3895 If SYMBOL, return the value of that symbol in the group parameters.
3896
3897 If you call this function inside a loop, consider using the faster
3898 `gnus-group-fast-parameter' instead."
3899   (save-excursion
3900     (set-buffer gnus-group-buffer)
3901     (if symbol
3902         (gnus-group-fast-parameter group symbol allow-list)
3903       (nconc
3904        (copy-sequence
3905         (funcall gnus-group-get-parameter-function group))
3906        (gnus-parameters-get-parameter group)))))
3907
3908 (defun gnus-group-get-parameter (group &optional symbol allow-list)
3909   "Return the group parameters for GROUP.
3910 If SYMBOL, return the value of that symbol in the group parameters.
3911 Most functions should use `gnus-group-find-parameter', which
3912 also examines the topic parameters."
3913   (let ((params (gnus-info-params (gnus-get-info group))))
3914     (if symbol
3915         (gnus-group-parameter-value params symbol allow-list)
3916       params)))
3917
3918 (defun gnus-group-parameter-value (params symbol &optional
3919                                           allow-list present-p)
3920   "Return the value of SYMBOL in group PARAMS."
3921   ;; We only wish to return group parameters (dotted lists) and
3922   ;; not local variables, which may have the same names.
3923   ;; But first we handle single elements...
3924   (or (car (memq symbol params))
3925       ;; Handle alist.
3926       (let (elem)
3927         (catch 'found
3928           (while (setq elem (pop params))
3929             (when (and (consp elem)
3930                        (eq (car elem) symbol)
3931                        (or allow-list
3932                            (atom (cdr elem))))
3933               (throw 'found (if present-p (list (cdr elem))
3934                               (cdr elem)))))))))
3935
3936 (defun gnus-group-add-parameter (group param)
3937   "Add parameter PARAM to GROUP."
3938   (let ((info (gnus-get-info group)))
3939     (when info
3940       (gnus-group-remove-parameter group (if (consp param) (car param) param))
3941       ;; Cons the new param to the old one and update.
3942       (gnus-group-set-info (cons param (gnus-info-params info))
3943                            group 'params))))
3944
3945 (defun gnus-group-set-parameter (group name value)
3946   "Set parameter NAME to VALUE in GROUP."
3947   (let ((info (gnus-get-info group)))
3948     (when info
3949       (gnus-group-remove-parameter group name)
3950       (let ((old-params (gnus-info-params info))
3951             (new-params (list (cons name value))))
3952         (while old-params
3953           (when (or (not (listp (car old-params)))
3954                     (not (eq (caar old-params) name)))
3955             (setq new-params (append new-params (list (car old-params)))))
3956           (setq old-params (cdr old-params)))
3957         (gnus-group-set-info new-params group 'params)))))
3958
3959 (defun gnus-group-remove-parameter (group name)
3960   "Remove parameter NAME from GROUP."
3961   (let ((info (gnus-get-info group)))
3962     (when info
3963       (let ((params (gnus-info-params info)))
3964         (when params
3965           (setq params (delq name params))
3966           (while (assq name params)
3967             (gnus-pull name params))
3968           (gnus-info-set-params info params))))))
3969
3970 (defun gnus-group-add-score (group &optional score)
3971   "Add SCORE to the GROUP score.
3972 If SCORE is nil, add 1 to the score of GROUP."
3973   (let ((info (gnus-get-info group)))
3974     (when info
3975       (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
3976
3977 (defun gnus-short-group-name (group &optional levels)
3978   "Collapse GROUP name LEVELS.
3979 Select methods are stripped and any remote host name is stripped down to
3980 just the host name."
3981   (let* ((name "")
3982          (foreign "")
3983          (depth 0)
3984          (skip 1)
3985          (levels (or levels
3986                      gnus-group-uncollapsed-levels
3987                      (progn
3988                        (while (string-match "\\." group skip)
3989                          (setq skip (match-end 0)
3990                                depth (+ depth 1)))
3991                        depth))))
3992     ;; Separate foreign select method from group name and collapse.
3993     ;; If method contains a server, collapse to non-domain server name,
3994     ;; otherwise collapse to select method.
3995     (let* ((colon (string-match ":" group))
3996            (server (and colon (substring group 0 colon)))
3997            (plus (and server (string-match "+" server))))
3998       (when server
3999         (if plus
4000             (setq foreign (substring server (+ 1 plus)
4001                                      (string-match "\\." server))
4002                   group (substring group (+ 1 colon)))
4003           (setq foreign server
4004                 group (substring group (+ 1 colon))))
4005         (setq foreign (concat foreign ":")))
4006       ;; Collapse group name leaving LEVELS uncollapsed elements
4007       (let* ((slist (split-string group "/"))
4008              (slen (length slist))
4009              (dlist (split-string group "\\."))
4010              (dlen (length dlist))
4011              glist
4012              glen
4013              gsep
4014              res)
4015         (if (> slen dlen)
4016             (setq glist slist
4017                   glen slen
4018                   gsep "/")
4019           (setq glist dlist
4020                 glen dlen
4021                 gsep "."))
4022         (setq levels (- glen levels))
4023         (dolist (g glist)
4024           (push (if (>= (decf levels) 0)
4025                     (if (zerop (length g))
4026                         ""
4027                       (substring g 0 1))
4028                   g)
4029                 res))
4030         (concat foreign (mapconcat 'identity (nreverse res) gsep))))))
4031
4032 (defun gnus-narrow-to-body ()
4033   "Narrow to the body of an article."
4034   (narrow-to-region
4035    (progn
4036      (goto-char (point-min))
4037      (or (search-forward "\n\n" nil t)
4038          (point-max)))
4039    (point-max)))
4040
4041 \f
4042 ;;;
4043 ;;; Kill file handling.
4044 ;;;
4045
4046 (defun gnus-apply-kill-file ()
4047   "Apply a kill file to the current newsgroup.
4048 Returns the number of articles marked as read."
4049   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
4050           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
4051       (gnus-apply-kill-file-internal)
4052     0))
4053
4054 (defun gnus-kill-save-kill-buffer ()
4055   (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
4056     (when (get-file-buffer file)
4057       (save-excursion
4058         (set-buffer (get-file-buffer file))
4059         (when (buffer-modified-p)
4060           (save-buffer))
4061         (kill-buffer (current-buffer))))))
4062
4063 (defcustom gnus-kill-file-name "KILL"
4064   "Suffix of the kill files."
4065   :group 'gnus-score-kill
4066   :group 'gnus-score-files
4067   :type 'string)
4068
4069 (defun gnus-newsgroup-kill-file (newsgroup)
4070   "Return the name of a kill file name for NEWSGROUP.
4071 If NEWSGROUP is nil, return the global kill file name instead."
4072   (cond
4073    ;; The global KILL file is placed at top of the directory.
4074    ((or (null newsgroup)
4075         (string-equal newsgroup ""))
4076     (expand-file-name gnus-kill-file-name
4077                       gnus-kill-files-directory))
4078    ;; Append ".KILL" to newsgroup name.
4079    ((gnus-use-long-file-name 'not-kill)
4080     (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
4081                               "." gnus-kill-file-name)
4082                       gnus-kill-files-directory))
4083    ;; Place "KILL" under the hierarchical directory.
4084    (t
4085     (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
4086                               "/" gnus-kill-file-name)
4087                       gnus-kill-files-directory))))
4088
4089 ;;; Server things.
4090
4091 (defun gnus-member-of-valid (symbol group)
4092   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
4093   (memq symbol (assoc
4094                 (symbol-name (car (gnus-find-method-for-group group)))
4095                 gnus-valid-select-methods)))
4096
4097 (defun gnus-method-option-p (method option)
4098   "Return non-nil if select METHOD has OPTION as a parameter."
4099   (when (stringp method)
4100     (setq method (gnus-server-to-method method)))
4101   (memq option (assoc (format "%s" (car method))
4102                       gnus-valid-select-methods)))
4103
4104 (defun gnus-similar-server-opened (method)
4105   (let ((opened gnus-opened-servers))
4106     (while (and method opened)
4107       (when (and (equal (cadr method) (cadaar opened))
4108                  (equal (car method) (caaar opened))
4109                  (not (equal method (caar opened))))
4110         (setq method nil))
4111       (pop opened))
4112     (not method)))
4113
4114 (defun gnus-server-extend-method (group method)
4115   ;; This function "extends" a virtual server.  If the server is
4116   ;; "hello", and the select method is ("hello" (my-var "something"))
4117   ;; in the group "alt.alt", this will result in a new virtual server
4118   ;; called "hello+alt.alt".
4119   (if (or (not (inline (gnus-similar-server-opened method)))
4120           (not (cddr method)))
4121       method
4122     `(,(car method) ,(concat (cadr method) "+" group)
4123       (,(intern (format "%s-address" (car method))) ,(cadr method))
4124       ,@(cddr method))))
4125
4126 (defun gnus-server-status (method)
4127   "Return the status of METHOD."
4128   (nth 1 (assoc method gnus-opened-servers)))
4129
4130 (defun gnus-group-name-to-method (group)
4131   "Guess a select method based on GROUP."
4132   (if (string-match ":" group)
4133       (let ((server (substring group 0 (match-beginning 0))))
4134         (if (string-match "\\+" server)
4135             (list (intern (substring server 0 (match-beginning 0)))
4136                   (substring server (match-end 0)))
4137           (list (intern server) "")))
4138     gnus-select-method))
4139
4140 (defun gnus-server-string (server)
4141   "Return a readable string that describes SERVER."
4142   (let* ((server (gnus-server-to-method server))
4143          (address (nth 1 server)))
4144     (if (and address
4145              (not (zerop (length address))))
4146         (format "%s using %s" address (car server))
4147       (format "%s" (car server)))))
4148
4149 (defun gnus-find-method-for-group (group &optional info)
4150   "Find the select method that GROUP uses."
4151   (or gnus-override-method
4152       (and (not group)
4153            gnus-select-method)
4154       (and (not (gnus-group-entry group));; a new group
4155            (gnus-group-name-to-method group))
4156       (let ((info (or info (gnus-get-info group)))
4157             method)
4158         (if (or (not info)
4159                 (not (setq method (gnus-info-method info)))
4160                 (equal method "native"))
4161             gnus-select-method
4162           (setq method
4163                 (cond ((stringp method)
4164                        (inline (gnus-server-to-method method)))
4165                       ((stringp (cadr method))
4166                        (inline (gnus-server-extend-method group method)))
4167                       (t
4168                        method)))
4169           (cond ((equal (cadr method) "")
4170                  method)
4171                 ((null (cadr method))
4172                  (list (car method) ""))
4173                 (t
4174                  (gnus-server-add-address method)))))))
4175
4176 (defun gnus-methods-using (feature)
4177   "Find all methods that have FEATURE."
4178   (let ((valids gnus-valid-select-methods)
4179         outs)
4180     (while valids
4181       (when (memq feature (car valids))
4182         (push (car valids) outs))
4183       (setq valids (cdr valids)))
4184     outs))
4185
4186 (eval-and-compile
4187   (autoload 'message-y-or-n-p "message" nil nil 'macro))
4188
4189 (defun gnus-read-group (prompt &optional default)
4190   "Prompt the user for a group name.
4191 Disallow invalid group names."
4192   (let ((prefix "")
4193         group)
4194     (while (not group)
4195       (when (string-match
4196              gnus-invalid-group-regexp
4197              (setq group (read-string (concat prefix prompt)
4198                                       (cons (or default "") 0)
4199                                       'gnus-group-history)))
4200         (let ((match (match-string 0 group)))
4201           ;; Might be okay (e.g. for nnimap), so ask the user:
4202           (unless (and (not (string-match "^$\\|:" match))
4203                        (message-y-or-n-p
4204                         "Proceed and create group anyway? " t
4205 "The group name \"" group "\" contains a forbidden character: \"" match "\".
4206
4207 Usually, it's dangerous to create a group with this name, because it's not
4208 supported by all back ends and servers.  On IMAP servers it should work,
4209 though.  If you are really sure, you can proceed anyway and create the group.
4210
4211 You may customize the variable `gnus-invalid-group-regexp', which currently is
4212 set to \"" gnus-invalid-group-regexp
4213 "\", if you want to get rid of this query permanently."))
4214             (setq prefix (format "Invalid group name: \"%s\".  " group)
4215                   group nil)))))
4216     group))
4217
4218 (defun gnus-read-method (prompt)
4219   "Prompt the user for a method.
4220 Allow completion over sensible values."
4221   (let* ((open-servers
4222           (mapcar (lambda (i) (cons (format "%s:%s" (caar i) (cadar i)) i))
4223                   gnus-opened-servers))
4224          (valid-methods
4225           (let (methods)
4226             (dolist (method gnus-valid-select-methods)
4227               (if (or (memq 'prompt-address method)
4228                       (not (assoc (format "%s:" (car method)) open-servers)))
4229                   (push method methods)))
4230             methods))
4231          (servers
4232           (append valid-methods
4233                   open-servers
4234                   gnus-predefined-server-alist
4235                   gnus-server-alist))
4236          (method
4237           (completing-read
4238            prompt servers
4239            nil t nil 'gnus-method-history)))
4240     (cond
4241      ((equal method "")
4242       (setq method gnus-select-method))
4243      ((assoc method gnus-valid-select-methods)
4244       (let ((address (if (memq 'prompt-address
4245                                (assoc method gnus-valid-select-methods))
4246                          (read-string "Address: ")
4247                        "")))
4248         (or (cadr (assoc (format "%s:%s" method address) open-servers))
4249             (list (intern method) address))))
4250      ((assoc method servers)
4251       method)
4252      (t
4253       (list (intern method) "")))))
4254
4255 ;;; Agent functions
4256
4257 (defun gnus-agent-method-p (method)
4258   "Say whether METHOD is covered by the agent."
4259   (or (eq (car gnus-agent-method-p-cache) method)
4260       (setq gnus-agent-method-p-cache
4261             (cons method
4262                   (member (if (stringp method)
4263                               method
4264                             (gnus-method-to-server method)) gnus-agent-covered-methods))))
4265   (cdr gnus-agent-method-p-cache))
4266
4267 (defun gnus-online (method)
4268   (not
4269    (if gnus-plugged
4270        (eq (cadr (assoc method gnus-opened-servers)) 'offline)
4271      (gnus-agent-method-p method))))
4272
4273 ;;; User-level commands.
4274
4275 ;;;###autoload
4276 (defun gnus-slave-no-server (&optional arg)
4277   "Read network news as a slave, without connecting to the local server."
4278   (interactive "P")
4279   (gnus-no-server arg t))
4280
4281 ;;;###autoload
4282 (defun gnus-no-server (&optional arg slave)
4283   "Read network news.
4284 If ARG is a positive number, Gnus will use that as the startup
4285 level. If ARG is nil, Gnus will be started at level 2.  If ARG is
4286 non-nil and not a positive number, Gnus will prompt the user for the
4287 name of an NNTP server to use.
4288 As opposed to `gnus', this command will not connect to the local
4289 server."
4290   (interactive "P")
4291   (gnus-no-server-1 arg slave))
4292
4293 ;;;###autoload
4294 (defun gnus-slave (&optional arg)
4295   "Read news as a slave."
4296   (interactive "P")
4297   (gnus arg nil 'slave))
4298
4299 (defcustom gnus-frame-properties nil
4300   "The properties of the frame in which gnus is displayed. Under XEmacs,
4301 the variable `toolbar-news-frame-plist' will be refered instead."
4302   :type '(repeat (cons :format "%v"
4303                        (symbol :tag "Parameter")
4304                        (sexp :tag "Value")))
4305   :group 'gnus)
4306
4307 ;;;###autoload
4308 (defun gnus-other-frame (&optional arg display)
4309   "Pop up a frame to read news.
4310 This will call one of the Gnus commands which is specified by the user
4311 option `gnus-other-frame-function' (default `gnus') with the argument
4312 ARG if Gnus is not running, otherwise just pop up a Gnus frame.  The
4313 optional second argument DISPLAY should be a standard display string
4314 such as \"unix:0\" to specify where to pop up a frame.  If DISPLAY is
4315 omitted or the function `make-frame-on-display' is not available, the
4316 current display is used."
4317   (interactive "P")
4318   (if (fboundp 'make-frame-on-display)
4319       (unless display
4320         (setq display (gnus-frame-or-window-display-name (selected-frame))))
4321     (setq display nil))
4322   (let ((alive (gnus-alive-p)))
4323     (unless (and alive
4324                  (catch 'found
4325                    (walk-windows
4326                     (lambda (window)
4327                       (when (and (or (not display)
4328                                      (equal display
4329                                             (gnus-frame-or-window-display-name
4330                                              window)))
4331                                  (with-current-buffer (window-buffer window)
4332                                    (string-match "\\`gnus-"
4333                                                  (symbol-name major-mode))))
4334                         (gnus-select-frame-set-input-focus
4335                          (setq gnus-other-frame-object (window-frame window)))
4336                         (select-window window)
4337                         (throw 'found t)))
4338                     'ignore t)))
4339       (gnus-select-frame-set-input-focus
4340        (setq gnus-other-frame-object
4341              (if display
4342                  (make-frame-on-display display gnus-other-frame-parameters)
4343                (make-frame gnus-other-frame-parameters))))
4344       (if alive
4345           (switch-to-buffer gnus-group-buffer)
4346         (funcall gnus-other-frame-function arg)
4347         (add-hook 'gnus-exit-gnus-hook
4348                   '(lambda nil
4349                      (when (and (frame-live-p gnus-other-frame-object)
4350                                 (cdr (frame-list)))
4351                        (delete-frame gnus-other-frame-object))
4352                      (setq gnus-other-frame-object nil)))))))
4353
4354 ;;;###autoload
4355 (defun gnus (&optional arg dont-connect slave)
4356   "Read network news.
4357 If ARG is non-nil and a positive number, Gnus will use that as the
4358 startup level.  If ARG is non-nil and not a positive number, Gnus will
4359 prompt the user for the name of an NNTP server to use."
4360   (interactive "P")
4361   (unless (byte-code-function-p (symbol-function 'gnus))
4362     (message "You should byte-compile Gnus")
4363     (sit-for 2))
4364   (gnus-1 arg dont-connect slave))
4365
4366 ;; Allow redefinition of Gnus functions.
4367
4368 (gnus-ems-redefine)
4369
4370 (product-provide (provide 'gnus) 'gnus-vers)
4371
4372 ;;; gnus.el ends here