;;; gnus-srvr.el --- virtual server support for Gnus
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2012 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(require 'gnus-int)
(require 'gnus-range)
+(autoload 'gnus-group-make-nnir-group "nnir")
+
(defcustom gnus-server-mode-hook nil
"Hook run in `gnus-server-mode' buffers."
:group 'gnus-server
["Kill" gnus-server-kill-server t]
["Yank" gnus-server-yank-server t]
["Copy" gnus-server-copy-server t]
+ ["Show" gnus-server-show-server t]
["Edit" gnus-server-edit-server t]
["Regenerate" gnus-server-regenerate-server t]
["Compact" gnus-server-compact-server t]
"c" gnus-server-copy-server
"a" gnus-server-add-server
"e" gnus-server-edit-server
+ "S" gnus-server-show-server
"s" gnus-server-scan-server
"O" gnus-server-open-server
"g" gnus-server-regenerate-server
+ "G" gnus-group-make-nnir-group
+
"z" gnus-server-compact-server
"\C-c\C-i" gnus-info-find-node
(dolist (open gnus-opened-servers)
(when (and (not (member (car open) done))
;; Just ignore ephemeral servers.
- (not (member (car open) gnus-ephemeral-servers)))
+ (not (gnus-method-ephemeral-p (car open))))
(push (car open) done)
(gnus-server-insert-server-line
(setq op-ser (format "%s:%s" (caar open) (nth 1 (car open))))
(when entry
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
- (gnus-prin1-to-string (cdr entry)) ")\n")))
+ (gnus-prin1-to-string (cdr entry)) ")\n")
+ (concat "^(gnus-server-set-info \"" (regexp-quote server) "\"")))
(when (or entry oentry)
;; Buffer may be narrowed.
(save-restriction
(when (and server info)
(gnus-dribble-enter
(concat "(gnus-server-set-info \"" server "\" '"
- (gnus-prin1-to-string info) ")"))
+ (gnus-prin1-to-string info) ")")
+ (concat "^(gnus-server-set-info \"" (regexp-quote server) "\""))
(let* ((server (nth 1 info))
(entry (assoc server gnus-server-alist))
(cached (assoc server gnus-server-method-cache)))
(gnus-server-list-servers))
(defun gnus-server-copy-server (from to)
- "Copy a server definiton to a new name."
+ "Copy a server definition to a new name."
(interactive
(list
(or (gnus-server-server-name)
(gnus-server-position-point))
'edit-server)))
+(defun gnus-server-show-server (server)
+ "Show the definition of the server on the current line."
+ (interactive (list (gnus-server-server-name)))
+ (unless server
+ (error "No server on current line"))
+ (let ((info (gnus-server-to-method server)))
+ (gnus-edit-form
+ info "Showing the server."
+ `(lambda (form)
+ (gnus-server-position-point))
+ 'edit-server)))
+
(defun gnus-server-scan-server (server)
"Request a scan from the current server."
(interactive (list (gnus-server-server-name)))
(with-current-buffer nntp-server-buffer
(let ((cur (current-buffer)))
(goto-char (point-min))
- (unless (string= gnus-ignored-newsgroups "")
+ (unless (or (null gnus-ignored-newsgroups)
+ (string= gnus-ignored-newsgroups ""))
(delete-matching-lines gnus-ignored-newsgroups))
;; We treat NNTP as a special case to avoid problems with
;; garbage group names like `"foo' that appear in some badly
;; mechanism for new group subscription.
(gnus-call-subscribe-functions
gnus-browse-subscribe-newsgroup-method
- group)))
+ group)
+ (gnus-request-update-group-status group 'subscribe)))
(delete-char 1)
(insert (let ((lvl (gnus-group-level group)))
(cond