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
