[gnus git] branch master updated: m0-9-45-gdc0bb80 =2= Make it possible to specify servers to be covered by the cloud ; Make it possible to specify servers to be covered by the cloud

Lars Ingebrigtsen <[email protected]> Fri, 07 Feb 2014 02:58:16 +0100
Newsgroups gmane.emacs.gnus.cvs
Message-ID <[email protected]>
       via  dc0bb800b34f9fbea3d43dcb77402b052779cd14 (commit)
       via  8bbd3e56968f9a25f53d79d925551e7ed4213b0c (commit)
      from  3473191dc8a1fe61f874555a230284a7210f0442 (commit)


- Log -----------------------------------------------------------------
commit dc0bb800b34f9fbea3d43dcb77402b052779cd14
Author: Lars Ingebrigtsen <[email protected]>
Date:   Thu Feb 6 17:57:06 2014 -0800

    Make it possible to specify servers to be covered by the cloud

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index e6f22e4..8b20ce0 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,8 @@
 2014-02-07  Lars Ingebrigtsen  <[email protected]>
 
+	* gnus-srvr.el (gnus-server-toggle-cloud-server): New command and
+	keystroke.
+
 	* ietf-drums.el (ietf-drums-parse-address): Don't bug out when called
 	with an empty string.
 
diff --git a/lisp/gnus-cloud.el b/lisp/gnus-cloud.el
index 9739f7c..62a25d7 100644
--- a/lisp/gnus-cloud.el
+++ b/lisp/gnus-cloud.el
@@ -42,6 +42,7 @@
   :type '(repeat regexp))
 
 (defvar gnus-cloud-group-name "*Emacs Cloud*")
+(defvar gnus-cloud-covered-servers nil)
 
 (defvar gnus-cloud-version 1)
 (defvar gnus-cloud-sequence 1)
@@ -318,6 +319,9 @@
 	  (push (gnus-cloud-parse-chunk) chunks)
 	  (forward-line 1))))))
 
