Minor gnus-cloud UI improvements.scratch/gnus-cloud

* gnus-cloud.el (gnus-cloud-host-acceptable-method-p): New function so
other code can check if a server method can host the Gnus cloud.
(gnus-cloud-storage-method): Use 'radio instead of 'choice for better UI.
(gnus-cloud-method): Make this a defcustom and note how to set it.

* gnus-srvr.el (gnus-server-toggle-cloud-method-server): Use
gnus-cloud-host-acceptable-method-p.
(gnus-server-toggle-cloud-method-server): Use custom-set-variables to
set the gnus-cloud-method. Ask the user if it's OK to upload the data
right now.

2 files changed, 22 insertions, 12 deletions

diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index 08606234cdd..22086b1f36e 100644
--- a/lisp/gnus/gnus-cloud.el
+++ b/lisp/gnus/gnus-cloud.el
@@ -52,10 +52,10 @@
 (defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip)
   "Storage method for cloud data, defaults to EPG if that's available."
   :group 'gnus-cloud
-  :type '(choice (const :tag "No encoding" nil)
-                 (const :tag "Base64" base64)
-                 (const :tag "Base64+gzip" base64-gzip)
-                 (const :tag "EPG" epg)))
+  :type '(radio (const :tag "No encoding" nil)
+                (const :tag "Base64" base64)
+                (const :tag "Base64+gzip" base64-gzip)
+                (const :tag "EPG" epg)))
 
 (defcustom gnus-cloud-interactive t
   "Whether Gnus Cloud changes should be confirmed."
@@ -68,8 +68,13 @@
 (defvar gnus-cloud-version 1)
 (defvar gnus-cloud-sequence 1)
 
-(defvar gnus-cloud-method nil
-  "The IMAP select method used to store the cloud data.")
+(defcustom gnus-cloud-method nil
+  "The IMAP select method used to store the cloud data.
+See also `gnus-server-toggle-cloud-method-server' for an
+easy interactive way to set this from the Server buffer."
+  :group 'gnus-cloud
+  :type '(radio (const :tag "Not set" nil)
+                (string :tag "A Gnus server name as a string")))
 
 (defun gnus-cloud-make-chunk (elems)
   (with-temp-buffer
@@ -468,6 +473,9 @@ Otherwise, returns the Gnus Cloud data chunks."
 (defun gnus-cloud-host-server-p (server)
   (equal gnus-cloud-method server))
 
+(defun gnus-cloud-host-acceptable-method-p (server)
+  (eq (car-safe (gnus-server-to-method server)) 'nnimap))
+
 (defun gnus-cloud-collect-full-newsrc ()
   "Collect all the Gnus newsrc data in a portable format."
   (let ((infos nil))
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index 4f463f8d482..66fb9ee1b59 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -32,6 +32,7 @@
 (require 'gnus-group)
 (require 'gnus-int)
 (require 'gnus-range)
+(require 'gnus-cloud)
 
 (autoload 'gnus-group-make-nnir-group "nnir")
 
@@ -322,7 +323,7 @@ The following commands are available:
                             "")
                           (if (gnus-cloud-server-p gnus-tmp-name)
 			     " (cloud-sync)"
-			   ""))))
+                            ""))))
     (beginning-of-line)
     (add-text-properties
      (point)
@@ -1152,12 +1153,13 @@ Requesting compaction of %s... (this may take a long time)"
   (let ((server (gnus-server-server-name)))
     (unless server
       (error "No server on the current line"))
-    (unless (eq (car-safe (gnus-server-to-method server)) 'nnimap)
-      (error "The server under point is not IMAP, so it can't host the Emacs Cloud"))
+    (unless (gnus-cloud-host-acceptable-method-p server)
+      (error "The server under point can't host the Emacs Cloud"))
 
-    (setq gnus-cloud-method server)
-    (gnus-message 1 "Uploading all data to Emacs Cloud with %S" gnus-cloud-method)
-    (gnus-cloud-upload-data t)))
+    (custom-set-variables '(gnus-cloud-method server))
+    (when (gnus-yes-or-no-p (format "Upload Cloud data to %S now? " server))
+      (gnus-message 1 "Uploading all data to Emacs Cloud server %S" server)
+      (gnus-cloud-upload-data t))))
 
 (provide 'gnus-srvr)