#
# Copyright (c) 1993 Eric Schenk.
# All rights reserved.
#
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
# 
# IN NO EVENT SHALL ERIC SCHENK BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
# OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF ERIC
# SCHENK HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# ERIC SCHENK SPECIFICALLY DISCLAIMS ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
# AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
# ON AN "AS IS" BASIS, AND ERIC SCHENK HAS NO OBLIGATION TO
# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.

# set up the default values for the widgets configuration

tkwm_widget::setdefaults frame motif_button {
	{-geometry geometry Geometry {}}
	{-insidegeometry insideGeometry InsideGeometry {}}
	{-bitmap bitmap Bitmap {}}
	{-command command Command {}}
	{-background background Background white}
	{-borderwidth borderWidth BorderWidth 1}
	{-state state State normal}
        {-cursor cursor Cursor {}}
	{-relief relief Relief raised}}

tkwm_widget::setdefaults frame motif_menubutton {
	{-geometry geometry Geometry {}}
	{-insidegeometry insideGeometry InsideGeometry {}}
	{-bitmap bitmap Bitmap {}}
	{-menu menu Menu {}}
        {-command command Command {}}
        {-state state State normal}
        {-cursor cursor Cursor {}}
	{-background background Background white}
	{-borderwidth borderWidth BorderWidth 1}
	{-relief relief Relief raised}}

proc motif_button {var args} {
    upvar #0 $var data

    # Do the initial configuration
    tkwm_widget::initialconfigure motif_button MotifButton $var args

    # return the inside frame of the widget
    # this is where things inside the widget should be "packed".
    return $data(inframe)
}

proc motif_menubutton {var args} {
    upvar #0 $var data

    # Do the intial configuration
    tkwm_widget::initialconfigure motif_menubutton MotifMenuButton $var args

    # return the inside frame of the widget
    # this is where things inside the widget should be "packed".
    return $data(inframe)
}

# Create the widget's internal hierarchy

proc motif_button::create {var} {
    upvar #0 $var data
    set w $var
    
    # widgets
    $w config -relief $data(-relief) -borderwidth $data(-borderwidth) -geometry $data(-geometry) -background $data(-background)
    if {$data(-bitmap)==""} {
        frame $w.i -relief raised -borderwidth $data(-borderwidth) -geometry $data(-insidegeometry) -background $data(-background)
    } else {
        label $w.i -border 0 -padx 0 -pady 0 -bitmap $data(-bitmap) -background $data(-background)
    }
    pack propagate $w 0
    pack $w.i   -expand 1

    # bindings

    bind $w   <Any-Enter> "tk_butEnter $w"
    bind $w.i   <Any-Enter> "tk_butEnter $w"
    bind $w   <Any-Leave> "tk_butLeave $w"
    bind $w.i   <Any-Leave> "tk_butLeave $w"
    bind $w   <1> "tk_butDown $w"
    bind $w.i <1> "tk_butDown $w"
    bind $w   <ButtonRelease-1> "tk_butUp $w"
    bind $w.i <ButtonRelease-1> "tk_butUp $w"

    set data(inframe) $w.i
}

proc motif_menubutton::create {var} {
    upvar #0 $var data
    set w $var
    
    # widgets
    $w config -relief $data(-relief) -borderwidth $data(-borderwidth) -geometry $data(-geometry) -background $data(-background)
    if {$data(-bitmap)==""} {
        frame $w.i -relief raised -borderwidth $data(-borderwidth) -geometry $data(-insidegeometry) -background $data(-background)
    } else {
        label $w.i -border 0 -padx 0 -pady 0 -bitmap $data(-bitmap) -background $data(-background)
    }
    pack propagate $w 0
    pack $w.i   -expand 1

    # bindings
    bind $w   <1> [list $w invoke]
    bind $w.i <1> [list $w invoke]
    bind $w   <Double-1> [list $w invoke-double]
    bind $w.i <Double-1> [list $w invoke-double]

    set data(inframe) $w.i
}

# The widget commands

proc motif_button::command-activate {var args} {}

proc motif_button::command-deactivate {var args} {}

proc motif_button::command-invoke {var args} {
    upvar "#0" $var data
    eval $data(-command)
}

proc motif_button::config-geometry {var option} {
    $var.root config -geometry $option
}

proc motif_button::config-insidegeometry {var option} {
    $var.i config -geometry $option
}

proc motif_button::config-bitmap {var option} {
    $var.i config -bitmap $option
}

proc motif_button::config-background {var option} {
    $var.root config -background $option
    $var.i config -background $option
}

proc motif_button::config-borderwidth {var option} {
    $var.root config -borderwidth $option
    $var.i config -borderwidth $option
}

proc motif_button::config-relief {var option} {
    $var.root config -relief $option
}

proc motif_button::config-cursor {var option} {
    $var.root config -cursor $option
    $var.i config -cursor $option
}

proc motif_menubutton::command-invoke {var args} {
    upvar "#0" $var data
    global current_client
    set current_client [winfo toplevel $var]
    tkwm_menubutton $data(-menu) $var
}

proc motif_menubutton::command-invoke-double {var args} {
    upvar "#0" $var data
    global current_client
    set current_client [winfo toplevel $var]
    eval $data(-command)
}

proc motif_menubutton::config-geometry {var option} {
    $var.root config -geometry $option
}

proc motif_menubutton::config-insidegeometry {var option} {
    $var.i config -geometry $option
}

proc motif_menubutton::config-bitmap {var option} {
    $var.i config -bitmap $option
}

proc motif_menubutton::config-background {var option} {
    $var.root config -background $option
    $var.i config -background $option
}

proc motif_menubutton::config-borderwidth {var option} {
    $var.root config -borderwidth $option
    $var.i config -borderwidth $option
}

proc motif_menubutton::config-cursor {var option} {
    $var.root config -cursor $option
    $var.i config -cursor $option
}

proc motif_menubutton::config-relief {var option} {
    $var.root config -relief $option
}