2001-12-21 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>

[gnus] / lisp / gnus-srvr.el

diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el
index c95cf29..3bc45fc 100644 (file)
--- a/lisp/gnus-srvr.el
+++ b/lisp/gnus-srvr.el
@@ -1,7 +1,8 @@
 ;;; gnus-srvr.el --- virtual server support for Gnus
 ;;; gnus-srvr.el --- virtual server support for Gnus

-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
+;;        Free Software Foundation, Inc.

 
 

-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>

 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.


@@ -25,40 +26,64 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

+(eval-when-compile (require 'cl))
+

 (require 'gnus)
 (require 'gnus-spec)
 (require 'gnus-group)
 (require 'gnus-int)
 (require 'gnus-range)
 
 (require 'gnus)
 (require 'gnus-spec)
 (require 'gnus-group)
 (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)
+
+(defcustom gnus-server-exit-hook nil
+  "Hook run when exiting the server buffer."
+  :group 'gnus-server
+  :type 'hook)

 
 

-(defconst gnus-server-line-format "     {%(%h:%w%)} %s\n"
+(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,
   "Format of server lines.
 It works along the same lines as a normal formatting string,

-with some simple extensions.")
+with some simple extensions.
+
+The following specs are understood:
+
+%h backend
+%n name
+%w address
+%s status
+%a agent covered"
+  :group 'gnus-server-visual
+  :type 'string)

 
 

-(defvar gnus-server-mode-line-format "Gnus  List of servers"
-  "The format specification for the server mode line.")
+(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-exit-hook nil
-  "*Hook run when exiting the server buffer.")
+(defcustom gnus-server-browse-in-group-buffer nil
+  "Whether browse server in group buffer."
+  :group 'gnus-server-visual
+  :type 'string)

 
 ;;; Internal variables.
 
 (defvar gnus-inserted-opened-servers nil)
 
 (defvar gnus-server-line-format-alist
 
 ;;; Internal variables.
 
 (defvar gnus-inserted-opened-servers nil)
 
 (defvar gnus-server-line-format-alist

-  `((?h how ?s)
-    (?n name ?s)
-    (?w where ?s)
-    (?s status ?s)))
+  `((?h gnus-tmp-how ?s)
+    (?n gnus-tmp-name ?s)
+    (?w gnus-tmp-where ?s)
+    (?s gnus-tmp-status ?s)
+    (?a gnus-tmp-agent ?s)))

 
 (defvar gnus-server-mode-line-format-alist
 
 (defvar gnus-server-mode-line-format-alist

-  `((?S news-server ?s)
-    (?M news-method ?s)
-    (?u user-defined ?s)))
+  `((?S gnus-tmp-news-server ?s)
+    (?M gnus-tmp-news-method ?s)
+    (?u gnus-tmp-user-defined ?s)))

 
 (defvar gnus-server-line-format-spec nil)
 (defvar gnus-server-mode-line-format-spec nil)
 
 (defvar gnus-server-line-format-spec nil)
 (defvar gnus-server-mode-line-format-spec nil)


@@ -97,7 +122,7 @@ with some simple extensions.")
        ["Close All" gnus-server-close-all-servers t]
        ["Reset All" gnus-server-remove-denials t]))
 
        ["Close All" gnus-server-close-all-servers t]
        ["Reset All" gnus-server-remove-denials t]))
 

-    (run-hooks 'gnus-server-menu-hook)))
+    (gnus-run-hooks 'gnus-server-menu-hook)))

 
 (defvar gnus-server-mode-map nil)
 (put 'gnus-server-mode 'mode-class 'special)
 
 (defvar gnus-server-mode-map nil)
 (put 'gnus-server-mode 'mode-class 'special)


@@ -106,39 +131,97 @@ with some simple extensions.")
   (setq gnus-server-mode-map (make-sparse-keymap))
   (suppress-keymap gnus-server-mode-map)
 
   (setq gnus-server-mode-map (make-sparse-keymap))
   (suppress-keymap gnus-server-mode-map)
 

-  (gnus-define-keys
-   gnus-server-mode-map
-   " " gnus-server-read-server
-   "\r" gnus-server-read-server
-   gnus-mouse-2 gnus-server-pick-server
-   "q" gnus-server-exit
-   "l" gnus-server-list-servers
-   "k" gnus-server-kill-server
-   "y" gnus-server-yank-server
-   "c" gnus-server-copy-server
-   "a" gnus-server-add-server
-   "e" gnus-server-edit-server
-   "s" gnus-server-scan-server
-
-   "O" gnus-server-open-server
-   "\M-o" gnus-server-open-all-servers
-   "C" gnus-server-close-server
-   "\M-c" gnus-server-close-all-servers
-   "D" gnus-server-deny-server
-   "R" gnus-server-remove-denials
-
-   "g" gnus-server-regenerate-server
+  (gnus-define-keys gnus-server-mode-map
+    " " gnus-server-read-server-in-server-buffer
+    "\r" gnus-server-read-server
+    gnus-mouse-2 gnus-server-pick-server
+    "q" gnus-server-exit
+    "l" gnus-server-list-servers
+    "k" gnus-server-kill-server
+    "y" gnus-server-yank-server
+    "c" gnus-server-copy-server
+    "a" gnus-server-add-server
+    "e" gnus-server-edit-server
+    "s" gnus-server-scan-server
+
+    "O" gnus-server-open-server
+    "\M-o" gnus-server-open-all-servers
+    "C" gnus-server-close-server
+    "\M-c" gnus-server-close-all-servers
+    "D" gnus-server-deny-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))
 
 
     "\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
 (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:
 
 
 The following commands are available:
 


@@ -153,29 +236,40 @@ The following commands are available:
   (gnus-set-default-directory)
   (setq mode-line-process nil)
   (use-local-map gnus-server-mode-map)
   (gnus-set-default-directory)
   (setq mode-line-process nil)
   (use-local-map gnus-server-mode-map)

-  (buffer-disable-undo (current-buffer))
+  (buffer-disable-undo)

   (setq truncate-lines t)
   (setq buffer-read-only t)
   (setq truncate-lines t)
   (setq buffer-read-only t)

-  (run-hooks 'gnus-server-mode-hook))
-
-(defun gnus-server-insert-server-line (name method)
-  (let* ((how (car method))
-        (where (nth 1 method))
+  (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))
         (elem (assoc method gnus-opened-servers))

-        (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))
+                            " (agent)"
+                          "")))

     (beginning-of-line)
     (gnus-add-text-properties
      (point)
      (prog1 (1+ (point))
        ;; Insert the text.
        (eval gnus-server-line-format-spec))
     (beginning-of-line)
     (gnus-add-text-properties
      (point)
      (prog1 (1+ (point))
        ;; Insert the text.
        (eval gnus-server-line-format-spec))

-     (list 'gnus-server (intern name)))))
+     (list 'gnus-server (intern gnus-tmp-name)))))

 
 (defun gnus-enter-server-buffer ()
   "Set up the server buffer."
 
 (defun gnus-enter-server-buffer ()
   "Set up the server buffer."


@@ -187,18 +281,14 @@ The following commands are available:
   "Initialize the server buffer."
   (unless (get-buffer gnus-server-buffer)
     (save-excursion
   "Initialize the server buffer."
   (unless (get-buffer gnus-server-buffer)
     (save-excursion

-      (set-buffer (get-buffer-create gnus-server-buffer))
+      (set-buffer (gnus-get-buffer-create gnus-server-buffer))

       (gnus-server-mode)
       (when gnus-carpal
        (gnus-carpal-setup-buffer 'server)))))
 
 (defun gnus-server-prepare ()
       (gnus-server-mode)
       (when gnus-carpal
        (gnus-carpal-setup-buffer 'server)))))
 
 (defun gnus-server-prepare ()

-  (setq gnus-server-mode-line-format-spec
-       (gnus-parse-format gnus-server-mode-line-format
-                          gnus-server-mode-line-format-alist))
-  (setq gnus-server-line-format-spec
-       (gnus-parse-format gnus-server-line-format
-                          gnus-server-line-format-alist t))
+  (gnus-set-format 'server-mode)
+  (gnus-set-format 'server t)

   (let ((alist gnus-server-alist)
        (buffer-read-only nil)
        (opened gnus-opened-servers)
   (let ((alist gnus-server-alist)
        (buffer-read-only nil)
        (opened gnus-opened-servers)


@@ -211,11 +301,15 @@ The following commands are available:
        (push (cdar alist) done)
        (cdr (setq server (pop alist)))
        (when (and server (car server) (cdr server))
        (push (cdar alist) done)
        (cdr (setq server (pop alist)))
        (when (and server (car server) (cdr server))

-         (gnus-server-insert-server-line (car server) (cdr server)))))
+         (gnus-server-insert-server-line (car server) (cdr server))))
+      (when (member (cdar alist) done)
+       (pop alist)))

     ;; Then we insert the list of servers that have been opened in
     ;; this session.
     (while opened
     ;; Then we insert the list of servers that have been opened in
     ;; this session.
     (while opened

-      (unless (member (caar opened) done)
+      (when (and (not (member (caar opened) done))
+                ;; Just ignore ephemeral servers.
+                (not (member (caar opened) gnus-ephemeral-servers)))

        (push (caar opened) done)
        (gnus-server-insert-server-line
         (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened))))
        (push (caar opened) done)
        (gnus-server-insert-server-line
         (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened))))


@@ -279,12 +373,24 @@ The following commands are available:
       (error "No server on the current line")))
   (unless (assoc server gnus-server-alist)
     (error "Read-only server %s" server))
       (error "No server on the current line")))
   (unless (assoc server gnus-server-alist)
     (error "Read-only server %s" server))

-  (gnus-dribble-enter "")
+  (gnus-dribble-touch)

   (let ((buffer-read-only nil))
     (gnus-delete-line))
   (push (assoc server gnus-server-alist) gnus-server-killed-servers)
   (setq gnus-server-alist (delq (car gnus-server-killed-servers)
                                gnus-server-alist))
   (let ((buffer-read-only nil))
     (gnus-delete-line))
   (push (assoc server gnus-server-alist) gnus-server-killed-servers)
   (setq gnus-server-alist (delq (car gnus-server-killed-servers)
                                gnus-server-alist))

+  (let ((groups (gnus-groups-from-server server)))
+    (when (and groups
+              (gnus-yes-or-no-p
+               (format "Kill all %s groups from this server? "
+                       (length groups))))
+      (dolist (group groups)
+       (setq gnus-newsrc-alist
+             (delq (assoc group gnus-newsrc-alist)
+                   gnus-newsrc-alist))
+       (when gnus-group-change-level-function
+         (funcall gnus-group-change-level-function
+                  group gnus-level-killed 3)))))

   (gnus-server-position-point))
 
 (defun gnus-server-yank-server ()
   (gnus-server-position-point))
 
 (defun gnus-server-yank-server ()


@@ -312,9 +418,9 @@ The following commands are available:
 (defun gnus-server-exit ()
   "Return to the group buffer."
   (interactive)
 (defun gnus-server-exit ()
   "Return to the group buffer."
   (interactive)

+  (gnus-run-hooks 'gnus-server-exit-hook)

   (kill-buffer (current-buffer))
   (kill-buffer (current-buffer))

-  (switch-to-buffer gnus-group-buffer)
-  (run-hooks 'gnus-server-exit-hook))
+  (gnus-configure-windows 'group t))

 
 (defun gnus-server-list-servers ()
   "List all available servers."
 
 (defun gnus-server-list-servers ()
   "List all available servers."


@@ -373,9 +479,8 @@ The following commands are available:
 (defun gnus-server-close-all-servers ()
   "Close all servers."
   (interactive)
 (defun gnus-server-close-all-servers ()
   "Close all servers."
   (interactive)

-  (let ((servers gnus-inserted-opened-servers))
-    (while servers
-      (gnus-server-close-server (car (pop servers))))))
+  (dolist (server gnus-inserted-opened-servers)
+    (gnus-server-close-server (car server))))

 
 (defun gnus-server-deny-server (server)
   "Make sure SERVER will never be attempted opened."
 
 (defun gnus-server-deny-server (server)
   "Make sure SERVER will never be attempted opened."


@@ -391,11 +496,9 @@ The following commands are available:
 (defun gnus-server-remove-denials ()
   "Make all denied servers into closed servers."
   (interactive)
 (defun gnus-server-remove-denials ()
   "Make all denied servers into closed servers."
   (interactive)

-  (let ((servers gnus-opened-servers))
-    (while servers
-      (when (eq (nth 1 (car servers)) 'denied)
-       (setcar (nthcdr 1 (car servers)) 'closed))
-      (setq servers (cdr servers))))
+  (dolist (server gnus-opened-servers)
+    (when (eq (nth 1 server) 'denied)
+      (setcar (nthcdr 1 server) 'closed)))

   (gnus-server-list-servers))
 
 (defun gnus-server-copy-server (from to)
   (gnus-server-list-servers))
 
 (defun gnus-server-copy-server (from to)


@@ -458,16 +561,25 @@ The following commands are available:
 (defun gnus-server-scan-server (server)
   "Request a scan from the current server."
   (interactive (list (gnus-server-server-name)))
 (defun gnus-server-scan-server (server)
   "Request a scan from the current server."
   (interactive (list (gnus-server-server-name)))

-  (gnus-message 3 "Scanning %s...done" server)
-  (gnus-request-scan nil (gnus-server-to-method server))
-  (gnus-message 3 "Scanning %s...done" server))
+  (let ((method (gnus-server-to-method server)))
+    (if (not (gnus-get-function method 'request-scan))
+       (error "Server %s can't scan" (car method))
+      (gnus-message 3 "Scanning %s..." server)
+      (gnus-request-scan nil method)
+      (gnus-message 3 "Scanning %s...done" server))))
+
+(defun gnus-server-read-server-in-server-buffer (server)
+  "Browse a server in server buffer."
+  (interactive (list (gnus-server-server-name)))
+  (let (gnus-server-browse-in-group-buffer)
+    (gnus-server-read-server server)))

 
 (defun gnus-server-read-server (server)
   "Browse a server."
   (interactive (list (gnus-server-server-name)))
   (let ((buf (current-buffer)))
     (prog1
 
 (defun gnus-server-read-server (server)
   "Browse a server."
   (interactive (list (gnus-server-server-name)))
   (let ((buf (current-buffer)))
     (prog1

-       (gnus-browse-foreign-server (gnus-server-to-method server) buf)
+       (gnus-browse-foreign-server server buf)

       (save-excursion
        (set-buffer buf)
        (gnus-server-update-server (gnus-server-server-name))
       (save-excursion
        (set-buffer buf)
        (gnus-server-update-server (gnus-server-server-name))


@@ -495,27 +607,28 @@ The following commands are available:
   (suppress-keymap gnus-browse-mode-map)
 
   (gnus-define-keys
   (suppress-keymap gnus-browse-mode-map)
 
   (gnus-define-keys

-   gnus-browse-mode-map
-   " " gnus-browse-read-group
-   "=" gnus-browse-select-group
-   "n" gnus-browse-next-group
-   "p" gnus-browse-prev-group
-   "\177" gnus-browse-prev-group
-   "N" gnus-browse-next-group
-   "P" gnus-browse-prev-group
-   "\M-n" gnus-browse-next-group
-   "\M-p" gnus-browse-prev-group
-   "\r" gnus-browse-select-group
-   "u" gnus-browse-unsubscribe-current-group
-   "l" gnus-browse-exit
-   "L" gnus-browse-exit
-   "q" gnus-browse-exit
-   "Q" gnus-browse-exit
-   "\C-c\C-c" gnus-browse-exit
-   "?" gnus-browse-describe-briefly
-
-   "\C-c\C-i" gnus-info-find-node
-   "\C-c\C-b" gnus-bug))
+      gnus-browse-mode-map
+    " " gnus-browse-read-group
+    "=" gnus-browse-select-group
+    "n" gnus-browse-next-group
+    "p" gnus-browse-prev-group
+    "\177" gnus-browse-prev-group
+    [delete] gnus-browse-prev-group
+    "N" gnus-browse-next-group
+    "P" gnus-browse-prev-group
+    "\M-n" gnus-browse-next-group
+    "\M-p" gnus-browse-prev-group
+    "\r" gnus-browse-select-group
+    "u" gnus-browse-unsubscribe-current-group
+    "l" gnus-browse-exit
+    "L" gnus-browse-exit
+    "q" gnus-browse-exit
+    "Q" gnus-browse-exit
+    "\C-c\C-c" gnus-browse-exit
+    "?" gnus-browse-describe-briefly
+
+    "\C-c\C-i" gnus-info-find-node
+    "\C-c\C-b" gnus-bug))

 
 (defun gnus-browse-make-menu-bar ()
   (gnus-turn-off-edit-menu 'browse)
 
 (defun gnus-browse-make-menu-bar ()
   (gnus-turn-off-edit-menu 'browse)


@@ -525,29 +638,31 @@ The following commands are available:
      '("Browse"
        ["Subscribe" gnus-browse-unsubscribe-current-group t]
        ["Read" gnus-browse-read-group t]
      '("Browse"
        ["Subscribe" gnus-browse-unsubscribe-current-group t]
        ["Read" gnus-browse-read-group t]

-       ["Select" gnus-browse-read-group t]
+       ["Select" gnus-browse-select-group t]

        ["Next" gnus-browse-next-group t]
        ["Next" gnus-browse-next-group t]

-       ["Prev" gnus-browse-next-group t]
-       ["Exit" gnus-browse-exit t]
-       ))
-    (run-hooks 'gnus-browse-menu-hook)))
+       ["Prev" gnus-browse-prev-group t]
+       ["Exit" gnus-browse-exit t]))
+    (gnus-run-hooks 'gnus-browse-menu-hook)))

 
 (defvar gnus-browse-current-method nil)
 (defvar gnus-browse-return-buffer nil)
 
 (defvar gnus-browse-buffer "*Gnus Browse Server*")
 
 
 (defvar gnus-browse-current-method nil)
 (defvar gnus-browse-return-buffer nil)
 
 (defvar gnus-browse-buffer "*Gnus Browse Server*")
 

-(defun gnus-browse-foreign-server (method &optional return-buffer)
-  "Browse the server METHOD."
-  (setq gnus-browse-current-method method)
+(defun gnus-browse-foreign-server (server &optional return-buffer)
+  "Browse the server SERVER."
+  (setq gnus-browse-current-method (gnus-server-to-method server))

   (setq gnus-browse-return-buffer return-buffer)
   (setq gnus-browse-return-buffer return-buffer)

-  (let ((gnus-select-method method)
-       groups group)
+  (let* ((method gnus-browse-current-method)
+        (orig-select-method gnus-select-method)
+        (gnus-select-method method)
+        groups group)

     (gnus-message 5 "Connecting to %s..." (nth 1 method))
     (cond
      ((not (gnus-check-server method))
       (gnus-message
     (gnus-message 5 "Connecting to %s..." (nth 1 method))
     (cond
      ((not (gnus-check-server method))
       (gnus-message

-       1 "Unable to contact server: %s" (gnus-status-message method))
+       1 "Unable to contact server %s: %s" (nth 1 method)
+       (gnus-status-message method))

       nil)
      ((not
        (prog2
       nil)
      ((not
        (prog2


@@ -558,41 +673,83 @@ The following commands are available:
        1 "Couldn't request list: %s" (gnus-status-message method))
       nil)
      (t
        1 "Couldn't request list: %s" (gnus-status-message method))
       nil)
      (t

-      (get-buffer-create gnus-browse-buffer)
-      (gnus-add-current-to-buffer-list)
-      (when gnus-carpal
-       (gnus-carpal-setup-buffer 'browse))
-      (gnus-configure-windows 'browse)
-      (buffer-disable-undo (current-buffer))
-      (let ((buffer-read-only nil))
-       (erase-buffer))
-      (gnus-browse-mode)
-      (setq mode-line-buffer-identification
-           (list
-            (format
-             "Gnus: %%b {%s:%s}" (car method) (cadr method))))

       (save-excursion
        (set-buffer nntp-server-buffer)
        (let ((cur (current-buffer)))
          (goto-char (point-min))
          (unless (string= gnus-ignored-newsgroups "")
            (delete-matching-lines gnus-ignored-newsgroups))
       (save-excursion
        (set-buffer nntp-server-buffer)
        (let ((cur (current-buffer)))
          (goto-char (point-min))
          (unless (string= gnus-ignored-newsgroups "")
            (delete-matching-lines gnus-ignored-newsgroups))

-         (while (re-search-forward
-                 "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
-           (goto-char (match-end 1))
-           (push (cons (match-string 1)
-                       (max 0 (- (1+ (read cur)) (read cur))))
-                 groups))))
+         (while (not (eobp))
+           (ignore-errors
+             (push (cons
+                    (if (eq (char-after) ?\")
+                        (read cur)
+                      (let ((p (point)) (name ""))
+                        (skip-chars-forward "^ \t\\\\")
+                        (setq name (buffer-substring p (point)))
+                        (while (eq (char-after) ?\\)
+                          (setq p (1+ (point)))
+                          (forward-char 2)
+                          (skip-chars-forward "^ \t\\\\")
+                          (setq name (concat name (buffer-substring
+                                                   p (point)))))
+                        name))
+                    (let ((last (read cur)))
+                      (cons (read cur) last)))
+                   groups))
+           (forward-line))))

       (setq groups (sort groups
                         (lambda (l1 l2)
                           (string< (car l1) (car l2)))))
       (setq groups (sort groups
                         (lambda (l1 l2)
                           (string< (car l1) (car l2)))))

-      (let ((buffer-read-only nil))
-       (while groups
-         (setq group (car groups))
-         (insert
-          (format "K%7d: %s\n" (cdr group) (car group)))
-         (setq groups (cdr groups))))
-      (switch-to-buffer (current-buffer))
+      (if gnus-server-browse-in-group-buffer
+         (let* ((gnus-select-method orig-select-method)
+                (gnus-group-listed-groups
+                 (mapcar (lambda (group)
+                           (let ((name
+                                  (gnus-group-prefixed-name
+                                   (car group) method)))
+                             (gnus-set-active name (cdr group))
+                             name))
+                         groups)))
+           (gnus-configure-windows 'group)
+           (funcall gnus-group-prepare-function
+                    gnus-level-killed 'ignore 1 'ingore))
+       (gnus-get-buffer-create gnus-browse-buffer)
+       (when gnus-carpal
+         (gnus-carpal-setup-buffer 'browse))
+       (gnus-configure-windows 'browse)
+       (buffer-disable-undo)
+       (let ((buffer-read-only nil))
+         (erase-buffer))
+       (gnus-browse-mode)
+       (setq mode-line-buffer-identification
+             (list
+              (format
+               "Gnus: %%b {%s:%s}" (car method) (cadr method))))
+       (let ((buffer-read-only nil) charset)
+         (while groups
+           (setq group (car groups))
+           (setq charset (gnus-group-name-charset method (car group)))
+           (gnus-add-text-properties
+            (point)
+            (prog1 (1+ (point))
+              (insert
+               (format "%c%7d: %s\n"
+                       (let ((level
+                              (let ((gnus-select-method orig-select-method))
+                                (gnus-group-level
+                                 (gnus-group-prefixed-name (car group)
+                                                           method)))))
+                             (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)))
+           (setq groups (cdr groups))))
+       (switch-to-buffer (current-buffer)))

       (goto-char (point-min))
       (gnus-group-position-point)
       (gnus-message 5 "Connecting to %s...done" (nth 1 method))
       (goto-char (point-min))
       (gnus-group-position-point)
       (gnus-message 5 "Connecting to %s...done" (nth 1 method))


@@ -622,20 +779,24 @@ buffer.
   (setq mode-name "Browse Server")
   (setq mode-line-process nil)
   (use-local-map gnus-browse-mode-map)
   (setq mode-name "Browse Server")
   (setq mode-line-process nil)
   (use-local-map gnus-browse-mode-map)

-  (buffer-disable-undo (current-buffer))
+  (buffer-disable-undo)

   (setq truncate-lines t)
   (gnus-set-default-directory)
   (setq buffer-read-only t)
   (setq truncate-lines t)
   (gnus-set-default-directory)
   (setq buffer-read-only t)

-  (run-hooks 'gnus-browse-mode-hook))
+  (gnus-run-hooks 'gnus-browse-mode-hook))

 
 (defun gnus-browse-read-group (&optional no-article)
   "Enter the group at the current line."
   (interactive)
 
 (defun gnus-browse-read-group (&optional no-article)
   "Enter the group at the current line."
   (interactive)

-  (let ((group (gnus-group-real-name (gnus-browse-group-name))))
-    (unless (gnus-group-read-ephemeral-group
-            group gnus-browse-current-method nil
-            (cons (current-buffer) 'browse))
-      (error "Couldn't enter %s" group))))
+  (let ((group (gnus-browse-group-name)))
+    (if (or (not (gnus-get-info group))
+           (gnus-ephemeral-group-p group))
+       (unless (gnus-group-read-ephemeral-group
+                (gnus-group-real-name group) gnus-browse-current-method nil
+                (cons (current-buffer) 'browse))
+         (error "Couldn't enter %s" group))
+      (unless (gnus-group-read-group nil no-article group)
+       (error "Couldn't enter %s" group)))))

 
 (defun gnus-browse-select-group ()
   "Select the current group."
 
 (defun gnus-browse-select-group ()
   "Select the current group."


@@ -658,7 +819,7 @@ buffer.
   "(Un)subscribe to the next ARG groups."
   (interactive "p")
   (when (eobp)
   "(Un)subscribe to the next ARG groups."
   (interactive "p")
   (when (eobp)

-    (error "No group at current line."))
+    (error "No group at current line"))

   (let ((ward (if (< arg 0) -1 1))
        (arg (abs arg)))
     (while (and (> arg 0)
   (let ((ward (if (< arg 0) -1 1))
        (arg (abs arg)))
     (while (and (> arg 0)


@@ -674,8 +835,12 @@ buffer.
 (defun gnus-browse-group-name ()
   (save-excursion
     (beginning-of-line)
 (defun gnus-browse-group-name ()
   (save-excursion
     (beginning-of-line)

-    (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
-      (gnus-group-prefixed-name (match-string 1) gnus-browse-current-method))))
+    (let ((name (get-text-property (point) 'gnus-group)))
+      (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
+       (gnus-group-prefixed-name
+        (or name
+            (match-string-no-properties 1))
+        gnus-browse-current-method)))))

 
 (defun gnus-browse-unsubscribe-group ()
   "Toggle subscription of the current group in the browse buffer."
 
 (defun gnus-browse-unsubscribe-group ()
   "Toggle subscription of the current group in the browse buffer."


@@ -685,27 +850,36 @@ buffer.
     (save-excursion
       (beginning-of-line)
       ;; If this group it killed, then we want to subscribe it.
     (save-excursion
       (beginning-of-line)
       ;; If this group it killed, then we want to subscribe it.

-      (when (= (following-char) ?K)
+      (unless (eq (char-after) ? )

        (setq sub t))
       (setq group (gnus-browse-group-name))
        (setq sub t))
       (setq group (gnus-browse-group-name))

-      ;; Make sure the group has been properly removed before we
-      ;; subscribe to it.
-      (gnus-kill-ephemeral-group group)
-      (delete-char 1)
+      ;;;;
+      ;;(when (and sub
+      ;;                (cadr (gnus-gethash group gnus-newsrc-hashtb)))
+      ;;(error "Group already subscribed"))

       (if sub
          (progn
       (if sub
          (progn

+           ;; Make sure the group has been properly removed before we
+           ;; subscribe to it.
+           (gnus-kill-ephemeral-group group)

            (gnus-group-change-level
             (list t group gnus-level-default-subscribed
            (gnus-group-change-level
             (list t group gnus-level-default-subscribed

-                  nil nil gnus-browse-current-method)
-            gnus-level-default-subscribed gnus-level-killed
+                  nil nil (if (gnus-server-equal
+                               gnus-browse-current-method "native")
+                              nil
+                            (gnus-method-simplify
+                             gnus-browse-current-method)))
+            gnus-level-default-subscribed (gnus-group-level group)

             (and (car (nth 1 gnus-newsrc-alist))
                  (gnus-gethash (car (nth 1 gnus-newsrc-alist))
                                gnus-newsrc-hashtb))
             t)
             (and (car (nth 1 gnus-newsrc-alist))
                  (gnus-gethash (car (nth 1 gnus-newsrc-alist))
                                gnus-newsrc-hashtb))
             t)

+           (delete-char 1)

            (insert ? ))
        (gnus-group-change-level
            (insert ? ))
        (gnus-group-change-level

-        group gnus-level-killed gnus-level-default-subscribed)
-       (insert ?K)))
+        group gnus-level-unsubscribed gnus-level-default-subscribed)
+       (delete-char 1)
+       (insert ?U)))

     t))
 
 (defun gnus-browse-exit ()
     t))
 
 (defun gnus-browse-exit ()


@@ -733,14 +907,18 @@ buffer.
   (let ((server (gnus-server-server-name)))
     (unless server
       (error "No server on the current line"))
   (let ((server (gnus-server-server-name)))
     (unless server
       (error "No server on the current line"))

-    (if (not (gnus-check-backend-function
-             'request-regenerate (car (gnus-server-to-method server))))
-       (error "This backend doesn't support regeneration")
-      (gnus-message 5 "Requesting regeneration of %s..." server)
-      (if (gnus-request-regenerate server)
-         (gnus-message 5 "Requesting regeneration of %s...done" server)
-       (gnus-message 5 "Couldn't regenerate %s" server)))))
+    (condition-case ()
+       (gnus-get-function (gnus-server-to-method server)
+                          'request-regenerate)
+      (error
+       (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"))
+    (if (gnus-request-regenerate server)
+       (gnus-message 5 "Requesting regeneration of %s...done" server)
+      (gnus-message 5 "Couldn't regenerate %s" server))))

 
 (provide 'gnus-srvr)
 
 
 (provide 'gnus-srvr)
 

-;;; gnus-srvr.el ends here.
+;;; gnus-srvr.el ends here