;;; gnus-srvr.el --- virtual server support for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(require 'gnus-int)
(require 'gnus-range)
-(defvar gnus-server-mode-hook nil
- "Hook run in `gnus-server-mode' buffers.")
+(defcustom gnus-server-mode-hook nil
+ "Hook run in `gnus-server-mode' buffers."
+ :group 'gnus-server
+ :type 'hook)
-(defconst gnus-server-line-format " {%(%h:%w%)} %s\n"
+(defcustom gnus-server-exit-hook nil
+ "Hook run when exiting the server buffer."
+ :group 'gnus-server
+ :type 'hook)
+
+(defcustom gnus-server-line-format " {%(%h:%w%)} %s%a\n"
"Format of server lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
%h backend
%n name
%w address
-%s status")
-
-(defvar gnus-server-mode-line-format "Gnus: %%b"
- "The format specification for the server mode line.")
-
-(defvar gnus-server-exit-hook nil
- "*Hook run when exiting the server buffer.")
+%s status
+%a agent covered
+
+General format specifiers can also be used.
+See Info node `(gnus)Formatting Variables'."
+ :link '(custom-manual "(gnus)Formatting Variables")
+ :group 'gnus-server-visual
+ :type 'string)
+
+(defcustom gnus-server-mode-line-format "Gnus: %%b"
+ "The format specification for the server mode line."
+ :group 'gnus-server-visual
+ :type 'string)
+
+(defcustom gnus-server-browse-in-group-buffer nil
+ "Whether server browsing should take place in the group buffer.
+If nil, a faster, but more primitive, buffer is used instead."
+ :group 'gnus-server-visual
+ :type 'boolean)
;;; Internal variables.
`((?h gnus-tmp-how ?s)
(?n gnus-tmp-name ?s)
(?w gnus-tmp-where ?s)
- (?s gnus-tmp-status ?s)))
+ (?s gnus-tmp-status ?s)
+ (?a gnus-tmp-agent ?s)))
(defvar gnus-server-mode-line-format-alist
`((?S gnus-tmp-news-server ?s)
(easy-menu-define
gnus-server-server-menu gnus-server-mode-map ""
'("Server"
- ["Add" gnus-server-add-server t]
+ ["Add..." gnus-server-add-server t]
["Browse" gnus-server-read-server t]
["Scan" gnus-server-scan-server t]
["List" gnus-server-list-servers t]
'("Connections"
["Open" gnus-server-open-server t]
["Close" gnus-server-close-server t]
+ ["Offline" gnus-server-offline-server t]
["Deny" gnus-server-deny-server t]
"---"
["Open All" gnus-server-open-all-servers t]
(suppress-keymap gnus-server-mode-map)
(gnus-define-keys gnus-server-mode-map
- " " gnus-server-read-server
+ " " gnus-server-read-server-in-server-buffer
"\r" gnus-server-read-server
gnus-mouse-2 gnus-server-pick-server
"q" gnus-server-exit
"C" gnus-server-close-server
"\M-c" gnus-server-close-all-servers
"D" gnus-server-deny-server
+ "L" gnus-server-offline-server
"R" gnus-server-remove-denials
"n" next-line
"p" previous-line
-
+
"g" gnus-server-regenerate-server
"\C-c\C-i" gnus-info-find-node
"\C-c\C-b" gnus-bug))
+(defface gnus-server-agent-face
+ '((((class color) (background light)) (:foreground "PaleTurquoise" :bold t))
+ (((class color) (background dark)) (:foreground "PaleTurquoise" :bold t))
+ (t (:bold t)))
+ "Face used for displaying AGENTIZED servers"
+ :group 'gnus-server-visual)
+
+(defface gnus-server-opened-face
+ '((((class color) (background light)) (:foreground "Green3" :bold t))
+ (((class color) (background dark)) (:foreground "Green1" :bold t))
+ (t (:bold t)))
+ "Face used for displaying OPENED servers"
+ :group 'gnus-server-visual)
+
+(defface gnus-server-closed-face
+ '((((class color) (background light)) (:foreground "Steel Blue" :italic t))
+ (((class color) (background dark))
+ (:foreground "Light Steel Blue" :italic t))
+ (t (:italic t)))
+ "Face used for displaying CLOSED servers"
+ :group 'gnus-server-visual)
+
+(defface gnus-server-denied-face
+ '((((class color) (background light)) (:foreground "Red" :bold t))
+ (((class color) (background dark)) (:foreground "Pink" :bold t))
+ (t (:inverse-video t :bold t)))
+ "Face used for displaying DENIED servers"
+ :group 'gnus-server-visual)
+
+(defface gnus-server-offline-face
+ '((((class color) (background light)) (:foreground "Orange" :bold t))
+ (((class color) (background dark)) (:foreground "Yellow" :bold t))
+ (t (:inverse-video t :bold t)))
+ "Face used for displaying OFFLINE servers"
+ :group 'gnus-server-visual)
+
+(defcustom gnus-server-agent-face 'gnus-server-agent-face
+ "Face name to use on AGENTIZED servers."
+ :group 'gnus-server-visual
+ :type 'face)
+
+(defcustom gnus-server-opened-face 'gnus-server-opened-face
+ "Face name to use on OPENED servers."
+ :group 'gnus-server-visual
+ :type 'face)
+
+(defcustom gnus-server-closed-face 'gnus-server-closed-face
+ "Face name to use on CLOSED servers."
+ :group 'gnus-server-visual
+ :type 'face)
+
+(defcustom gnus-server-denied-face 'gnus-server-denied-face
+ "Face name to use on DENIED servers."
+ :group 'gnus-server-visual
+ :type 'face)
+
+(defcustom gnus-server-offline-face 'gnus-server-offline-face
+ "Face name to use on OFFLINE servers."
+ :group 'gnus-server-visual
+ :type 'face)
+
+(defvar gnus-server-font-lock-keywords
+ (list
+ '("(\\(agent\\))" 1 gnus-server-agent-face)
+ '("(\\(opened\\))" 1 gnus-server-opened-face)
+ '("(\\(closed\\))" 1 gnus-server-closed-face)
+ '("(\\(offline\\))" 1 gnus-server-offline-face)
+ '("(\\(denied\\))" 1 gnus-server-denied-face)))
+
(defun gnus-server-mode ()
"Major mode for listing and editing servers.
All normal editing commands are switched off.
\\<gnus-server-mode-map>
For more in-depth information on this mode, read the manual
-(`\\[gnus-info-find-node]').
+\(`\\[gnus-info-find-node]').
The following commands are available:
(buffer-disable-undo)
(setq truncate-lines t)
(setq buffer-read-only t)
+ (if (featurep 'xemacs)
+ (put 'gnus-server-mode 'font-lock-defaults '(gnus-server-font-lock-keywords t))
+ (set (make-local-variable 'font-lock-defaults)
+ '(gnus-server-font-lock-keywords t)))
(gnus-run-hooks 'gnus-server-mode-hook))
(defun gnus-server-insert-server-line (gnus-tmp-name method)
(let* ((gnus-tmp-how (car method))
(gnus-tmp-where (nth 1 method))
(elem (assoc method gnus-opened-servers))
- (gnus-tmp-status (cond ((eq (nth 1 elem) 'denied)
- "(denied)")
- ((or (gnus-server-opened method)
- (eq (nth 1 elem) 'ok))
- "(opened)")
- (t
- "(closed)"))))
+ (gnus-tmp-status
+ (cond
+ ((eq (nth 1 elem) 'denied) "(denied)")
+ ((eq (nth 1 elem) 'offline) "(offline)")
+ (t
+ (condition-case nil
+ (if (or (gnus-server-opened method)
+ (eq (nth 1 elem) 'ok))
+ "(opened)"
+ "(closed)")
+ ((error) "(error)")))))
+ (gnus-tmp-agent (if (and gnus-agent
+ (member method
+ gnus-agent-covered-methods))
+ " (agent)"
+ "")))
(beginning-of-line)
(gnus-add-text-properties
(point)
(while alist
(unless (member (cdar alist) done)
(push (cdar alist) done)
- (cdr (setq server (pop alist)))
+ (setq server (pop alist))
(when (and server (car server) (cdr server))
(gnus-server-insert-server-line (car server) (cdr server))))
(when (member (cdar alist) done)
(when entry
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
- (prin1-to-string (cdr entry)) ")\n")))
+ (gnus-prin1-to-string (cdr entry)) ")\n")))
(when (or entry oentry)
;; Buffer may be narrowed.
(save-restriction
projects / gnus / blobdiff