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-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 ["Rotate left channels" liece-command-pop
125 (or liece-current-channels liece-current-chat-partners)]
126 ["Rotate right channels" liece-command-push
127 (or liece-current-channels liece-current-chat-partners)]
129 ["Invite to this channel" liece-command-invite
130 liece-current-channel]
131 ["Kick out from this channel" liece-command-kick
132 liece-current-channel]
134 ["Set mode of this channel" liece-command-modec
135 liece-current-channel]
136 ["Set topic of this channel" liece-command-topic
137 liece-current-channel]
139 ["Toggle freeze of this channel" liece-command-freeze
140 liece-current-channel]
141 ["Toggle own freeze of this channel" liece-command-own-freeze
142 liece-current-channel]
143 ["Toggle beep notice of this channel" liece-dialogue-beep
144 liece-current-channel]
146 ["List channel" liece-command-list
147 (liece-server-opened)]
148 ["Display names of channel" liece-command-names
149 (liece-server-opened)]
150 ["Display who are on the channel" liece-command-names
151 (liece-server-opened)]
153 ["Set default key of this channel" liece-command-set-default-key
154 (or liece-current-channel liece-current-chat-partner)]
156 (list liece-menu-ctcp-menu)))
158 (defvar liece-menu-IRC-menu
160 ["Load variables file" liece-command-load-vars t]
161 ["Save variables file" liece-command-save-vars t]
163 ["Change window style" liece-command-set-window-style t]
164 ["Reload style file" liece-command-reload-window-style t]
165 ["Reconfigure windows" liece-command-reconfigure-windows t]
166 ["Toggle channel buffer display state"
167 liece-command-toggle-channel-buffer-mode t]
168 ["Toggle nick buffer display state"
169 liece-command-toggle-nick-buffer-mode t]
171 ["Enter debug mode" liece-command-debug t]
172 ["Quit IRC" liece-command-quit t]))
174 (defvar liece-menu-alist
176 (liece-menu-IRC-menu "IRC Menu.")
177 (liece-menu-channel-menu "Channel Menu.")
178 (liece-menu-private-menu "Private Menu.")
179 (liece-menu-dcc-menu "DCC Menu.")
180 (liece-menu-url-menu "URL Menu.")))
182 (defvar liece-menu-IRC-menu-map)
183 (defvar liece-menu-channel-menu-map)
184 (defvar liece-menu-private-menu-map)
185 (defvar liece-menu-dcc-menu-map)
186 (defvar liece-menu-url-menu-map)
190 (defmacro liece-menu-bogus-filter-constructor (name menu)
192 (setq x (x-popup-menu t ,menu)
193 y (and x (lookup-key ,menu (apply #'vector x))))
197 (defmacro liece-menu-popup-menu (event menu)
198 (if (featurep 'xemacs)
201 (easy-menu-define bogus-menu nil nil ,menu)
202 (liece-menu-bogus-filter-constructor "Popup" bogus-menu))))
204 (defun liece-nick-popup-menu (widget &optional event)
205 (let ((menu (copy-sequence liece-nick-popup-menu))
206 (pos (widget-event-point event)))
209 (if (eq major-mode 'liece-nick-mode)
210 (liece-nick-update-region))
211 (liece-menu-popup-menu event menu))))
213 ;;; @ initialize menus
215 (when (or (featurep 'menubar); XEmacs
216 (featurep 'menu-bar))
217 (add-hook 'liece-command-mode-hook 'liece-command-define-menus)
218 (add-hook 'liece-command-mode-hook 'liece-command-add-menus 'append)
219 (add-hook 'liece-add-url-functions 'liece-menu-add-url))
221 (defun liece-menu-define (menu)
222 (eval (list 'easy-menu-define
223 (intern (concat (symbol-name (car menu)) "-map"))
224 'liece-command-mode-map (cadr menu)
225 '(symbol-value (car menu)))))
227 (defun liece-command-define-menus-1 (value)
232 (when liece-use-localized-menu
233 (aset spec 0 (liece-intl-get-msgstr (aref spec 0)))))
235 (liece-command-define-menus-1 spec)))))
237 (defun liece-command-define-menus ()
238 (dolist (menu (reverse liece-menu-alist))
239 (let ((value (symbol-value (car menu))))
240 (liece-command-define-menus-1 value)
241 (liece-menu-define menu))))
243 (defun liece-command-add-menus ()
244 (dolist (menu liece-menu-alist)
245 (easy-menu-add (symbol-value (car menu)) liece-command-mode-map)))
247 (defun liece-menu-add-url (url)
248 (when (boundp 'liece-menu-url-menu-map)
250 liece-menu-url-menu-map nil
251 (vector url (list 'liece-command-browse-url url) t))))
255 (autoload 'liece-menu-callback-ctcp-version "liece-ctcp" nil t)
256 (autoload 'liece-menu-callback-ctcp-userinfo "liece-ctcp" nil t)
257 (autoload 'liece-menu-callback-ctcp-help "liece-ctcp" nil t)
258 (autoload 'liece-menu-callback-ctcp-clientinfo "liece-ctcp" nil t)
259 (autoload 'liece-menu-callback-ctcp-ping "liece-ctcp" nil t)
261 (defun liece-menu-callback-finger ()
263 (dolist (nick liece-nick-region-nicks)
264 (liece-command-finger nick)))
266 (defun liece-menu-callback-kick ()
268 (dolist (nick liece-nick-region-nicks)
269 (liece-command-kick nick)))
271 (defun liece-menu-callback-mode+o ()
273 (dolist (oper liece-nick-region-opers)
274 (setq liece-nick-region-nicks
275 (string-list-remove-ignore-case oper liece-nick-region-nicks)))
276 (liece-command-mode+o liece-nick-region-nicks))
278 (defun liece-menu-callback-mode+v ()
280 (dolist (voice liece-nick-region-voices)
281 (setq liece-nick-region-nicks
282 (string-list-remove-ignore-case voice liece-nick-region-nicks)))
283 (liece-command-mode+v liece-nick-region-nicks))
285 (defun liece-menu-callback-mode-o ()
287 (liece-command-mode-o liece-nick-region-opers))
289 (defun liece-menu-callback-mode-v ()
291 (liece-command-mode-v liece-nick-region-voices))
293 (provide 'liece-menu)
295 ;;; liece-menu.el ends here