;;; gnus-srvr.el --- virtual server support for Gnus

;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
;;   2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(eval-when-compile (require 'cl))

(require 'gnus)
(require 'gnus-start)
(require 'gnus-spec)
(require 'gnus-group)
(require 'gnus-int)
(require 'gnus-range)

(defcustom gnus-server-mode-hook nil
  "Hook run in `gnus-server-mode' buffers."
  :group 'gnus-server
  :type 'hook)

(defcustom gnus-server-exit-hook nil
  "Hook run when exiting the server buffer."
  :group 'gnus-server
  :type 'hook)

(defcustom gnus-server-line-format "     {%(%h:%w%)} %s%a\n"
  "Format of server lines.
It works along the same lines as a normal formatting string,
with some simple extensions.

The following specs are understood:

%h back end
%n name
%w address
%s status
%a agent covered

General format specifiers can also be used.
See Info node `(gnus)Formatting Variables'."
  :link '(custom-manual "(gnus)Formatting Variables")
  :group 'gnus-server-visual
  :type 'string)

(defcustom gnus-server-mode-line-format "Gnus: %%b"
  "The format specification for the server mode line."
  :group 'gnus-server-visual
  :type 'string)

(defcustom gnus-server-browse-in-group-buffer nil
  "Whether server browsing should take place in the group buffer.
If nil, a faster, but more primitive, buffer is used instead."
  :version "22.1"
  :group 'gnus-server-visual
  :type 'boolean)

;;; Internal variables.

(defvar gnus-inserted-opened-servers nil)

(defvar gnus-server-line-format-alist
  `((?h gnus-tmp-how ?s)
    (?n gnus-tmp-name ?s)
    (?w gnus-tmp-where ?s)
    (?s gnus-tmp-status ?s)
    (?a gnus-tmp-agent ?s)))

(defvar gnus-server-mode-line-format-alist
  `((?S gnus-tmp-news-server ?s)
    (?M gnus-tmp-news-method ?s)
    (?u gnus-tmp-user-defined ?s)))

(defvar gnus-server-line-format-spec nil)
(defvar gnus-server-mode-line-format-spec nil)
(defvar gnus-server-killed-servers nil)

(defvar gnus-server-mode-map)

(defvar gnus-server-menu-hook nil
  "*Hook run after the creation of the server mode menu.")

(defun gnus-server-make-menu-bar ()
  (gnus-turn-off-edit-menu 'server)
  (unless (boundp 'gnus-server-server-menu)
    (easy-menu-define
     gnus-server-server-menu gnus-server-mode-map ""
     '("Server"
       ["Add..." gnus-server-add-server t]
       ["Browse" gnus-server-read-server t]
       ["Scan" gnus-server-scan-server t]
       ["List" gnus-server-list-servers t]
       ["Kill" gnus-server-kill-server t]
       ["Yank" gnus-server-yank-server t]
       ["Copy" gnus-server-copy-server t]
       ["Edit" gnus-server-edit-server t]
       ["Regenerate" gnus-server-regenerate-server t]
       ["Compact" gnus-server-compact-server t]
       ["Exit" gnus-server-exit t]))

    (easy-menu-define
     gnus-server-connections-menu gnus-server-mode-map ""
     '("Connections"
       ["Open" gnus-server-open-server t]
       ["Close" gnus-server-close-server t]
       ["Offline" gnus-server-offline-server t]
       ["Deny" gnus-server-deny-server t]
       "---"
       ["Open All" gnus-server-open-all-servers t]
       ["Close All" gnus-server-close-all-servers t]
       ["Reset All" gnus-server-remove-denials t]))

    (gnus-run-hooks 'gnus-server-menu-hook)))

(defvar gnus-server-mode-map nil)
(put 'gnus-server-mode 'mode-class 'special)

(unless gnus-server-mode-map
  (setq gnus-server-mode-map (make-sparse-keymap))
  (suppress-keymap gnus-server-mode-map)

  (gnus-define-keys gnus-server-mode-map
    " " gnus-server-read-server-in-server-buffer
    "\r" gnus-server-read-server
    gnus-mouse-2 gnus-server-pick-server
    "q" gnus-server-exit
    "l" gnus-server-list-servers
    "k" gnus-server-kill-server
    "y" gnus-server-yank-server
    "c" gnus-server-copy-server
    "a" gnus-server-add-server
    "e" gnus-server-edit-server
    "s" gnus-server-scan-server

    "O" gnus-server-open-server
    "\M-o" gnus-server-open-all-servers
    "C" gnus-server-close-server
    "\M-c" gnus-server-close-all-servers
    "D" gnus-server-deny-server
    "L" gnus-server-offline-server
    "R" gnus-server-remove-denials

    "n" next-line
    "p" previous-line

    "g" gnus-server-regenerate-server

    "z" gnus-server-compact-server

    "\C-c\C-i" gnus-info-find-node
    "\C-c\C-b" gnus-bug))

(defface gnus-server-agent
  '((((class color) (background light)) (:foreground "PaleTurquoise" :bold t))
    (((class color) (background dark)) (:foreground "PaleTurquoise" :bold t))
    (t (:bold t)))
  "Face used for displaying AGENTIZED servers"
  :group 'gnus-server-visual)
;; backward-compatibility alias
(put 'gnus-server-agent-face 'face-alias 'gnus-server-agent)
(put 'gnus-server-agent-face 'obsolete-face "22.1")

(defface gnus-server-opened
  '((((class color) (background light)) (:foreground "Green3" :bold t))
    (((class color) (background dark)) (:foreground "Green1" :bold t))
    (t (:bold t)))
  "Face used for displaying OPENED servers"
  :group 'gnus-server-visual)
;; backward-compatibility alias
(put 'gnus-server-opened-face 'face-alias 'gnus-server-opened)
(put 'gnus-server-opened-face 'obsolete-face "22.1")

(defface gnus-server-closed
  '((((class color) (background light)) (:foreground "Steel Blue" :italic t))
    (((class color) (background dark))
     (:foreground "LightBlue" :italic t))
    (t (:italic t)))
  "Face used for displaying CLOSED servers"
  :group 'gnus-server-visual)
;; backward-compatibility alias
(put 'gnus-server-closed-face 'face-alias 'gnus-server-closed)
(put 'gnus-server-closed-face 'obsolete-face "22.1")

(defface gnus-server-denied
  '((((class color) (background light)) (:foreground "Red" :bold t))
    (((class color) (background dark)) (:foreground "Pink" :bold t))
    (t (:inverse-video t :bold t)))
  "Face used for displaying DENIED servers"
  :group 'gnus-server-visual)
;; backward-compatibility alias
(put 'gnus-server-denied-face 'face-alias 'gnus-server-denied)
(put 'gnus-server-denied-face 'obsolete-face "22.1")

(defface gnus-server-offline
  '((((class color) (background light)) (:foreground "Orange" :bold t))
    (((class color) (background dark)) (:foreground "Yellow" :bold t))
    (t (:inverse-video t :bold t)))
  "Face used for displaying OFFLINE servers"
  :group 'gnus-server-visual)
;; backward-compatibility alias
(put 'gnus-server-offline-face 'face-alias 'gnus-server-offline)
(put 'gnus-server-offline-face 'obsolete-face "22.1")

(defvar gnus-server-font-lock-keywords
  '(("(\\(agent\\))" 1 'gnus-server-agent)
    ("(\\(opened\\))" 1 'gnus-server-opened)
    ("(\\(closed\\))" 1 'gnus-server-closed)
    ("(\\(offline\\))" 1 'gnus-server-offline)
    ("(\\(denied\\))" 1 'gnus-server-denied)))

(defun gnus-server-mode ()
  "Major mode for listing and editing servers.

All normal editing commands are switched off.
\\<gnus-server-mode-map>
For more in-depth information on this mode, read the manual
\(`\\[gnus-info-find-node]').

The following commands are available:

\\{gnus-server-mode-map}"
  (interactive)
  (when (gnus-visual-p 'server-menu 'menu)
    (gnus-server-make-menu-bar))
  (kill-all-local-variables)
  (gnus-simplify-mode-line)
  (setq major-mode 'gnus-server-mode)
  (setq mode-name "Server")
  (gnus-set-default-directory)
  (setq mode-line-process nil)
  (use-local-map gnus-server-mode-map)
  (buffer-disable-undo)
  (setq truncate-lines t)
  (setq buffer-read-only t