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