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-set-operators
59 liece-nick-region-nicks]
60 ["Set Channel Voice(s)" liece-menu-callback-set-voices
61 liece-nick-region-nicks]
62 ["Unset Channel Operator(s)" liece-menu-callback-unset-operators
63 liece-nick-region-nicks]
64 ["Unset Channel Voice(s)" liece-menu-callback-unset-voices
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-private-menu
84 ["Toggle private conversation" liece-command-toggle-private
85 (liece-server-opened)]
86 ["IsON" liece-command-ison (liece-server-opened)]
87 ["Register friends" liece-command-activate-friends t]
88 ["Unregister friends" liece-command-deactivate-friends t]
89 ["Display userhost" liece-command-userhost (liece-server-opened)]
90 ["Ignore nicks / regexp" liece-command-kill t]
91 ["Compose mail" liece-command-mail-compose t]))
93 (defvar liece-menu-ctcp-menu
95 ["ACTION" liece-command-client-action
96 liece-current-channel]
97 ["VERSION" liece-command-client-version
98 liece-current-channel]
99 ["USERINFO" liece-command-client-userinfo
100 liece-current-channel]
101 ["HELP" liece-command-client-help
102 liece-current-channel]
103 ["CLIENTINFO" liece-command-client-clientinfo
104 liece-current-channel]
105 ["PING" liece-command-client-ping
106 liece-current-channel]
108 ["Request X-Face" liece-command-client-x-face
109 liece-current-channel]
110 ["Set my X-Face" liece-command-client-x-face-from-xbm-file
111 liece-current-channel]))
113 (defvar liece-menu-channel-menu
116 ["Join channel" liece-command-join
117 (liece-server-opened)]
118 ["Part channel" liece-command-part
119 (or liece-current-channels liece-current-chat-partners)]
120 ["Go to next channel" liece-command-next-channel
121 (or liece-current-channels liece-current-chat-partners)]
122 ["Go to previous channel" liece-command-previous-channel
123 (or liece-current-channels liece-current-chat-partners)]
124 ["Go to unread channel" liece-command-unread-channel
125 (or liece-current-channels liece-current-chat-partners)]
126 ["Rotate left channels" liece-command-pop
127 (or liece-current-channels liece-current-chat-partners)]
128 ["Rotate right channels" liece-command-push
129 (or liece-current-channels liece-current-chat-partners)]
131 ["Invite to this channel" liece-command-invite
132 liece-current-channel]
133 ["Kick out from this channel" liece-command-kick
134 liece-current-channel]
136 ["Set mode of this channel" liece-command-modec
137 liece-current-channel]
138 ["Set topic of this channel" liece-command-topic
139 liece-current-channel]
141 ["Toggle freeze of this channel" liece-command-freeze
142 liece-current-channel]
143 ["Toggle own freeze of this channel" liece-command-own-freeze
144 liece-current-channel]
145 ["Toggle beep notice of this channel" liece-dialogue-beep
146 liece-current-channel]
148 ["List channel" liece-command-list
149 (liece-server-opened)]
150 ["Display names of channel" liece-command-names
151 (liece-server-opened)]
152 ["Display who are on the channel" liece-command-names
153 (liece-server-opened)]
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 ["Enter debug mode" liece-command-debug t]
174 ["Quit IRC" liece-command-quit t]))
176 (defvar liece-menu-alist
178 (liece-menu-IRC-menu "IRC Menu.")
179 (liece-menu-channel-menu "Channel Menu.")
180 (liece-menu-private-menu "Private Menu.")
181 (liece-menu-dcc-menu "DCC Menu.")
182 (liece-menu-url-menu "URL Menu.")))
184 (defvar liece-menu-IRC-menu-map)
185 (defvar liece-menu-channel-menu-map)
186 (defvar liece-menu-private-menu-map)
187 (defvar liece-menu-dcc-menu-map)
188 (defvar liece-menu-url-menu-map)
192 (defmacro liece-menu-bogus-filter-constructor (name menu)
194 (setq x (x-popup-menu t ,menu)
195 y (and x (lookup-key ,menu (apply #'vector x))))
199 (defmacro liece-menu-popup-menu (event menu)
200 (if (featurep 'xemacs)
203 (easy-menu-define bogus-menu nil nil ,menu)
204 (liece-menu-bogus-filter-constructor "Popup" bogus-menu))))
206 (defun liece-nick-popup-menu (widget &optional event)
207 (let ((menu (copy-sequence liece-nick-popup-menu))
208 (pos (widget-event-point event)))
211 (if (eq major-mode 'liece-nick-mode)
212 (liece-nick-update-region))
213 (liece-menu-popup-menu event menu))))
215 ;;; @ initialize menus
217 (when (or (featurep 'menubar); XEmacs
218 (featurep 'menu-bar))
219 (add-hook 'liece-command-mode-hook 'liece-command-define-menus)
220 (add-hook 'liece-command-mode-hook 'liece-command-add-menus 'append)
221 (add-hook 'liece-add-url-functions 'liece-menu-add-url))
223 (defun liece-menu-define (menu)
224 (eval (list 'easy-menu-define
225 (intern (concat (symbol-name (car menu)) "-map"))
226 'liece-command-mode-map (cadr menu)
227 '(symbol-value (car menu)))))
229 (defun liece-command-define-menus-1 (value)
234 (when liece-use-localized-menu
235 (aset spec 0 (liece-intl-get-msgstr (aref spec 0)))))
237 (liece-command-define-menus-1 spec)))))
239 (defun liece-command-define-menus ()
240 (dolist (menu (reverse liece-menu-alist))
241 (let ((value (symbol-value (car menu))))
242 (liece-command-define-menus-1 value)
243 (liece-menu-define menu))))
245 (defun liece-command-add-menus ()
246 (dolist (menu liece-menu-alist)
247 (easy-menu-add (symbol-value (car menu)) liece-command-mode-map)))
249 (defun liece-menu-add-url (url)
250 (when (boundp 'liece-menu-url-menu-map)
252 liece-menu-url-menu-map nil
253 (vector url (list 'liece-command-browse-url url) t))))
257 (autoload 'liece-menu-callback-ctcp-version "liece-ctcp" nil t)
258 (autoload 'liece-menu-callback-ctcp-userinfo "liece-ctcp" nil t)
259 (autoload 'liece-menu-callback-ctcp-help "liece-ctcp" nil t)
260 (autoload 'liece-menu-callback-ctcp-clientinfo "liece-ctcp" nil t)
261 (autoload 'liece-menu-callback-ctcp-ping "liece-ctcp" nil t)
263 (defun liece-menu-callback-finger ()
265 (dolist (nick liece-nick-region-nicks)
266 (liece-command-finger nick)))
268 (defun liece-menu-callback-kick ()
270 (dolist (nick liece-nick-region-nicks)
271 (liece-command-kick nick)))
273 (defun liece-menu-callback-set-operators ()
275 (let ((opers (liece-channel-get-operators)))
276 (setq liece-nick-region-nicks
277 (filter-elements nick liece-nick-region-nicks
278 (not (liece-nick-member nick opers)))))
279 (liece-command-set-operators liece-nick-region-nicks))
281 (defun liece-menu-callback-set-voices ()
283 (let ((voices (liece-channel-get-voices)))
284 (setq liece-nick-region-nicks
285 (filter-elements nick liece-nick-region-nicks
286 (not (liece-nick-member nick voices)))))
287 (liece-command-set-voices liece-nick-region-nicks))
289 (defun liece-menu-callback-unset-operators ()
291 (let ((opers (liece-channel-get-operators)))
292 (setq liece-nick-region-nicks
293 (filter-elements nick liece-nick-region-nicks
294 (liece-nick-member nick opers))))
295 (liece-command-set-operators liece-nick-region-nicks t))
297 (defun liece-menu-callback-unset-voices ()
299 (let ((voices (liece-channel-get-voices)))
300 (setq liece-nick-region-nicks
301 (filter-elements nick liece-nick-region-nicks
302 (liece-nick-member nick voices))))
303 (liece-command-set-voices liece-nick-region-nicks t))
305 (provide 'liece-menu)
307 ;;; liece-menu.el ends here