X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fgnus-srvr.el;h=3d3ab3e526e6d81bf2488b2eb52aa6137fd57c7b;hp=d981834d6520a78de2fda7be50ea335ae435ae8e;hb=a3e52de2271f1336cb7e3c31c14bd122f4db609e;hpb=8a5183a15fcafbe38e375a736885ba48dc326a12 diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index d981834d6..3d3ab3e52 100644 --- 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,96 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news @@ -55,7 +55,7 @@ with some simple extensions.") (?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))) @@ -129,22 +129,22 @@ with some simple extensions.") "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. \\ -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) @@ -189,15 +189,15 @@ 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) @@ -207,14 +207,19 @@ The following commands are available: (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)) @@ -238,10 +243,9 @@ The following commands are available: (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 @@ -250,7 +254,7 @@ The following commands are available: (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)))))) @@ -258,7 +262,7 @@ The following commands are available: (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)) @@ -310,9 +314,9 @@ The following commands are available: (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." @@ -399,8 +403,8 @@ The following commands are available: (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")) @@ -408,19 +412,22 @@ The following commands are available: (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)) @@ -467,7 +474,7 @@ The following commands are available: (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) @@ -509,7 +516,8 @@ The following commands are available: "\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) @@ -522,8 +530,7 @@ The following commands are available: ["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) @@ -535,6 +542,8 @@ The following commands are available: "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)) @@ -609,8 +618,7 @@ buffer. 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) @@ -626,7 +634,7 @@ buffer. (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)) @@ -670,7 +678,10 @@ buffer. (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." @@ -680,7 +691,7 @@ 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 @@ -726,15 +737,16 @@ buffer. "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.