*** empty log message ***
[gnus] / lisp / gnus.el
1 ;;; gnus.el --- a newsreader for GNU Emacs
2 ;; Copyright (C) 1987,88,89,90,93,94,95,96,97 Free Software Foundation, Inc.
3
4 ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Keywords: news
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;; Commentary:
26
27 ;;; Code:
28
29 (eval '(run-hooks 'gnus-load-hook))
30
31 (require 'custom)
32 (require 'gnus-load)
33
34 (defgroup gnus nil
35   "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
36   :group 'emacs)
37
38 (defgroup gnus-start nil
39   "Starting your favorite newsreader."
40   :group 'gnus)
41
42 ;; These belong to gnus-group.el.
43 (defgroup gnus-group nil
44   "Group buffers."
45   :link '(custom-manual "(gnus)The Group Buffer")
46   :group 'gnus)
47
48 (defgroup gnus-group-foreign nil
49   "Foreign groups."
50   :link '(custom-manual "(gnus)Foreign Groups")
51   :group 'gnus-group)
52
53 (defgroup gnus-group-levels nil
54   "Group levels."
55   :link '(custom-manual "(gnus)Group Levels")
56   :group 'gnus-group)
57
58 (defgroup gnus-group-select nil
59   "Selecting a Group."
60   :link '(custom-manual "(gnus)Selecting a Group")
61   :group 'gnus-group)
62
63 (defgroup gnus-group-listing nil
64   "Showing slices of the group list."
65   :link '(custom-manual "(gnus)Listing Groups")
66   :group 'gnus-group)
67
68 (defgroup gnus-group-visual nil
69   "Sorting the group buffer."
70   :link '(custom-manual "(gnus)Group Buffer Format")
71   :group 'gnus-group
72   :group 'gnus-visual)
73
74 (defgroup gnus-group-various nil
75   "Various group options."
76   :link '(custom-manual "(gnus)Scanning New Messages")
77   :group 'gnus-group)
78
79 ;; These belong to gnus-sum.el.
80 (defgroup gnus-summary nil
81   "Summary buffers."
82   :link '(custom-manual "(gnus)The Summary Buffer")
83   :group 'gnus)
84
85 (defgroup gnus-summary-exit nil
86   "Leaving summary buffers."
87   :link '(custom-manual "(gnus)Exiting the Summary Buffer")
88   :group 'gnus-summary)
89
90 (defgroup gnus-summary-marks nil
91   "Marks used in summary buffers."
92   :link '(custom-manual "(gnus)Marking Articles")
93   :group 'gnus-summary)
94
95 (defgroup gnus-thread nil
96   "Ordering articles according to replies."
97   :link '(custom-manual "(gnus)Threading")
98   :group 'gnus-summary)
99
100 (defgroup gnus-summary-format nil
101   "Formatting of the summary buffer."
102   :link '(custom-manual "(gnus)Summary Buffer Format")
103   :group 'gnus-summary)
104
105 (defgroup gnus-summary-choose nil
106   "Choosing Articles."
107   :link '(custom-manual "(gnus)Choosing Articles")
108   :group 'gnus-summary)
109
110 (defgroup gnus-summary-maneuvering nil
111   "Summary movement commands."
112   :link '(custom-manual "(gnus)Summary Maneuvering")
113   :group 'gnus-summary)
114
115 (defgroup gnus-summary-mail nil
116   "Mail group commands."
117   :link '(custom-manual "(gnus)Mail Group Commands")
118   :group 'gnus-summary)
119
120 (defgroup gnus-summary-sort nil
121   "Sorting the summary buffer."
122   :link '(custom-manual "(gnus)Sorting")
123   :group 'gnus-summary)
124
125 (defgroup gnus-summary-visual nil
126   "Highlighting and menus in the summary buffer."
127   :link '(custom-manual "(gnus)Summary Highlighting")
128   :group 'gnus-visual
129   :group 'gnus-summary)
130
131 (defgroup gnus-summary-various nil
132   "Various summary buffer options."
133   :link '(custom-manual "(gnus)Various Summary Stuff")
134   :group 'gnus-summary)
135
136 ;; Belongs to gnus-uu.el
137 (defgroup gnus-extract-view nil
138   "Viewing extracted files."
139   :link '(custom-manual "(gnus)Viewing Files")
140   :group 'gnus-extract)
141
142 ;; Belongs to gnus-score.el
143 (defgroup gnus-score nil
144   "Score and kill file handling."
145   :group 'gnus)
146
147 (defgroup gnus-score-kill nil
148   "Kill files."
149   :group 'gnus-score)
150
151 (defgroup gnus-score-adapt nil
152   "Adaptive score files."
153   :group 'gnus-score)
154
155 (defgroup gnus-score-files nil
156   "Score and kill file names."
157   :group 'gnus-score
158   :group 'gnus-files)
159
160 (defgroup gnus-score-various nil
161   "Various scoring and killing options."
162   :group 'gnus-score)
163
164 ;; Other
165 (defgroup gnus-visual nil
166   "Options controling the visual fluff."
167   :group 'gnus)
168
169 (defgroup gnus-mail-expire nil
170   "Expiring articles in mail backends."
171   :group 'gnus-mail)
172
173 (defgroup gnus-files nil
174   "Files used by Gnus."
175   :group 'gnus)
176
177 (defgroup gnus-server nil
178   "Options related to newsservers and other servers used by Gnus."
179   :group 'gnus)
180
181 (defgroup gnus-message '((message custom-group))
182   "Composing replies and followups in Gnus."
183   :group 'gnus)
184
185 (defgroup gnus-meta nil
186   "Meta variables controling major portions of Gnus.
187 In general, modifying these variables does not take affect until Gnus
188 is restarted, and sometimes reloaded."
189   :group 'gnus)
190
191 (defgroup gnus-various nil
192   "Other Gnus options."
193   :link '(custom-manual "(gnus)Various Various")
194   :group 'gnus)
195
196 (defgroup gnus-exit nil
197   "Exiting gnus."
198   :link '(custom-manual "(gnus)Exiting Gnus")
199   :group 'gnus)
200
201 (defconst gnus-version-number "5.4.12"
202   "Version number for this version of Gnus.")
203
204 (defconst gnus-version (format "Gnus v%s" gnus-version-number)
205   "Version string for this version of Gnus.")
206
207 (defcustom gnus-inhibit-startup-message nil
208   "If non-nil, the startup message will not be displayed.
209 This variable is used before `.gnus.el' is loaded, so it should
210 be set in `.emacs' instead."
211   :group 'gnus-start
212   :type 'boolean)
213
214 (defcustom gnus-play-startup-jingle nil
215   "If non-nil, play the Gnus jingle at startup."
216   :group 'gnus-start
217   :type 'boolean)
218
219 ;;; Kludges to help the transition from the old `custom.el'.
220
221 (unless (featurep 'gnus-xmas)
222   (defalias 'gnus-make-overlay 'make-overlay)
223   (defalias 'gnus-overlay-put 'overlay-put)
224   (defalias 'gnus-move-overlay 'move-overlay)
225   (defalias 'gnus-overlay-end 'overlay-end)
226   (defalias 'gnus-extent-detached-p 'ignore)
227   (defalias 'gnus-extent-start-open 'ignore)
228   (defalias 'gnus-set-text-properties 'set-text-properties)
229   (defalias 'gnus-group-remove-excess-properties 'ignore)
230   (defalias 'gnus-topic-remove-excess-properties 'ignore)
231   (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
232   (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
233   (defalias 'gnus-add-hook 'add-hook)
234   (defalias 'gnus-character-to-event 'identity)
235   (defalias 'gnus-add-text-properties 'add-text-properties)
236   (defalias 'gnus-put-text-property 'put-text-property)
237   (defalias 'gnus-mode-line-buffer-identification 'identity)
238   (defalias 'gnus-characterp 'numberp)
239   (defalias 'gnus-key-press-event-p 'numberp))
240
241 ;; The XEmacs people think this is evil, so it must go.
242 (defun custom-face-lookup (&optional fg bg stipple bold italic underline)
243   "Lookup or create a face with specified attributes."
244   (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S"
245                               (or fg "default")
246                               (or bg "default")
247                               (or stipple "default")
248                               bold italic underline))))
249     (if (and (custom-facep name)
250              (fboundp 'make-face))
251         ()
252       (copy-face 'default name)
253       (when (and fg
254                  (not (string-equal fg "default")))
255         (ignore-errors
256           (set-face-foreground name fg)))
257       (when (and bg
258                  (not (string-equal bg "default")))
259         (ignore-errors
260           (set-face-background name bg)))
261       (when (and stipple
262                  (not (string-equal stipple "default"))
263                  (not (eq stipple 'custom:asis))
264                  (fboundp 'set-face-stipple))
265         (set-face-stipple name stipple))
266       (when (and bold
267                  (not (eq bold 'custom:asis)))
268         (ignore-errors
269           (make-face-bold name)))
270       (when (and italic
271                  (not (eq italic 'custom:asis)))
272         (ignore-errors
273           (make-face-italic name)))
274       (when (and underline
275                  (not (eq underline 'custom:asis)))
276         (ignore-errors
277           (set-face-underline-p name t))))
278     name))
279
280 ;; We define these group faces here to avoid the display
281 ;; update forced when creating new faces.
282
283 (defface gnus-group-news-1-face 
284   '((((class color)
285       (background dark))
286      (:foreground "PaleTurquoise" :bold t))
287     (((class color)
288       (background light))
289      (:foreground "ForestGreen" :bold t))
290     (t
291      ()))
292   "Level 1 newsgroup face.")
293
294 (defface gnus-group-news-1-empty-face
295   '((((class color)
296       (background dark))
297      (:foreground "PaleTurquoise"))
298     (((class color)
299       (background light))
300      (:foreground "ForestGreen"))
301     (t
302      ()))
303   "Level 1 empty newsgroup face.")
304
305 (defface gnus-group-news-2-face 
306   '((((class color)
307       (background dark))
308      (:foreground "turquoise" :bold t))
309     (((class color)
310       (background light))
311      (:foreground "CadetBlue4" :bold t))
312     (t
313      ()))
314   "Level 2 newsgroup face.")
315
316 (defface gnus-group-news-2-empty-face
317   '((((class color)
318       (background dark))
319      (:foreground "turquoise"))
320     (((class color)
321       (background light))
322      (:foreground "CadetBlue4"))
323     (t
324      ()))
325   "Level 2 empty newsgroup face.")
326
327 (defface gnus-group-news-3-face 
328   '((((class color)
329       (background dark))
330      (:bold t))
331     (((class color)
332       (background light))
333      (:bold t))
334     (t
335      ()))
336   "Level 3 newsgroup face.")
337
338 (defface gnus-group-news-3-empty-face
339   '((((class color)
340       (background dark))
341      ())
342     (((class color)
343       (background light))
344      ())
345     (t
346      ()))
347   "Level 3 empty newsgroup face.")
348
349 (defface gnus-group-news-low-face 
350   '((((class color)
351       (background dark))
352      (:foreground "DarkTurquoise" :bold t))
353     (((class color)
354       (background light))
355      (:foreground "DarkGreen" :bold t))
356     (t
357      ()))
358   "Low level newsgroup face.")
359
360 (defface gnus-group-news-low-empty-face
361   '((((class color)
362       (background dark))
363      (:foreground "DarkTurquoise"))
364     (((class color)
365       (background light))
366      (:foreground "DarkGreen"))
367     (t
368      ()))
369   "Low level empty newsgroup face.")
370
371 (defface gnus-group-mail-1-face 
372   '((((class color)
373       (background dark))
374      (:foreground "aquamarine1" :bold t))
375     (((class color)
376       (background light))
377      (:foreground "DeepPink3" :bold t))
378     (t
379      (:bold t)))
380   "Level 1 mailgroup face.")
381
382 (defface gnus-group-mail-1-empty-face
383   '((((class color)
384       (background dark))
385      (:foreground "aquamarine1"))
386     (((class color)
387       (background light))
388      (:foreground "DeepPink3"))
389     (t
390      (:italic t :bold t)))
391   "Level 1 empty mailgroup face.")
392
393 (defface gnus-group-mail-2-face 
394   '((((class color)
395       (background dark))
396      (:foreground "aquamarine2" :bold t))
397     (((class color)
398       (background light))
399      (:foreground "HotPink3" :bold t))
400     (t
401      (:bold t)))
402   "Level 2 mailgroup face.")
403
404 (defface gnus-group-mail-2-empty-face
405   '((((class color)
406       (background dark))
407      (:foreground "aquamarine2"))
408     (((class color)
409       (background light))
410      (:foreground "HotPink3"))
411     (t
412      (:bold t)))
413   "Level 2 empty mailgroup face.")
414
415 (defface gnus-group-mail-3-face 
416   '((((class color)
417       (background dark))
418      (:foreground "aquamarine3" :bold t))
419     (((class color)
420       (background light))
421      (:foreground "magenta4" :bold t))
422     (t
423      (:bold t)))
424   "Level 3 mailgroup face.")
425
426 (defface gnus-group-mail-3-empty-face
427   '((((class color)
428       (background dark))
429      (:foreground "aquamarine3"))
430     (((class color)
431       (background light))
432      (:foreground "magenta4"))
433     (t
434      ()))
435   "Level 3 empty mailgroup face.")
436
437 (defface gnus-group-mail-low-face 
438   '((((class color)
439       (background dark))
440      (:foreground "aquamarine4" :bold t))
441     (((class color)
442       (background light))
443      (:foreground "DeepPink4" :bold t))
444     (t
445      (:bold t)))
446   "Low level mailgroup face.")
447
448 (defface gnus-group-mail-low-empty-face
449   '((((class color)
450       (background dark))
451      (:foreground "aquamarine4"))
452     (((class color)
453       (background light))
454      (:foreground "DeepPink4"))
455     (t
456      (:bold t)))
457   "Low level empty mailgroup face.")
458
459 ;; Summary mode faces.
460
461 (defface gnus-summary-selected-face '((t 
462                                        (:underline t)))
463   "Face used for selected articles.")
464
465 (defface gnus-summary-cancelled-face 
466   '((((class color))
467      (:foreground "yellow" :background "black")))
468   "Face used for cancelled articles.")
469
470 (defface gnus-summary-high-ticked-face
471   '((((class color)
472       (background dark))
473      (:foreground "pink" :bold t))
474     (((class color)
475       (background light))
476      (:foreground "firebrick" :bold t))
477     (t 
478      (:bold t)))
479   "Face used for high interest ticked articles.")
480
481 (defface gnus-summary-low-ticked-face
482   '((((class color)
483       (background dark))
484      (:foreground "pink" :italic t))
485     (((class color)
486       (background light))
487      (:foreground "firebrick" :italic t))
488     (t 
489      (:italic t)))
490   "Face used for low interest ticked articles.")
491
492 (defface gnus-summary-normal-ticked-face
493   '((((class color)
494       (background dark))
495      (:foreground "pink"))
496     (((class color)
497       (background light))
498      (:foreground "firebrick"))
499     (t 
500      ()))
501   "Face used for normal interest ticked articles.")
502   
503 (defface gnus-summary-high-ancient-face
504   '((((class color)
505       (background dark))
506      (:foreground "SkyBlue" :bold t))
507     (((class color)
508       (background light))
509      (:foreground "RoyalBlue" :bold t))
510     (t 
511      (:bold t)))
512   "Face used for high interest ancient articles.")
513
514 (defface gnus-summary-low-ancient-face
515   '((((class color)
516       (background dark))
517      (:foreground "SkyBlue" :italic t))
518     (((class color)
519       (background light))
520      (:foreground "RoyalBlue" :italic t))
521     (t 
522      (:italic t)))
523   "Face used for low interest ancient articles.")
524
525 (defface gnus-summary-normal-ancient-face
526   '((((class color)
527       (background dark))
528      (:foreground "SkyBlue"))
529     (((class color)
530       (background light))
531      (:foreground "RoyalBlue"))
532     (t 
533      ()))
534   "Face used for normal interest ancient articles.")
535   
536 (defface gnus-summary-high-unread-face
537   '((t 
538      (:bold t)))
539   "Face used for high interest unread articles.")
540
541 (defface gnus-summary-low-unread-face
542   '((t 
543      (:italic t)))
544   "Face used for low interest unread articles.")
545
546 (defface gnus-summary-normal-unread-face
547   '((t 
548      ()))
549   "Face used for normal interest unread articles.")
550   
551 (defface gnus-summary-high-read-face
552   '((((class color)
553       (background dark))
554      (:foreground "PaleGreen"
555                   :bold t))
556     (((class color)
557       (background light))
558      (:foreground "DarkGreen"
559                   :bold t))
560     (t 
561      (:bold t)))
562   "Face used for high interest read articles.")
563
564 (defface gnus-summary-low-read-face
565   '((((class color)
566       (background dark))
567      (:foreground "PaleGreen"
568                   :italic t))
569     (((class color)
570       (background light))
571      (:foreground "DarkGreen"
572                   :italic t))
573     (t 
574      (:italic t)))
575   "Face used for low interest read articles.")
576
577 (defface gnus-summary-normal-read-face
578   '((((class color)
579       (background dark))
580      (:foreground "PaleGreen"))
581     (((class color)
582       (background light))
583      (:foreground "DarkGreen"))
584     (t 
585      ()))
586   "Face used for normal interest read articles.")
587
588
589 ;;; Splash screen.
590
591 (defvar gnus-group-buffer "*Group*")
592
593 (eval-and-compile
594   (autoload 'gnus-play-jingle "gnus-audio"))
595
596 (defface gnus-splash-face 
597   '((((class color)
598       (background dark))
599      (:foreground "red"))
600     (((class color)
601       (background light))
602      (:foreground "red"))
603     (t
604      ()))
605   "Level 1 newsgroup face.")
606
607 (defun gnus-splash ()
608   (save-excursion
609     (switch-to-buffer gnus-group-buffer)
610     (let ((buffer-read-only nil))
611       (erase-buffer)
612       (unless gnus-inhibit-startup-message
613         (gnus-group-startup-message)
614         (sit-for 0)
615         (when gnus-play-startup-jingle
616           (gnus-play-jingle))))))
617
618 (defun gnus-indent-rigidly (start end arg)
619   "Indent rigidly using only spaces and no tabs."
620   (save-excursion
621     (save-restriction
622       (narrow-to-region start end)
623       (indent-rigidly start end arg)
624       ;; We translate tabs into spaces -- not everybody uses
625       ;; an 8-character tab.
626       (goto-char (point-min))
627       (while (search-forward "\t" nil t)
628         (replace-match "        " t t)))))
629
630 (defvar gnus-simple-splash nil)
631
632 (defun gnus-group-startup-message (&optional x y)
633   "Insert startup message in current buffer."
634   ;; Insert the message.
635   (erase-buffer)
636   (insert
637    (format "              %s
638           _    ___ _             _
639           _ ___ __ ___  __    _ ___
640           __   _     ___    __  ___
641               _           ___     _
642              _  _ __             _
643              ___   __            _
644                    __           _
645                     _      _   _
646                    _      _    _
647                       _  _    _
648                   __  ___
649                  _   _ _     _
650                 _   _
651               _    _
652              _    _
653             _
654           __
655
656 "
657            ""))
658   ;; And then hack it.
659   (gnus-indent-rigidly (point-min) (point-max)
660                        (/ (max (- (window-width) (or x 46)) 0) 2))
661   (goto-char (point-min))
662   (forward-line 1)
663   (let* ((pheight (count-lines (point-min) (point-max)))
664          (wheight (window-height))
665          (rest (- wheight pheight)))
666     (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
667   ;; Fontify some.
668   (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
669   (goto-char (point-min))
670   (setq mode-line-buffer-identification (concat " " gnus-version))
671   (setq gnus-simple-splash t)
672   (set-buffer-modified-p t))
673
674 (eval-when (load)
675   (let ((command (format "%s" this-command)))
676     (when (and (string-match "gnus" command)
677                (not (string-match "gnus-other-frame" command)))
678       (gnus-splash))))
679
680 ;;; Do the rest.
681
682 (require 'custom)
683 (require 'gnus-util)
684 (require 'nnheader)
685
686 (defcustom gnus-directory (or (getenv "SAVEDIR") "~/News/")
687   "Directory variable from which all other Gnus file variables are derived."
688   :group 'gnus-files
689   :type 'directory)
690
691 (defcustom gnus-default-directory nil
692   "*Default directory for all Gnus buffers."
693   :group 'gnus-files
694   :type '(choice (const :tag "current" nil)
695                  directory))
696
697 ;; Site dependent variables.  These variables should be defined in
698 ;; paths.el.
699
700 (defvar gnus-default-nntp-server nil
701   "Specify a default NNTP server.
702 This variable should be defined in paths.el, and should never be set
703 by the user.
704 If you want to change servers, you should use `gnus-select-method'.
705 See the documentation to that variable.")
706
707 ;; Don't touch this variable.
708 (defvar gnus-nntp-service "nntp"
709   "NNTP service name (\"nntp\" or 119).
710 This is an obsolete variable, which is scarcely used.  If you use an
711 nntp server for your newsgroup and want to change the port number
712 used to 899, you would say something along these lines:
713
714  (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
715
716 (defcustom gnus-nntpserver-file "/etc/nntpserver"
717   "A file with only the name of the nntp server in it."
718   :group 'gnus-files
719   :group 'gnus-server
720   :type 'file)
721
722 ;; This function is used to check both the environment variable
723 ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
724 ;; an nntp server name default.
725 (defun gnus-getenv-nntpserver ()
726   (or (getenv "NNTPSERVER")
727       (and (file-readable-p gnus-nntpserver-file)
728            (save-excursion
729              (set-buffer (get-buffer-create " *gnus nntp*"))
730              (buffer-disable-undo (current-buffer))
731              (insert-file-contents gnus-nntpserver-file)
732              (let ((name (buffer-string)))
733                (prog1
734                    (if (string-match "^[ \t\n]*$" name)
735                        nil
736                      name)
737                  (kill-buffer (current-buffer))))))))
738
739 (defcustom gnus-select-method
740   (ignore-errors
741     (nconc
742      (list 'nntp (or (ignore-errors
743                        (gnus-getenv-nntpserver))
744                      (when (and gnus-default-nntp-server
745                                 (not (string= gnus-default-nntp-server "")))
746                        gnus-default-nntp-server)
747                      (system-name)))
748      (if (or (null gnus-nntp-service)
749              (equal gnus-nntp-service "nntp"))
750          nil
751        (list gnus-nntp-service))))
752   "Default method for selecting a newsgroup.
753 This variable should be a list, where the first element is how the
754 news is to be fetched, the second is the address.
755
756 For instance, if you want to get your news via NNTP from
757 \"flab.flab.edu\", you could say:
758
759 \(setq gnus-select-method '(nntp \"flab.flab.edu\"))
760
761 If you want to use your local spool, say:
762
763 \(setq gnus-select-method (list 'nnspool (system-name)))
764
765 If you use this variable, you must set `gnus-nntp-server' to nil.
766
767 There is a lot more to know about select methods and virtual servers -
768 see the manual for details."
769   :group 'gnus-server
770   :type 'gnus-select-method)
771
772 (defcustom gnus-message-archive-method 
773   `(nnfolder
774     "archive"
775     (nnfolder-directory ,(nnheader-concat message-directory "archive"))
776     (nnfolder-active-file 
777      ,(nnheader-concat message-directory "archive/active"))
778     (nnfolder-get-new-mail nil)
779     (nnfolder-inhibit-expiry t))
780   "Method used for archiving messages you've sent.
781 This should be a mail method.
782
783 It's probably not a very effective to change this variable once you've
784 run Gnus once.  After doing that, you must edit this server from the
785 server buffer."
786   :group 'gnus-server
787   :group 'gnus-message
788   :type 'gnus-select-method)
789
790 (defcustom gnus-message-archive-group nil
791   "*Name of the group in which to save the messages you've written.
792 This can either be a string, a list of strings; or an alist
793 of regexps/functions/forms to be evaluated to return a string (or a list
794 of strings).  The functions are called with the name of the current
795 group (or nil) as a parameter.
796
797 If you want to save your mail in one group and the news articles you
798 write in another group, you could say something like:
799
800  \(setq gnus-message-archive-group 
801         '((if (message-news-p)
802               \"misc-news\" 
803             \"misc-mail\")))
804
805 Normally the group names returned by this variable should be
806 unprefixed -- which implicitly means \"store on the archive server\".
807 However, you may wish to store the message on some other server.  In
808 that case, just return a fully prefixed name of the group --
809 \"nnml+private:mail.misc\", for instance."
810   :group 'gnus-message
811   :type '(choice (const :tag "none" nil)
812                  string))
813
814 (defcustom gnus-secondary-servers nil
815   "List of NNTP servers that the user can choose between interactively.
816 To make Gnus query you for a server, you have to give `gnus' a
817 non-numeric prefix - `C-u M-x gnus', in short."
818   :group 'gnus-server
819   :type '(repeat string))
820
821 (defcustom gnus-nntp-server nil
822   "*The name of the host running the NNTP server.
823 This variable is semi-obsolete.  Use the `gnus-select-method'
824 variable instead."
825   :group 'gnus-server
826   :type '(choice (const :tag "disable" nil)
827                  string))
828
829 (defcustom gnus-secondary-select-methods nil
830   "A list of secondary methods that will be used for reading news.
831 This is a list where each element is a complete select method (see
832 `gnus-select-method').
833
834 If, for instance, you want to read your mail with the nnml backend,
835 you could set this variable:
836
837 \(setq gnus-secondary-select-methods '((nnml \"\")))"
838 :group 'gnus-server
839 :type '(repeat gnus-select-method))
840
841 (defvar gnus-backup-default-subscribed-newsgroups
842   '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
843   "Default default new newsgroups the first time Gnus is run.
844 Should be set in paths.el, and shouldn't be touched by the user.")
845
846 (defcustom gnus-local-domain nil
847   "Local domain name without a host name.
848 The DOMAINNAME environment variable is used instead if it is defined.
849 If the `system-name' function returns the full Internet name, there is
850 no need to set this variable."
851   :group 'gnus-message
852   :type '(choice (const :tag "default" nil)
853                  string))
854
855 (defcustom gnus-local-organization nil
856   "String with a description of what organization (if any) the user belongs to.
857 The ORGANIZATION environment variable is used instead if it is defined.
858 If this variable contains a function, this function will be called
859 with the current newsgroup name as the argument.  The function should
860 return a string.
861
862 In any case, if the string (either in the variable, in the environment
863 variable, or returned by the function) is a file name, the contents of
864 this file will be used as the organization."
865   :group 'gnus-message
866   :type '(choice (const :tag "default" nil)
867                  string))
868
869 ;; Customization variables
870
871 (defcustom gnus-refer-article-method nil
872   "Preferred method for fetching an article by Message-ID.
873 If you are reading news from the local spool (with nnspool), fetching
874 articles by Message-ID is painfully slow.  By setting this method to an
875 nntp method, you might get acceptable results.
876
877 The value of this variable must be a valid select method as discussed
878 in the documentation of `gnus-select-method'."
879   :group 'gnus-server
880   :type '(choice (const :tag "default" nil)
881                  gnus-select-method))
882
883 (defcustom gnus-group-faq-directory
884   '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
885     "/ftp@sunsite.auc.dk:/pub/usenet/"
886     "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
887     "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
888     "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
889     "/ftp@rtfm.mit.edu:/pub/usenet/"
890     "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
891     "/ftp@ftp.sunet.se:/pub/usenet/"
892     "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
893     "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
894     "/ftp@ftp.hk.super.net:/mirror/faqs/")
895   "Directory where the group FAQs are stored.
896 This will most commonly be on a remote machine, and the file will be
897 fetched by ange-ftp.
898
899 This variable can also be a list of directories.  In that case, the
900 first element in the list will be used by default.  The others can
901 be used when being prompted for a site.
902
903 Note that Gnus uses an aol machine as the default directory.  If this
904 feels fundamentally unclean, just think of it as a way to finally get
905 something of value back from them.
906
907 If the default site is too slow, try one of these:
908
909    North America: mirrors.aol.com                /pub/rtfm/usenet
910                   ftp.seas.gwu.edu               /pub/rtfm
911                   rtfm.mit.edu                   /pub/usenet
912    Europe:        ftp.uni-paderborn.de           /pub/FAQ
913                   src.doc.ic.ac.uk               /usenet/news-FAQS
914                   ftp.sunet.se                   /pub/usenet
915                   sunsite.auc.dk                 /pub/usenet
916    Asia:          nctuccca.edu.tw                /USENET/FAQ
917                   hwarang.postech.ac.kr          /pub/usenet
918                   ftp.hk.super.net               /mirror/faqs"
919   :group 'gnus-group-various
920   :type '(choice directory
921                  (repeat directory)))
922
923 (defcustom gnus-use-cross-reference t
924   "*Non-nil means that cross referenced articles will be marked as read.
925 If nil, ignore cross references.  If t, mark articles as read in
926 subscribed newsgroups.  If neither t nor nil, mark as read in all
927 newsgroups."
928   :group 'gnus-server
929   :type '(choice (const :tag "off" nil)
930                  (const :tag "subscribed" t)
931                  (sexp :format "all"
932                        :value always)))
933
934 (defcustom gnus-process-mark ?#
935   "*Process mark."
936   :group 'gnus-group-visual
937   :group 'gnus-summary-marks
938   :type 'character)
939
940 (defcustom gnus-asynchronous nil
941   "*If non-nil, Gnus will supply backends with data needed for async article fetching."
942   :group 'gnus-asynchronous
943   :type 'boolean)
944
945 (defcustom gnus-large-newsgroup 200
946   "*The number of articles which indicates a large newsgroup.
947 If the number of articles in a newsgroup is greater than this value,
948 confirmation is required for selecting the newsgroup."
949   :group 'gnus-group-select
950   :type 'integer)
951
952 (defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
953   "*Non-nil means that the default name of a file to save articles in is the group name.
954 If it's nil, the directory form of the group name is used instead.
955
956 If this variable is a list, and the list contains the element
957 `not-score', long file names will not be used for score files; if it
958 contains the element `not-save', long file names will not be used for
959 saving; and if it contains the element `not-kill', long file names
960 will not be used for kill files.
961
962 Note that the default for this variable varies according to what system
963 type you're using.  On `usg-unix-v' and `xenix' this variable defaults
964 to nil while on all other systems it defaults to t."
965   :group 'gnus-start
966   :type 'boolean)
967
968 (defcustom gnus-kill-files-directory gnus-directory
969   "*Name of the directory where kill files will be stored (default \"~/News\")."
970   :group 'gnus-score-files
971   :group 'gnus-score-kill
972   :type 'directory)
973
974 (defcustom gnus-save-score nil
975   "*If non-nil, save group scoring info."
976   :group 'gnus-score-various
977   :group 'gnus-start
978   :type 'boolean)
979
980 (defcustom gnus-use-undo t
981   "*If non-nil, allow undoing in Gnus group mode buffers."
982   :group 'gnus-meta
983   :type 'boolean)
984
985 (defcustom gnus-use-adaptive-scoring nil
986   "*If non-nil, use some adaptive scoring scheme.
987 If a list, then the values `word' and `line' are meaningful.  The
988 former will perform adaption on individual words in the subject
989 header while `line' will perform adaption on several headers."
990   :group 'gnus-meta
991   :group 'gnus-score-adapt
992   :type '(set (const word) (const line)))
993
994 (defcustom gnus-use-cache 'passive
995   "*If nil, Gnus will ignore the article cache.
996 If `passive', it will allow entering (and reading) articles
997 explicitly entered into the cache.  If anything else, use the
998 cache to the full extent of the law."
999   :group 'gnus-meta
1000   :group 'gnus-cache
1001   :type '(choice (const :tag "off" nil)
1002                  (const :tag "passive" passive)
1003                  (const :tag "active" t)))
1004
1005 (defcustom gnus-use-trees nil
1006   "*If non-nil, display a thread tree buffer."
1007   :group 'gnus-meta
1008   :type 'boolean)
1009
1010 (defcustom gnus-use-grouplens nil
1011   "*If non-nil, use GroupLens ratings."
1012   :group 'gnus-meta
1013   :type 'boolean)
1014
1015 (defcustom gnus-keep-backlog nil
1016   "*If non-nil, Gnus will keep read articles for later re-retrieval.
1017 If it is a number N, then Gnus will only keep the last N articles
1018 read.  If it is neither nil nor a number, Gnus will keep all read
1019 articles.  This is not a good idea."
1020   :group 'gnus-meta
1021   :type '(choice (const :tag "off" nil)
1022                  integer
1023                  (sexp :format "all" 
1024                        :value t)))
1025
1026 (defcustom gnus-use-nocem nil
1027   "*If non-nil, Gnus will read NoCeM cancel messages."
1028   :group 'gnus-meta
1029   :type 'boolean)
1030
1031 (defcustom gnus-suppress-duplicates nil
1032   "*If non-nil, Gnus will mark duplicate copies of the same article as read."
1033   :group 'gnus-meta
1034   :type 'boolean)
1035
1036 (defcustom gnus-use-demon nil
1037   "If non-nil, Gnus might use some demons."
1038   :group 'gnus-meta
1039   :type 'boolean)
1040
1041 (defcustom gnus-use-scoring t
1042   "*If non-nil, enable scoring."
1043   :group 'gnus-meta
1044   :type 'boolean)
1045
1046 (defcustom gnus-use-picons nil
1047   "*If non-nil, display picons."
1048   :group 'gnus-meta
1049   :type 'boolean)
1050
1051 (defcustom gnus-summary-prepare-exit-hook 
1052   '(gnus-summary-expire-articles)
1053   "A hook called when preparing to exit from the summary buffer.
1054 It calls `gnus-summary-expire-articles' by default."
1055   :group 'gnus-summary-exit
1056   :type 'hook)
1057
1058 (defcustom gnus-novice-user t
1059   "*Non-nil means that you are a usenet novice.
1060 If non-nil, verbose messages may be displayed and confirmations may be
1061 required."
1062   :group 'gnus-meta
1063   :type 'boolean)
1064
1065 (defcustom gnus-expert-user nil
1066   "*Non-nil means that you will never be asked for confirmation about anything.
1067 And that means *anything*."
1068   :group 'gnus-meta
1069   :type 'boolean)
1070
1071 (defcustom gnus-interactive-catchup t
1072   "*If non-nil, require your confirmation when catching up a group."
1073   :group 'gnus-group-select
1074   :type 'boolean)
1075
1076 (defcustom gnus-interactive-exit t
1077   "*If non-nil, require your confirmation when exiting Gnus."
1078   :group 'gnus-exit
1079   :type 'boolean)
1080
1081 (defcustom gnus-extract-address-components 'gnus-extract-address-components
1082   "*Function for extracting address components from a From header.
1083 Two pre-defined function exist: `gnus-extract-address-components',
1084 which is the default, quite fast, and too simplistic solution, and
1085 `mail-extract-address-components', which works much better, but is
1086 slower."
1087   :group 'gnus-summary-format
1088   :type '(radio (function-item gnus-extract-address-components)
1089                 (function-item mail-extract-address-components)
1090                 (function :tag "Other")))
1091
1092 (defcustom gnus-carpal nil
1093   "*If non-nil, display clickable icons."
1094   :group 'gnus-meta
1095   :type 'boolean)
1096
1097 (defcustom gnus-shell-command-separator ";"
1098   "String used to separate to shell commands."
1099   :group 'gnus-files
1100   :type 'string)
1101
1102 (defcustom gnus-valid-select-methods
1103   '(("nntp" post address prompt-address physical-address)
1104     ("nnspool" post address)
1105     ("nnvirtual" post-mail virtual prompt-address)
1106     ("nnmbox" mail respool address)
1107     ("nnml" mail respool address)
1108     ("nnmh" mail respool address)
1109     ("nndir" post-mail prompt-address physical-address)
1110     ("nneething" none address prompt-address physical-address)
1111     ("nndoc" none address prompt-address)
1112     ("nnbabyl" mail address respool)
1113     ("nnkiboze" post virtual)
1114     ("nnsoup" post-mail address)
1115     ("nndraft" post-mail)
1116     ("nnfolder" mail respool address)
1117     ("nngateway" none address prompt-address physical-address)
1118     ("nnweb" none))
1119   "An alist of valid select methods.
1120 The first element of each list lists should be a string with the name
1121 of the select method.  The other elements may be the category of
1122 this method (i. e., `post', `mail', `none' or whatever) or other
1123 properties that this method has (like being respoolable).
1124 If you implement a new select method, all you should have to change is
1125 this variable.  I think."
1126   :group 'gnus-server
1127   :type '(repeat (group (string :tag "Name")
1128                         (radio-button-choice (const :format "%v " post)
1129                                              (const :format "%v " mail)
1130                                              (const :format "%v " none)
1131                                              (const post-mail))
1132                         (checklist :inline t
1133                                    (const :format "%v " address)
1134                                    (const :format "%v " prompt-address)
1135                                    (const :format "%v " virtual)
1136                                    (const respool)))))
1137
1138 (define-widget 'gnus-select-method 'list
1139   "Widget for entering a select method."
1140   :args `((choice :tag "Method"
1141                   ,@(mapcar (lambda (entry)
1142                               (list 'const :format "%v\n"
1143                                     (intern (car entry))))
1144                             gnus-valid-select-methods))
1145           (string :tag "Address")
1146           (editable-list  :inline t
1147                           (list :format "%v"
1148                                 variable 
1149                                 (sexp :tag "Value")))))
1150
1151 (defcustom gnus-updated-mode-lines '(group article summary tree)
1152   "List of buffers that should update their mode lines.
1153 The list may contain the symbols `group', `article', `tree' and
1154 `summary'.  If the corresponding symbol is present, Gnus will keep
1155 that mode line updated with information that may be pertinent.
1156 If this variable is nil, screen refresh may be quicker."
1157   :group 'gnus-various
1158   :type '(set (const group)
1159               (const article)
1160               (const summary)
1161               (const tree)))
1162
1163 ;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
1164 (defcustom gnus-mode-non-string-length nil
1165   "*Max length of mode-line non-string contents.
1166 If this is nil, Gnus will take space as is needed, leaving the rest
1167 of the modeline intact.  Note that the default of nil is unlikely
1168 to be desirable; see the manual for further details."
1169   :group 'gnus-various
1170   :type '(choice (const nil)
1171                  integer))
1172
1173 (defcustom gnus-auto-expirable-newsgroups nil
1174   "*Groups in which to automatically mark read articles as expirable.
1175 If non-nil, this should be a regexp that should match all groups in
1176 which to perform auto-expiry.  This only makes sense for mail groups."
1177   :group 'gnus-mail-expire
1178   :type '(choice (const nil)
1179                  regexp))
1180
1181 (defcustom gnus-total-expirable-newsgroups nil
1182   "*Groups in which to perform expiry of all read articles.
1183 Use with extreme caution.  All groups that match this regexp will be
1184 expiring - which means that all read articles will be deleted after
1185 \(say) one week.         (This only goes for mail groups and the like, of
1186 course.)"
1187   :group 'gnus-mail-expire
1188   :type '(choice (const nil)
1189                  regexp))
1190
1191 (defcustom gnus-group-uncollapsed-levels 1
1192   "Number of group name elements to leave alone when making a short group name."
1193   :group 'gnus-group-visual
1194   :type 'integer)
1195
1196 (defcustom gnus-group-use-permanent-levels nil
1197   "*If non-nil, once you set a level, Gnus will use this level."
1198   :group 'gnus-group-levels
1199   :type 'boolean)
1200
1201 ;; Hooks.
1202
1203 (defcustom gnus-load-hook nil
1204   "A hook run while Gnus is loaded."
1205   :group 'gnus-start
1206   :type 'hook)
1207
1208 (defcustom gnus-apply-kill-hook '(gnus-apply-kill-file)
1209   "A hook called to apply kill files to a group.
1210 This hook is intended to apply a kill file to the selected newsgroup.
1211 The function `gnus-apply-kill-file' is called by default.
1212
1213 Since a general kill file is too heavy to use only for a few
1214 newsgroups, I recommend you to use a lighter hook function.  For
1215 example, if you'd like to apply a kill file to articles which contains
1216 a string `rmgroup' in subject in newsgroup `control', you can use the
1217 following hook:
1218
1219  (setq gnus-apply-kill-hook
1220       (list
1221         (lambda ()
1222           (cond ((string-match \"control\" gnus-newsgroup-name)
1223                  (gnus-kill \"Subject\" \"rmgroup\")
1224                  (gnus-expunge \"X\"))))))"
1225   :group 'gnus-score-kill
1226   :options '(gnus-apply-kill-file)
1227   :type 'hook)
1228
1229 (defcustom gnus-group-change-level-function nil
1230   "Function run when a group level is changed.
1231 It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
1232   :group 'gnus-group-level
1233   :type 'function)
1234
1235 ;;; Face thingies.
1236
1237 (defcustom gnus-visual 
1238   '(summary-highlight group-highlight article-highlight 
1239                       mouse-face
1240                       summary-menu group-menu article-menu
1241                       tree-highlight menu highlight
1242                       browse-menu server-menu
1243                       page-marker tree-menu binary-menu pick-menu
1244                       grouplens-menu)
1245   "Enable visual features.
1246 If `visual' is disabled, there will be no menus and few faces.  Most of
1247 the visual customization options below will be ignored.  Gnus will use
1248 less space and be faster as a result.
1249
1250 This variable can also be a list of visual elements to switch on.  For
1251 instance, to switch off all visual things except menus, you can say:
1252
1253    (setq gnus-visual '(menu))
1254
1255 Valid elements include `summary-highlight', `group-highlight',
1256 `article-highlight', `mouse-face', `summary-menu', `group-menu',
1257 `article-menu', `tree-highlight', `menu', `highlight', `browse-menu',
1258 `server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu',
1259 and `grouplens-menu'."
1260   :group 'gnus-meta
1261   :group 'gnus-visual
1262   :type '(set (const summary-highlight)
1263               (const group-highlight)
1264               (const article-highlight)
1265               (const mouse-face)
1266               (const summary-menu)
1267               (const group-menu)
1268               (const article-menu)
1269               (const tree-highlight)
1270               (const menu)
1271               (const highlight)
1272               (const browse-menu)
1273               (const server-menu)
1274               (const page-marker)
1275               (const tree-menu)
1276               (const binary-menu)
1277               (const pick-menu)
1278               (const grouplens-menu)))
1279
1280 (defcustom gnus-mouse-face
1281   (condition-case ()
1282       (if (gnus-visual-p 'mouse-face 'highlight)
1283           (if (boundp 'gnus-mouse-face)
1284               (or gnus-mouse-face 'highlight)
1285             'highlight)
1286         'default)
1287     (error 'highlight))
1288   "Face used for group or summary buffer mouse highlighting.
1289 The line beneath the mouse pointer will be highlighted with this
1290 face."
1291   :group 'gnus-visual
1292   :type 'face)
1293
1294 (defcustom gnus-article-display-hook
1295   (if (and (string-match "XEmacs" emacs-version)
1296            (featurep 'xface))
1297       '(gnus-article-hide-headers-if-wanted
1298         gnus-article-hide-boring-headers
1299         gnus-article-treat-overstrike
1300         gnus-article-maybe-highlight
1301         gnus-article-display-x-face)
1302     '(gnus-article-hide-headers-if-wanted
1303       gnus-article-hide-boring-headers
1304       gnus-article-treat-overstrike
1305       gnus-article-maybe-highlight))
1306   "Controls how the article buffer will look.
1307
1308 If you leave the list empty, the article will appear exactly as it is
1309 stored on the disk.  The list entries will hide or highlight various
1310 parts of the article, making it easier to find the information you
1311 want."
1312   :group 'gnus-article-highlight
1313   :group 'gnus-visual
1314   :type 'hook
1315   :options '(gnus-article-add-buttons
1316              gnus-article-add-buttons-to-head
1317              gnus-article-emphasize
1318              gnus-article-fill-cited-article
1319              gnus-article-remove-cr
1320              gnus-article-de-quoted-unreadable
1321              gnus-article-display-x-face
1322              gnus-summary-stop-page-breaking
1323              ;; gnus-summary-caesar-message
1324              ;; gnus-summary-verbose-headers
1325              gnus-summary-toggle-mime
1326              gnus-article-hide
1327              gnus-article-hide-headers
1328              gnus-article-hide-boring-headers
1329              gnus-article-hide-signature
1330              gnus-article-hide-citation
1331              gnus-article-hide-pgp
1332              gnus-article-hide-pem
1333              gnus-article-highlight
1334              gnus-article-highlight-headers
1335              gnus-article-highlight-citation
1336              gnus-article-highlight-signature
1337              gnus-article-date-ut
1338              gnus-article-date-local
1339              gnus-article-date-lapsed
1340              gnus-article-date-original
1341              gnus-article-remove-trailing-blank-lines
1342              gnus-article-strip-leading-blank-lines
1343              gnus-article-strip-multiple-blank-lines
1344              gnus-article-strip-blank-lines
1345              gnus-article-treat-overstrike
1346              ))
1347
1348 \f
1349 ;;; Internal variables
1350
1351 (defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
1352 (defvar gnus-original-article-buffer " *Original Article*")
1353 (defvar gnus-newsgroup-name nil)
1354
1355 (defvar gnus-current-select-method nil
1356   "The current method for selecting a newsgroup.")
1357
1358 (defvar gnus-tree-buffer "*Tree*"
1359   "Buffer where Gnus thread trees are displayed.")
1360
1361 ;; Dummy variable.
1362 (defvar gnus-use-generic-from nil)
1363
1364 ;; Variable holding the user answers to all method prompts.
1365 (defvar gnus-method-history nil)
1366 (defvar gnus-group-history nil)
1367
1368 ;; Variable holding the user answers to all mail method prompts.
1369 (defvar gnus-mail-method-history nil)
1370
1371 ;; Variable holding the user answers to all group prompts.
1372 (defvar gnus-group-history nil)
1373
1374 (defvar gnus-server-alist nil
1375   "List of available servers.")
1376
1377 (defvar gnus-predefined-server-alist
1378   `(("cache"
1379      (nnspool "cache"
1380               (nnspool-spool-directory "~/News/cache/")
1381               (nnspool-nov-directory "~/News/cache/")
1382               (nnspool-active-file "~/News/cache/active"))))
1383   "List of predefined (convenience) servers.")
1384
1385 (defvar gnus-topic-indentation "") ;; Obsolete variable.
1386
1387 (defconst gnus-article-mark-lists
1388   '((marked . tick) (replied . reply)
1389     (expirable . expire) (killed . killed)
1390     (bookmarks . bookmark) (dormant . dormant)
1391     (scored . score) (saved . save)
1392     (cached . cache)))
1393
1394 (defvar gnus-headers-retrieved-by nil)
1395 (defvar gnus-article-reply nil)
1396 (defvar gnus-override-method nil)
1397 (defvar gnus-article-check-size nil)
1398 (defvar gnus-opened-servers nil)
1399
1400 (defvar gnus-current-kill-article nil)
1401
1402 (defvar gnus-have-read-active-file nil)
1403
1404 (defconst gnus-maintainer
1405   "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
1406   "The mail address of the Gnus maintainers.")
1407
1408 (defvar gnus-info-nodes
1409   '((gnus-group-mode "(gnus)The Group Buffer")
1410     (gnus-summary-mode "(gnus)The Summary Buffer")
1411     (gnus-article-mode "(gnus)The Article Buffer")
1412     (mime/viewer-mode "(gnus)The Article Buffer")
1413     (gnus-server-mode "(gnus)The Server Buffer")
1414     (gnus-browse-mode "(gnus)Browse Foreign Server")
1415     (gnus-tree-mode "(gnus)Tree Display"))
1416   "Alist of major modes and related Info nodes.")
1417
1418 (defvar gnus-group-buffer "*Group*")
1419 (defvar gnus-summary-buffer "*Summary*")
1420 (defvar gnus-article-buffer "*Article*")
1421 (defvar gnus-server-buffer "*Server*")
1422
1423 (defvar gnus-buffer-list nil
1424   "Gnus buffers that should be killed on exit.")
1425
1426 (defvar gnus-slave nil
1427   "Whether this Gnus is a slave or not.")
1428
1429 (defvar gnus-batch-mode nil
1430   "Whether this Gnus is running in batch mode or not.")
1431
1432 (defvar gnus-variable-list
1433   '(gnus-newsrc-options gnus-newsrc-options-n
1434     gnus-newsrc-last-checked-date
1435     gnus-newsrc-alist gnus-server-alist
1436     gnus-killed-list gnus-zombie-list
1437     gnus-topic-topology gnus-topic-alist
1438     gnus-format-specs)
1439   "Gnus variables saved in the quick startup file.")
1440
1441 (defvar gnus-newsrc-alist nil
1442   "Assoc list of read articles.
1443 gnus-newsrc-hashtb should be kept so that both hold the same information.")
1444
1445 (defvar gnus-newsrc-hashtb nil
1446   "Hashtable of gnus-newsrc-alist.")
1447
1448 (defvar gnus-killed-list nil
1449   "List of killed newsgroups.")
1450
1451 (defvar gnus-killed-hashtb nil
1452   "Hash table equivalent of gnus-killed-list.")
1453
1454 (defvar gnus-zombie-list nil
1455   "List of almost dead newsgroups.")
1456
1457 (defvar gnus-description-hashtb nil
1458   "Descriptions of newsgroups.")
1459
1460 (defvar gnus-list-of-killed-groups nil
1461   "List of newsgroups that have recently been killed by the user.")
1462
1463 (defvar gnus-active-hashtb nil
1464   "Hashtable of active articles.")
1465
1466 (defvar gnus-moderated-hashtb nil
1467   "Hashtable of moderated newsgroups.")
1468
1469 ;; Save window configuration.
1470 (defvar gnus-prev-winconf nil)
1471
1472 (defvar gnus-reffed-article-number nil)
1473
1474 ;;; Let the byte-compiler know that we know about this variable.
1475 (defvar rmail-default-rmail-file)
1476
1477 (defvar gnus-dead-summary nil)
1478
1479 ;;; End of variables.
1480
1481 ;; Define some autoload functions Gnus might use.
1482 (eval-and-compile
1483
1484   ;; This little mapcar goes through the list below and marks the
1485   ;; symbols in question as autoloaded functions.
1486   (mapcar
1487    (lambda (package)
1488      (let ((interactive (nth 1 (memq ':interactive package))))
1489        (mapcar
1490         (lambda (function)
1491           (let (keymap)
1492             (when (consp function)
1493               (setq keymap (car (memq 'keymap function)))
1494               (setq function (car function)))
1495             (autoload function (car package) nil interactive keymap)))
1496         (if (eq (nth 1 package) ':interactive)
1497             (cdddr package)
1498           (cdr package)))))
1499    '(("metamail" metamail-buffer)
1500      ("info" Info-goto-node)
1501      ("hexl" hexl-hex-string-to-integer)
1502      ("pp" pp pp-to-string pp-eval-expression)
1503      ("ps-print" ps-print-preprint)
1504      ("mail-extr" mail-extract-address-components)
1505      ("message" :interactive t
1506       message-send-and-exit message-yank-original)
1507      ("nnmail" nnmail-split-fancy nnmail-article-group nnmail-date-to-time)
1508      ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
1509      ("timezone" timezone-make-date-arpa-standard timezone-fix-time
1510       timezone-make-sortable-date timezone-make-time-string)
1511      ("rmailout" rmail-output)
1512      ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
1513       rmail-show-message)
1514      ("gnus-audio" :interactive t gnus-audio-play)
1515      ("gnus-xmas" gnus-xmas-splash)
1516      ("gnus-soup" :interactive t
1517       gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
1518       gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
1519      ("nnsoup" nnsoup-pack-replies)
1520      ("score-mode" :interactive t gnus-score-mode)
1521      ("gnus-mh" gnus-summary-save-article-folder
1522       gnus-Folder-save-name gnus-folder-save-name)
1523      ("gnus-mh" :interactive t gnus-summary-save-in-folder)
1524      ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
1525       gnus-demon-add-rescan gnus-demon-add-scan-timestamps
1526       gnus-demon-add-disconnection gnus-demon-add-handler
1527       gnus-demon-remove-handler)
1528      ("gnus-demon" :interactive t
1529       gnus-demon-init gnus-demon-cancel)
1530      ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
1531       gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
1532      ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
1533       gnus-nocem-unwanted-article-p)
1534      ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
1535      ("gnus-srvr" gnus-browse-foreign-server)
1536      ("gnus-cite" :interactive t
1537       gnus-article-highlight-citation gnus-article-hide-citation-maybe
1538       gnus-article-hide-citation gnus-article-fill-cited-article
1539       gnus-article-hide-citation-in-followups)
1540      ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
1541       gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
1542       gnus-execute gnus-expunge)
1543      ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
1544       gnus-cache-possibly-remove-articles gnus-cache-request-article
1545       gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
1546       gnus-cache-enter-remove-article gnus-cached-article-p
1547       gnus-cache-open gnus-cache-close gnus-cache-update-article)
1548       ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
1549        gnus-cache-remove-article gnus-summary-insert-cached-articles)
1550       ("gnus-score" :interactive t
1551        gnus-summary-increase-score gnus-summary-set-score
1552        gnus-summary-raise-thread gnus-summary-raise-same-subject
1553        gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
1554        gnus-summary-lower-thread gnus-summary-lower-same-subject
1555        gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
1556        gnus-summary-current-score gnus-score-default
1557        gnus-score-flush-cache gnus-score-close
1558        gnus-possibly-score-headers gnus-score-followup-article
1559        gnus-score-followup-thread)
1560       ("gnus-score"
1561        (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
1562       gnus-current-score-file-nondirectory gnus-score-adaptive
1563       gnus-score-find-trace gnus-score-file-name)
1564      ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize)
1565      ("gnus-topic" :interactive t gnus-topic-mode)
1566      ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters)
1567      ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
1568      ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
1569      ("gnus-uu" :interactive t
1570       gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
1571       gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
1572       gnus-uu-mark-by-regexp gnus-uu-mark-all
1573       gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
1574       gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
1575       gnus-uu-decode-unshar-and-save gnus-uu-decode-save
1576       gnus-uu-decode-binhex gnus-uu-decode-uu-view
1577       gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
1578       gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
1579       gnus-uu-decode-binhex-view)
1580      ("gnus-uu" gnus-uu-delete-work-dir)
1581      ("gnus-msg" (gnus-summary-send-map keymap)
1582       gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
1583      ("gnus-msg" :interactive t
1584       gnus-group-post-news gnus-group-mail gnus-summary-post-news
1585       gnus-summary-followup gnus-summary-followup-with-original
1586       gnus-summary-cancel-article gnus-summary-supersede-article
1587       gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
1588       gnus-summary-mail-forward gnus-summary-mail-other-window
1589       gnus-summary-resend-message gnus-summary-resend-bounced-mail
1590       gnus-bug)
1591      ("gnus-picon" :interactive t gnus-article-display-picons
1592       gnus-group-display-picons gnus-picons-article-display-x-face
1593       gnus-picons-display-x-face)
1594      ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p 
1595       gnus-grouplens-mode)
1596      ("smiley" :interactive t gnus-smiley-display)
1597      ("gnus-win" gnus-configure-windows gnus-add-configuration)
1598      ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
1599       gnus-list-of-unread-articles gnus-list-of-read-articles
1600       gnus-offer-save-summaries gnus-make-thread-indent-array
1601       gnus-summary-exit gnus-update-read-articles)
1602      ("gnus-group" gnus-group-insert-group-line gnus-group-quit
1603       gnus-group-list-groups gnus-group-first-unread-group
1604       gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
1605       gnus-group-setup-buffer gnus-group-get-new-news
1606       gnus-group-make-help-group gnus-group-update-group)
1607      ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article
1608       gnus-backlog-remove-article)
1609      ("gnus-art" gnus-article-read-summary-keys gnus-article-save
1610       gnus-article-prepare gnus-article-set-window-start
1611       gnus-article-next-page gnus-article-prev-page
1612       gnus-request-article-this-buffer gnus-article-mode
1613       gnus-article-setup-buffer gnus-narrow-to-page)
1614      ("gnus-art" :interactive t
1615       gnus-article-hide-headers gnus-article-hide-boring-headers
1616       gnus-article-treat-overstrike gnus-article-word-wrap
1617       gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
1618       gnus-article-display-x-face gnus-article-de-quoted-unreadable
1619       gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp
1620       gnus-article-hide-pem gnus-article-hide-signature
1621       gnus-article-strip-leading-blank-lines gnus-article-date-local
1622       gnus-article-date-original gnus-article-date-lapsed
1623       gnus-article-show-all-headers 
1624       gnus-article-edit-mode gnus-article-edit-article
1625       gnus-article-edit-done gnus-decode-rfc1522 article-decode-rfc1522)
1626      ("gnus-int" gnus-request-type)
1627      ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
1628       gnus-dribble-enter)
1629      ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article
1630       gnus-dup-enter-articles)
1631      ("gnus-range" gnus-copy-sequence)
1632      ("gnus-eform" gnus-edit-form)
1633      ("gnus-move" :interactive t
1634       gnus-group-move-group-to-server gnus-change-server)
1635      ("gnus-logic" gnus-score-advanced)
1636      ("gnus-undo" gnus-undo-mode gnus-undo-register)
1637      ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
1638       gnus-async-prefetch-article gnus-async-prefetch-remove-group
1639       gnus-async-halt-prefetch)
1640      ("gnus-vm" :interactive t gnus-summary-save-in-vm
1641       gnus-summary-save-article-vm))))
1642
1643 ;;; gnus-sum.el thingies
1644
1645
1646 (defcustom gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
1647   "*The format specification of the lines in the summary buffer.
1648
1649 It works along the same lines as a normal formatting string,
1650 with some simple extensions.
1651
1652 %N   Article number, left padded with spaces (string)
1653 %S   Subject (string)
1654 %s   Subject if it is at the root of a thread, and \"\" otherwise (string)
1655 %n   Name of the poster (string)
1656 %a   Extracted name of the poster (string)
1657 %A   Extracted address of the poster (string)
1658 %F   Contents of the From: header (string)
1659 %x   Contents of the Xref: header (string)
1660 %D   Date of the article (string)
1661 %d   Date of the article (string) in DD-MMM format
1662 %M   Message-id of the article (string)
1663 %r   References of the article (string)
1664 %c   Number of characters in the article (integer)
1665 %L   Number of lines in the article (integer)
1666 %I   Indentation based on thread level (a string of spaces)
1667 %T   A string with two possible values: 80 spaces if the article
1668      is on thread level two or larger and 0 spaces on level one
1669 %R   \"A\" if this article has been replied to, \" \" otherwise (character)
1670 %U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
1671 %[   Opening bracket (character, \"[\" or \"<\")
1672 %]   Closing bracket (character, \"]\" or \">\")
1673 %>   Spaces of length thread-level (string)
1674 %<   Spaces of length (- 20 thread-level) (string)
1675 %i   Article score (number)
1676 %z   Article zcore (character)
1677 %t   Number of articles under the current thread (number).
1678 %e   Whether the thread is empty or not (character).
1679 %l   GroupLens score (string).
1680 %V   Total thread score (number).
1681 %P   The line number (number).
1682 %u   User defined specifier.  The next character in the format string should
1683      be a letter.  Gnus will call the function gnus-user-format-function-X,
1684      where X is the letter following %u.  The function will be passed the
1685      current header as argument.  The function should return a string, which
1686      will be inserted into the summary just like information from any other
1687      summary specifier.
1688
1689 Text between %( and %) will be highlighted with `gnus-mouse-face'
1690 when the mouse point is placed inside the area.  There can only be one
1691 such area.
1692
1693 The %U (status), %R (replied) and %z (zcore) specs have to be handled
1694 with care.  For reasons of efficiency, Gnus will compute what column
1695 these characters will end up in, and \"hard-code\" that.  This means that
1696 it is illegal to have these specs after a variable-length spec.  Well,
1697 you might not be arrested, but your summary buffer will look strange,
1698 which is bad enough.
1699
1700 The smart choice is to have these specs as for to the left as
1701 possible.
1702
1703 This restriction may disappear in later versions of Gnus."
1704   :type 'string
1705   :group 'gnus-summary-format)
1706
1707 ;;;
1708 ;;; Skeleton keymaps
1709 ;;;
1710
1711 (defun gnus-suppress-keymap (keymap)
1712   (suppress-keymap keymap)
1713   (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2 
1714     (while keys
1715       (define-key keymap (pop keys) 'undefined))))
1716
1717 (defvar gnus-article-mode-map
1718   (let ((keymap (make-keymap)))
1719     (gnus-suppress-keymap keymap)
1720     keymap))
1721 (defvar gnus-summary-mode-map 
1722   (let ((keymap (make-keymap)))
1723     (gnus-suppress-keymap keymap)
1724     keymap))
1725 (defvar gnus-group-mode-map
1726   (let ((keymap (make-keymap)))
1727     (gnus-suppress-keymap keymap)
1728     keymap))
1729
1730 \f
1731
1732 ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
1733 ;; If you want the cursor to go somewhere else, set these two
1734 ;; functions in some startup hook to whatever you want.
1735 (defalias 'gnus-summary-position-point 'gnus-goto-colon)
1736 (defalias 'gnus-group-position-point 'gnus-goto-colon)
1737
1738 ;;; Various macros and substs.
1739
1740 (defun gnus-header-from (header)
1741   (mail-header-from header))
1742
1743 (defmacro gnus-gethash (string hashtable)
1744   "Get hash value of STRING in HASHTABLE."
1745   `(symbol-value (intern-soft ,string ,hashtable)))
1746
1747 (defmacro gnus-sethash (string value hashtable)
1748   "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
1749   `(set (intern ,string ,hashtable) ,value))
1750 (put 'gnus-sethash 'edebug-form-spec '(form form form))
1751
1752 (defmacro gnus-group-unread (group)
1753   "Get the currently computed number of unread articles in GROUP."
1754   `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
1755
1756 (defmacro gnus-group-entry (group)
1757   "Get the newsrc entry for GROUP."
1758   `(gnus-gethash ,group gnus-newsrc-hashtb))
1759
1760 (defmacro gnus-active (group)
1761   "Get active info on GROUP."
1762   `(gnus-gethash ,group gnus-active-hashtb))
1763
1764 (defmacro gnus-set-active (group active)
1765   "Set GROUP's active info."
1766   `(gnus-sethash ,group ,active gnus-active-hashtb))
1767
1768 (defun gnus-alive-p ()
1769   "Say whether Gnus is running or not."
1770   (and gnus-group-buffer
1771        (get-buffer gnus-group-buffer)
1772        (save-excursion
1773          (set-buffer gnus-group-buffer)
1774          (eq major-mode 'gnus-group-mode))))
1775
1776 ;; Info access macros.
1777
1778 (defmacro gnus-info-group (info)
1779   `(nth 0 ,info))
1780 (defmacro gnus-info-rank (info)
1781   `(nth 1 ,info))
1782 (defmacro gnus-info-read (info)
1783   `(nth 2 ,info))
1784 (defmacro gnus-info-marks (info)
1785   `(nth 3 ,info))
1786 (defmacro gnus-info-method (info)
1787   `(nth 4 ,info))
1788 (defmacro gnus-info-params (info)
1789   `(nth 5 ,info))
1790
1791 (defmacro gnus-info-level (info)
1792   `(let ((rank (gnus-info-rank ,info)))
1793      (if (consp rank)
1794          (car rank)
1795        rank)))
1796 (defmacro gnus-info-score (info)
1797   `(let ((rank (gnus-info-rank ,info)))
1798      (or (and (consp rank) (cdr rank)) 0)))
1799
1800 (defmacro gnus-info-set-group (info group)
1801   `(setcar ,info ,group))
1802 (defmacro gnus-info-set-rank (info rank)
1803   `(setcar (nthcdr 1 ,info) ,rank))
1804 (defmacro gnus-info-set-read (info read)
1805   `(setcar (nthcdr 2 ,info) ,read))
1806 (defmacro gnus-info-set-marks (info marks &optional extend)
1807   (if extend
1808       `(gnus-info-set-entry ,info ,marks 3)
1809     `(setcar (nthcdr 3 ,info) ,marks)))
1810 (defmacro gnus-info-set-method (info method &optional extend)
1811   (if extend
1812       `(gnus-info-set-entry ,info ,method 4)
1813     `(setcar (nthcdr 4 ,info) ,method)))
1814 (defmacro gnus-info-set-params (info params &optional extend)
1815   (if extend
1816       `(gnus-info-set-entry ,info ,params 5)
1817     `(setcar (nthcdr 5 ,info) ,params)))
1818
1819 (defun gnus-info-set-entry (info entry number)
1820   ;; Extend the info until we have enough elements.
1821   (while (<= (length info) number)
1822     (nconc info (list nil)))
1823   ;; Set the entry.
1824   (setcar (nthcdr number info) entry))
1825
1826 (defmacro gnus-info-set-level (info level)
1827   `(let ((rank (cdr ,info)))
1828      (if (consp (car rank))
1829          (setcar (car rank) ,level)
1830        (setcar rank ,level))))
1831 (defmacro gnus-info-set-score (info score)
1832   `(let ((rank (cdr ,info)))
1833      (if (consp (car rank))
1834          (setcdr (car rank) ,score)
1835        (setcar rank (cons (car rank) ,score)))))
1836
1837 (defmacro gnus-get-info (group)
1838   `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
1839
1840 ;; Byte-compiler warning.
1841 (defvar gnus-visual)
1842 ;; Find out whether the gnus-visual TYPE is wanted.
1843 (defun gnus-visual-p (&optional type class)
1844   (and gnus-visual                      ; Has to be non-nil, at least.
1845        (if (not type)                   ; We don't care about type.
1846            gnus-visual
1847          (if (listp gnus-visual)        ; It's a list, so we check it.
1848              (or (memq type gnus-visual)
1849                  (memq class gnus-visual))
1850            t))))
1851
1852 ;;; Load the compatability functions.
1853
1854 (require 'gnus-ems)
1855
1856 \f
1857 ;;;
1858 ;;; Shutdown
1859 ;;;
1860
1861 (defvar gnus-shutdown-alist nil)
1862
1863 (defun gnus-add-shutdown (function &rest symbols)
1864   "Run FUNCTION whenever one of SYMBOLS is shut down."
1865   (push (cons function symbols) gnus-shutdown-alist))
1866
1867 (defun gnus-shutdown (symbol)
1868   "Shut down everything that waits for SYMBOL."
1869   (let ((alist gnus-shutdown-alist)
1870         entry)
1871     (while (setq entry (pop alist))
1872       (when (memq symbol (cdr entry))
1873         (funcall (car entry))))))
1874
1875 \f
1876 ;;;
1877 ;;; Gnus Utility Functions
1878 ;;;
1879
1880 ;; Add the current buffer to the list of buffers to be killed on exit.
1881 (defun gnus-add-current-to-buffer-list ()
1882   (or (memq (current-buffer) gnus-buffer-list)
1883       (push (current-buffer) gnus-buffer-list)))
1884
1885 (defun gnus-version (&optional arg)
1886   "Version number of this version of Gnus.
1887 If ARG, insert string at point."
1888   (interactive "P")
1889   (let ((methods gnus-valid-select-methods)
1890         (mess gnus-version)
1891         meth)
1892     ;; Go through all the legal select methods and add their version
1893     ;; numbers to the total version string.  Only the backends that are
1894     ;; currently in use will have their message numbers taken into
1895     ;; consideration.
1896     (while methods
1897       (setq meth (intern (concat (caar methods) "-version")))
1898       (and (boundp meth)
1899            (stringp (symbol-value meth))
1900            (setq mess (concat mess "; " (symbol-value meth))))
1901       (setq methods (cdr methods)))
1902     (if arg
1903         (insert (message mess))
1904       (message mess))))
1905
1906 (defun gnus-continuum-version (version)
1907   "Return VERSION as a floating point number."
1908   (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
1909             (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
1910     (let* ((alpha (and (match-beginning 1) (match-string 1 version)))
1911            (number (match-string 2 version))
1912            major minor least)
1913       (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
1914       (setq major (string-to-number (match-string 1 number)))
1915       (setq minor (string-to-number (match-string 2 number)))
1916       (setq least (if (match-beginning 3)
1917                       (string-to-number (match-string 3 number))
1918                     0))
1919       (string-to-number
1920        (if (zerop major)
1921            (format "%s00%02d%02d"
1922                    (cond 
1923                     ((member alpha '("(ding)" "d")) "4.99")
1924                     ((member alpha '("September" "s")) "5.01")
1925                     ((member alpha '("Red" "r")) "5.03"))
1926                    minor least)
1927          (format "%d.%02d%02d" major minor least))))))
1928
1929 (defun gnus-info-find-node ()
1930   "Find Info documentation of Gnus."
1931   (interactive)
1932   ;; Enlarge info window if needed.
1933   (let (gnus-info-buffer)
1934     (Info-goto-node (cadr (assq major-mode gnus-info-nodes)))
1935     (setq gnus-info-buffer (current-buffer))
1936     (gnus-configure-windows 'info)))
1937
1938 ;;; More various functions.
1939
1940 (defun gnus-group-read-only-p (&optional group)
1941   "Check whether GROUP supports editing or not.
1942 If GROUP is nil, `gnus-newsgroup-name' will be checked instead.  Note
1943 that that variable is buffer-local to the summary buffers."
1944   (let ((group (or group gnus-newsgroup-name)))
1945     (not (gnus-check-backend-function 'request-replace-article group))))
1946
1947 (defun gnus-group-total-expirable-p (group)
1948   "Check whether GROUP is total-expirable or not."
1949   (let ((params (gnus-group-find-parameter group))
1950         val)
1951     (cond
1952      ((memq 'total-expire params)
1953       t)
1954      ((setq val (assq 'total-expire params)) ; (auto-expire . t)
1955       (cdr val))
1956      (gnus-total-expirable-newsgroups   ; Check var.
1957       (string-match gnus-total-expirable-newsgroups group)))))
1958
1959 (defun gnus-group-auto-expirable-p (group)
1960   "Check whether GROUP is total-expirable or not."
1961   (let ((params (gnus-group-find-parameter group))
1962         val)
1963     (cond
1964      ((memq 'auto-expire params)
1965       t)
1966      ((setq val (assq 'auto-expire params)) ; (auto-expire . t)
1967       (cdr val))
1968      (gnus-auto-expirable-newsgroups    ; Check var.
1969       (string-match gnus-auto-expirable-newsgroups group)))))
1970
1971 (defun gnus-virtual-group-p (group)
1972   "Say whether GROUP is virtual or not."
1973   (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
1974                         gnus-valid-select-methods)))
1975
1976 (defun gnus-news-group-p (group &optional article)
1977   "Return non-nil if GROUP (and ARTICLE) come from a news server."
1978   (or (gnus-member-of-valid 'post group) ; Ordinary news group.
1979       (and (gnus-member-of-valid 'post-mail group) ; Combined group.
1980            (eq (gnus-request-type group article) 'news))))
1981
1982 ;; Returns a list of writable groups.
1983 (defun gnus-writable-groups ()
1984   (let ((alist gnus-newsrc-alist)
1985         groups group)
1986     (while (setq group (car (pop alist)))
1987       (unless (gnus-group-read-only-p group)
1988         (push group groups)))
1989     (nreverse groups)))
1990
1991 ;; Check whether to use long file names.
1992 (defun gnus-use-long-file-name (symbol)
1993   ;; The variable has to be set...
1994   (and gnus-use-long-file-name
1995        ;; If it isn't a list, then we return t.
1996        (or (not (listp gnus-use-long-file-name))
1997            ;; If it is a list, and the list contains `symbol', we
1998            ;; return nil.
1999            (not (memq symbol gnus-use-long-file-name)))))
2000
2001 ;; Generate a unique new group name.
2002 (defun gnus-generate-new-group-name (leaf)
2003   (let ((name leaf)
2004         (num 0))
2005     (while (gnus-gethash name gnus-newsrc-hashtb)
2006       (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
2007     name))
2008
2009 (defun gnus-ephemeral-group-p (group)
2010   "Say whether GROUP is ephemeral or not."
2011   (gnus-group-get-parameter group 'quit-config))
2012
2013 (defun gnus-group-quit-config (group)
2014   "Return the quit-config of GROUP."
2015   (gnus-group-get-parameter group 'quit-config))
2016
2017 (defun gnus-kill-ephemeral-group (group)
2018   "Remove ephemeral GROUP from relevant structures."
2019   (gnus-sethash group nil gnus-newsrc-hashtb))
2020
2021 (defun gnus-simplify-mode-line ()
2022   "Make mode lines a bit simpler."
2023   (setq mode-line-modified "-- ")
2024   (when (listp mode-line-format)
2025     (make-local-variable 'mode-line-format)
2026     (setq mode-line-format (copy-sequence mode-line-format))
2027     (when (equal (nth 3 mode-line-format) "   ")
2028       (setcar (nthcdr 3 mode-line-format) " "))))
2029
2030 ;;; Servers and groups.
2031
2032 (defsubst gnus-server-add-address (method)
2033   (let ((method-name (symbol-name (car method))))
2034     (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
2035              (not (assq (intern (concat method-name "-address")) method))
2036              (memq 'physical-address (assq (car method) 
2037                                            gnus-valid-select-methods)))
2038         (append method (list (list (intern (concat method-name "-address"))
2039                                    (nth 1 method))))
2040       method)))
2041
2042 (defsubst gnus-server-get-method (group method)
2043   ;; Input either a server name, and extended server name, or a
2044   ;; select method, and return a select method.
2045   (cond ((stringp method)
2046          (gnus-server-to-method method))
2047         ((equal method gnus-select-method)
2048          gnus-select-method)
2049         ((and (stringp (car method)) group)
2050          (gnus-server-extend-method group method))
2051         ((and method (not group)
2052               (equal (cadr method) ""))
2053          method)
2054         (t
2055          (gnus-server-add-address method))))
2056
2057 (defun gnus-server-to-method (server)
2058   "Map virtual server names to select methods."
2059   (or 
2060    ;; Is this a method, perhaps?
2061    (and server (listp server) server)
2062    ;; Perhaps this is the native server?
2063    (and (equal server "native") gnus-select-method)
2064    ;; It should be in the server alist.
2065    (cdr (assoc server gnus-server-alist))
2066    ;; It could be in the predefined server alist.
2067    (cdr (assoc server gnus-predefined-server-alist))
2068    ;; If not, we look through all the opened server
2069    ;; to see whether we can find it there.
2070    (let ((opened gnus-opened-servers))
2071      (while (and opened
2072                  (not (equal server (format "%s:%s" (caaar opened)
2073                                             (cadaar opened)))))
2074        (pop opened))
2075      (caar opened))))
2076
2077 (defmacro gnus-method-equal (ss1 ss2)
2078   "Say whether two servers are equal."
2079   `(let ((s1 ,ss1)
2080          (s2 ,ss2))
2081      (or (equal s1 s2)
2082          (and (= (length s1) (length s2))
2083               (progn
2084                 (while (and s1 (member (car s1) s2))
2085                   (setq s1 (cdr s1)))
2086                 (null s1))))))
2087
2088 (defun gnus-server-equal (m1 m2)
2089   "Say whether two methods are equal."
2090   (let ((m1 (cond ((null m1) gnus-select-method)
2091                   ((stringp m1) (gnus-server-to-method m1))
2092                   (t m1)))
2093         (m2 (cond ((null m2) gnus-select-method)
2094                   ((stringp m2) (gnus-server-to-method m2))
2095                   (t m2))))
2096     (gnus-method-equal m1 m2)))
2097
2098 (defun gnus-servers-using-backend (backend)
2099   "Return a list of known servers using BACKEND."
2100   (let ((opened gnus-opened-servers)
2101         out)
2102     (while opened
2103       (when (eq backend (caaar opened))
2104         (push (caar opened) out))
2105       (pop opened))
2106     out))
2107
2108 (defun gnus-archive-server-wanted-p ()
2109   "Say whether the user wants to use the archive server."
2110   (cond 
2111    ((or (not gnus-message-archive-method)
2112         (not gnus-message-archive-group))
2113     nil)
2114    ((and gnus-message-archive-method gnus-message-archive-group)
2115     t)
2116    (t
2117     (let ((active (cadr (assq 'nnfolder-active-file
2118                               gnus-message-archive-method))))
2119       (and active
2120            (file-exists-p active))))))
2121
2122 (defun gnus-group-prefixed-name (group method)
2123   "Return the whole name from GROUP and METHOD."
2124   (and (stringp method) (setq method (gnus-server-to-method method)))
2125   (if (not method)
2126       group
2127     (concat (format "%s" (car method))
2128             (when (and
2129                    (or (assoc (format "%s" (car method))
2130                               (gnus-methods-using 'address))
2131                        (gnus-server-equal method gnus-message-archive-method))
2132                    (nth 1 method)
2133                    (not (string= (nth 1 method) "")))
2134               (concat "+" (nth 1 method)))
2135             ":" group)))
2136
2137 (defun gnus-group-real-prefix (group)
2138   "Return the prefix of the current group name."
2139   (if (string-match "^[^:]+:" group)
2140       (substring group 0 (match-end 0))
2141     ""))
2142
2143 (defun gnus-group-method (group)
2144   "Return the server or method used for selecting GROUP.
2145 You should probably use `gnus-find-method-for-group' instead."
2146   (let ((prefix (gnus-group-real-prefix group)))
2147     (if (equal prefix "")
2148         gnus-select-method
2149       (let ((servers gnus-opened-servers)
2150             (server "")
2151             backend possible found)
2152         (if (string-match "^[^\\+]+\\+" prefix)
2153             (setq backend (intern (substring prefix 0 (1- (match-end 0))))
2154                   server (substring prefix (match-end 0) (1- (length prefix))))
2155           (setq backend (intern (substring prefix 0 (1- (length prefix))))))
2156         (while servers
2157           (when (eq (caaar servers) backend)
2158             (setq possible (caar servers))
2159             (when (equal (cadaar servers) server)
2160               (setq found (caar servers))))
2161           (pop servers))
2162         (or (car (rassoc found gnus-server-alist))
2163             found
2164             (car (rassoc possible gnus-server-alist))
2165             possible
2166             (list backend server))))))
2167
2168 (defsubst gnus-secondary-method-p (method)
2169   "Return whether METHOD is a secondary select method."
2170   (let ((methods gnus-secondary-select-methods)
2171         (gmethod (gnus-server-get-method nil method)))
2172     (while (and methods
2173                 (not (equal (gnus-server-get-method nil (car methods))
2174                             gmethod)))
2175       (setq methods (cdr methods)))
2176     methods))
2177
2178 (defun gnus-group-foreign-p (group)
2179   "Say whether a group is foreign or not."
2180   (and (not (gnus-group-native-p group))
2181        (not (gnus-group-secondary-p group))))
2182
2183 (defun gnus-group-native-p (group)
2184   "Say whether the group is native or not."
2185   (not (string-match ":" group)))
2186
2187 (defun gnus-group-secondary-p (group)
2188   "Say whether the group is secondary or not."
2189   (gnus-secondary-method-p (gnus-find-method-for-group group)))
2190
2191 (defun gnus-group-find-parameter (group &optional symbol)
2192   "Return the group parameters for GROUP.
2193 If SYMBOL, return the value of that symbol in the group parameters."
2194   (save-excursion
2195     (set-buffer gnus-group-buffer)
2196     (let ((parameters (funcall gnus-group-get-parameter-function group)))
2197       (if symbol
2198           (gnus-group-parameter-value parameters symbol)
2199         parameters))))
2200
2201 (defun gnus-group-get-parameter (group &optional symbol)
2202   "Return the group parameters for GROUP.
2203 If SYMBOL, return the value of that symbol in the group parameters."
2204   (let ((params (gnus-info-params (gnus-get-info group))))
2205     (if symbol
2206         (gnus-group-parameter-value params symbol)
2207       params)))
2208
2209 (defun gnus-group-parameter-value (params symbol)
2210   "Return the value of SYMBOL in group PARAMS."
2211   (or (car (memq symbol params))        ; It's either a simple symbol
2212       (cdr (assq symbol params))))      ; or a cons.
2213
2214 (defun gnus-group-add-parameter (group param)
2215   "Add parameter PARAM to GROUP."
2216   (let ((info (gnus-get-info group)))
2217     (if (not info)
2218         ()                              ; This is a dead group.  We just ignore it.
2219       ;; Cons the new param to the old one and update.
2220       (gnus-group-set-info (cons param (gnus-info-params info))
2221                            group 'params))))
2222
2223 (defun gnus-group-set-parameter (group name value)
2224   "Set parameter NAME to VALUE in GROUP."
2225   (let ((info (gnus-get-info group)))
2226     (if (not info)
2227         ()                              ; This is a dead group.  We just ignore it.
2228       (let ((old-params (gnus-info-params info))
2229             (new-params (list (cons name value))))
2230         (while old-params
2231           (when (or (not (listp (car old-params)))
2232                     (not (eq (caar old-params) name)))
2233             (setq new-params (append new-params (list (car old-params)))))
2234           (setq old-params (cdr old-params)))
2235         (gnus-group-set-info new-params group 'params)))))
2236
2237 (defun gnus-group-add-score (group &optional score)
2238   "Add SCORE to the GROUP score.
2239 If SCORE is nil, add 1 to the score of GROUP."
2240   (let ((info (gnus-get-info group)))
2241     (when info
2242       (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
2243
2244 ;; Function written by Stainless Steel Rat <ratinox@peorth.gweep.net>
2245 (defun gnus-short-group-name (group &optional levels)
2246   "Collapse GROUP name LEVELS.
2247 Select methods are stripped and any remote host name is stripped down to
2248 just the host name."
2249   (let* ((name "") (foreign "") (depth -1) (skip 1)
2250          (levels (or levels
2251                      (progn
2252                        (while (string-match "\\." group skip)
2253                          (setq skip (match-end 0)
2254                                depth (+ depth 1)))
2255                        depth))))
2256     ;; separate foreign select method from group name and collapse.
2257     ;; if method contains a server, collapse to non-domain server name,
2258     ;; otherwise collapse to select method
2259     (when (string-match ":" group)
2260       (cond ((string-match "+" group)
2261              (let* ((plus (string-match "+" group))
2262                     (colon (string-match ":" group (or plus 0)))
2263                     (dot (string-match "\\." group)))
2264                (setq foreign (concat
2265                               (substring group (+ 1 plus)
2266                                          (cond ((null dot) colon)
2267                                                ((< colon dot) colon)
2268                                                ((< dot colon) dot)))
2269                               ":")
2270                      group (substring group (+ 1 colon)))))
2271             (t
2272              (let* ((colon (string-match ":" group)))
2273                (setq foreign (concat (substring group 0 (+ 1 colon)))
2274                      group (substring group (+ 1 colon)))))))
2275     ;; collapse group name leaving LEVELS uncollapsed elements
2276     (while group
2277       (if (and (string-match "\\." group) (> levels 0))
2278           (setq name (concat name (substring group 0 1))
2279                 group (substring group (match-end 0))
2280                 levels (- levels 1)
2281                 name (concat name "."))
2282         (setq name (concat foreign name group)
2283               group nil)))
2284     name))
2285
2286 \f
2287 ;;;
2288 ;;; Kill file handling.
2289 ;;;
2290
2291 (defun gnus-apply-kill-file ()
2292   "Apply a kill file to the current newsgroup.
2293 Returns the number of articles marked as read."
2294   (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
2295           (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
2296       (gnus-apply-kill-file-internal)
2297     0))
2298
2299 (defun gnus-kill-save-kill-buffer ()
2300   (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
2301     (when (get-file-buffer file)
2302       (save-excursion
2303         (set-buffer (get-file-buffer file))
2304         (when (buffer-modified-p)
2305           (save-buffer))
2306         (kill-buffer (current-buffer))))))
2307
2308 (defcustom gnus-kill-file-name "KILL"
2309   "Suffix of the kill files."
2310   :group 'gnus-score-kill
2311   :group 'gnus-score-files
2312   :type 'string)
2313
2314 (defun gnus-newsgroup-kill-file (newsgroup)
2315   "Return the name of a kill file name for NEWSGROUP.
2316 If NEWSGROUP is nil, return the global kill file name instead."
2317   (cond 
2318    ;; The global KILL file is placed at top of the directory.
2319    ((or (null newsgroup)
2320         (string-equal newsgroup ""))
2321     (expand-file-name gnus-kill-file-name
2322                       gnus-kill-files-directory))
2323    ;; Append ".KILL" to newsgroup name.
2324    ((gnus-use-long-file-name 'not-kill)
2325     (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
2326                               "." gnus-kill-file-name)
2327                       gnus-kill-files-directory))
2328    ;; Place "KILL" under the hierarchical directory.
2329    (t
2330     (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
2331                               "/" gnus-kill-file-name)
2332                       gnus-kill-files-directory))))
2333
2334 ;;; Server things.
2335
2336 (defun gnus-member-of-valid (symbol group)
2337   "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
2338   (memq symbol (assoc
2339                 (symbol-name (car (gnus-find-method-for-group group)))
2340                 gnus-valid-select-methods)))
2341
2342 (defun gnus-method-option-p (method option)
2343   "Return non-nil if select METHOD has OPTION as a parameter."
2344   (when (stringp method)
2345     (setq method (gnus-server-to-method method)))
2346   (memq option (assoc (format "%s" (car method))
2347                       gnus-valid-select-methods)))
2348
2349 (defun gnus-server-extend-method (group method)
2350   ;; This function "extends" a virtual server.  If the server is
2351   ;; "hello", and the select method is ("hello" (my-var "something"))
2352   ;; in the group "alt.alt", this will result in a new virtual server
2353   ;; called "hello+alt.alt".
2354   (if (or (not (gnus-similar-server-opened method))
2355           (not (cddr method)))
2356       method
2357     `(,(car method) ,(concat (cadr method) "+" group)
2358       (,(intern (format "%s-address" (car method))) ,(cadr method))
2359       ,@(cddr method))))
2360
2361 (defun gnus-similar-server-opened (method)
2362   (let ((opened gnus-opened-servers))
2363     (while (and method opened)
2364       (when (and (equal (cadr method) (cadaar opened))
2365                  (not (equal method (caar opened))))
2366         (setq method nil))
2367       (pop opened))
2368     (not method)))
2369
2370 (defun gnus-server-status (method)
2371   "Return the status of METHOD."
2372   (nth 1 (assoc method gnus-opened-servers)))
2373
2374 (defun gnus-group-name-to-method (group)
2375   "Guess a select method based on GROUP."
2376   (if (string-match ":" group)
2377       (let ((server (substring group 0 (match-beginning 0))))
2378         (if (string-match "\\+" server)
2379             (list (intern (substring server 0 (match-beginning 0)))
2380                   (substring server (match-end 0)))
2381           (list (intern server) "")))
2382     gnus-select-method))
2383
2384 (defun gnus-find-method-for-group (group &optional info)
2385   "Find the select method that GROUP uses."
2386   (or gnus-override-method
2387       (and (not group)
2388            gnus-select-method)
2389       (let ((info (or info (gnus-get-info group)))
2390             method)
2391         (if (or (not info)
2392                 (not (setq method (gnus-info-method info)))
2393                 (equal method "native"))
2394             gnus-select-method
2395           (setq method
2396                 (cond ((stringp method)
2397                        (gnus-server-to-method method))
2398                       ((stringp (cadr method))
2399                        (gnus-server-extend-method group method))
2400                       (t
2401                        method)))
2402           (cond ((equal (cadr method) "")
2403                  method)
2404                 ((null (cadr method))
2405                  (list (car method) ""))
2406                 (t
2407                  (gnus-server-add-address method)))))))
2408
2409 (defun gnus-check-backend-function (func group)
2410   "Check whether GROUP supports function FUNC.
2411 GROUP can either be a string (a group name) or a select method."
2412   (ignore-errors
2413     (let ((method (if (stringp group)
2414                       (car (gnus-find-method-for-group group))
2415                     group)))
2416       (unless (featurep method)
2417         (require method))
2418       (fboundp (intern (format "%s-%s" method func))))))
2419
2420 (defun gnus-methods-using (feature)
2421   "Find all methods that have FEATURE."
2422   (let ((valids gnus-valid-select-methods)
2423         outs)
2424     (while valids
2425       (when (memq feature (car valids))
2426         (push (car valids) outs))
2427       (setq valids (cdr valids)))
2428     outs))
2429
2430 (defun gnus-read-group (prompt &optional default)
2431   "Prompt the user for a group name.
2432 Disallow illegal group names."
2433   (let ((prefix "")
2434         group)
2435     (while (not group)
2436       (when (string-match
2437              "[: `'\"/]\\|^$"
2438              (setq group (read-string (concat prefix prompt)
2439                                       (cons (or default "") 0)
2440                                       'gnus-group-history)))
2441         (setq prefix (format "Illegal group name: \"%s\".  " group)
2442               group nil)))
2443     group))
2444
2445 (defun gnus-read-method (prompt)
2446   "Prompt the user for a method.
2447 Allow completion over sensible values."
2448   (let ((method
2449          (completing-read
2450           prompt (append gnus-valid-select-methods gnus-predefined-server-alist
2451                          gnus-server-alist)
2452           nil t nil 'gnus-method-history)))
2453     (cond 
2454      ((equal method "")
2455       (setq method gnus-select-method))
2456      ((assoc method gnus-valid-select-methods)
2457       (list (intern method)
2458             (if (memq 'prompt-address
2459                       (assoc method gnus-valid-select-methods))
2460                 (read-string "Address: ")
2461               "")))
2462      ((assoc method gnus-server-alist)
2463       method)
2464      (t
2465       (list (intern method) "")))))
2466
2467 ;;; User-level commands.
2468
2469 ;;;###autoload
2470 (defun gnus-slave-no-server (&optional arg)
2471   "Read network news as a slave, without connecting to local server"
2472   (interactive "P")
2473   (gnus-no-server arg t))
2474
2475 ;;;###autoload
2476 (defun gnus-no-server (&optional arg slave)
2477   "Read network news.
2478 If ARG is a positive number, Gnus will use that as the
2479 startup level.  If ARG is nil, Gnus will be started at level 2.
2480 If ARG is non-nil and not a positive number, Gnus will
2481 prompt the user for the name of an NNTP server to use.
2482 As opposed to `gnus', this command will not connect to the local server."
2483   (interactive "P")
2484   (gnus-no-server-1 arg slave))
2485
2486 ;;;###autoload
2487 (defun gnus-slave (&optional arg)
2488   "Read news as a slave."
2489   (interactive "P")
2490   (gnus arg nil 'slave))
2491
2492 ;;;###autoload
2493 (defun gnus-other-frame (&optional arg)
2494   "Pop up a frame to read news."
2495   (interactive "P")
2496   (let ((window (get-buffer-window gnus-group-buffer)))
2497     (cond (window
2498            (select-frame (window-frame window)))
2499           ((= (length (frame-list)) 1)
2500            (select-frame (make-frame)))
2501           (t
2502            (other-frame 1))))
2503   (gnus arg))
2504
2505 ;;;###autoload
2506 (defun gnus (&optional arg dont-connect slave)
2507   "Read network news.
2508 If ARG is non-nil and a positive number, Gnus will use that as the
2509 startup level.  If ARG is non-nil and not a positive number, Gnus will
2510 prompt the user for the name of an NNTP server to use."
2511   (interactive "P")
2512   (gnus-1 arg dont-connect slave))
2513
2514 ;; Allow redefinition of Gnus functions.
2515
2516 (gnus-ems-redefine)
2517
2518 (provide 'gnus)
2519
2520 ;;; gnus.el ends here