X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-srvr.el;h=835cd1492f5c65d9616ef9599789ab252e17bcfd;hb=f702159a4d7cb8471a17884108880aa8d7961728;hp=9bb79ce9435b308860d74e44d4e6265b38bb55c6;hpb=85093239bc794cb948ebbf5a5bd910b3d1c95cec;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 9bb79ce..835cd14 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, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen @@ -51,7 +51,7 @@ with some simple extensions. The following specs are understood: -%h backend +%h back end %n name %w address %s status @@ -71,6 +71,7 @@ See Info node `(gnus)Formatting Variables'." (defcustom gnus-server-browse-in-group-buffer nil "Whether server browsing should take place in the group buffer. If nil, a faster, but more primitive, buffer is used instead." + :version "21.4" :group 'gnus-server-visual :type 'boolean) @@ -204,26 +205,31 @@ If nil, a faster, but more primitive, buffer is used instead." (defcustom gnus-server-agent-face 'gnus-server-agent-face "Face name to use on AGENTIZED servers." + :version "21.4" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-opened-face 'gnus-server-opened-face "Face name to use on OPENED servers." + :version "21.4" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-closed-face 'gnus-server-closed-face "Face name to use on CLOSED servers." + :version "21.4" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-denied-face 'gnus-server-denied-face "Face name to use on DENIED servers." + :version "21.4" :group 'gnus-server-visual :type 'face) (defcustom gnus-server-offline-face 'gnus-server-offline-face "Face name to use on OFFLINE servers." + :version "21.4" :group 'gnus-server-visual :type 'face) @@ -313,7 +319,6 @@ The following commands are available: (gnus-set-format 'server t) (let ((alist gnus-server-alist) (buffer-read-only nil) - (opened gnus-opened-servers) done server op-ser) (erase-buffer) (setq gnus-inserted-opened-servers nil) @@ -328,16 +333,15 @@ The following commands are available: (pop alist))) ;; Then we insert the list of servers that have been opened in ;; this session. - (while opened - (when (and (not (member (caar opened) done)) + (dolist (open gnus-opened-servers) + (when (and (not (member (car open) done)) ;; Just ignore ephemeral servers. - (not (member (caar opened) gnus-ephemeral-servers))) - (push (caar opened) done) + (not (member (car open) gnus-ephemeral-servers))) + (push (car open) 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)) - (setq opened (cdr opened)))) + (setq op-ser (format "%s:%s" (caar open) (nth 1 (car open)))) + (car open)) + (push (list op-ser (car open)) gnus-inserted-opened-servers)))) (goto-char (point-min)) (gnus-server-position-point)) @@ -346,8 +350,8 @@ The following commands are available: (and server (symbol-name server)))) (defun gnus-server-named-server () - "Returns a server name that matches one of the names returned by -gnus-method-to-server." + "Return a server name that matches one of the names returned by +`gnus-method-to-server'." (let ((server (get-text-property (point-at-bol) 'gnus-named-server))) (and server (symbol-name server)))) @@ -391,7 +395,14 @@ gnus-method-to-server." (if cached (setq gnus-server-method-cache (delq cached gnus-server-method-cache))) - (if entry (setcdr entry info) + (if entry + (progn + ;; Remove the server from `gnus-opened-servers' since + ;; it has never been opened with the new `info' yet. + (gnus-opened-servers-remove (cdr entry)) + ;; Don't make a new Lisp object. + (setcar (cdr entry) (car info)) + (setcdr (cdr entry) (cdr info))) (setq gnus-server-alist (nconc gnus-server-alist (list (cons server info)))))))) @@ -492,9 +503,8 @@ gnus-method-to-server." (defun gnus-server-open-all-servers () "Open all servers." (interactive) - (let ((servers gnus-inserted-opened-servers)) - (while servers - (gnus-server-open-server (car (pop servers)))))) + (dolist (server gnus-inserted-opened-servers) + (gnus-server-open-server (car server)))) (defun gnus-server-close-server (server) "Close SERVER." @@ -730,10 +740,10 @@ gnus-method-to-server." (if (eq (car method) 'nntp) (while (not (eobp)) (ignore-errors - (push (cons - (buffer-substring + (push (cons + (buffer-substring (point) - (progn + (progn (skip-chars-forward "^ \t") (point))) (let ((last (read cur))) @@ -797,18 +807,26 @@ gnus-method-to-server." (prog1 (1+ (point)) (insert (format "%c%7d: %s\n" - (let ((level (gnus-group-level - (concat prefix (setq name (car group)))))) + (let ((level + (if (string= prefix "") + (gnus-group-level (setq name (car group))) + (gnus-group-level + (concat prefix (setq name (car group))))))) (cond ((<= level gnus-level-subscribed) ? ) ((<= level gnus-level-unsubscribed) ?U) ((= level gnus-level-zombie) ?Z) (t ?K))) (max 0 (- (1+ (cddr group)) (cadr group))) - (decode-coding-string - name - (inline (gnus-group-name-charset method name)))))) - (list 'gnus-group name)))) + ;; Don't decode if name is ASCII + (if (and (fboundp 'detect-coding-string) + (eq (detect-coding-string name t) 'undecided)) + name + (decode-coding-string + name + (inline (gnus-group-name-charset method name))))))) + (list 'gnus-group name) + ))) (switch-to-buffer (current-buffer))) (goto-char (point-min)) (gnus-group-position-point) @@ -897,7 +915,7 @@ buffer. (beginning-of-line) (let ((name (get-text-property (point) 'gnus-group))) (when (re-search-forward ": \\(.*\\)$" (point-at-eol) t) - (concat (gnus-method-to-server-name gnus-browse-current-method) ":" + (concat (gnus-method-to-server-name gnus-browse-current-method) ":" (or name (match-string-no-properties 1))))))) @@ -972,7 +990,7 @@ buffer. (gnus-get-function (gnus-server-to-method server) 'request-regenerate) (error - (error "This backend doesn't support regeneration"))) + (error "This back end doesn't support regeneration"))) (gnus-message 5 "Requesting regeneration of %s..." server) (unless (gnus-open-server server) (error "Couldn't open server"))