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