#
# 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.

# motif_button
# Options:
#	-geometry
#	-insidegeometry
#	-bitmap
#	-command
#	-background
#	-borderwidth
#	-relief
#	-cursor
#	-state
#
# widget commands:
#	configure
#	invoke
#	activate
#	deactivate

# set up the default values for the widgets configuration

tkwm_widget::setdefaults motif_button MotifButton {
	{-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}}

# Widget constructor

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

    # Set up the widget data structures
    set data(type) motif_button

    # Do the intial configuration
    eval tkwm_widget::initialconfigure $var args

    # Create the widget
    motif_button::create $var

    # Create the widget command
    tkwm_widget::makecommand $var motif_button::command

    # Default bindings
    bind $w <Destroy>     "tkwm_widget::destroy $var"

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

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

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

    # Set up the widget data structures
    set data(type) motif_menubutton


    # Do the intial configuration
    eval tkwm_widget::initialconfigure $var args

    # Create the widget
    motif_menubutton::create $var

    # Create the widget command
    tkwm_widget::makecommand $var motif_menubutton::command

    # Default bindings
    bind $w <Destroy>     "tkwm_widget::destroy $var"

    # 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]

    set data(inframe) $w.i
}


# The widget command

proc motif_button::command {option args} {
    # the name of the data structure is the same as the procedure
    #------------------------------------------------------------
    set var [lindex [info level 0] 0]
    upvar #0 $var data
    set w $var

    case $option in {
	{config configure} {
	    set result [eval tkwm_widget::configure motif_button::configure $var args]
	    return $result
	}
	activate {}
	deactivate {}
        invoke {
	    eval "$data(-command)"
        }
	default {
	    error "Unknown widget command"
	}
    }
}

proc motif_button::configure {var flag option} {
    upvar #0 $var data
    switch -- $flag {
	-geometry {
	    $var.root config -geometry $option
	}
	-insidegeometry {
	    $var.i config -geometry $option
	}
        -bitmap {
	    $var.i config -bitmap $option
        }
	-background {
	    $var.root config -background $option
	    $var.i config -background $option
	}
	-borderwidth {
	    $var.root config -borderwidth $option
	    $var.i config -borderwidth $option
	}
	-relief {
	    $var.root config -relief $option
	}
	-cursor {
	    $var.root config -cursor $option
	    $var.i config -cursor $option
	}
	-command {
	}
	-state {
	}
	default {
	    error "Unknown option. Must be one of: -geometry, -insidegeometry, -borderwidth, -relief, -state, or -command"
	}
    }
    set data($flag) $option
}

proc motif_menubutton::command {option args} {
    # the name of the data structure is the same as the procedure
    #------------------------------------------------------------
    set var [lindex [info level 0] 0]
    upvar #0 $var data

    set w $var

    case $option in {
	{config configure} {
	    set result [eval tkwm_widget::configure motif_menubutton::configure $var args]
	    return $result
	}
        invoke {
	    global current_client
            set current_client [winfo toplevel $w]
	    tkwm_menubutton $data(-menu) $w
        }
	default {
	    error "Unknown widget command"
	}
    }
}

proc motif_menubutton::configure {var flag option} {
    upvar #0 $var data
    switch -- $flag {
	-geometry {
	    $var.root config -geometry $option
	}
	-insidegeometry {
	    $var.i config -geometry $option
	}
        -bitmap {
	    $var.i config -bitmap $option
        }
	-background {
	    $var.root config -background $option
	    $var.i config -background $option
	}
	-borderwidth {
	    $var.root config -borderwidth $option
	    $var.i config -borderwidth $option
	}
	-cursor {
	    $var.root config -cursor $option
	    $var.i config -cursor $option
	}
	-relief {
	    $var.root config -relief $option
	}
	-menu {
	}
	-state {
	}
	default {
	    error "Unknown option. Must be one of: -geometry, -insidegeometry, -borderwidth, -relief, -state, or -command"
	}
    }
    set data($flag) $option
}