;;; gnus-srvr.el --- virtual server support for Gnus
-;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97,98 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.
(defconst gnus-server-line-format " {%(%h:%w%)} %s\n"
"Format of server lines.
It works along the same lines as a normal formatting string,
-with some simple extensions.")
+with some simple extensions.
-(defvar gnus-server-mode-line-format "Gnus List of servers"
+The following specs are understood:
+
+%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
["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)
(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
+ "\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
"\C-c\C-i" gnus-info-find-node
"\C-c\C-b" gnus-bug))
(buffer-disable-undo (current-buffer))
(setq truncate-lines t)
(setq buffer-read-only t)
- (run-hooks 'gnus-server-mode-hook))
+ (gnus-run-hooks 'gnus-server-mode-hook))
(defun gnus-server-insert-server-line (name method)
(let* ((how (car method))
(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)
;; 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))))
(defun gnus-server-exit ()
"Return to the group buffer."
(interactive)
- (run-hooks 'gnus-server-exit-hook)
+ (gnus-run-hooks 'gnus-server-exit-hook)
(kill-buffer (current-buffer))
(gnus-configure-windows 'group t))
(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))
["Next" gnus-browse-next-group t]
["Prev" gnus-browse-next-group t]
["Exit" gnus-browse-exit t]))
- (run-hooks 'gnus-browse-menu-hook)))
+ (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*")
-(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 server)
(setq gnus-browse-return-buffer return-buffer)
- (when (stringp method)
- (setq method (gnus-server-to-method method)))
- (let ((gnus-select-method method)
- groups group)
+ (let* ((method (gnus-server-to-method server))
+ (gnus-select-method method)
+ groups group)
(gnus-message 5 "Connecting to %s..." (nth 1 method))
(cond
((not (gnus-check-server method))
(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)
- (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
+ 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."
(interactive)
;; If this group it killed, then we want to subscribe it.
(when (= (following-char) ?K)
(setq sub t))
- (when (gnus-gethash (setq group (gnus-browse-group-name))
- gnus-newsrc-hashtb)
+ (setq group (gnus-browse-group-name))
+ (when (and sub
+ (cadr (gnus-gethash group gnus-newsrc-hashtb)))
(error "Group already subscribed"))
- ;; Make sure the group has been properly removed before we
- ;; subscribe to it.
- (gnus-kill-ephemeral-group group)
(delete-char 1)
(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
- nil nil gnus-browse-current-method)
+ nil nil (if (gnus-server-equal
+ gnus-browse-current-method "native")
+ nil
+ gnus-browse-current-method))
gnus-level-default-subscribed gnus-level-killed
(and (car (nth 1 gnus-newsrc-alist))
(gnus-gethash (car (nth 1 gnus-newsrc-alist))