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

   1 ;;; gnus-srvr.el --- virtual server support for Gnus
   2
   3 ;; Copyright (C) 1995-2013 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 3 of the License, or
  13 ;; (at your option) 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.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (eval-when-compile (require 'cl))
  28
  29 (require 'gnus)
  30 (require 'gnus-start)
  31 (require 'gnus-spec)
  32 (require 'gnus-group)
  33 (require 'gnus-int)
  34 (require 'gnus-range)
  35
  36 (autoload 'gnus-group-make-nnir-group "nnir")
  37
  38 (defcustom gnus-server-mode-hook nil
  39   "Hook run in `gnus-server-mode' buffers."
  40   :group 'gnus-server
  41   :type 'hook)
  42
  43 (defcustom gnus-server-exit-hook nil
  44   "Hook run when exiting the server buffer."
  45   :group 'gnus-server
  46   :type 'hook)
  47
  48 (defcustom gnus-server-line-format "     {%(%h:%w%)} %s%a\n"
  49   "Format of server lines.
  50 It works along the same lines as a normal formatting string,
  51 with some simple extensions.
  52
  53 The following specs are understood:
  54
  55 %h back end
  56 %n name
  57 %w address
  58 %s status
  59 %a agent covered
  60
  61 General format specifiers can also be used.
  62 See Info node `(gnus)Formatting Variables'."
  63   :link '(custom-manual "(gnus)Formatting Variables")
  64   :group 'gnus-server-visual
  65   :type 'string)
  66
  67 (defcustom gnus-server-mode-line-format "Gnus: %%b"
  68   "The format specification for the server mode line."
  69   :group 'gnus-server-visual
  70   :type 'string)
  71
  72 (defcustom gnus-server-browse-in-group-buffer nil
  73   "Whether server browsing should take place in the group buffer.
  74 If nil, a faster, but more primitive, buffer is used instead."
  75   :version "22.1"
  76   :group 'gnus-server-visual
  77   :type 'boolean)
  78
  79 ;;; Internal variables.
  80
  81 (defvar gnus-inserted-opened-servers nil)
  82
  83 (defvar gnus-server-line-format-alist
  84   `((?h gnus-tmp-how ?s)
  85     (?n gnus-tmp-name ?s)
  86     (?w gnus-tmp-where ?s)
  87     (?s gnus-tmp-status ?s)
  88     (?a gnus-tmp-agent ?s)))
  89
  90 (defvar gnus-server-mode-line-format-alist
  91   `((?S gnus-tmp-news-server ?s)
  92     (?M gnus-tmp-news-method ?s)
  93     (?u gnus-tmp-user-defined ?s)))
  94
  95 (defvar gnus-server-line-format-spec nil)
  96 (defvar gnus-server-mode-line-format-spec nil)
  97 (defvar gnus-server-killed-servers nil)
  98
  99 (defvar gnus-server-mode-map)
 100
 101 (defvar gnus-server-menu-hook nil
 102   "*Hook run after the creation of the server mode menu.")
 103
 104 (defun gnus-server-make-menu-bar ()
 105   (gnus-turn-off-edit-menu 'server)
 106   (unless (boundp 'gnus-server-server-menu)
 107     (easy-menu-define
 108      gnus-server-server-menu gnus-server-mode-map ""
 109      '("Server"
 110        ["Add..." gnus-server-add-server t]
 111        ["Browse" gnus-server-read-server t]
 112        ["Scan" gnus-server-scan-server t]
 113        ["List" gnus-server-list-servers t]
 114        ["Kill" gnus-server-kill-server t]
 115        ["Yank" gnus-server-yank-server t]
 116        ["Copy" gnus-server-copy-server t]
 117        ["Show" gnus-server-show-server t]
 118        ["Edit" gnus-server-edit-server t]
 119        ["Regenerate" gnus-server-regenerate-server t]
 120        ["Compact" gnus-server-compact-server t]
 121        ["Exit" gnus-server-exit t]))
 122
 123     (easy-menu-define
 124      gnus-server-connections-menu gnus-server-mode-map ""
 125      '("Connections"
 126        ["Open" gnus-server-open-server t]
 127        ["Close" gnus-server-close-server t]
 128        ["Offline" gnus-server-offline-server t]
 129        ["Deny" gnus-server-deny-server t]
 130        "---"
 131        ["Open All" gnus-server-open-all-servers t]
 132        ["Close All" gnus-server-close-all-servers t]
 133        ["Reset All" gnus-server-remove-denials t]))
 134
 135     (gnus-run-hooks 'gnus-server-menu-hook)))
 136
 137 (defvar gnus-server-mode-map nil)
 138 (put 'gnus-server-mode 'mode-class 'special)
 139
 140 (unless gnus-server-mode-map
 141   (setq gnus-server-mode-map (make-sparse-keymap))
 142   (suppress-keymap gnus-server-mode-map)
 143
 144   (gnus-define-keys gnus-server-mode-map
 145     " " gnus-server-read-server-in-server-buffer
 146     "\r" gnus-server-read-server
 147     gnus-mouse-2 gnus-server-pick-server
 148     "q" gnus-server-exit
 149     "l" gnus-server-list-servers
 150     "k" gnus-server-kill-server
 151     "y" gnus-server-yank-server
 152     "c" gnus-server-copy-server
 153     "a" gnus-server-add-server
 154     "e" gnus-server-edit-server
 155     "S" gnus-server-show-server
 156     "s" gnus-server-scan-server
 157
 158     "O" gnus-server-open-server
 159     "\M-o" gnus-server-open-all-servers
 160     "C" gnus-server-close-server
 161     "\M-c" gnus-server-close-all-servers
 162     "D" gnus-server-deny-server
 163     "L" gnus-server-offline-server
 164     "R" gnus-server-remove-denials
 165
 166     "n" next-line
 167     "p" previous-line
 168
 169     "g" gnus-server-regenerate-server
 170
 171     "G" gnus-group-make-nnir-group
 172
 173     "z" gnus-server-compact-server
 174
 175     "\C-c\C-i" gnus-info-find-node
 176     "\C-c\C-b" gnus-bug))
 177
 178 (defface gnus-server-agent
 179   '((((class color) (background light)) (:foreground "PaleTurquoise" :bold t))
 180     (((class color) (background dark)) (:foreground "PaleTurquoise" :bold t))
 181     (t (:bold t)))
 182   "Face used for displaying AGENTIZED servers"
 183   :group 'gnus-server-visual)
 184 ;; backward-compatibility alias
 185 (put 'gnus-server-agent-face 'face-alias 'gnus-server-agent)
 186 (put 'gnus-server-agent-face 'obsolete-face "22.1")
 187
 188 (defface gnus-server-opened
 189   '((((class color) (background light)) (:foreground "Green3" :bold t))
 190     (((class color) (background dark)) (:foreground "Green1" :bold t))
 191     (t (:bold t)))
 192   "Face used for displaying OPENED servers"
 193   :group 'gnus-server-visual)
 194 ;; backward-compatibility alias
 195 (put 'gnus-server-opened-face 'face-alias 'gnus-server-opened)
 196 (put 'gnus-server-opened-face 'obsolete-face "22.1")
 197
 198 (defface gnus-server-closed
 199   '((((class color) (background light)) (:foreground "Steel Blue" :italic t))
 200     (((class color) (background dark))
 201      (:foreground "LightBlue" :italic t))
 202     (t (:italic t)))
 203   "Face used for displaying CLOSED servers"
 204   :group 'gnus-server-visual)
 205 ;; backward-compatibility alias
 206 (put 'gnus-server-closed-face 'face-alias 'gnus-server-closed)
 207 (put 'gnus-server-closed-face 'obsolete-face "22.1")
 208
 209 (defface gnus-server-denied
 210   '((((class color) (background light)) (:foreground "Red" :bold t))
 211     (((class color) (background dark)) (:foreground "Pink" :bold t))
 212     (t (:inverse-video t :bold t)))
 213   "Face used for displaying DENIED servers"
 214   :group 'gnus-server-visual)
 215 ;; backward-compatibility alias
 216 (put 'gnus-server-denied-face 'face-alias 'gnus-server-denied)
 217 (put 'gnus-server-denied-face 'obsolete-face "22.1")
 218
 219 (defface gnus-server-offline
 220   '((((class color) (background light)) (:foreground "Orange" :bold t))
 221     (((class color) (background dark)) (:foreground "Yellow" :bold t))
 222     (t (:inverse-video t :bold t)))