lisp/liece-menu.el

   1 ;;; liece-menu.el --- Define menus.
   2 ;; Copyright (C) 1998-2000 Daiki Ueno
   3
   4 ;; Author: Daiki Ueno <ueno@unixuser.org>
   5 ;; Created: 1999-09-06
   6 ;; Revised: 1999-09-06
   7 ;; Keywords: menu, easymenu
   8
   9 ;; This file is part of Liece.
  10
  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)
  14 ;; any later version.
  15
  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.
  20
  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.
  25
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31
  32 (eval-when-compile
  33   (require 'easymenu)
  34   (require 'advice)
  35   (require 'liece-compat)
  36   (require 'liece-commands)
  37   (require 'liece-intl)
  38   (require 'liece-nick))
  39
  40 (defvar liece-use-localized-menu (featurep 'meadow))
  41
  42 (defvar liece-nick-popup-menu
  43   '("Liece"
  44     ["Finger" liece-menu-callback-finger
  45      liece-nick-region-nicks]
  46     "----"
  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]
  57     "----"
  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]
  66     "----"
  67     ["Kick" liece-menu-callback-kick
  68      liece-nick-region-nicks]))
  69
  70 (defvar liece-menu-url-menu '("URL" "----"))
  71 (defvar liece-menu-dcc-menu
  72   '("DCC"
  73     ["Send file" liece-command-dcc-send t]
  74     ["Receive file" liece-command-dcc-receive t]
  75     "----"
  76     ["Send chat request" liece-command-dcc-chat-listen t]
  77     ["Accept chat request" liece-command-dcc-chat-connect t]
  78     "----"
  79     ["List DCC request" liece-command-dcc-list t]
  80     ["Dispatch stacked DCC requests" liece-command-dcc-accept t]))
  81
  82 (defvar liece-menu-private-menu
  83   '("Private"
  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]))
  92
  93 (defvar liece-menu-ctcp-menu
  94   '("CTCP"
  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]
 107     "----"
 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]))
 112
 113 (defvar liece-menu-channel-menu
 114   (nconc
 115    '("Channel"
 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)]
 128      "----"
 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]
 133      "----"
 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]
 138      "----"
 139      ["List channel" liece-command-list
 140       (liece-server-opened)]
 141      ["Display names of channel" liece-command-names
 142       (liece-server-opened)]
 143      ["Display who are on the channel" liece-command-names
 144       (liece-server-opened)]
 145      "----"
 146      ["Set default key of this channel" liece-command-set-default-key
 147       (or liece-current-channel liece-current-chat-partner)]
 148      "----")
 149    (list liece-menu-ctcp-menu)))
 150
 151 (defvar liece-menu-IRC-menu
 152   '("IRC"
 153     ["Load variables file" liece-command-load-vars t]
 154     ["Save variables file" liece-command-save-vars t]
 155     "----"
 156     ["Change window style" liece-command-set-window-style t]
 157     ["Reload style file" liece-command-reload-window-style t]
 158     ["Reconfigure windows" liece-command-reconfigure-windows t]
 159     ["Toggle channel buffer display state"
 160      liece-command-toggle-channel-buffer-mode t]
 161     ["Toggle nick buffer display state"
 162      liece-command-toggle-nick-buffer-mode t]
 163     "----"
 164     ["Freeze buffer" liece-command-freeze t]
 165     ["Own freeze buffer" liece-command-own-freeze t]
 166     ["Enter debug mode" liece-command-debug t]
 167     ["Quit IRC" liece-command-quit t]))
 168
 169 (defvar liece-menu-alist
 170   '(
 171     (liece-menu-IRC-menu "IRC Menu.")
 172     (liece-menu-channel-menu "Channel Menu.")
 173     (liece-menu-private-menu "Private Menu.")
 174     (liece-menu-dcc-menu "DCC Menu.")
 175     (liece-menu-url-menu "URL Menu.")))
 176
 177 (defvar liece-menu-IRC-menu-map)
 178 (defvar liece-menu-channel-menu-map)
 179 (defvar liece-menu-private-menu-map)
 180 (defvar liece-menu-dcc-menu-map)
 181 (defvar liece-menu-url-menu-map)
 182
 183 ;;; @ popup menus
 184 ;;;
 185 (defmacro liece-menu-bogus-filter-constructor (name menu)
 186   `(let (x y)
 187      (setq x (x-popup-menu t ,menu)
 188            y (and x (lookup-key ,menu (apply #'vector x))))
 189      (if (and x y)
 190          (funcall y))))
 191
 192 (defmacro liece-menu-popup-menu (event menu)
 193   (if (featurep 'xemacs)
 194       `(popup-menu ,menu)
 195     `(let (bogus-menu)
 196        (easy-menu-define bogus-menu nil nil ,menu)
 197        (liece-menu-bogus-filter-constructor "Popup" bogus-menu))))
 198
 199 (defun liece-nick-popup-menu (widget &optional event)
 200   (let ((menu (copy-sequence liece-nick-popup-menu))
 201         (pos (widget-event-point event)))
 202     (when pos
 203       (goto-char pos)
 204       (if (eq major-mode 'liece-nick-mode)
 205           (liece-nick-update-region))
 206       (liece-menu-popup-menu event menu))))
 207
 208 ;;; @ initialize menus
 209 ;;;
 210 (when (or (featurep 'menubar); XEmacs
 211           (featurep 'menu-bar))
 212   (add-hook 'liece-command-mode-hook 'liece-command-define-menus)
 213   (add-hook 'liece-command-mode-hook 'liece-command-add-menus 'append)
 214   (add-hook 'liece-add-url-functions 'liece-menu-add-url))
 215
 216 (defun liece-menu-define (menu)
 217   (eval (list 'easy-menu-define
 218               (intern (concat (symbol-name (car menu)) "-map"))
 219               'liece-command-mode-map (cadr menu)
 220               '(symbol-value (car menu)))))
 221
 222 (defun liece-command-define-menus-1 (value)
 223   (dolist (spec value)
 224     (cond
 225      ((stringp spec))
 226      ((vectorp spec)
 227       (when liece-use-localized-menu
 228         (aset spec 0 (liece-intl-get-msgstr (aref spec 0)))))
 229      ((listp spec)
 230       (liece-command-define-menus-1 spec)))))
 231
 232 (defun liece-command-define-menus ()
 233   (dolist (menu (reverse liece-menu-alist))
 234     (let ((value (symbol-value (car menu))))
 235       (liece-command-define-menus-1 value)
 236       (liece-menu-define menu))))
 237
 238 (defun liece-command-add-menus ()
 239   (dolist (menu liece-menu-alist)
 240     (easy-menu-add (symbol-value (car menu)) liece-command-mode-map)))
 241
 242 (defun liece-menu-add-url (url)
 243   (when (boundp 'liece-menu-url-menu-map)
 244     (easy-menu-add-item
 245      liece-menu-url-menu-map nil
 246      (vector url (list 'liece-command-browse-url url) t))))
 247
 248 ;;; @ menu callbacks
 249 ;;;
 250 (autoload 'liece-menu-callback-ctcp-version "liece-ctcp" nil t)
 251 (autoload 'liece-menu-callback-ctcp-userinfo "liece-ctcp" nil t)
 252 (autoload 'liece-menu-callback-ctcp-help "liece-ctcp" nil t)
 253 (autoload 'liece-menu-callback-ctcp-clientinfo "liece-ctcp" nil t)
 254 (autoload 'liece-menu-callback-ctcp-ping "liece-ctcp" nil t)
 255
 256 (defun liece-menu-callback-finger ()
 257   (interactive)
 258   (dolist (nick liece-nick-region-nicks)
 259     (liece-command-finger nick)))
 260
 261 (defun liece-menu-callback-kick ()
 262   (interactive)
 263   (dolist (nick liece-nick-region-nicks)
 264     (liece-command-kick nick)))
 265
 266 (defun liece-menu-callback-mode+o ()
 267   (interactive)
 268   (dolist (oper liece-nick-region-opers)
 269     (setq liece-nick-region-nicks
 270           (string-list-remove-ignore-case oper liece-nick-region-nicks)))
 271   (liece-command-mode+o liece-nick-region-nicks))
 272
 273 (defun liece-menu-callback-mode+v ()
 274   (interactive)
 275   (dolist (voice liece-nick-region-voices)
 276     (setq liece-nick-region-nicks
 277           (string-list-remove-ignore-case voice liece-nick-region-nicks)))
 278   (liece-command-mode+v liece-nick-region-nicks))
 279
 280 (defun liece-menu-callback-mode-o ()
 281   (interactive)
 282   (liece-command-mode-o liece-nick-region-opers))
 283
 284 (defun liece-menu-callback-mode-v ()
 285   (interactive)
 286   (liece-command-mode-v liece-nick-region-voices))
 287
 288 (provide 'liece-menu)
 289
 290 ;;; liece-menu.el ends here