(ietf-drums-syntax-table): Set syntax of ?* ?\;

[gnus] / lisp / gnus-srvr.el

diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el
index 43f5d08..43a0231 100644 (file)
--- 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 <larsi@gnus.org>
@@ -51,7 +51,7 @@ with some simple extensions.
 
 The following specs are understood:
 
-%h backend
+%h back end
 %n name
 %w address
 %s status
@@ -281,8 +281,7 @@ The following commands are available:
                  "(closed)")
              ((error) "(error)")))))
         (gnus-tmp-agent (if (and gnus-agent
-                                 (member method
-                                         gnus-agent-covered-methods))
+                                 (gnus-agent-method-p method))
                             " (agent)"
                           "")))
     (beginning-of-line)
@@ -291,7 +290,8 @@ The following commands are available:
      (prog1 (1+ (point))
        ;; Insert the text.
        (eval gnus-server-line-format-spec))
-     (list 'gnus-server (intern gnus-tmp-name)))))
+     (list 'gnus-server (intern gnus-tmp-name)
+           'gnus-named-server (intern (gnus-method-to-server method))))))
 
 (defun gnus-enter-server-buffer ()
   "Set up the server buffer."
@@ -342,7 +342,13 @@ The following commands are available:
   (gnus-server-position-point))
 
 (defun gnus-server-server-name ()
-  (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server)))
+  (let ((server (get-text-property (point-at-bol) 'gnus-server)))
+    (and server (symbol-name server))))
+
+(defun gnus-server-named-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))))
 
 (defalias 'gnus-server-position-point 'gnus-goto-colon)
@@ -385,7 +391,14 @@ The following commands are available:
       (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))))))))
 
@@ -724,10 +737,10 @@ The following commands are available:
          (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)))
@@ -791,18 +804,26 @@ The following commands are available:
             (prog1 (1+ (point))
               (insert
                (format "%c%7d: %s\n"
-                       (let ((level (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)))
+                       (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)))
-                       (mm-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
+                         (mm-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)
@@ -890,8 +911,8 @@ buffer.
   (save-excursion
     (beginning-of-line)
     (let ((name (get-text-property (point) 'gnus-group)))
-      (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
-       (concat (gnus-method-to-server-name gnus-browse-current-method) ":" 
+      (when (re-search-forward ": \\(.*\\)$" (point-at-eol) t)
+       (concat (gnus-method-to-server-name gnus-browse-current-method) ":"
                (or name
                    (match-string-no-properties 1)))))))
 
@@ -927,8 +948,7 @@ buffer.
                              gnus-browse-current-method)))
             gnus-level-default-subscribed (gnus-group-level group)
             (and (car (nth 1 gnus-newsrc-alist))
-                 (gnus-gethash (car (nth 1 gnus-newsrc-alist))
-                               gnus-newsrc-hashtb))
+                 (gnus-group-entry (car (nth 1 gnus-newsrc-alist))))
             t)
            (delete-char 1)
            (insert ? ))
@@ -967,7 +987,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"))
@@ -977,4 +997,5 @@ buffer.
 
 (provide 'gnus-srvr)
 
+;;; arch-tag: c0117f64-27ca-475d-9406-8da6854c7a25
 ;;; gnus-srvr.el ends here