This was a posting by Jos Decoster posted to comp.lang.tcl a while back providing some help to the Bwidget developer. [L1 ]
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::define TitleFrame 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 {}}
}The first command to execute when defining a new widget is the Widget::define command. This command's arguments are as follows:
Widget::define <widgetClass> <widgetFileName> ?includedClass? ?includedClass? ...
This defines the new widget class, tells BWidget what the filename (without the .tcl extension) should be for this class and what other classes this widget will use. IE:
Widget::define ListBox listbox DragSite DropSite DynamicHelp
Says that the new ListBox widget is in a file called listbox(.tcl) and that it needs a copy of the DragSite, DropSite and DynamicHelp libraries.
The Widget::define command does several things. It creates a proc called ::<widgetClass> for the new widget as well as a <widgetClass>::use proc. It also specifically calls the ::use proc for any widget that is declared as required by the widget. This ensures that all the necessary libraries get loaded before this widget is truly defined or used. Finally, Widget::define binds the <Destroy> event for the widget class to the default Widget::destroy command which does all the necessary cleanup for a BWidget. Any custom cleanup should be defined in a proc for the widget class, and that proc should call Widget::destroy in turn for the final cleanup.
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-nameSome 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 megawidgetThis 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 {}}
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"
return [Widget::create TitleFrame $path]
}
The create procedure 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 $yThe 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, you want to call the Widget::create command to create the widget, rename its path to let BWidget handle commands and create the handling proc. Widget::create returns the path of the widget, so it is usually easiest to just let Widget::create return the path to the user. Like so:
return [Widget::create TitleFrame $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 as 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 any 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::define BWframe bwframe
Widget::declare BWframe {
}
}
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]
return [Widget::create BWframe $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]
return [Widget::create BWframe $path]
}where the argument parsing and initialisation 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::define Yab yab
Widget::tkinclude Yab button .b
Widget::declare Yab {
}
}
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
return [Widget::create Yab $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::define Yab 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::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
return [Widget::create Yab $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.
de: To 7.: To include a BWidget widget is almost as simple as to include a Tk widget. Use Widget::bwinclude instead of Widget::tkinclude and add an <Classname>::use before that. A minimum example:
namespace eval MyTree {
Widget::define MyTree mytree Tree
Widget::declare MyTree {
}
Widget::bwinclude MyTree Tree .t
}CLN I'm sure this is largely a matter of familiarity but when I looked at BWidget internals and considered creating some of my own, I saw too much complexity and I gave up. When Snit came along, I found something where I could start small and add complexity as I choose (that is, a simple BWidget seemed to require a lot of overhead but a simple Snit widget was simple). Which begs the question: since BWidget and Snit are both pure Tcl, how do they compare on performance? If BWidgets were lots faster, it'd be worth the learning curve in some situations...but I have no data to work from. Has anyone done both?