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

# template file for creating new widgets

# replace the string WIDGET with whatever you want to call your new
# widget and then fill in the stub procedures.

# set up the default values for the widgets configuration

tkwm_widget::setdefaults WIDGET WIDGETCLASS {
	{-borderwidth borderWidth BorderWidth 1}
	{-relief relief Relief raised}}

# Widget constructor

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

    # Set up the widget data structures, any other private values
    # you want should be initialized here as well.
    set data(type) WIDGET

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

    # Create the widget
    WIDGET::create $var

    # Create the widget command
    tkwm_widget::makecommand $var WIDGET::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 WIDGET::create {var} {
    upvar #0 $var data
    set w $var
    
    # configure (or destroy) the outside frame created to get
    # the initial values from the option database.
    $w config -relief $data(-relief) -borderwidth $data(-borderwidth)

    # create the rest of the widget heirarchy
    # pack the widget heirarchy

    # bindings

    set data(inframe) $w.i
}


# The widget command

proc WIDGET::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 WIDGET::configure $var args]
	    return $result
	}
	default {
	    error "Unknown widget command"
	}
    }
}

proc WIDGET::configure {var flag option} {
    upvar #0 $var data
    switch -- $flag {
	-borderwidth {
	    $var.root config -borderwidth $option
	    $var.i config -borderwidth $option
	}
	-relief {
	    $var.root config -relief $option
	}
	default {
	    error "Unknown option. Must be one of: -borderwidth or -relief"
	}
    }
    set data($flag) $option
}