;;; gnus-srvr.el --- virtual server support for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
(?w where ?s)
(?s status ?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)))
"g" gnus-server-regenerate-server
- "\C-c\C-i" gnus-info-find-node))
+ "\C-c\C-i" gnus-info-find-node
+ "\C-c\C-b" gnus-bug))
(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]').
+For more in-depth information on this mode, read the manual
+(`\\[gnus-info-find-node]').
The following commands are available:
(save-excursion
(set-buffer (get-buffer-create gnus-server-buffer))
(gnus-server-mode)
- (when gnus-carpal
+ (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
+ (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
+ (setq gnus-server-line-format-spec
+ (gnus-parse-format gnus-server-line-format
gnus-server-line-format-alist t))
(let ((alist gnus-server-alist)
(buffer-read-only nil)
(setq gnus-inserted-opened-servers nil)
;; First we do the real list of servers.
(while alist
- (push (cdr (setq server (pop alist))) done)
- (when (and server (car server) (cdr server))
- (gnus-server-insert-server-line (car server) (cdr server))))
+ (unless (member (cdar alist) done)
+ (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)))))
;; Then we insert the list of servers that have been opened in
;; this session.
- (while opened
+ (while opened
(unless (member (caar opened) done)
(push (caar opened) done)
- (gnus-server-insert-server-line
+ (gnus-server-insert-server-line
(setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened))))
(caar opened))
(push (list op-ser (caar opened)) gnus-inserted-opened-servers))
(oentry (assoc (gnus-server-to-method server)
gnus-opened-servers)))
(when entry
- (gnus-dribble-enter
+ (gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
- (prin1-to-string (cdr entry)) ")
-")))
+ (prin1-to-string (cdr entry)) ")\n")))
(when (or entry oentry)
;; Buffer may be narrowed.
(save-restriction
(gnus-delete-line))
(if entry
(gnus-server-insert-server-line (car entry) (cdr entry))
- (gnus-server-insert-server-line
+ (gnus-server-insert-server-line
(format "%s:%s" (caar oentry) (nth 1 (car oentry)))
(car oentry)))
(gnus-server-position-point))))))
(defun gnus-server-set-info (server info)
;; Enter a select method into the virtual server alist.
(when (and server info)
- (gnus-dribble-enter
+ (gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
(prin1-to-string info) ")"))
(let* ((server (nth 1 info))
(defun gnus-server-copy-server (from to)
(interactive
(list
- (unless (gnus-server-server-name)
- (error "No server on the current line"))
+ (or (gnus-server-server-name)
+ (error "No server on the current line"))
(read-string "Copy to: ")))
(unless from
(error "No server on current line"))
(error "No name to copy to"))
(when (assoc to gnus-server-alist)
(error "%s already exists" to))
- (unless (assoc from gnus-server-alist)
+ (unless (gnus-server-to-method from)
(error "%s: no such server" from))
- (let ((to-entry (gnus-copy-sequence (assoc from gnus-server-alist))))
+ (let ((to-entry (cons from (gnus-copy-sequence
+ (gnus-server-to-method from)))))
(setcar to-entry to)
(setcar (nthcdr 2 to-entry) to)
(push to-entry gnus-server-killed-servers)
(gnus-server-yank-server)))
(defun gnus-server-add-server (how where)
- (interactive
+ (interactive
(list (intern (completing-read "Server method: "
gnus-valid-select-methods nil t))
(read-string "Server name: ")))
+ (when (assq where gnus-server-alist)
+ (error "Server with that name already defined"))
(push (list where how where) gnus-server-killed-servers)
(gnus-server-yank-server))
(set-buffer buf)
(gnus-server-update-server (gnus-server-server-name))
(gnus-server-position-point)))))
-
+
(defun gnus-server-pick-server (e)
(interactive "e")
(mouse-set-point e)
"\C-c\C-c" gnus-browse-exit
"?" gnus-browse-describe-briefly
- "\C-c\C-i" gnus-info-find-node))
+ "\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)
"Issue a command to the server to regenerate all its data structures."
(interactive)
(let ((server (gnus-server-server-name)))
- (unless server
+ (unless server
(error "No server on the current line"))
- (if (not (gnus-check-backend-function
+ (if (not (gnus-check-backend-function
'request-regenerate (car (gnus-server-to-method server))))
(error "This backend doesn't support regeneration")
- (gnus-message 5 "Requesing regeneration of %s..." server)
- (when (gnus-request-regenerate server)
- (gnus-message 5 "Requesing regeneration of %s...done" server)))))
-
+ (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)))))
+
(provide 'gnus-srvr)
;;; gnus-srvr.el ends here.