1 ;;; gnus-srvr.el --- virtual server support for Gnus
2 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
3 ;; Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
8 ;; This file is part of GNU Emacs.
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)
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.
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.
29 (eval-when-compile (require 'cl))
37 (defcustom gnus-server-mode-hook nil
38 "Hook run in `gnus-server-mode' buffers."
42 (defcustom gnus-server-exit-hook nil
43 "Hook run when exiting the server buffer."
47 (defcustom gnus-server-line-format " {%(%h:%w%)} %s%a\n"
48 "Format of server lines.
49 It works along the same lines as a normal formatting string,
50 with some simple extensions.
52 The following specs are understood:
60 General format specifiers can also be used.
61 See Info node `(gnus)Formatting Variables'."
62 :link '(custom-manual "(gnus)Formatting Variables")
63 :group 'gnus-server-visual
66 (defcustom gnus-server-mode-line-format "Gnus: %%b"
67 "The format specification for the server mode line."
68 :group 'gnus-server-visual
71 (defcustom gnus-server-browse-in-group-buffer nil
72 "Whether server browsing should take place in the group buffer.
73 If nil, a faster, but more primitive, buffer is used instead."
74 :group 'gnus-server-visual
77 ;;; Internal variables.
79 (defvar gnus-inserted-opened-servers nil)
81 (defvar gnus-server-line-format-alist
82 `((?h gnus-tmp-how ?s)
84 (?w gnus-tmp-where ?s)
85 (?s gnus-tmp-status ?s)
86 (?a gnus-tmp-agent ?s)))
88 (defvar gnus-server-mode-line-format-alist
89 `((?S gnus-tmp-news-server ?s)
90 (?M gnus-tmp-news-method ?s)
91 (?u gnus-tmp-user-defined ?s)))
93 (defvar gnus-server-line-format-spec nil)
94 (defvar gnus-server-mode-line-format-spec nil)
95 (defvar gnus-server-killed-servers nil)
97 (defvar gnus-server-mode-map)
99 (defvar gnus-server-menu-hook nil
100 "*Hook run after the creation of the server mode menu.")
102 (defun gnus-server-make-menu-bar ()
103 (gnus-turn-off-edit-menu 'server)
104 (unless (boundp 'gnus-server-server-menu)
106 gnus-server-server-menu gnus-server-mode-map ""
108 ["Add..." gnus-server-add-server t]
109 ["Browse" gnus-server-read-server t]
110 ["Scan" gnus-server-scan-server t]
111 ["List" gnus-server-list-servers t]
112 ["Kill" gnus-server-kill-server t]
113 ["Yank" gnus-server-yank-server t]
114 ["Copy" gnus-server-copy-server t]
115 ["Edit" gnus-server-edit-server t]
116 ["Regenerate" gnus-server-regenerate-server t]
117 ["Exit" gnus-server-exit t]))
120 gnus-server-connections-menu gnus-server-mode-map ""
122 ["Open" gnus-server-open-server t]
123 ["Close" gnus-server-close-server t]
124 ["Offline" gnus-server-offline-server t]
125 ["Deny" gnus-server-deny-server t]
127 ["Open All" gnus-server-open-all-servers t]
128 ["Close All" gnus-server-close-all-servers t]
129 ["Reset All" gnus-server-remove-denials t]))
131 (gnus-run-hooks 'gnus-server-menu-hook)))
133 (defvar gnus-server-mode-map nil)
134 (put 'gnus-server-mode 'mode-class 'special)
136 (unless gnus-server-mode-map
137 (setq gnus-server-mode-map (make-sparse-keymap))
138 (suppress-keymap gnus-server-mode-map)
140 (gnus-define-keys gnus-server-mode-map
141 " " gnus-server-read-server-in-server-buffer
142 "\r" gnus-server-read-server
143 gnus-mouse-2 gnus-server-pick-server
145 "l" gnus-server-list-servers
146 "k" gnus-server-kill-server
147 "y" gnus-server-yank-server
148 "c" gnus-server-copy-server
149 "a" gnus-server-add-server
150 "e" gnus-server-edit-server
151 "s" gnus-server-scan-server
153 "O" gnus-server-open-server
154 "\M-o" gnus-server-open-all-servers
155 "C" gnus-server-close-server
156 "\M-c" gnus-server-close-all-servers
157 "D" gnus-server-deny-server
158 "L" gnus-server-offline-server
159 "R" gnus-server-remove-denials
164 "g" gnus-server-regenerate-server
166 "\C-c\C-i" gnus-info-find-node
167 "\C-c\C-b" gnus-bug))
169 (defface gnus-server-agent-face
170 '((((class color) (background light)) (:foreground "PaleTurquoise" :bold t))
171 (((class color) (background dark)) (:foreground "PaleTurquoise" :bold t))
173 "Face used for displaying AGENTIZED servers"
174 :group 'gnus-server-visual)
176 (defface gnus-server-opened-face
177 '((((class color) (background light)) (:foreground "Green3" :bold t))
178 (((class color) (background dark)) (:foreground "Green1" :bold t))
180 "Face used for displaying OPENED servers"
181 :group 'gnus-server-visual)
183 (defface gnus-server-closed-face
184 '((((class color) (background light)) (:foreground "Steel Blue" :italic t))
185 (((class color) (background dark))
186 (:foreground "Light Steel Blue" :italic t))
188 "Face used for displaying CLOSED servers"
189 :group 'gnus-server-visual)
191 (defface gnus-server-denied-face
192 '((((class color) (background light)) (:foreground "Red" :bold t))
193 (((class color) (background dark)) (:foreground "Pink" :bold t))
194 (t (:inverse-video t :bold t)))
195 "Face used for displaying DENIED servers"
196 :group 'gnus-server-visual)
198 (defface gnus-server-offline-face
199 '((((class color) (background light)) (:foreground "Orange" :bold t))
200 (((class color) (background dark)) (:foreground "Yellow" :bold t))
201 (t (:inverse-video t :bold t)))
202 "Face used for displaying OFFLINE servers"
203 :group 'gnus-server-visual)
205 (defcustom gnus-server-agent-face 'gnus-server-agent-face
206 "Face name to use on AGENTIZED servers."
207 :group 'gnus-server-visual
210 (defcustom gnus-server-opened-face 'gnus-server-opened-face
211 "Face name to use on OPENED servers."
212 :group 'gnus-server-visual
215 (defcustom gnus-server-closed-face 'gnus-server-closed-face
216 "Face name to use on CLOSED servers."
217 :group 'gnus-server-visual
220 (defcustom gnus-server-denied-face 'gnus-server-denied-face
221 "Face name to use on DENIED servers."
222 :group 'gnus-server-visual