cgit.sxemacs.org Git - gnus/blob - lisp/gnus-srvr.el

   1 ;;; gnus-srvr.el --- virtual server support for Gnus
   2 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001
   3 ;;        Free Software Foundation, Inc.
   4
   5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   6 ;; Keywords: news
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (eval-when-compile (require 'cl))
  30
  31 (require 'gnus)
  32 (require 'gnus-spec)
  33 (require 'gnus-group)
  34 (require 'gnus-int)
  35 (require 'gnus-range)
  36
  37 (defvar gnus-server-mode-hook nil
  38   "Hook run in `gnus-server-mode' buffers.")
  39
  40 (defconst gnus-server-line-format "     {%(%h:%w%)} %s%a\n"
  41   "Format of server lines.
  42 It works along the same lines as a normal formatting string,
  43 with some simple extensions.
  44
  45 The following specs are understood:
  46
  47 %h backend
  48 %n name
  49 %w address
  50 %s status
  51 %a agent covered")
  52
  53 (defvar gnus-server-mode-line-format "Gnus: %%b"
  54   "The format specification for the server mode line.")
  55
  56 (defvar gnus-server-exit-hook nil
  57   "*Hook run when exiting the server buffer.")
  58
  59 (defvar gnus-server-browse-in-group-buffer nil
  60   "Whether browse server in group buffer.")
  61
  62 ;;; Internal variables.
  63
  64 (defvar gnus-inserted-opened-servers nil)
  65
  66 (defvar gnus-server-line-format-alist
  67   `((?h gnus-tmp-how ?s)
  68     (?n gnus-tmp-name ?s)
  69     (?w gnus-tmp-where ?s)
  70     (?s gnus-tmp-status ?s)
  71     (?a gnus-tmp-agent ?s)))
  72
  73 (defvar gnus-server-mode-line-format-alist
  74   `((?S gnus-tmp-news-server ?s)
  75     (?M gnus-tmp-news-method ?s)
  76     (?u gnus-tmp-user-defined ?s)))
  77
  78 (defvar gnus-server-line-format-spec nil)
  79 (defvar gnus-server-mode-line-format-spec nil)
  80 (defvar gnus-server-killed-servers nil)
  81
  82 (defvar gnus-server-mode-map)
  83
  84 (defvar gnus-server-menu-hook nil
  85   "*Hook run after the creation of the server mode menu.")
  86
  87 (defun gnus-server-make-menu-bar ()
  88   (gnus-turn-off-edit-menu 'server)
  89   (unless (boundp 'gnus-server-server-menu)
  90     (easy-menu-define
  91      gnus-server-server-menu gnus-server-mode-map ""
  92      '("Server"
  93        ["Add" gnus-server-add-server t]
  94        ["Browse" gnus-server-read-server t]
  95        ["Scan" gnus-server-scan-server t]
  96        ["List" gnus-server-list-servers t]
  97        ["Kill" gnus-server-kill-server t]
  98        ["Yank" gnus-server-yank-server t]
  99        ["Copy" gnus-server-copy-server t]
 100        ["Edit" gnus-server-edit-server t]
 101        ["Regenerate" gnus-server-regenerate-server t]
 102        ["Exit" gnus-server-exit t]))
 103
 104     (easy-menu-define
 105      gnus-server-connections-menu gnus-server-mode-map ""
 106      '("Connections"
 107        ["Open" gnus-server-open-server t]
 108        ["Close" gnus-server-close-server t]
 109        ["Deny" gnus-server-deny-server t]
 110        "---"
 111        ["Open All" gnus-server-open-all-servers t]
 112        ["Close All" gnus-server-close-all-servers t]
 113        ["Reset All" gnus-server-remove-denials t]))
 114
 115     (gnus-run-hooks 'gnus-server-menu-hook)))
 116
 117 (defvar gnus-server-mode-map nil)
 118 (put 'gnus-server-mode 'mode-class 'special)
 119
 120 (unless gnus-server-mode-map
 121   (setq gnus-server-mode-map (make-sparse-keymap))
 122   (suppress-keymap gnus-server-mode-map)
 123
 124   (gnus-define-keys gnus-server-mode-map
 125     " " gnus-server-read-server-in-server-buffer
 126     "\r" gnus-server-read-server
 127     gnus-mouse-2 gnus-server-pick-server
 128     "q" gnus-server-exit
 129     "l" gnus-server-list-servers
 130     "k" gnus-server-kill-server
 131     "y" gnus-server-yank-server
 132     "c" gnus-server-copy-server
 133     "a" gnus-server-add-server
 134     "e" gnus-server-edit-server
 135     "s" gnus-server-scan-server
 136
 137     "O" gnus-server-open-server
 138     "\M-o" gnus-server-open-all-servers
 139     "C" gnus-server-close-server
 140     "\M-c" gnus-server-close-all-servers
 141     "D" gnus-server-deny-server
 142     "R" gnus-server-remove-denials
 143
 144     "n" next-line
 145     "p" previous-line
 146
 147     "g" gnus-server-regenerate-server
 148
 149     "\C-c\C-i" gnus-info-find-node
 150     "\C-c\C-b" gnus-bug))
 151
 152 (defface gnus-server-agent-face
 153   '((((class color) (background light)) (:foreground "PaleTurquoise" :bold t))
 154     (((class color) (background dark)) (:foreground "PaleTurquoise" :bold t))
 155     (t (:bold t)))
 156   "Face used for displaying AGENTIZED servers"
 157   :group 'gnus-server-visual)
 158
 159 (defface gnus-server-opened-face
 160   '((((class color) (background light)) (:foreground "Green3" :bold t))
 161     (((class color) (background dark)) (:foreground "Green1" :bold t))
 162     (t (:bold t)))
 163   "Face used for displaying OPENED servers"
 164   :group 'gnus-server-visual)
 165
 166 (defface gnus-server-closed-face
 167   '((((class color) (background light)) (:foreground "Steel Blue" :italic t))
 168     (((class color) (background dark))
 169      (:foreground "Light Steel Blue" :italic t))
 170     (t (:italic t)))
 171   "Face used for displaying CLOSED servers"
 172   :group 'gnus-server-visual)
 173
 174 (defface gnus-server-denied-face
 175   '((((class color) (background light)) (:foreground "Red" :bold t))
 176     (((class color) (background dark)) (:foreground "Pink" :bold t))
 177     (t (:inverse-video t :bold t)))
 178   "Face used for displaying DENIED servers"
 179   :group 'gnus-server-visual)
 180
 181 (defcustom gnus-server-agent-face 'gnus-server-agent-face
 182   "Face name to use on AGENTIZED servers."
 183   :group 'gnus-server-visual
 184   :type 'face)
 185
 186 (defcustom gnus-server-opened-face 'gnus-server-opened-face
 187   "Face name to use on OPENED servers."
 188   :group 'gnus-server-visual
 189   :type 'face)
 190