+(defun gnus-cloud-server-p (server)
+  (member server gnus-cloud-covered-servers))
+
 (provide 'gnus-cloud)
 
 ;;; gnus-cloud.el ends here
diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el
index 319f7a8..584515c 100644
--- a/lisp/gnus-srvr.el
+++ b/lisp/gnus-srvr.el
@@ -45,7 +45,7 @@
   :group 'gnus-server
   :type 'hook)
 
-(defcustom gnus-server-line-format "     {%(%h:%w%)} %s%a\n"
+(defcustom gnus-server-line-format "     {%(%h:%w%)} %s%a%c\n"
   "Format of server lines.
 It works along the same lines as a normal formatting string,
 with some simple extensions.
@@ -85,7 +85,8 @@ If nil, a faster, but more primitive, buffer is used instead."
     (?n gnus-tmp-name ?s)
     (?w gnus-tmp-where ?s)
     (?s gnus-tmp-status ?s)
-    (?a gnus-tmp-agent ?s)))
+    (?a gnus-tmp-agent ?s)
+    (?c gnus-tmp-cloud ?s)))
 
 (defvar gnus-server-mode-line-format-alist
   `((?S gnus-tmp-news-server ?s)
@@ -127,6 +128,7 @@ If nil, a faster, but more primitive, buffer is used instead."
        ["Close" gnus-server-close-server t]
        ["Offline" gnus-server-offline-server t]
        ["Deny" gnus-server-deny-server t]
+       ["Toggle Cloud" gnus-server-toggle-cloud-server t]
        "---"
        ["Open All" gnus-server-open-all-servers t]
        ["Close All" gnus-server-close-all-servers t]
@@ -172,6 +174,8 @@ If nil, a faster, but more primitive, buffer is used instead."
 
     "z" gnus-server-compact-server
 
+    "i" gnus-server-toggle-cloud-server
+
     "\C-c\C-i" gnus-info-find-node
     "\C-c\C-b" gnus-bug))
 
@@ -185,6 +189,13 @@ If nil, a faster, but more primitive, buffer is used instead."
 (put 'gnus-server-agent-face 'face-alias 'gnus-server-agent)
 (put 'gnus-server-agent-face 'obsolete-face "22.1")
 
+(defface gnus-server-cloud
+  '((((class color) (background light)) (:foreground "ForestGreen" :bold t))
+    (((class color) (background dark)) (:foreground "PaleGreen" :bold t))
+    (t (:bold t)))
+  "Face used for displaying AGENTIZED servers"
+  :group 'gnus-server-visual)
+
 (defface gnus-server-opened
   '((((class color) (background light)) (:foreground "Green3" :bold t))
     (((class color) (background dark)) (:foreground "Green1" :bold t))
@@ -228,6 +239,7 @@ If nil, a faster, but more primitive, buffer is used instead."
 
 (defvar gnus-server-font-lock-keywords
   '(("(\\(agent\\))" 1 'gnus-server-agent)
+    ("(\\(cloud\\))" 1 'gnus-server-cloud)
     ("(\\(opened\\))" 1 'gnus-server-opened)
     ("(\\(closed\\))" 1 'gnus-server-closed)
     ("(\\(offline\\))" 1 'gnus-server-offline)
@@ -282,6 +294,9 @@ The following commands are available:
 	 (gnus-tmp-agent (if (and gnus-agent
 				  (gnus-agent-method-p method))
 			     " (agent)"
+			   ""))
+	 (gnus-tmp-cloud (if (gnus-cloud-server-p gnus-tmp-name)
+			     " (cloud)"
 			   "")))
     (beginning-of-line)
     (gnus-add-text-properties
@@ -1084,6 +1099,24 @@ Requesting compaction of %s... (this may take a long time)"
       (let ((original (get-buffer gnus-original-article-buffer)))
 	(and original (gnus-kill-buffer original))))))
 
+(defun gnus-server-toggle-cloud-server ()
+  "Make the server under point be replicated in the Emacs Cloud."
+  (interactive)
+  (let ((server (gnus-server-server-name)))
+    (unless server
+      (error "No server on the current line"))
+
+    (if (gnus-cloud-server-p server)
+	(setq gnus-cloud-covered-servers
+	      (delete server gnus-cloud-covered-servers))
+      (push server gnus-cloud-covered-servers))
+
+    (gnus-server-update-server server)
+    (gnus-message 1 (if (gnus-cloud-server-p server)
+			"Replication of %s in the cloud will start"
+		      "Replication of %s in the cloud will stop")
+		  server)))
+
 (provide 'gnus-srvr)
 
 ;;; gnus-srvr.el ends here

commit 8bbd3e56968f9a25f53d79d925551e7ed4213b0c
Author: Lars Ingebrigtsen <[email protected]>
Date:   Thu Feb 6 17:56:44 2014 -0800

    Make it possible to specify servers to be covered by the cloud

diff --git a/lisp/gnus.el b/lisp/gnus.el
index bf39dcf..2c9cc11 100644
--- a/lisp/gnus.el
+++ b/lisp/gnus.el
@@ -2703,6 +2703,7 @@ such as a mark that says whether an article is stored in the cache
 			gnus-killed-list gnus-zombie-list
 			gnus-topic-topology gnus-topic-alist
 			gnus-cloud-sequence
+			gnus-cloud-covered-servers
 			gnus-cloud-file-timestamps)
   "Gnus variables saved in the quick startup file.")
 

-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.

Summary of changes:
 lisp/ChangeLog     |    3 +++
 lisp/gnus-cloud.el |    4 ++++
 lisp/gnus-srvr.el  |   37 +++++++++++++++++++++++++++++++++++--
 lisp/gnus.el       |    1 +
 4 files changed, 43 insertions(+), 2 deletions(-)

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".

The branch, master has been updated


hooks/post-receive
-- 
Gnus Project