;;; 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:
\\{gnus-server-mode-map}"
(interactive)
- (when (and menu-bar-mode
- (gnus-visual-p 'server-menu 'menu))
+ (when (gnus-visual-p 'server-menu 'menu)
(gnus-server-make-menu-bar))
(kill-all-local-variables)
(gnus-simplify-mode-line)
(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))))
+ (when (member (cdar alist) done)
+ (pop alist)))
;; Then we insert the list of servers that have been opened in
;; this session.
- (while opened
+ (while opened
(unless (member (caar opened) done)
- (gnus-server-insert-server-line
+ (push (caar opened) done)
+ (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-exit ()
"Return to the group buffer."
(interactive)
+ (run-hooks 'gnus-server-exit-hook)
(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-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)
["Select" gnus-browse-read-group t]
["Next" gnus-browse-next-group t]
["Prev" gnus-browse-next-group t]
- ["Exit" gnus-browse-exit t]
- ))
+ ["Exit" gnus-browse-exit t]))
(run-hooks 'gnus-browse-menu-hook)))
(defvar gnus-browse-current-method nil)
"Browse the server METHOD."
(setq gnus-browse-current-method method)
(setq gnus-browse-return-buffer return-buffer)
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(let ((gnus-select-method method)
groups group)
(gnus-message 5 "Connecting to %s..." (nth 1 method))
3) `\\[gnus-browse-exit]' to return to the group buffer."
(interactive)
(kill-all-local-variables)
- (when (and menu-bar-mode
- (gnus-visual-p 'browse-menu 'menu))
+ (when (gnus-visual-p 'browse-menu 'menu)
(gnus-browse-make-menu-bar))
(gnus-simplify-mode-line)
(setq major-mode 'gnus-browse-mode)
(defun gnus-browse-read-group (&optional no-article)
"Enter the group at the current line."
(interactive)
- (let ((group (gnus-browse-group-name)))
+ (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))
(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))))
+ (gnus-group-prefixed-name
+ ;; Remove text props.
+ (format "%s" (match-string 1))
+ gnus-browse-current-method))))
(defun gnus-browse-unsubscribe-group ()
"Toggle subscription of the current group in the browse buffer."
(save-excursion
(beginning-of-line)
;; If this group it killed, then we want to subscribe it.
- (when (= (following-char) ?K)
+ (when (= (char-after (point)) ?K)
(setq sub t))
(setq group (gnus-browse-group-name))
;; Make sure the group has been properly removed before we
"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.
projects / gnus / blobdiff