1 ;;; liece-menu.el --- Define menus.
2 ;; Copyright (C) 1998-2000 Daiki Ueno
4 ;; Author: Daiki Ueno <ueno@unixuser.org>
7 ;; Keywords: menu, easymenu
9 ;; This file is part of Liece.
11 ;; This program is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; This program is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
35 (require 'liece-compat)
36 (require 'liece-commands)
38 (require 'liece-nick))
40 (defvar liece-use-localized-menu (featurep 'meadow))
42 (defvar liece-nick-popup-menu
44 ["Finger" liece-menu-callback-finger
45 liece-nick-region-nicks]
47 ["CTCP VERSION" liece-menu-callback-ctcp-version
48 liece-nick-region-nicks]
49 ["CTCP USERINFO" liece-menu-callback-ctcp-userinfo
50 liece-nick-region-nicks]
51 ["CTCP HELP" liece-menu-callback-ctcp-help
52 liece-nick-region-nicks]
53 ["CTCP CLIENTINFO" liece-menu-callback-ctcp-clientinfo
54 liece-nick-region-nicks]
55 ["CTCP PING" liece-menu-callback-ctcp-ping
56 liece-nick-region-nicks]
58 ["Set Channel Operator(s)" liece-menu-callback-mode+o
59 liece-nick-region-nicks]
60 ["Set Channel Voice(s)" liece-menu-callback-mode+v
61 liece-nick-region-nicks]
62 ["Unset Channel Operator(s)" liece-menu-callback-mode-o
63 liece-nick-region-nicks]
64 ["Unset Channel Voice(s)" liece-menu-callback-mode-v
65 liece-nick-region-nicks]
67 ["Kick" liece-menu-callback-kick
68 liece-nick-region-nicks]))
70 (defvar liece-menu-url-menu '("URL" "----"))
71 (defvar liece-menu-dcc-menu
73 ["Send file" liece-command-dcc-send t]
74 ["Receive file" liece-command-dcc-receive t]
76 ["Send chat request" liece-command-dcc-chat-listen t]
77 ["Accept chat request" liece-command-dcc-chat-connect t]
79 ["List DCC request" liece-command-dcc-list t]
80 ["Dispatch stacked DCC requests" liece-command-dcc-accept t]))
82 (defvar liece-menu-crypt-menu
84 ["Toggle crypt mode" liece-command-toggle-crypt t]
85 ["Set default key for this channel" liece-command-set-encryption-key
86 (or liece-current-channel liece-current-chat-partner)]
87 ["Add new key to keyring" liece-command-add-decryption-key t]
88 ["Remove key from keyring" liece-command-delete-decryption-key t]))
90 (defvar liece-menu-private-menu
92 ["Toggle private conversation" liece-command-toggle-private
93 (liece-server-opened)]
94 ["IsON" liece-command-ison (liece-server-opened)]
95 ["Register friends" liece-command-activate-friends t]
96 ["Unregister friends" liece-command-deactivate-friends t]
97 ["Display userhost" liece-command-userhost (liece-server-opened)]
98 ["Ignore nicks / regexp" liece-command-kill t]
99 ["Compose mail" liece-command-mail-compose t]))
101 (defvar liece-menu-ctcp-menu
103 ["ACTION" liece-command-client-action
104 liece-current-channel]
105 ["VERSION" liece-command-client-version
106 liece-current-channel]
107 ["USERINFO" liece-command-client-userinfo
108 liece-current-channel]
109 ["HELP" liece-command-client-help
110 liece-current-channel]
111 ["CLIENTINFO" liece-command-client-clientinfo
112 liece-current-channel]
113 ["PING" liece-command-client-ping
114 liece-current-channel]
116 ["Request X-Face" liece-command-client-x-face
117 liece-current-channel]
118 ["Set my X-Face" liece-command-client-x-face-from-xbm-file
119 liece-current-channel]))
121 (defvar liece-menu-channel-menu
124 ["Join channel" liece-command-join
125 (liece-server-opened)]
126 ["Part channel" liece-command-part
127 (or liece-current-channels liece-current-chat-partners)]
128 ["Go to next channel" liece-command-next-channel
129 (or liece-current-channels liece-current-chat-partners)]
130 ["Go to previous channel" liece-command-previous-channel
131 (or liece-current-channels liece-current-chat-partners)]
132 ["Rotate left channels" liece-command-pop
133 (or liece-current-channels liece-current-chat-partners)]
134 ["Rotate right channels" liece-command-push
135 (or liece-current-channels liece-current-chat-partners)]
137 ["Invite to this channel" liece-command-invite
138 liece-current-channel]
139 ["Kick out from this channel" liece-command-kick
140 liece-current-channel]
142 ["Set mode of this channel" liece-command-modec
143 liece-current-channel]
144 ["Set topic of this channel" liece-command-topic
145 liece-current-channel]
147 ["List channel" liece-command-list
148 (liece-server-opened)]
149 ["Display names of channel" liece-command-names
150 (liece-server-opened)]
151 ["Display who are on the channel" liece-command-names
152 (liece-server-opened)]
154 ["Toggle crypt mode" liece-command-toggle-crypt t]
155 ["Set default key of this channel" liece-command-set-default-key
156 (or liece-current-channel liece-current-chat-partner)]
158 (list liece-menu-ctcp-menu)))
160 (defvar liece-menu-IRC-menu
162 ["Load variables file" liece-command-load-vars t]
163 ["Save variables file" liece-command-save-vars t]
165 ["Change window style" liece-command-set-window-style t]
166 ["Reload style file" liece-command-reload-window-style t]
167 ["Reconfigure windows" liece-command-reconfigure-windows t]
168 ["Toggle channel buffer display state"
169 liece-command-toggle-channel-buffer-mode t]
170 ["Toggle nick buffer display state"
171 liece-command-toggle-nick-buffer-mode t]
173 ["Freeze buffer" liece-command-freeze t]
174 ["Own freeze buffer" liece-command-own-freeze t]
175 ["Enter debug mode" liece-command-debug t]
176 ["Quit IRC" liece-command-quit t]))
178 (defvar liece-menu-alist
180 (liece-menu-IRC-menu "IRC Menu.")
181 (liece-menu-channel-menu "Channel Menu.")
182 (liece-menu-private-menu "Private Menu.")
183 (liece-menu-crypt-menu "Crypt Menu.")
184 (liece-menu-dcc-menu "DCC Menu.")
185 (liece-menu-url-menu "URL Menu.")))
187 (defvar liece-menu-IRC-menu-map)
188 (defvar liece-menu-channel-menu-map)
189 (defvar liece-menu-private-menu-map)
190 (defvar liece-menu-crypt-menu-map)
191 (defvar liece-menu-dcc-menu-map)
192 (defvar liece-menu-url-menu-map)
196 (defmacro liece-menu-bogus-filter-constructor (name menu)
198 (setq x (x-popup-menu t ,menu)
199 y (and x (lookup-key ,menu (apply #'vector x))))
203 (defmacro liece-menu-popup-menu (event menu)
204 (if (featurep 'xemacs)
207 (easy-menu-define bogus-menu nil nil ,menu)
208 (liece-menu-bogus-filter-constructor "Popup" bogus-menu))))
210 (defun liece-nick-popup-menu (widget &optional event)
211 (let ((menu (copy-sequence liece-nick-popup-menu))
212 (pos (widget-event-point event)))
215 (if (eq major-mode 'liece-nick-mode)
216 (liece-nick-update-region))
217 (liece-menu-popup-menu event menu))))
219 ;;; @ initialize menus
221 (when (or (featurep 'menubar); XEmacs
222 (featurep 'menu-bar))
223 (add-hook 'liece-command-mode-hook 'liece-command-define-menus)
224 (add-hook 'liece-command-mode-hook 'liece-command-add-menus 'append)
225 (add-hook 'liece-url-add-hook 'liece-menu-add-url))
227 (defun liece-menu-define (menu)
228 (eval (list 'easy-menu-define
229 (intern (concat (symbol-name (car menu)) "-map"))
230 'liece-command-mode-map (cadr menu)
231 '(symbol-value (car menu)))))
233 (defun liece-command-define-menus-1 (value)
238 (when liece-use-localized-menu
239 (aset spec 0 (liece-intl-get-msgstr (aref spec 0)))))
241 (liece-command-define-menus-1 spec)))))
243 (defun liece-command-define-menus ()
244 (dolist (menu (reverse liece-menu-alist))
245 (let ((value (symbol-value (car menu))))
246 (liece-command-define-menus-1 value)
247 (liece-menu-define menu))))
249 (defun liece-command-add-menus ()
250 (dolist (menu liece-menu-alist)
251 (easy-menu-add (symbol-value (car menu)) liece-command-mode-map)))
253 (defun liece-menu-add-url (url)
254 (when (boundp 'liece-menu-url-menu-map)
256 liece-menu-url-menu-map nil
257 (vector url (list 'liece-command-browse-url url) t))))
261 (autoload 'liece-menu-callback-ctcp-version "liece-ctcp" nil t)
262 (autoload 'liece-menu-callback-ctcp-userinfo "liece-ctcp" nil t)
263 (autoload 'liece-menu-callback-ctcp-help "liece-ctcp" nil t)
264 (autoload 'liece-menu-callback-ctcp-clientinfo "liece-ctcp" nil t)
265 (autoload 'liece-menu-callback-ctcp-ping "liece-ctcp" nil t)
267 (defun liece-menu-callback-finger ()
269 (dolist (nick liece-nick-region-nicks)
270 (liece-command-finger nick)))
272 (defun liece-menu-callback-kick ()
274 (dolist (nick liece-nick-region-nicks)
275 (liece-command-kick nick)))
277 (defun liece-menu-callback-mode+o ()
279 (dolist (oper liece-nick-region-opers)
280 (setq liece-nick-region-nicks
281 (string-list-remove-ignore-case oper liece-nick-region-nicks)))
282 (liece-command-mode+o liece-nick-region-nicks))
284 (defun liece-menu-callback-mode+v ()
286 (dolist (voice liece-nick-region-voices)
287 (setq liece-nick-region-nicks
288 (string-list-remove-ignore-case voice liece-nick-region-nicks)))
289 (liece-command-mode+v liece-nick-region-nicks))
291 (defun liece-menu-callback-mode-o ()
293 (liece-command-mode-o liece-nick-region-opers))
295 (defun liece-menu-callback-mode-v ()
297 (liece-command-mode-v liece-nick-region-voices))
299 (provide 'liece-menu)
301 ;;; liece-menu.el ends here