[NEM] ''17 Oct 2005'': Here's an experiment with combining Tk widgets with namespaces as another attempt at a megawidget package. Instead of being based on an [OO] design, this one is based on a simple compositional syntax: you create nested hierarchies of widgets by simply nesting them inside one another. It's not quite as compositional as I'd like it yet, but it illustrates the general idea. Also, ''beware:'' widget path-names are currently tied to the namespace hierarchy, so you should either fully-qualify widget names (as you have to in Tk), or always create widgets from the global namespace. I intend to fix that behaviour at some point. Without further ado, some code: # comptk.tcl -- # # Compositional Tk: an experiment on making Tk widget composition # simpler. # # Copyright (c) 2005 by Neil Madden (nem@cs.nott.ac.uk). # # License: Same as Tcl package require Tcl 8.4 package require Tk 8.4 package provide comptk 0.1 namespace eval ::comptk { proc Dispatch {fqname args} { if {[llength $args] == 0} { return [string map {:: .} $fqname] } else { uplevel 1 [list namespace eval $fqname $args] } } proc Values {arrName} { upvar 1 $arrName array set ret [list] foreach item [array names array] { lappend ret $array($item) } return $ret } # Option parsing proc CheckOpts {opts arglist} { if {[lindex $opts end] eq "args"} { set have_args 1 set opts [lrange $opts 0 end-1] } else { set have_args 0 } array set options { } # Defaults foreach item $opts { if {[llength $item] == 2} { set options([lindex $item 0]) [lindex $item 1] } } set pass [list] foreach {name value} $arglist { # Remove leading - set sname [string range $name 1 end] if {[lsearch -exact $opts $sname] > -1} { set options($sname) $value } elseif {$have_args} { lappend pass $name $value } else { error "unknown option \"$sname\"" } } set ret [list] foreach item $opts { if {[info exists options($item)]} { lappend ret $options($item) } else { error "no value specified for option \"$item\"" } } if {$have_args} { return [concat $ret $pass] } else { return $ret } } proc Resolve {name} { if {[string index $name 0] eq "."} { # Fully qualified return [string map {. ::} $name] } # Note! uplevel _2_... set ns [uplevel 2 [list namespace current]] if {$ns eq "::"} { set fqname ::[string map {. ::} $name] } else { set fqname ${ns}::[string map {. ::} $name] } } proc In {ns params args body} { set env [CheckOpts $params $args] set tmp ${ns}::InTmp[clock clicks] proc $tmp $params $body uplevel #0 [linsert $env 0 $tmp] rename $tmp {} } proc self {args} { set ns [uplevel 1 [list namespace current]] if {[llength $args]} { set name [lindex $args 0] return [lreplace $args 0 0 [string map {:: .} $ns].$name] } else { return [string map {:: .} $ns] } } proc widget {name params body} { set ns [uplevel 1 { namespace current }] interp alias {} ${ns}::$name {} \ [namespace current]::Create $params $body return $name } proc Create {opts script name args} { if {([llength $args] %2) == 1} { set body [lindex $args end] set args [lrange $args 0 end-1] } else { set body "" } set fqname [Resolve $name] namespace eval $fqname { namespace import -force ::comptk::* } In $fqname $opts $args $script namespace eval $fqname $body interp alias {} $fqname {} ::comptk::Dispatch $fqname return $name } proc widgetadaptor {name {target {}}} { if {![string length $target]} { set target ::$name } uplevel 1 [list ::comptk::widget $name args [format { eval [linsert $args 0 %s [self]] } [list $target]]] } widget window {title args} { eval toplevel [self] $args wm title [self] $title } widgetadaptor text widgetadaptor scrollbar widgetadaptor entry # Other widgets... namespace export {[a-z]*} } Now that we have the basic package, here is some demo code that creates a new megawidget that is the beginnings of a simple text editor: # Withdraw root window wm withdraw . # A simple test comptk::widget texteditor {title} { comptk::window [self] -title $title { text t -yscrollcommand [self vsb set] -xscrollcommand [self hsb set] scrollbar vsb -orient vertical -command [self t yview] scrollbar hsb -orient horizontal -command [self t xview] entry status -textvariable [namespace current]::status } grid [t] -row 0 -column 0 -sticky nsew grid [vsb] -row 0 -column 1 -sticky ns grid [hsb] -row 1 -column 0 -sticky ew grid [status] -row 2 -column 0 -sticky ew -columnspan 2 grid rowconfigure [self] 0 -weight 1 grid columnconfigure [self] 0 -weight 1 } texteditor foo -title "CompTk Test" # Set the status to something nice: foo set status "Hello, World!" bind [foo] { exit } Note little touches like that [[foo set status ...]] stuff. Making widgets into namespaces comes along with some bonuses like that. Making a new text editor is as simple as just: texteditor bar -title "Another editor!" bar set status "More status messages..." Obviously there is a lot of polish to add before this is as industrial-quality as, say [snit]. It might be nice to combine this with [Traits] for adding orthogonal behaviours to widgets (e.g., undo etc). Widget hierarchies are ensembles too, so you can do stuff like: [bar status] configure -text Ideally, that would be just [[bar status configure -text]], but I need to add some magic for that to work...