;;; liece-menu.el --- Define menus. ;; Copyright (C) 1998-2000 Daiki Ueno ;; Author: Daiki Ueno ;; Created: 1999-09-06 ;; Revised: 1999-09-06 ;; Keywords: menu, easymenu ;; This file is part of Liece. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 2, or (at your option) ;; any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; ;;; Code: (eval-when-compile (require 'easymenu) (require 'advice) (require 'liece-compat) (require 'liece-commands) (require 'liece-intl) (require 'liece-nick)) (defvar liece-use-localized-menu (featurep 'meadow)) (defvar liece-nick-popup-menu '("Liece" ["Finger" liece-menu-callback-finger liece-nick-region-nicks] "----" ["CTCP VERSION" liece-menu-callback-ctcp-version liece-nick-region-nicks] ["CTCP USERINFO" liece-menu-callback-ctcp-userinfo liece-nick-region-nicks] ["CTCP HELP" liece-menu-callback-ctcp-help liece-nick-region-nicks] ["CTCP CLIENTINFO" liece-menu-callback-ctcp-clientinfo liece-nick-region-nicks] ["CTCP PING" liece-menu-callback-ctcp-ping liece-nick-region-nicks] "----" ["Set Channel Operator(s)" liece-menu-callback-set-operators liece-nick-region-nicks] ["Set Channel Voice(s)" liece-menu-callback-set-voices liece-nick-region-nicks] ["Unset Channel Operator(s)" liece-menu-callback-unset-operators liece-nick-region-nicks] ["Unset Channel Voice(s)" liece-menu-callback-unset-voices liece-nick-region-nicks] "----" ["Kick" liece-menu-callback-kick liece-nick-region-nicks])) (defvar liece-menu-url-menu '("URL" "----")) (defvar liece-menu-dcc-menu '("DCC" ["Send file" liece-command-dcc-send t] ["Receive file" liece-command-dcc-receive t] "----" ["Send chat request" liece-command-dcc-chat-listen t] ["Accept chat request" liece-command-dcc-chat-connect t] "----" ["List DCC request" liece-command-dcc-list t] ["Dispatch stacked DCC requests" liece-command-dcc-accept t])) (defvar liece-menu-private-menu '("Private" ["Toggle private conversation" liece-command-toggle-private (liece-server-opened)] ["IsON" liece-command-ison (liece-server-opened)] ["Register friends" liece-command-activate-friends t] ["Unregister friends" liece-command-deactivate-friends t] ["Display userhost" liece-command-userhost (liece-server-opened)] ["Ignore nicks / regexp" liece-command-kill t] ["Compose mail" liece-command-mail-compose t])) (defvar liece-menu-ctcp-menu '("CTCP" ["ACTION" liece-command-ctcp-action liece-current-channel] ["VERSION" liece-command-ctcp-version liece-current-channel] ["USERINFO" liece-command-ctcp-userinfo liece-current-channel] ["HELP" liece-command-ctcp-help liece-current-channel] ["CLIENTINFO" liece-command-ctcp-clientinfo liece-current-channel] ["PING" liece-command-ctcp-ping liece-current-channel] "----" ["Request X-Face" liece-command-ctcp-x-face liece-current-channel] ["Set my X-Face" liece-command-ctcp-x-face-from-xbm-file liece-current-channel])) (defvar liece-menu-channel-menu (nconc '("Channel" ["Join channel" liece-command-join (liece-server-opened)] ["Part channel" liece-command-part (or liece-current-channels liece-current-chat-partners)] ["Go to next channel" liece-command-next-channel (or liece-current-channels liece-current-chat-partners)] ["Go to previous channel" liece-command-previous-channel (or liece-current-channels liece-current-chat-partners)] ["Go to unread channel" liece-command-unread-channel (or liece-current-channels liece-current-chat-partners)] ["Rotate left channels" liece-command-pop (or liece-current-channels liece-current-chat-partners)] ["Rotate right channels" liece-command-push (or liece-current-channels liece-current-chat-partners)] "----" ["Invite to this channel" liece-command-invite liece-current-channel] ["Kick out from this channel" liece-command-kick liece-current-channel] "----" ["Set mode of this channel" liece-command-modec liece-current-channel] ["Set topic of this channel" liece-command-topic liece-current-channel] "----" ["Toggle freeze of this channel" liece-command-freeze liece-current-channel] ["Toggle own freeze of this channel" liece-command-own-freeze liece-current-channel] ["Toggle beep notice of this channel" liece-dialogue-beep liece-current-channel] "----" ["List channel" liece-command-list (liece-server-opened)] ["Display names of channel" liece-command-names (liece-server-opened)] ["Display who are on the channel" liece-command-names (liece-server-opened)] "----" ["Set default key of this channel" liece-command-set-default-key (or liece-current-channel liece-current-chat-partner)] "----") (list liece-menu-ctcp-menu))) (defvar liece-menu-IRC-menu '("IRC" ["Load variables file" liece-command-load-vars t] ["Save variables file" liece-command-save-vars t] "----" ["Change window style" liece-command-set-window-style t] ["Reload style file" liece-command-reload-window-style t] ["Reconfigure windows" liece-command-reconfigure-windows t] ["Toggle channel buffer display state" liece-command-toggle-channel-buffer-mode t] ["Toggle nick buffer display state" liece-command-toggle-nick-buffer-mode t] "----" ["Enter debug mode" liece-command-debug t] ["Quit IRC" liece-command-quit t])) (defvar liece-menu-alist '( (liece-menu-IRC-menu "IRC Menu.") (liece-menu-channel-menu "Channel Menu.") (liece-menu-private-menu "Private Menu.") (liece-menu-dcc-menu "DCC Menu.") (liece-menu-url-menu "URL Menu."))) (defvar liece-menu-IRC-menu-map) (defvar liece-menu-channel-menu-map) (defvar liece-menu-private-menu-map) (defvar liece-menu-dcc-menu-map) (defvar liece-menu-url-menu-map) ;;; @ popup menus ;;; (defmacro liece-menu-bogus-filter-constructor (name menu) `(let (x y) (setq x (x-popup-menu t ,menu) y (and x (lookup-key ,menu (apply #'vector x)))) (if (and x y) (funcall y)))) (defmacro liece-menu-popup-menu (event menu) (if (featurep 'xemacs) `(popup-menu ,menu) `(let (bogus-menu) (easy-menu-define bogus-menu nil nil ,menu) (liece-menu-bogus-filter-constructor "Popup" bogus-menu)))) (defun liece-nick-popup-menu (widget &optional event) (let ((menu (copy-sequence liece-nick-popup-menu)) (pos (widget-event-point event))) (when pos (goto-char pos) (if (eq major-mode 'liece-nick-mode) (liece-nick-update-region)) (liece-menu-popup-menu event menu)))) ;;; @ initialize menus ;;; (when (or (featurep 'menubar); XEmacs (featurep 'menu-bar)) (add-hook 'liece-command-mode-hook 'liece-command-define-menus) (add-hook 'liece-command-mode-hook 'liece-command-add-menus 'append) (add-hook 'liece-add-url-functions 'liece-menu-add-url)) (defun liece-menu-define (menu) (eval (list 'easy-menu-define (intern (concat (symbol-name (car menu)) "-map")) 'liece-command-mode-map (cadr menu) '(symbol-value (car menu))))) (defun liece-command-define-menus-1 (value) (dolist (spec value) (cond ((stringp spec)) ((vectorp spec) (when liece-use-localized-menu (aset spec 0 (liece-intl-get-msgstr (aref spec 0))))) ((listp spec) (liece-command-define-menus-1 spec))))) (defun liece-command-define-menus () (dolist (menu (reverse liece-menu-alist)) (let ((value (symbol-value (car menu)))) (liece-command-define-menus-1 value) (liece-menu-define menu)))) (defun liece-command-add-menus () (dolist (menu liece-menu-alist) (easy-menu-add (symbol-value (car menu)) liece-command-mode-map))) (defun liece-menu-add-url (url) (when (boundp 'liece-menu-url-menu-map) (easy-menu-add-item liece-menu-url-menu-map nil (vector url (list 'liece-command-browse-url url) t)))) ;;; @ menu callbacks ;;; (autoload 'liece-menu-callback-ctcp-version "liece-ctcp" nil t) (autoload 'liece-menu-callback-ctcp-userinfo "liece-ctcp" nil t) (autoload 'liece-menu-callback-ctcp-help "liece-ctcp" nil t) (autoload 'liece-menu-callback-ctcp-clientinfo "liece-ctcp" nil t) (autoload 'liece-menu-callback-ctcp-ping "liece-ctcp" nil t) (defun liece-menu-callback-finger () (interactive) (dolist (nick liece-nick-region-nicks) (liece-command-finger nick))) (defun liece-menu-callback-kick () (interactive) (dolist (nick liece-nick-region-nicks) (liece-command-kick nick))) (defun liece-menu-callback-set-operators () (interactive) (let ((opers (liece-channel-get-operators))) (setq liece-nick-region-nicks (filter-elements nick liece-nick-region-nicks (not (liece-nick-member nick opers))))) (liece-command-set-operators liece-nick-region-nicks)) (defun liece-menu-callback-set-voices () (interactive) (let ((voices (liece-channel-get-voices))) (setq liece-nick-region-nicks (filter-elements nick liece-nick-region-nicks (not (liece-nick-member nick voices))))) (liece-command-set-voices liece-nick-region-nicks)) (defun liece-menu-callback-unset-operators () (interactive) (let ((opers (liece-channel-get-operators))) (setq liece-nick-region-nicks (filter-elements nick liece-nick-region-nicks (liece-nick-member nick opers)))) (liece-command-set-operators liece-nick-region-nicks t)) (defun liece-menu-callback-unset-voices () (interactive) (let ((voices (liece-channel-get-voices))) (setq liece-nick-region-nicks (filter-elements nick liece-nick-region-nicks (liece-nick-member nick voices)))) (liece-command-set-voices liece-nick-region-nicks t)) (provide 'liece-menu) ;;; liece-menu.el ends here