cgit.sxemacs.org Git - riece/blob - lisp/riece-menu.el

   1 ;;; riece-menu.el --- setup menus
   2 ;; Copyright (C) 1998-2003 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1998-09-28
   6 ;; Keywords: IRC, riece
   7
   8 ;; This file is part of Riece.
   9
  10 ;; This program 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 ;; This program 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., 51 Franklin Street, Fifth Floor,
  23 ;; Boston, MA 02110-1301, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; NOTE: This is an add-on module for Riece.
  28
  29 ;;; Code:
  30
  31 (require 'riece-options)
  32 (require 'riece-globals)
  33 (require 'riece-identity)
  34 (require 'riece-layout)
  35 (require 'riece-server)
  36 (require 'riece-mcat)
  37
  38 (defcustom riece-menu-items
  39   (list
  40    "Riece"
  41    (vector (riece-mcat "Next Channel") 'riece-command-next-channel
  42            'riece-current-channels)
  43    (vector (riece-mcat "Previous Channel") 'riece-command-previous-channel
  44            'riece-current-channels)
  45    "----"
  46    (list (riece-mcat "Channels")
  47          :filter 'riece-menu-create-channels-menu)
  48    (list (riece-mcat "Servers")
  49          :filter 'riece-menu-create-servers-menu)
  50    "----"
  51    (vector (riece-mcat "Redraw Layout") 'riece-command-configure-windows t)
  52    (list (riece-mcat "Change Window Layout...")
  53          :filter 'riece-menu-create-layouts-menu)
  54    (list (riece-mcat "Toggle...")
  55          (vector (riece-mcat "Freeze Channel Buffer")
  56                  'riece-command-toggle-freeze t)
  57          (vector (riece-mcat "Freeze Channel Buffer Until Next Message")
  58                  'riece-command-toggle-own-freeze t)
  59          (vector (riece-mcat "Display Channel Buffer")
  60                  'riece-command-toggle-channel-buffer-mode t)
  61          (vector (riece-mcat "Display Channel List Buffer")
  62                  'riece-command-toggle-channel-list-buffer-mode t)
  63          (vector (riece-mcat "Display User List Buffer")
  64                  'riece-command-toggle-user-list-buffer-mode t))
  65    "----"
  66    (vector (riece-mcat "Join Channel") 'riece-command-join t)
  67    (vector (riece-mcat "Part Channel") 'riece-command-part
  68            'riece-current-channel)
  69    (vector (riece-mcat "Set Channel Topic") 'riece-command-topic
  70            'riece-current-channel)
  71    (vector (riece-mcat "Kick User") 'riece-command-kick
  72            'riece-current-channel)
  73    (vector (riece-mcat "Invite User") 'riece-command-invite
  74            'riece-current-channel)
  75    "----"
  76    (vector (riece-mcat "Manage Add-ons") 'riece-command-list-addons t)
  77    (vector (riece-mcat "Version") 'riece-version t)
  78    (vector (riece-mcat "Submit Bug Report") 'riece-submit-bug-report t)
  79    "----"
  80    (vector (riece-mcat "Mark As Away") 'riece-command-toggle-away t)
  81    (vector (riece-mcat "Change Nickname") 'riece-command-change-nickname t)
  82    (vector (riece-mcat "Quit IRC") 'riece-command-quit t))
  83   "Menu used in command mode."
  84   :type 'sexp
  85   :group 'riece-options)
  86
  87 (defconst riece-menu-description
  88   "Setup Riece's command menus.")
  89
  90 (defun riece-menu-create-layouts-menu (menu)
  91   (mapcar (lambda (entry)
  92             (vector (car entry) (list 'riece-command-change-layout (car entry))
  93                     t))
  94           riece-layout-alist))
  95
  96 (defun riece-menu-create-channels-menu (menu)
  97   (mapcar (lambda (channel)
  98             (list (riece-format-identity channel)
  99                   (vector (riece-mcat "Switch To Channel")
 100                           (list 'riece-command-switch-to-channel channel) t)
 101                   (vector (riece-mcat "Part Channel")
 102                           (list 'riece-command-part channel) t)
 103                   (vector (riece-mcat "List Channel")
 104                           (list 'riece-command-list
 105                                 (riece-identity-prefix channel)) t)))
 106           riece-current-channels))
 107
 108 (defun riece-menu-create-servers-menu (menu)
 109   (mapcar (lambda (entry)
 110             (list (car entry)
 111                   (vector (riece-mcat "Open Server")
 112                           (list 'riece-command-open-server (car entry))
 113                           (not (riece-server-opened (car entry))))
 114                   (vector (riece-mcat "Close Server")
 115                           (list 'riece-command-close-server (car entry))
 116                           (riece-server-opened (car entry)))))
 117           riece-server-alist))
 118
 119 (defvar riece-command-mode-map)
 120 (defvar riece-menu)
 121
 122 (defun riece-menu-command-mode-hook ()
 123   (easy-menu-define riece-menu
 124                     riece-command-mode-map
 125                     "Riece Menu"
 126                     riece-menu-items)
 127   (easy-menu-add riece-menu))
 128
 129 (defun riece-menu-requires ()
 130   (if (memq 'riece-mcat riece-addons)
 131       '(riece-mcat)))
 132
 133 (defun riece-menu-insinuate ()
 134   (if (fboundp 'custom-reevaluate-setting)
 135       (custom-reevaluate-setting 'riece-menu-items)
 136     ;; We could emulate custom-reevaluate-setting by manually eval the
 137     ;; 'standard-value property of 'riece-menu-items.  In that case
 138     ;; (i.e. XEmacs 21.4), however, there is no way to render
 139     ;; non-ASCII labels in the menu, so give up here.
 140     )
 141   (if riece-command-buffer
 142       (with-current-buffer riece-command-buffer
 143         (riece-menu-command-mode-hook)))
 144   (add-hook 'riece-command-mode-hook
 145             'riece-menu-command-mode-hook))
 146
 147 (defun riece-menu-uninstall ()
 148   (if riece-command-buffer
 149       (with-current-buffer riece-command-buffer
 150         (easy-menu-remove riece-menu)))
 151   (remove-hook 'riece-command-mode-hook
 152                'riece-menu-command-mode-hook))
 153
 154 (provide 'riece-menu)
 155
 156 ;;; riece-menu.el ends here