[DKF]: The content of this page represents a first reasonably-serious attempt at doing [megawidget]s with [TclOO]. The example code below comes in two parts, a pair of classes that represent how to build a megawidget (i.e. the class of factories of [widget]s, and the class of widgets), and some demonstration code. The demo code builds an extended [frame] that supports two extra methods: '''change''' which alters the background colour of the widget, and '''flash''' which makes the widget highly visible for a bit. It then does a tiny demo usage of the code. ---- ====== package require Tk package require TclOO 0.3a0 oo::class create widgetFactory { superclass oo::class constructor {underlying methods definitionScript} { next $definitionScript my variable u m set u $underlying set m $methods } method getUnderlying {} { my variable u return $u } method getMethods {} { my variable m return $m } method unknown {args} { if {[string match .* [lindex $args 0]]} { return [uplevel 1 [list [self] create {*}$args]] } next {*}$args } } oo::class create widget { # Note that we are not using the standard 'create' method! self { unexport create method createSubclass {name underlying {definitionScript {}}} { set script "[list superclass [self]];$definitionScript" # Discover what methods are supported by the underlying widget $underlying .____ catch {.____ ?} msg destroy .____ regexp {: must be (.*)} $msg -> opts regsub -all {, | or |} $opts {} m uplevel 1 [list widgetFactory create $name $underlying $m $script] } } constructor {args} { my variable w props set props {} # Don't use [self class]; need the actual class of the object set class [info object class [self]] set underlying [$class getUnderlying] set pathName [namespace tail [self]] rename [self] __tmp set w _$pathName set pathName [uplevel 1 [list $underlying $pathName {*}$args]] uplevel 1 [list rename $pathName $w] uplevel 1 [list rename [self] $pathName] return $pathName } method cget property { my variable w props if {[dict exists $props $property]} { return [dict get $props $property] } $w cget $property } method configure {property value} { my variable w props if {[catch {$w configure $property $value}]} { dict set props $property $value } return $value } method unknown {method args} { my variable w set class [info object class [self]] if {$method in [$class getMethods]} { oo::objdefine [self] forward $method $w $method $w $method {*}$args } } } # Demonstrate by making an extended frame widget widget createSubclass FlashingFrame frame { constructor args { next {*}$args my variable flashing set flashing 0 } method change color { [self] configure -bg $color } method flash {} { my variable flashing if {!$flashing} { set w [self] set c [$w cget -bg] set flashing 1 after 0 $w change white after 50 $w change black after 100 $w change $c after 200 $w change white after 250 $w change black after 300 $w change $c after 400 $w change white after 450 $w change black after 500 $w change $c after 600 $w change white after 650 $w change black after 700 $w change $c after 700 [namespace code {my EndFlashing}] } } method EndFlashing {} { my variable flashing set flashing 0 } } # Put the FlashingFrame through its paces FlashingFrame .f -background red -width 100 -height 100 pack .f after 500 .f change green bind .f <1> { %W flash } ====== ---- '''[DGP]''' I'm not very close to this subject, so my impressions may be mistaken, but I've thought one of the virtues sought in a megawidget system was that the script-defined megawidgets got used the same way as the built-in C-coded base widget set, so that scripts could use both kinds of widget commands without being bothered to know which was which, and so that megawidget creators could make things on the same level as the original commands just as [proc] writers produce commands which take their place on an even playing field with the Tcl built-in commands. However, I see FlashingFrame create .f ... And I know that the base Tk widget looks like: frame .f ... Is this an indcation that TclOO has some issues serving as ''the'' base for Tk megawidgets? [DKF]: No; it should be fine. It just requires an unknown handler on the `widgetFactory` that redirects unknown calls to methods beginning with a period to the instantiation method. ''(Now added)'' ---- !!!!!! %| [Category GUI] | [Category Object Orientation] | [Category Widget] |% !!!!!!