* texi/gnus-ja.texi (Article Date): Update Japanese translation.

[elisp/gnus.git-] / lisp / gnus-srvr.el

diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el
index dbf3776..9d6b543 100644 (file)
--- a/lisp/gnus-srvr.el
+++ b/lisp/gnus-srvr.el
@@ -1,5 +1,5 @@
 ;;; gnus-srvr.el --- virtual server support for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
 ;;        Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@@ -55,7 +55,11 @@ The following specs are understood:
 %n name
 %w address
 %s status
-%a agent covered"
+%a agent covered
+
+General format specifiers can also be used.
+See (gnus)Formatting Variables."
+  :link '(custom-manual "(gnus)Formatting Variables")
   :group 'gnus-server-visual
   :type 'string)
 
@@ -117,6 +121,7 @@ If nil, a faster, but more primitive, buffer is used instead."
      '("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]
@@ -150,6 +155,7 @@ If nil, a faster, but more primitive, buffer is used instead."
     "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
@@ -189,6 +195,13 @@ If nil, a faster, but more primitive, buffer is used instead."
   "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
@@ -209,11 +222,17 @@ If nil, a faster, but more primitive, buffer is used instead."
   :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 ()
@@ -243,22 +262,24 @@ The following commands are available:
   (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-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
-         (if (eq (nth 1 elem) 'denied)
-             "(denied)"
-           (condition-case nil
-               (if (or (gnus-server-opened method)
-                       (eq (nth 1 elem) 'ok))
+        (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)"))))
+                 "(closed)")
+             ((error) "(error)")))))
         (gnus-tmp-agent (if (and gnus-agent
                                  (member method
                                          gnus-agent-covered-methods))
@@ -411,7 +432,7 @@ The following commands are available:
          (setq alist (cdr alist)))
        (if alist
            (setcdr alist (cons killed (cdr alist)))
-         (setq gnus-server-alist (list killed)))))
+         (setq gnus-server-alist (list killed)))))
     (gnus-server-update-server (car killed))
     (setq gnus-server-killed-servers (cdr gnus-server-killed-servers))
     (gnus-server-position-point)))
@@ -477,6 +498,18 @@ The following commands are available:
       (gnus-server-update-server server)
       (gnus-server-position-point))))
 
+(defun gnus-server-offline-server (server)
+  "Set SERVER to offline."
+  (interactive (list (gnus-server-server-name)))
+  (let ((method (gnus-server-to-method server)))
+    (unless method
+      (error "No such server: %s" server))
+    (prog1
+       (gnus-close-server method)
+      (gnus-server-set-status method 'offline)
+      (gnus-server-update-server server)
+      (gnus-server-position-point))))
+
 (defun gnus-server-close-all-servers ()
   "Close all servers."
   (interactive)
@@ -739,11 +772,11 @@ The following commands are available:
               (insert
                (format "%c%7d: %s\n"
                        (let ((level (gnus-group-level (concat prefix (car group)))))
-                             (cond
-                              ((<= level gnus-level-subscribed) ? )
-                              ((<= level gnus-level-unsubscribed) ?U)
-                              ((= level gnus-level-zombie) ?Z)
-                              (t ?K)))
+                         (cond
+                          ((<= level gnus-level-subscribed) ? )
+                          ((<= level gnus-level-unsubscribed) ?U)
+                          ((= level gnus-level-zombie) ?Z)
+                          (t ?K)))
                        (max 0 (- (1+ (cddr group)) (cadr group)))
                        (gnus-group-name-decode (car group) charset))))
             (list 'gnus-group (car group)))
@@ -910,7 +943,7 @@ buffer.
        (gnus-get-function (gnus-server-to-method server)
                           'request-regenerate)
       (error
-       (error "This backend doesn't support regeneration")))
+       (error "This backend doesn't support regeneration")))
     (gnus-message 5 "Requesting regeneration of %s..." server)
     (unless (gnus-open-server server)
       (error "Couldn't open server"))