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   (delq nil
  98         (mapcar (lambda (channel)
  99                   (if channel
 100                       (list (riece-format-identity channel)
 101                             (vector (riece-mcat "Switch To Channel")
 102                                     (list 'riece-command-switch-to-channel
 103                                           channel)
 104                                     t)
 105                             (vector (riece-mcat "Part Channel")
 106                                     (list 'riece-command-part channel) t)
 107                             (vector (riece-mcat "List Channel")
 108                                     (list 'riece-command-list
 109                                           (riece-identity-prefix channel)) t))))
 110                 riece-current-channels)))
 111
 112 (defun riece-menu-create-servers-menu (menu)
 113   (mapcar (lambda (entry)
 114             (list (car entry)
 115                   (vector (riece-mcat "Open Server")
 116                           (list 'riece-command-open-server (car entry))
 117                           (not (riece-server-opened (car entry))))
 118                   (vector (riece-mcat "Close Server")
 119                           (list 'riece-command-close-server (car entry))
 120                           (riece-server-opened (car entry)))))
 121           riece-server-alist))
 122
 123 (defvar riece-command-mode-map)
 124 (defvar riece-menu)
 125
 126 (defun riece-menu-command-mode-hook ()
 127   (easy-menu-define riece-menu
 128                     riece-command-mode-map
 129                     "Riece Menu"
 130                     riece-menu-items)
 131   (easy-menu-add riece-menu))
 132
 133 (defun riece-menu-requires ()
 134   (if (memq 'riece-mcat riece-addons)
 135       '(riece-mcat)))
 136
 137 (defun riece-menu-insinuate ()
 138   (if (fboundp 'custom-reevaluate-setting)
 139       (custom-reevaluate-setting 'riece-menu-items)
 140     ;; We could emulate custom-reevaluate-setting by manually eval the
 141     ;; 'standard-value property of 'riece-menu-items.  In that case
 142     ;; (i.e. XEmacs 21.4), however, there is no way to render
 143     ;; non-ASCII labels in the menu, so give up here.
 144     )
 145   (if riece-command-buffer
 146       (with-current-buffer riece-command-buffer
 147         (riece-menu-command-mode-hook)))
 148   (add-hook 'riece-command-mode-hook
 149             'riece-menu-command-mode-hook))
 150
 151 (defun riece-menu-uninstall ()
 152   (if riece-command-buffer
 153       (with-current-buffer riece-command-buffer
 154         (easy-menu-remove riece-menu)))
 155   (remove-hook 'riece-command-mode-hook
 156                'riece-menu-command-mode-hook))
 157
 158 (provide 'riece-menu)
 159
 160 ;;; riece-menu.el ends here