[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/gnus-cloud 9e226b6 2/3: Minor gnus-cloud UI improv
From: |
Teodor Zlatanov |
Subject: |
[Emacs-diffs] scratch/gnus-cloud 9e226b6 2/3: Minor gnus-cloud UI improvements. |
Date: |
Tue, 19 Jul 2016 20:12:30 +0000 (UTC) |
branch: scratch/gnus-cloud
commit 9e226b668bb105318b152d02aa1e669bc6e2431b
Author: Ted Zlatanov <address@hidden>
Commit: Ted Zlatanov <address@hidden>
Minor gnus-cloud UI improvements.
* 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.
---
lisp/gnus/gnus-cloud.el | 20 ++++++++++++++------
lisp/gnus/gnus-srvr.el | 14 ++++++++------
2 files changed, 22 insertions(+), 12 deletions(-)
diff --git a/lisp/gnus/gnus-cloud.el b/lisp/gnus/gnus-cloud.el
index 0860623..22086b1 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 4f463f8..66fb9ee 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)