;;; gnus-srvr.el --- virtual server support for Gnus
-;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(defvar gnus-inserted-opened-servers nil)
(defvar gnus-server-line-format-alist
- `((?h how ?s)
- (?n name ?s)
- (?w where ?s)
- (?s status ?s)))
+ `((?h gnus-tmp-how ?s)
+ (?n gnus-tmp-name ?s)
+ (?w gnus-tmp-where ?s)
+ (?s gnus-tmp-status ?s)))
(defvar gnus-server-mode-line-format-alist
- `((?S news-server ?s)
- (?M news-method ?s)
- (?u user-defined ?s)))
+ `((?S gnus-tmp-news-server ?s)
+ (?M gnus-tmp-news-method ?s)
+ (?u gnus-tmp-user-defined ?s)))
(defvar gnus-server-line-format-spec nil)
(defvar gnus-server-mode-line-format-spec nil)
"D" gnus-server-deny-server
"R" gnus-server-remove-denials
+ "n" next-line
+ "p" previous-line
+
"g" gnus-server-regenerate-server
"\C-c\C-i" gnus-info-find-node
(gnus-set-default-directory)
(setq mode-line-process nil)
(use-local-map gnus-server-mode-map)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(setq truncate-lines t)
(setq buffer-read-only t)
(gnus-run-hooks 'gnus-server-mode-hook))
-(defun gnus-server-insert-server-line (name method)
- (let* ((how (car method))
- (where (nth 1 method))
+(defun gnus-server-insert-server-line (gnus-tmp-name method)
+ (let* ((gnus-tmp-how (car method))
+ (gnus-tmp-where (nth 1 method))
(elem (assoc method gnus-opened-servers))
- (status (cond ((eq (nth 1 elem) 'denied)
- "(denied)")
- ((or (gnus-server-opened method)
- (eq (nth 1 elem) 'ok))
- "(opened)")
- (t
- "(closed)"))))
+ (gnus-tmp-status (cond ((eq (nth 1 elem) 'denied)
+ "(denied)")
+ ((or (gnus-server-opened method)
+ (eq (nth 1 elem) 'ok))
+ "(opened)")
+ (t
+ "(closed)"))))
(beginning-of-line)
(gnus-add-text-properties
(point)
(prog1 (1+ (point))
;; Insert the text.
(eval gnus-server-line-format-spec))
- (list 'gnus-server (intern name)))))
+ (list 'gnus-server (intern gnus-tmp-name)))))
(defun gnus-enter-server-buffer ()
"Set up the server buffer."
(error "No server on the current line")))
(unless (assoc server gnus-server-alist)
(error "Read-only server %s" server))
- (gnus-dribble-enter "")
+ (gnus-dribble-touch)
(let ((buffer-read-only nil))
(gnus-delete-line))
(push (assoc server gnus-server-alist) gnus-server-killed-servers)
(setq gnus-server-alist (delq (car gnus-server-killed-servers)
gnus-server-alist))
+ (let ((groups (gnus-groups-from-server server)))
+ (when (and groups
+ (gnus-yes-or-no-p
+ (format "Kill all %s groups from this server? "
+ (length groups))))
+ (dolist (group groups)
+ (setq gnus-newsrc-alist
+ (delq (assoc group gnus-newsrc-alist)
+ gnus-newsrc-alist))
+ (when gnus-group-change-level-function
+ (funcall gnus-group-change-level-function
+ group gnus-level-killed 3)))))
(gnus-server-position-point))
(defun gnus-server-yank-server ()
(suppress-keymap gnus-browse-mode-map)
(gnus-define-keys
- gnus-browse-mode-map
- " " gnus-browse-read-group
- "=" gnus-browse-select-group
- "n" gnus-browse-next-group
- "p" gnus-browse-prev-group
- "\177" gnus-browse-prev-group
- [delete] gnus-browse-prev-group
- "N" gnus-browse-next-group
- "P" gnus-browse-prev-group
- "\M-n" gnus-browse-next-group
- "\M-p" gnus-browse-prev-group
- "\r" gnus-browse-select-group
- "u" gnus-browse-unsubscribe-current-group
- "l" gnus-browse-exit
- "L" gnus-browse-exit
- "q" gnus-browse-exit
- "Q" gnus-browse-exit
- "\C-c\C-c" gnus-browse-exit
- "?" gnus-browse-describe-briefly
-
- "\C-c\C-i" gnus-info-find-node
- "\C-c\C-b" gnus-bug))
+ gnus-browse-mode-map
+ " " gnus-browse-read-group
+ "=" gnus-browse-select-group
+ "n" gnus-browse-next-group
+ "p" gnus-browse-prev-group
+ "\177" gnus-browse-prev-group
+ [delete] gnus-browse-prev-group
+ "N" gnus-browse-next-group
+ "P" gnus-browse-prev-group
+ "\M-n" gnus-browse-next-group
+ "\M-p" gnus-browse-prev-group
+ "\r" gnus-browse-select-group
+ "u" gnus-browse-unsubscribe-current-group
+ "l" gnus-browse-exit
+ "L" gnus-browse-exit
+ "q" gnus-browse-exit
+ "Q" gnus-browse-exit
+ "\C-c\C-c" gnus-browse-exit
+ "?" gnus-browse-describe-briefly
+
+ "\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)
(defun gnus-browse-foreign-server (server &optional return-buffer)
"Browse the server SERVER."
- (setq gnus-browse-current-method server)
+ (setq gnus-browse-current-method (gnus-server-to-method server))
(setq gnus-browse-return-buffer return-buffer)
- (let* ((method (gnus-server-to-method server))
+ (let* ((method gnus-browse-current-method)
(gnus-select-method method)
groups group)
(gnus-message 5 "Connecting to %s..." (nth 1 method))
(when gnus-carpal
(gnus-carpal-setup-buffer 'browse))
(gnus-configure-windows 'browse)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(let ((buffer-read-only nil))
(erase-buffer))
(gnus-browse-mode)
(goto-char (point-min))
(unless (string= gnus-ignored-newsgroups "")
(delete-matching-lines gnus-ignored-newsgroups))
- (while (re-search-forward
- "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
- (goto-char (match-end 1))
- (push (cons (match-string 1)
- (max 0 (- (1+ (read cur)) (read cur))))
- groups))))
+ (while (not (eobp))
+ (ignore-errors
+ (push (cons
+ (if (eq (char-after) ?\")
+ (read cur)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ name))
+ (max 0 (- (1+ (read cur)) (read cur))))
+ groups))
+ (forward-line))))
(setq groups (sort groups
(lambda (l1 l2)
(string< (car l1) (car l2)))))
(setq mode-name "Browse Server")
(setq mode-line-process nil)
(use-local-map gnus-browse-mode-map)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(setq truncate-lines t)
(gnus-set-default-directory)
(setq buffer-read-only t)
(error "Couldn't enter %s" group))
(unless (gnus-group-read-group nil no-article group)
(error "Couldn't enter %s" group)))))
-
+
(defun gnus-browse-select-group ()
"Select the current group."
(interactive)
(save-excursion
(beginning-of-line)
;; If this group it killed, then we want to subscribe it.
- (when (= (following-char) ?K)
+ (when (eq (char-after) ?K)
(setq sub t))
(setq group (gnus-browse-group-name))
(when (and sub
nil nil (if (gnus-server-equal
gnus-browse-current-method "native")
nil
- gnus-browse-current-method))
+ (gnus-method-simplify
+ gnus-browse-current-method)))
gnus-level-default-subscribed gnus-level-killed
(and (car (nth 1 gnus-newsrc-alist))
(gnus-gethash (car (nth 1 gnus-newsrc-alist))
projects / gnus / blobdiff