Update copyright year to 2015

[gnus] / lisp / gnus-srvr.el

diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el
index 6977458..d32f7ca 100644 (file)
--- a/lisp/gnus-srvr.el
+++ b/lisp/gnus-srvr.el
@@ -1,6 +1,6 @@
 ;;; gnus-srvr.el --- virtual server support for Gnus
 
-;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: news
@@ -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.
@@ -78,6 +78,16 @@ If nil, a faster, but more primitive, buffer is used instead."
 
 ;;; Internal variables.
 
+(defvar gnus-tmp-how)
+(defvar gnus-tmp-name)
+(defvar gnus-tmp-where)
+(defvar gnus-tmp-status)
+(defvar gnus-tmp-agent)
+(defvar gnus-tmp-cloud)
+(defvar gnus-tmp-news-server)
+(defvar gnus-tmp-news-method)
+(defvar gnus-tmp-user-defined)
+
 (defvar gnus-inserted-opened-servers nil)
 
 (defvar gnus-server-line-format-alist
@@ -85,7 +95,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 +138,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 +184,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 +199,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 +249,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)
@@ -244,6 +266,7 @@ For more in-depth information on this mode, read the manual
 The following commands are available:
 
 \\{gnus-server-mode-map}"
+  ;; FIXME: Use define-derived-mode.
   (interactive)
   (when (gnus-visual-p 'server-menu 'menu)
     (gnus-server-make-menu-bar))
@@ -263,8 +286,9 @@ The following commands are available:
         '(gnus-server-font-lock-keywords t)))
   (gnus-run-mode-hooks 'gnus-server-mode-hook))
 
-(defun gnus-server-insert-server-line (gnus-tmp-name method)
-  (let* ((gnus-tmp-how (car method))
+(defun gnus-server-insert-server-line (name method)
+  (let* ((gnus-tmp-name name)
+         (gnus-tmp-how (car method))
         (gnus-tmp-where (nth 1 method))
         (elem (assoc method gnus-opened-servers))
         (gnus-tmp-status
@@ -281,6 +305,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
@@ -869,7 +896,7 @@ claim them."
       (gnus-message 5 "Connecting to %s...done" (nth 1 method))
       t))))
 
-(defun gnus-browse-mode ()
+(define-derived-mode gnus-browse-mode fundamental-mode "Browse Server"
   "Major mode for browsing a foreign server.
 
 All normal editing commands are switched off.
@@ -884,20 +911,14 @@ buffer.
 2) `\\[gnus-browse-read-group]' to read a group ephemerally.
 
 3) `\\[gnus-browse-exit]' to return to the group buffer."
-  (interactive)
-  (kill-all-local-variables)
   (when (gnus-visual-p 'browse-menu 'menu)
     (gnus-browse-make-menu-bar))
   (gnus-simplify-mode-line)
-  (setq major-mode 'gnus-browse-mode)
-  (setq mode-name "Browse Server")
   (setq mode-line-process nil)
-  (use-local-map gnus-browse-mode-map)
   (buffer-disable-undo)
   (setq truncate-lines t)
   (gnus-set-default-directory)
-  (setq buffer-read-only t)
-  (gnus-run-mode-hooks 'gnus-browse-mode-hook))
+  (setq buffer-read-only t))
 
 (defun gnus-browse-read-group (&optional no-article number)
   "Enter the group at the current line.
@@ -1022,7 +1043,7 @@ doing the deletion."
 (defun gnus-browse-exit ()
   "Quit browsing and return to the group buffer."
   (interactive)
-  (when (eq major-mode 'gnus-browse-mode)
+  (when (derived-mode-p 'gnus-browse-mode)
     (gnus-kill-buffer (current-buffer)))
   ;; Insert the newly subscribed groups in the group buffer.
   (with-current-buffer gnus-group-buffer
@@ -1089,6 +1110,27 @@ 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"))
+
+    (unless (gnus-method-option-p server 'cloud)
+      (error "The server under point doesn't support cloudiness"))
+
+    (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