This was a posting by [Jos Decoster] posted to comp.lang.tcl a while back providing some help to the [Bwidgets] developer. [http://groups.google.com/groups?hl=en&lr=&ie=UTF-8&safe=off&selm=3B419A28.D2A4FE34%40retarget.com&rnum=2]
----
 
'''1. Creating a widget with BWidget:'''

Introduction:

Creating a new widget using BWidgets can help you a lot. You declare the
arguments for the new widgets, eventually include some other widgets, write a create, configure, cget and destroy procedure and of you go.

A good source for information are the BWidget widgets themselves.

The way to create a new widget base an BWidgets has changes since version 1.2.1. This small document tries to explain how to create new BWidgets based on the CVS release of 28-jun-2001. 

This document is not trying to cover the complete BWidget functionality but only those parts I regularly use to create new widgets. I'll explain how I use BWidgets based on a small example: the TitleFrame included in the BWidget distribution.


'''2. Widget declaration:'''

Each widget needs it own namespace. In a 'namespace eval' statement, the widget is declared as follows:

  namespace eval TitleFrame {
    Widget::declare TitleFrame {
        {-relief      TkResource groove 0 frame}
        {-borderwidth TkResource 2      0 frame}
        {-font        TkResource ""     0 label}
        {-foreground  TkResource ""     0 label}
        {-state       TkResource ""     0 label}
        {-background  TkResource ""     0 frame}
        {-text        String     ""     0}
        {-ipad        Int        4      0 "%d >=0"}
        {-side        Enum       left   0 {left center right}}
        {-baseline    Enum       center 0 {top center bottom}}
        {-fg          Synonym    -foreground}
        {-bg          Synonym    -background}
        {-bd          Synonym    -borderwidth}
    }

    Widget::addmap TitleFrame "" :cmd {-background {}}
    Widget::addmap TitleFrame "" .l   {-background {} -foreground {} -text {} -font {}}
    Widget::addmap TitleFrame "" .l   {-state {}}
    Widget::addmap TitleFrame "" .p   {-background {}}
    Widget::addmap TitleFrame "" .b   {-background {} -relief {} -borderwidth {}}
    Widget::addmap TitleFrame "" .b.p {-background {}}
    Widget::addmap TitleFrame "" .f   {-background {}}

    proc ::TitleFrame { path args } { return [eval TitleFrame::create $path $args] }
    proc use {} {}
  }

The widget::declare statement declares the megawidget options. Possible
megawidget option types are:

    Enum
    Int
    Boolean 
    String
    Flag
    Synonym
    TkResource
    BwResource 

An option is declared as:

   <option> <option type> <default value> <is readonly?> [<additional info>]

The different option types need the following extra info:

    Enum        : List of enumeration values
    Int         : boundary information
    Boolean : none
    String      : none
    Flag        : string of valid flag characters
    Synonym     : none, also has no readonly flag
    TkResource  : tk-widget tk-widget-option-name
    BwResource : BWidget-widget BWidget-widget-option-name

Some examples:

    {-side         Enum       left   0 {left center right}}
     |             |          |      | |
     |             |          |      | +-> List of valid enumerations
     |             |          |      +-> Not read-only
     |             |          +-> Default value
     |             +-> Option type
     +-> Option name

    {-ipad         Int        4      0 "%d >=0"}
                                       |
                                       +-> Expression used to check value

    {-redraw       Boolean    1      0}

    {-text         String     ""     0}

    {-dropovermode Flag      "wpn"   0 "wpn"}
                                       |
                                       +-> Valid characters

    {-fg           Synonym   -foreground}
                             |      
                             +-> Option synonym refers to

    {-relief       TkResource groove 0 frame}
                                       |
           +-> Take relief from Tk frame -relief 
               option.

    {-fill         TkResource black  0 {listbox -foreground}}
                                       |
           +-> Take fill from Tk listbox 
               -foreground option.

    {-repeatdelay  BwResource ""     0 ArrowButton}
                                       |
           +-> Take repeatdelay from BWidget
               ArrowButton.


To map megawidget options to options of sub-widgets, you can use the
Widget::addmap statement. Some examples:

    Widget::addmap TitleFrame "" .l   {-background {} -foreground {}}
     |       |  |    |
     |       |  |    +-> Options to be mapped.
     |       |  +-> Path of subwidget, relative to path of 
     |       |      megawidget.
     |       +-> Optionally a class of subwidget
     +-> Name of megawidget

This statement maps the megawidget -background option to the -background option of the subwidget with path <path of megawidget>.

The following addmap statement maps the -deltay option of the ListBox
megawidget to the -yscrollincrement option of the subwidget with path <path of megawidget>.

    Widget::addmap ListBox "" .c {-deltay -yscrollincrement}

This is an example where also the class of the subwidget is specified:

    Widget::addmap SpinBox ArrowButton .arrup {
        -foreground {} -background {} -disabledforeground {} -state {} \
  -repeatinterval {} -repeatdelay {}
    }

To map options for the base-frame, you can use this statement provided you rename the widgetcommand of the baseframe to '::<path of megawidget>:cmd :

    Widget::addmap TitleFrame "" :cmd {-background {}}

A megawidget command is created in the global namespace:

    proc ::TitleFrame { path args } { return [eval TitleFrame::create $path $args] }

This commands calls the megawidget create command.

A 'use' procedure is also added. This 'use' procedure is usefull when including the megawidget being declared in other megawidgets.


'''3. Creating the megawidget:'''

The create procedure will actually create the megawidget and will also create the megawidget command:

  proc TitleFrame::create { path args } {
    Widget::init TitleFrame $path $args

    set frame  [eval frame $path [Widget::subcget $path :cmd] \
     -class TitleFrame -relief flat -bd 0 -highlightthickness 0]

    set padtop [eval frame $path.p [Widget::subcget $path :cmd] \
     -relief flat -borderwidth 0]
    set border [eval frame $path.b [Widget::subcget $path .b] \
            -highlightthickness 0]
    set label  [eval label $path.l [Widget::subcget $path .l] \
                    -highlightthickness 0 \
                    -relief flat \
                    -bd     0 -padx 2 -pady 0]
    set padbot [eval frame $border.p [Widget::subcget $path .p] \
     -relief flat -bd 0 -highlightthickness 0]
    set frame  [eval frame $path.f [Widget::subcget $path .f] \
     -relief flat -bd 0 -highlightthickness 0]
    set height [winfo reqheight $label]

    switch [Widget::getoption $path -side] {
        left   { set relx 0.0; set x 5;  set anchor nw }
        center { set relx 0.5; set x 0;  set anchor n  }
        right  { set relx 1.0; set x -5; set anchor ne }
    }
    set bd [Widget::getoption $path -borderwidth]
    switch [Widget::getoption $path -baseline] {
        top    { set htop $height; set hbot 1; set y 0 }
        center {
            set htop [expr {$height/2}]
            set hbot [expr {$height/2+$height%2+1}]
            set y 0 
        }
        bottom { set htop 1; set hbot $height; set y [expr {$bd+1}] }
    }
    $padtop configure -height $htop
    $padbot configure -height $hbot

    set pad [Widget::getoption $path -ipad]
    pack $padbot -side top -fill x
    pack $frame  -in $border -fill both -expand yes -padx $pad -pady $pad

    pack $padtop -side top -fill x
    pack $border -fill both -expand yes

    place $label -relx $relx -x $x -anchor $anchor -y $y

    bind $label <Configure> "TitleFrame::_place $path"
    bind $path  <Destroy>   {Widget::destroy %W; rename %W {}}

    rename $path ::$path:cmd
    proc ::$path { cmd args } "return \[eval TitleFrame::\$cmd $path \$args\]"
    
    return $path
  }


The create proceddure starts with an init command. This command processes the arguments entered by the user:

    Widget::init TitleFrame $path $args

After this, a base frame is created. This baseframe is create with the -class <megawidget> option to simplify the management of option in the
option-database:

    set frame  [eval frame $path [Widget::subcget $path :cmd] \
     -class TitleFrame -relief flat -bd 0 -highlightthickness 0]

The widget:subcget statement gets the subwidget commands for the specified subwidget (in this case he base-frame).

In this base-frame, the subwidgets are created. For each subwidget, options are read using the Widget::subcget statement.

    set padtop [eval frame $path.p [Widget::subcget $path :cmd] \
     -relief flat -borderwidth 0]
    set border [eval frame $path.b [Widget::subcget $path .b] \
            -highlightthickness 0]
    set label  [eval label $path.l [Widget::subcget $path .l] \
                    -highlightthickness 0 \
                    -relief flat \
                    -bd     0 -padx 2 -pady 0]
    set padbot [eval frame $border.p [Widget::subcget $path .p] \
     -relief flat -bd 0 -highlightthickness 0]
    set frame  [eval frame $path.f [Widget::subcget $path .f] \
     -relief flat -bd 0 -highlightthickness 0]

The Widget::getoption statement is used to get megawidget options. Base on these megawidget options the remaining parts of the megawidget are configured:

    switch [Widget::getoption $path -side] {
        left   { set relx 0.0; set x 5;  set anchor nw }
        center { set relx 0.5; set x 0;  set anchor n  }
        right  { set relx 1.0; set x -5; set anchor ne }
    }
    set bd [Widget::getoption $path -borderwidth]
    switch [Widget::getoption $path -baseline] {
        top    { set htop $height; set hbot 1; set y 0 }
        center {
            set htop [expr {$height/2}]
            set hbot [expr {$height/2+$height%2+1}]
            set y 0 
        }
        bottom { set htop 1; set hbot $height; set y [expr {$bd+1}] }
    }
    $padtop configure -height $htop
    $padbot configure -height $hbot

    set pad [Widget::getoption $path -ipad]
    pack $padbot -side top -fill x
    pack $frame  -in $border -fill both -expand yes -padx $pad -pady $pad

    pack $padtop -side top -fill x
    pack $border -fill both -expand yes

    place $label -relx $relx -x $x -anchor $anchor -y $y

The created procedure now adds some bindings for Configure and Destroy events:

    bind $label <Configure> "TitleFrame::_place $path"
    bind $path  <Destroy>   {Widget::destroy %W; rename %W {}}

Finally the baseframe widget command is renames and a new (mega)widget command is created:

    rename $path ::$path:cmd
    proc ::$path { cmd args } "return \[eval TitleFrame::\$cmd $path \$args\]"
    
The path of the baseframe is returned to the user:

    return $path

'''4. The megawidget configure command:'''

The BWidget package also helps in creating a configure and cget procedure for the new Megawidget:

  proc TitleFrame::configure { path args } {
    set res [Widget::configure $path $args]

    if { [Widget::hasChanged $path -ipad pad] } {
        pack configure $path.f -padx $pad -pady $pad
    }
    if { [Widget::hasChanged $path -borderwidth val] |
         [Widget::hasChanged $path -font        val] |
         [Widget::hasChanged $path -side        val] |
         [Widget::hasChanged $path -baseline    val] } {
        _place $path
    }

    return $res
  }

  proc TitleFrame::cget { path option } {
    return [Widget::cget $path $option] 
  }

The Widget::configure statement processes the arguments a would do the normal configure command of a Tk-widget. Options added with addmap are automatically forwarded to the subwidgets. The Widget::configure statement also keeps track of which options were changed and which were not. 

Using the Widget::hasChanged statement, it is possible to detect if a user modified an options and to retrieve the value for an option.

The megawidget configure function returns the result of the Widget::configure statement. This result has the same format as for normal Tk configure commands.

The Widget::cget statement helps creating a cget procedure as they exists for the Tk widgets.

'''5. Destroying the megawidget:'''


The destroy event was linked to the following command in the megawidget create procedure:

 bind $path  <Destroy>   {Widget::destroy %W; rename %W {}}

Upon destruction of the megawidget, the Widget::destroy command is called. This function will cleanup all internal state for the widget instance being destroyed. After this, the megawidget widget command is removed by renaming it to {}.

'''6. Basic framework:'''

Putting things together gives the following basic frame-work:

  namespace eval BWframe {

    Widget::declare BWframe {
    }


    proc ::BWframe { path args } { return [eval BWframe::create $path $args] }
    proc use {} {}
  }

  proc BWframe::create { path args } {

    Widget::init BWframe $path $args

    set frame  [eval frame $path [Widget::subcget $path :cmd] \
     -class BWframe -relief flat -bd 0 -highlightthickness 0]


    bind $path  <Destroy>   {Widget::destroy %W; rename %W {}}

    rename $path ::$path:cmd
    proc ::$path { cmd args } "return \[eval BWframe::\$cmd $path \$args\]"
    
    return $path
  }

  proc BWframe::configure { path args } {

    set res [Widget::configure $path $args]

    return $res
  }

  proc BWframe::cget { path option } {
    return [Widget::cget $path $option]
  }

To use this new BWidget widget, add the following line to the tclPkgSetup command in the BWidget pkgIndex.tcl file:

    {bwframe.tcl source {BWframe BWframe::create BWframe::use}}

or source the file after loading the Bwidget package.

Now you can use this widget:

    <wish> % BWframe .b
    .b
    <wish> % .b configure
    <wish> % 

This megawidget has no options yet.

An alternative create procedure would be:

  proc BWframe::create { path args } {

    array set maps [list BWframe {} :cmd {}]
    array set maps [Widget::parseArgs BWframe $args]

    Widget::initFromODB BWframe "$path" $maps(BWframe)

    set frame  [eval frame $path $maps(:cmd) \
     -class BWframe -relief flat -bd 0 -highlightthickness 0]

    bind $path  <Destroy>   {Widget::destroy %W; rename %W {}}

    rename $path ::$path:cmd
    proc ::$path { cmd args } "return \[eval BWframe::\$cmd $path \$args\]"
    
    return $path
  }

where the argument parsing and inittialisation is done separately.

'''7. Including other widgets:'''

When a subwidget needs to keep many of its options, it is easier to include it. This avoids the redefinition and mapping of all the subwidget options in the megawidget. It is possible to include Tk and BWidget widgets. Options of included widgets can be include, removed, renamed, prefixed, initialised and made read-only.

This is an example of including a Tk button:

  namespace eval Yab {

    Widget::tkinclude Yab button .b

    Widget::declare Yab {
    }


    proc ::Yab { path args } { return [eval Yab::create $path $args] }
    proc use {} {}
  }

  proc Yab::create { path args } {

    array set maps [list Yab {} :cmd {} .b {}]
    array set maps [Widget::parseArgs Yab $args]

    Widget::initFromODB Yab "$path" $maps(Yab)

    set frame  [eval frame $path $maps(:cmd) \
     -class Yab -relief flat -bd 0 -highlightthickness 0]

    set but [eval button $frame.b $maps(.b)]
    pack $but -fill both -expand true

    bind $path  <Destroy>   {Widget::destroy %W; rename %W {}}

    rename $path ::$path:cmd
    proc ::$path { cmd args } "return \[eval Yab::\$cmd $path \$args\]"
    
    return $path
  }

  proc Yab::configure { path args } {

    set res [Widget::configure $path $args]

    return $res
  }

  proc Yab::cget { path option } {
    return [Widget::cget $path $option]
  }

Now you can use the megawidget:

    <wish> % Yab .y
    .y
    <wish> % .y configure
{-activebackground activeBackground Foreground #ececec #ececec} {-activeforeground activeForeground Background Black Black} {-anchor anchor Anchor center center} {-background background Background Gray90 Gray90} {-bd borderWidth} {-bg background} {-bitmap bitmap Bitmap {} {}} {-borderwidth borderWidth BorderWidth 2 2} {-command command Command {} {}} {-cursor cursor Cursor {} {}} {-default default Default disabled disabled} {-disabledforeground disabledForeground DisabledForeground #a3a3a3 #a3a3a3} {-fg foreground} {-font font Font {Helvetica -12 bold} {Helvetica -12 bold}} {-foreground foreground Foreground black black} {-height height Height 0 0} {-highlightbackground highlightBackground HighlightBackground #d9d9d9 #d9d9d9} {-highlightcolor highlightColor HighlightColor Black Black} {-highlightthickness highlightThickness HighlightThickness 1 1} {-image image Image {} {}} {-justify justify Justify center center} {-padx padX Pad 3m 3m} {-pady padY Pad 1m 1m} {-relief relief Relief raised raised} {-state state State normal normal} {-takefocus takeFocus TakeFocus {} {}} {-text text Text 123456 123456} {-textvariable textVariable Variable {} {}} {-underline underline Underline -1 -1} {-width width Width 0 0} {-wraplength wrapLength WrapLength 0 0}
    <wish> % 

I got all options from the included button.

It is also possible to include multiple widgets, and prefix the options for each widget. The following example prefixes the -text, -textvariable, -bitmap, -image and -underline options:

  namespace eval Yab {

    Widget::tkinclude Yab button .lb \
     prefix { left -text -textvariable -bitmap -image -underline }
    Widget::tkinclude Yab button .rb \
     prefix { right -text -textvariable -bitmap -image -underline }

    Widget::declare Yab {
    }


    proc ::Yab { path args } { return [eval Yab::create $path $args] }
    proc use {} {}
  }

  proc Yab::create { path args } {

    array set maps [list Yab {} :cmd {} .lb {} .rb {}]
    array set maps [Widget::parseArgs Yab $args]

    Widget::initFromODB Yab "$path" $maps(Yab)
    Widget::initFromODB Yab "$path.lb" $maps(.lb)

    set frame  [eval frame $path $maps(:cmd) \
     -class Yab -relief flat -bd 0 -highlightthickness 0]

    set lbut [eval button $frame.lb $maps(.lb)]
    pack $lbut -fill both -expand true -side left

    set rbut [eval button $frame.rb $maps(.rb)]
    pack $rbut -fill both -expand true -side right

    bind $path  <Destroy>   {Widget::destroy %W; rename %W {}}

    rename $path ::$path:cmd
    proc ::$path { cmd args } "return \[eval Yab::\$cmd $path \$args\]"
    
    return $path
  }

  proc Yab::configure { path args } {

    set res [Widget::configure $path $args]

    return $res
  }

  proc Yab::cget { path option } {
    return [Widget::cget $path $option]
  }

Now use this widget:

    <wish> % Yab .y -lefttext LEFT -righttext RIGHT
    .y
    <wish> % .y configure
{-activebackground activeBackground Foreground #ececec #ececec} {-activeforeground activeForeground Background Black Black} {-anchor anchor Anchor center center} {-background background Background Gray90 Gray90} {-bd borderWidth} {-bg background} {-borderwidth borderWidth BorderWidth 2 2} {-command command Command {} {}} {-cursor cursor Cursor {} {}} {-default default Default disabled disabled} {-disabledforeground disabledForeground DisabledForeground #a3a3a3 #a3a3a3} {-fg foreground} {-font font Font {Helvetica -12 bold} {Helvetica -12 bold}} {-foreground foreground Foreground black black} {-height height Height 0 0} {-highlightbackground highlightBackground HighlightBackground #d9d9d9 #d9d9d9} {-highlightcolor highlightColor HighlightColor Black Black} {-highlightthickness highlightThickness HighlightThickness 1 1} {-justify justify Justify center center} {-leftbitmap leftbitmap Bitmap {} {}} {-leftimage leftimage Image {} {}} {-lefttext lefttext Text {} LEFT} {-lefttextvariable lefttextvariable Variable {} {}} {-leftunderline leftunderline Underline -1 -1} {-padx padX Pad 3m 3m} {-pady padY Pad 1m 1m} {-relief relief Relief raised raised} {-rightbitmap rightbitmap Bitmap {} {}} {-rightimage rightimage Image {} {}} {-righttext righttext Text {} RIGHT} {-righttextvariable righttextvariable Variable {} {}} {-rightunderline rightunderline Underline -1 -1} {-state state State normal normal} {-takefocus takeFocus TakeFocus {} {}} {-width width Width 0 0} {-wraplength wrapLength WrapLength 0 0}
    <wish> % 

Watch the -left* and -right* options. All other options are shared. When
configuring the background color:

    <wish> % .y configure -bg red

both buttons get the new color.

I could not yet figure out how to give prefixed options a default value using the initialize part of the Widget::tkinclude statement.


'''8. Private widget state'''

For storing private widget state the BWidet framework first creates a namespace below ::Widget using the declared name of the widget and then one namespace per widget inside of this one.

Example:

After executing
 % TitleFrame .tf

we have the namespace

 ::Widget::TitleFrame

for the class and

 ::Widget::TitleFrame::.tf

for the widget itself. This namespace can be used to store private widget state.