X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fgnus-srvr.el;h=66509c939dc128bbbedb604bfb1c8a5676c373c8;hb=873ba7b51ddfb07246cd874b7de72662308236c9;hp=11164a8df6c85aaf1b7de9ea1888a82b1462469d;hpb=751a11b16dcddded32f9566f9dbbb72d039e2b29;p=gnus diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el index 11164a8df..66509c939 100644 --- a/lisp/gnus-srvr.el +++ b/lisp/gnus-srvr.el @@ -1,7 +1,6 @@ ;;; 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 ;; Keywords: news @@ -34,6 +33,8 @@ (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 @@ -113,6 +114,7 @@ If nil, a faster, but more primitive, buffer is used instead." ["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] @@ -150,6 +152,7 @@ If nil, a faster, but more primitive, buffer is used instead." "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 @@ -165,6 +168,8 @@ If nil, a faster, but more primitive, buffer is used instead." "g" gnus-server-regenerate-server + "G" gnus-group-make-nnir-group + "z" gnus-server-compact-server "\C-c\C-i" gnus-info-find-node @@ -301,9 +306,7 @@ The following commands are available: "Initialize the server buffer." (unless (get-buffer gnus-server-buffer) (with-current-buffer (gnus-get-buffer-create gnus-server-buffer) - (gnus-server-mode) - (when gnus-carpal - (gnus-carpal-setup-buffer 'server))))) + (gnus-server-mode)))) (defun gnus-server-prepare () (gnus-set-format 'server-mode) @@ -327,7 +330,7 @@ The following commands are available: (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)))) @@ -359,7 +362,8 @@ The following commands are available: (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 @@ -378,7 +382,8 @@ The following commands are available: (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))) @@ -548,7 +553,7 @@ The following commands are available: (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) @@ -571,8 +576,9 @@ The following commands are available: (defun gnus-server-add-server (how where) (interactive - (list (intern (completing-read "Server method: " - gnus-valid-select-methods nil t)) + (list (intern (gnus-completing-read "Server method" + (mapcar 'car gnus-valid-select-methods) + t)) (read-string "Server name: "))) (when (assq where gnus-server-alist) (error "Server with that name already defined")) @@ -582,7 +588,7 @@ The following commands are available: (defun gnus-server-goto-server (server) "Jump to a server line." (interactive - (list (completing-read "Goto server: " gnus-server-alist nil t))) + (list (gnus-completing-read "Goto server" (mapcar 'car gnus-server-alist) t))) (let ((to (text-property-any (point-min) (point-max) 'gnus-server (intern server)))) (when to @@ -606,6 +612,18 @@ The following commands are available: (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))) @@ -749,7 +767,8 @@ claim them." (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 @@ -805,8 +824,6 @@ claim them." (funcall gnus-group-prepare-function gnus-level-killed 'ignore 1 'ignore)) (gnus-get-buffer-create gnus-browse-buffer) - (when gnus-carpal - (gnus-carpal-setup-buffer 'browse)) (gnus-configure-windows 'browse) (buffer-disable-undo) (let ((buffer-read-only nil)) @@ -977,7 +994,8 @@ how new groups will be entered into the group buffer." ;; 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