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    (list (riece-mcat "Change Window Layout...")
  52          :filter 'riece-menu-create-layouts-menu)
  53    (list (riece-mcat "Toggle...")
  54          (vector (riece-mcat "Freeze Channel Buffer")
  55                  'riece-command-toggle-freeze t)
  56          (vector (riece-mcat "Freeze Channel Buffer Until Next Message")
  57                  'riece-command-toggle-own-freeze t)
  58          (vector (riece-mcat "Display Channel Buffer")
  59                  'riece-command-toggle-channel-buffer-mode t)
  60          (vector (riece-mcat "Display Channel List Buffer")
  61                  'riece-command-toggle-channel-list-buffer-mode t)
  62          (vector (riece-mcat "Display User List Buffer")
  63                  'riece-command-toggle-user-list-buffer-mode t))
  64    "----"
  65    (vector (riece-mcat "Join Channel") 'riece-command-join t)
  66    (vector (riece-mcat "Part Channel") 'riece-command-part
  67            'riece-current-channel)
  68    (vector (riece-mcat "Set Channel Topic") 'riece-command-topic
  69            'riece-current-channel)
  70    (vector (riece-mcat "Kick User") 'riece-command-kick
  71            'riece-current-channel)
  72    (vector (riece-mcat "Invite User") 'riece-command-invite
  73            'riece-current-channel)
  74    "----"
  75    (vector (riece-mcat "Version") 'riece-version t)
  76    (vector (riece-mcat "Submit Bug Report") 'riece-submit-bug-report t)
  77    "----"
  78    (vector (riece-mcat "Mark As Away") 'riece-command-toggle-away t)
  79    (vector (riece-mcat "Change Nickname") 'riece-command-change-nickname t)
  80    (vector (riece-mcat "Quit IRC") 'riece-command-quit t))
  81   "Menu used in command mode."
  82   :type 'sexp
  83   :group 'riece-options)
  84
  85 (defconst riece-menu-description
  86   "Setup Riece's command menus.")
  87
  88 (defun riece-menu-create-layouts-menu (menu)
  89   (mapcar (lambda (entry)
  90             (vector (car entry) (list 'riece-command-change-layout (car entry))
  91                     t))
  92           riece-layout-alist))
  93
  94 (defun riece-menu-create-channels-menu (menu)
  95   (mapcar (lambda (channel)
  96             (list (riece-format-identity channel)
  97                   (vector (riece-mcat "Switch To Channel")
  98                           (list 'riece-command-switch-to-channel channel) t)
  99                   (vector (riece-mcat "Part Channel")
 100                           (list 'riece-command-part channel) t)
 101                   (vector (riece-mcat "List Channel")
 102                           (list 'riece-command-list
 103                                 (riece-identity-prefix channel)) t)))
 104           riece-current-channels))
 105
 106 (defun riece-menu-create-servers-menu (menu)
 107   (mapcar (lambda (entry)
 108             (list (car entry)
 109                   (vector (riece-mcat "Open Server")
 110                           (list 'riece-command-open-server (car entry))
 111                           (not (riece-server-opened (car entry))))
 112                   (vector (riece-mcat "Close Server")
 113                           (list 'riece-command-close-server (car entry))
 114                           (riece-server-opened (car entry)))))
 115           riece-server-alist))
 116
 117 (defvar riece-command-mode-map)
 118 (defvar riece-menu)
 119
 120 (defun riece-menu-command-mode-hook ()
 121   (easy-menu-define riece-menu
 122                     riece-command-mode-map
 123                     "Riece Menu"
 124                     riece-menu-items)
 125   (easy-menu-add riece-menu))
 126
 127 (defun riece-menu-requires ()
 128   (if (memq 'riece-mcat riece-addons)
 129       '(riece-mcat)))
 130
 131 (defun riece-menu-insinuate ()
 132   (if (fboundp 'custom-reevaluate-setting)
 133       (custom-reevaluate-setting 'riece-menu-items)
 134     ;; We could emulate custom-reevaluate-setting by manually eval the
 135     ;; 'standard-value property of 'riece-menu-items.  In that case
 136     ;; (i.e. XEmacs 21.4), however, there is no way to render
 137     ;; non-ASCII labels in the menu, so give up here.
 138     )
 139   (if riece-command-buffer
 140       (with-current-buffer riece-command-buffer
 141         (riece-menu-command-mode-hook)))
 142   (add-hook 'riece-command-mode-hook
 143             'riece-menu-command-mode-hook))
 144
 145 (defun riece-menu-uninstall ()
 146   (if riece-command-buffer
 147       (with-current-buffer riece-command-buffer
 148         (easy-menu-remove riece-menu)))
 149   (remove-hook 'riece-command-mode-hook
 150                'riece-menu-command-mode-hook))
 151
 152 (provide 'riece-menu)
 153
 154 ;;; riece-menu.el ends here