X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-srvr.el;h=e5179a6bcf3cb394f42beb6b590d2a1314307c6c;hb=36bd162f4f7cd40453b8683e796730836c352b2a;hp=ba93d8c8827ad702eb6f1cf54c0a2389013303de;hpb=07efe5c831f8a3261dc5948cc890449c30e9507e;p=elisp%2Fgnus.git-

diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el
index ba93d8c..e5179a6 100644
--- a/lisp/gnus-srvr.el
+++ b/lisp/gnus-srvr.el
@@ -34,10 +34,17 @@
 (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%a\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.
@@ -48,16 +55,19 @@ The following specs are understood:
 %n name
 %w address
 %s status
-%a agent covered")
-
-(defvar gnus-server-mode-line-format "Gnus: %%b"
-  "The format specification for the server mode line.")
+%a agent covered"
+  :group 'gnus-server-visual
+  :type 'string)
 
-(defvar gnus-server-exit-hook nil
-  "*Hook run when exiting the server buffer.")
+(defcustom gnus-server-mode-line-format "Gnus: %%b"
+  "The format specification for the server mode line."
+  :group 'gnus-server-visual
+  :type 'string)
 
-(defvar gnus-server-browse-in-group-buffer nil
-  "Whether browse server in group buffer.")
+(defcustom gnus-server-browse-in-group-buffer nil
+  "Whether browse server in group buffer."
+  :group 'gnus-server-visual
+  :type 'string)
 
 ;;; Internal variables.
 
@@ -149,13 +159,69 @@ The following specs are understood:
     "\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)
+
+(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)
+
+(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)
+   '("(\\(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:
 
@@ -173,19 +239,25 @@ 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
+	  (if (eq (nth 1 elem) 'denied)
+	      "(denied)"
+	    (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))
@@ -657,7 +729,7 @@ The following commands are available:
 	(let ((buffer-read-only nil) charset)
 	  (while groups
 	    (setq group (car groups))
-	    (setq charset (gnus-group-name-charset method group))
+	    (setq charset (gnus-group-name-charset method (car group)))
 	    (gnus-add-text-properties
 	     (point)
 	     (prog1 (1+ (point))