(require 'gnus-group)
(require 'gnus-int)
(require 'gnus-range)
+(require 'gnus-cloud)
(autoload 'gnus-group-make-nnir-group "nnir")
(defvar gnus-server-mode-map)
-(defvar gnus-server-menu-hook nil
- "*Hook run after the creation of the server mode menu.")
+(defcustom gnus-server-menu-hook nil
+ "Hook run after the creation of the server mode menu."
+ :type 'hook
+ :group 'gnus-server)
(defun gnus-server-make-menu-bar ()
(gnus-turn-off-edit-menu 'server)
["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]
+ ["Toggle Cloud Sync for this server" gnus-server-toggle-cloud-server t]
+ ["Toggle Cloud Sync Host" gnus-server-toggle-cloud-method-server t]
"---"
["Open All" gnus-server-open-all-servers t]
["Close All" gnus-server-close-all-servers t]
"z" gnus-server-compact-server
"i" gnus-server-toggle-cloud-server
+ "I" gnus-server-toggle-cloud-method-server
"\C-c\C-i" gnus-info-find-node
"\C-c\C-b" gnus-bug))
'((((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"
+ "Face used for displaying Cloud-synced servers"
+ :group 'gnus-server-visual)
+
+(defface gnus-server-cloud-host
+ '((((class color) (background light)) (:foreground "ForestGreen" :inverse-video t :italic t))
+ (((class color) (background dark)) (:foreground "PaleGreen" :inverse-video t :italic t))
+ (t (:inverse-video t :italic t)))
+ "Face used for displaying the Cloud Host"
:group 'gnus-server-visual)
(defface gnus-server-opened
(defvar gnus-server-font-lock-keywords
'(("(\\(agent\\))" 1 'gnus-server-agent)
- ("(\\(cloud\\))" 1 'gnus-server-cloud)
+ ("(\\(cloud[-]sync\\))" 1 'gnus-server-cloud)
+ ("(\\(CLOUD[-]HOST\\))" 1 'gnus-server-cloud-host)
("(\\(opened\\))" 1 'gnus-server-opened)
("(\\(closed\\))" 1 'gnus-server-closed)
("(\\(offline\\))" 1 'gnus-server-offline)
(gnus-agent-method-p method))
" (agent)"
""))
- (gnus-tmp-cloud (if (gnus-cloud-server-p gnus-tmp-name)
- " (cloud)"
- "")))
+ (gnus-tmp-cloud (concat
+ (if (gnus-cloud-host-server-p gnus-tmp-name)
+ " (CLOUD-HOST)"
+ "")
+ (if (gnus-cloud-server-p gnus-tmp-name)
+ " (cloud-sync)"
+ ""))))
(beginning-of-line)
(add-text-properties
(point)
;;; Browse Server Mode
;;;
-(defvar gnus-browse-menu-hook nil
- "*Hook run after the creation of the browse mode menu.")
+(defcustom gnus-browse-menu-hook nil
+ "Hook run after the creation of the browse mode menu."
+ :group 'gnus-server
+ :type 'hook)
(defcustom gnus-browse-subscribe-newsgroup-method
'gnus-subscribe-alphabetically
"Replication of %s in the cloud will stop")
server)))
+(defun gnus-server-toggle-cloud-method-server ()
+ "Set the server under point to host the Emacs Cloud."
+ (interactive)
+ (let ((server (gnus-server-server-name)))
+ (unless server
+ (error "No server on the current line"))
+ (unless (gnus-cloud-host-acceptable-method-p server)
+ (error "The server under point can't host the Emacs Cloud"))
+
+ (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)
;;; gnus-srvr.el ends here