;;; liece-menu.el --- Define menus.
;; Copyright (C) 1998-2000 Daiki Ueno

;; Author: Daiki Ueno <ueno@unixuser.org>
;; 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)
    (with-current-buffer liece-command-buffer
      (easy-menu-add-item
       nil (list (car liece-menu-url-menu))
       (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
