Gnocl Widget Tree -Revisited

WJG (15/12/09) After re-examining the post earlier today on providing a means of packing widgets together with the convenience that a tree-like structure, I came up with this alterantive -a pure Tcl scripted gnocl megawidget.

#---------------
# widgetTree.tcl
#---------------
# Created by William J Giddings
# 15-Dec-2009
#---------------
# Description:
#---------------

#!/bin/sh
# the next line restarts using tclsh \
exec tclsh "$0" "$@"

package require Gnocl

#---------------
# Overload the gnocl widget.
# https://wiki.tcl-lang.org/1146
#---------------
proc gnocl::widgetTree { args  } {
    eval "set w [gnocl::box -orientation vertical]"
    rename $w ${w}_
    interp alias {} $w {} gnocl::widgetTreeCmd $w
    return $w
 }

# implement the new widget
proc gnocl::widgetTreeCmd {self cmd args} {
    switch -- $cmd {
       add {
           # check to see if the array containing the gnocl path names
           # of the nodes is present, if not, create it.
           if { [array exists ${self}_nodes] } {
               set i [array size ${self}_nodes]
               incr i
           } else {
               set i 1
           }

           # add a new node to the tree, ie expander and container
           set box [gnocl::box -orientation vertical]
           set node [gnocl::expander -label $args -child $box]

           # this will actually add the node to the tree container
           ${self}_ add $node

           # add node pathaname to internal list
           set ${self}_nodes($i) $node
           return $i
           }
       addItem {
           # Add item to node
           # get the node index and gnocl path name of child widget(s)
           # NB: more complex layouts should be places in their own
           #     containter, the path of with is passed to this proc
           foreach {node child} $args {}
           # get the actual box inside the expander
           set box [ [set ${self}_nodes($node)] cget -child ]
           $box add $child
           }
       default {return [uplevel 1 "${self}_ $cmd" $args]}
    }
}

#---------------


# DEMO BLOCK

set wt1 [gnocl::widgetTree]

# use arrray to contain indices of new tree notes
set t(cars) [$wt1 add CARS ]
set t(planes) [$wt1 add PLANES ]
set t(shipping) [$wt1 add SHIPPING ]

# add a few items to the
$wt1 addItem $t(cars) [gnocl::button -text Lagonda]
$wt1 addItem $t(planes) [gnocl::button -text DeHaviland]
$wt1 addItem $t(shipping) [gnocl::button -text P&O]
$wt1 addItem $t(shipping) [gnocl::button -text Cunard]

# add items to node
set wt2 [gnocl::widgetTree]

# use arrray to contain indices of new tree notes
set t(dogs) [$wt2 add DOGS ]
set t(cats) [$wt2 add CATS ]
set t(birds) [$wt2 add BIRDS ]

# add a few items to the
$wt2 addItem $t(dogs) [gnocl::button -text Spaniel]
$wt2 addItem $t(cats) [gnocl::button -text Siamese]
$wt2 addItem $t(birds) [gnocl::button -text Parrot]
$wt2 addItem $t(birds) [gnocl::button -text Cockatoo]

# add items to node
$wt1 addItem $t(shipping) $wt2

# add more and more stuff..
set wt3 [gnocl::widgetTree]
set t(breeds) [$wt3 add BREEDS ]
$wt3 addItem $t(breeds) [gnocl::button -text "King Charles'"]
$wt3 addItem $t(breeds) [gnocl::button -text "Cocker"]

# add items to list
$wt2 addItem $t(dogs) $wt3

# pack the widget into a scrolled window and display
gnocl::window -child [gnocl::scrolledWindow -child $wt1] -width 150 -height 300
gnocl::mainLoop

http://lh5.ggpht.com/_yaFgKvuZ36o/Syf9WlFjg-I/AAAAAAAAALY/30TksEEstTI/s800/Screenshot-widgetTree_2.tcl.png