mm-decode.el (shr-map): Silence the byte compiler

[gnus] / lisp / gnus-srvr.el

diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el
index b532b74..6977458 100644 (file)
--- 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-2013 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; 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
@@ -325,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))))
@@ -357,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
@@ -376,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)))
@@ -483,8 +490,7 @@ The following commands are available:
       (error "No such server: %s" server))
     (gnus-server-set-status method 'ok)
     (prog1
-       (or (gnus-open-server method)
-           (progn (message "Couldn't open %s" server) nil))
+       (gnus-open-server method)
       (gnus-server-update-server server)
       (gnus-server-position-point))))
 
@@ -546,7 +552,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)
@@ -605,6 +611,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)))
@@ -695,6 +713,7 @@ claim them."
     "q" gnus-browse-exit
     "Q" gnus-browse-exit
     "d" gnus-browse-describe-group
+    [delete] gnus-browse-delete-group
     "\C-c\C-c" gnus-browse-exit
     "?" gnus-browse-describe-briefly
 
@@ -748,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
@@ -945,6 +965,16 @@ how new groups will be entered into the group buffer."
   (interactive (list (gnus-browse-group-name)))
   (gnus-group-describe-group nil group))
 
+(defun gnus-browse-delete-group (group force)
+  "Delete the current group.  Only meaningful with editable groups.
+If FORCE (the prefix) is non-nil, all the articles in the group will
+be deleted.  This is \"deleted\" as in \"removed forever from the face
+of the Earth\".  There is no undo.  The user will be prompted before
+doing the deletion."
+  (interactive (list (gnus-browse-group-name)
+                    current-prefix-arg))
+  (gnus-group-delete-group group force))
+
 (defun gnus-browse-unsubscribe-group ()
   "Toggle subscription of the current group in the browse buffer."
   (let ((sub nil)
@@ -974,7 +1004,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