[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