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