Version 1 of xml2gui

Updated 2003-05-16 04:48:55

MC, 15 May 2003: This is another package I put together building upon tDOM. (See also Pull down menus in XML and Using Snit to make Tk DOM Glue).

xml2gui creates & grids Tk widgets based on an XML description. I created it as an experiment to help me rapidly try different screen layouts out.


There are five tags which receive special treatment; all others are assumed to be the name of a type of widget.

The five special tags are:

  • <row>
  • <col>
  • <configure>
  • <tcl>
  • <null>


Generally, attributes in all uppercase are used by xml2gui while any lowercase or mixed-case attributes are passed as configuration parameters to the widget.


The only optional attribute for <row/> and <col/> is "weight" which will default to 0 if not specified.

<configure> has no special attributes; it is used to configure the widget referenced by its parent tag.

<null> has no special attributes, and is used only as a non-existant place holder in one or more column(s), or as the parent widget (root node of the XML document) already exists and doesn't need to be created by xml2gui. In this case, the special attributes of PATH and NAME should be supplied. PATH might equal "" and NAME might equal "bar".

<tcl> has no special attributes. It's textnode() is evaluated as Tcl code. @[email protected] is replaced with the widget path of <tcl>'s parent widget, and @[email protected] is replaced with the tDOM node command of the <tcl> element in the DOM tree.


All widgets except <tab>, <toplevel> and children of <canvas> have the following attributes that will effect how the widget is grid'ed:

  • IPADX (defaults to 0)
  • IPADY (defaults to 0)
  • PADX (defaults to 0)
  • PADY (defaults to 0)
  • STICKY (defaults to nsew)
  • COLSPAN (defaults to 1)
  • ROWSPAN (defaults to 1)

BLT <tab>'s have attributes of:

  • FILL (defaults to both)
  • ANCHOR (defaults to center)

Children of <canvas> widgets (i.e., <oval/>, <circle/>, etc.) must have an attribute of COORDS that specifies the coordinates on the canvas.

If an attribute of WIDGETVAR is present then a Tcl variable (in the global namespace if not otherwise qualified) will be set to the path of the created widget.

If an attribute of WIDGETNODE and WIDGETATTR are both present then the tDOM node $WIDGETNODE will have $WIDGETATTR set to the path of the created widget.

If an attribute of BINDTAGS is present then the specified bindtags are added either before the default bindtags (if the value of the bindtags attribute begins with a +) or after the default bindtags (if the bindtags end with a +).

Now for the code (also available in CVS at [L1 ]).

 # xml2gui, version 1.0
 #     Creates a GUI based on an XML description.

 namespace eval ::xml2gui {
     package require Tcl 8.3
     package require Tk  8.3
     package require tdom 0.7.7

 # Create the $child of a $parent
 proc ::xml2gui::Create {child parent} {
     foreach node [list $child $parent] {
         set type($node) [$node nodeName] 
         set name($node) [$node getAttribute NAME ""]

     # Dispatch based on the name (type) of the child node
     # row, col, configure, tcl, and null, receive special treatment.
     # All other node names are presumed to be the name of a type of 
     # Tk widget (or megawidget).
     switch -exact -- $type($child) {
         row       { GridConfigure rowconfigure $child $parent }
         col       { GridConfigure columnconfigure $child $parent }
         configure { Configure $child $parent }
         tcl       { TclCode $child $parent }
         null      { /dev/null }
         default   { CreateWidget $child $parent }

     # For new <row />, we increment rowcount & reset column to 0
     if {$type($child) == "row"} {
         $parent setAttribute ROW [expr {[$parent getAttribute ROW] + 1}]
         $parent setAttribute COL 0
     } elseif {[lsearch -exact {col configure tcl} $type($child)] == -1} {
         # For any widget (or null placeholder), increment column
         $parent setAttribute COL [expr {[$parent getAttribute COL] + 
                                         [$child getAttribute COLSPAN 1]}]

     # If a widget has children widgets, then it must be a container of
     # some sort (i.e., Frame, BLT tabset, BWidget ScrolledWindow, etc.)
     # so we set row = 0, col = 0.  On the other hand, it might be a regular
     # widget with a <tcl>...</tcl> child, in which case we'll never use
     # the row & col settings, but it doesn't hurt to set them.
     if {[$child hasChildNodes] && $type($child) != "tcl"} {
         $child setAttribute ROW 0
         $child setAttribute COL 0

         # Create each descendant widget recursively,
         # taking care to ignore COMMENT_NODEs, etc.
         foreach grandchild [$child childNodes] {
             if {[$grandchild nodeType] == "ELEMENT_NODE"} {
                 Create $grandchild $child

 # Special handling for <row /> & <col /> 
 proc ::xml2gui::GridConfigure {mode child parent} {
     if {$mode == "rowconfigure"} {
         set pos [$parent getAttribute ROW]
     } elseif {$mode == "columnconfigure"} {
         # COL contains the "next" column number, so we subtract one to
         # get the "current" column number
         set pos [expr {[$parent getAttribute COL] - 1}]

     grid $mode [$parent getAttribute PATH] $pos \
         -weight [$child getAttribute weight 0]

 # /dev/null is a no-op for <null /> (side effect is that the current COL 
 # number is incremented)
 proc ::xml2gui::/dev/null args {}

 # BuildCommand
 proc ::xml2gui::BuildCommand {child path {command {}}} {
     foreach attribute [$child attributes] {
         # All caps attributes are reserved for xml2gui's use 
         # (we don't know of any megawidget that uses an all-caps 
         # configuration -OPTION)
         if {[string equal $attribute [string toupper $attribute]]} then continue

         # incrementally build up our command, substituting 
         # @[email protected] with the widget name of our parent, and
         # @[email protected] with the tDOM node of the widget being created
         # (the latter is probably only useful in conjunction with the
         # tdg package)
         lappend command -$attribute \
             [string map [list @[email protected] $path @[email protected] $child] \
                 [$child getAttribute $attribute]]

     return $command

 # Configure the $child of a $parent for some <widget />
 proc ::xml2gui::Configure {child parent} {
     set path [$parent getAttribute PATH]
     set widget [string map [list @[email protected] $path] [$child getAttribute NAME]]

     set command [BuildCommand $child $path]
     if {[llength $command]} {
         eval [list $widget] configure $command

 # Special handling for <tcl>...</tcl>
 proc ::xml2gui::TclCode {child parent} {
     # If <tcl> has no child text() node, then we have no code to execute
     if {[set node [$child selectNodes text()]] == ""} then return

     set path [$parent getAttribute PATH]
     eval [string map [list @[email protected] $path @[email protected] $child] [$node data]]

 # Create a <widget />
 proc ::xml2gui::CreateWidget {child parent} {
     upvar 1 type type
     upvar 1 name name

     # Make sure we have the right package loaded to be able to create 
     # the requested type of widget
     # (Other megawidgets can be used assuming they've been properly 
     # [package require'd] previously ...)
     switch -exact -- $type($child) {
         table           { package require Tktable }
         tabset          -
         graph           -
         stripchart      -
         barchart        -
         chart           { package require BLT }
         Dialog          -
         MainFrame       -
         LabelFrame      -
         TitleFrame      -
         ScrolledWindow  -
         PagesManager    -
         ScrollableFrame { package require BWidget }
         default         { package require Tk }

     # Find out the name of the parent widget
     set path [$parent getAttribute PATH]
     set widget $path

     # Unless this widget is a BLT <tab>
     if {$type($child) != "tab"} {
         # If the parent is not the "." root window, append a . before the
         # child's name to create the path of the new widget
         if {[string index $widget end] != "."} {
             append widget .
         append widget $name($child)

     # default initially to PATH == $widget
     $child setAttribute PATH $widget

     # We don't need to create (and can't!) the "." toplevel, for instance
     if {$type($child) != "tab" && [info commands $widget] != ""} then return

     # Command to create the widget
     if {$type($parent) != "canvas"} {
         switch -exact -- $type($child) {
             tabset    { set command [list ::blt::tabset $widget]   }
             tab       { set command [list $path insert end $name($child)]  }
             graph     { set command [list ::blt::graph $widget]    }
             barchart  -
             chart     { set command [list ::blt::barchart $widget] }
             default   { set command [list $type($child) $widget]   }
     } else {
         set command [list $path create $type($child) \
             [$child getAttribute COORDS]]

     set command [BuildCommand $child $path $command]

     # Create the widget.  No error catching.  If the widget syntax fails,
     # so be it.
     eval $command

     # Some megawidgets have a different frame for future child widgets
     switch -exact -- $type($child) {
         Dialog          -
         MainFrame       -
         LabelFrame      -
         TitleFrame      -
         ScrolledWindow  -
         ScrollableFrame { $child setAttribute PATH [$widget getframe] }

     if {$type($parent) == "tab"} {
         # The BLT tabset manages the geometry of children of <tab> 
         $path tab configure $name($parent) -window $widget \
             -fill   [$child getAttribute FILL both] \
             -anchor [$child getAttribute ANCHOR center]
     } elseif {$type($parent) == "canvas"} {
         # Canvas takes care of it's own internal geometry management
     } elseif {$type($child) != "tab" && $type($child) != "toplevel"} {
         # Non <tab>'s & non-<toplevel>'s use the grid geometry manager
         grid $widget -row     [$parent getAttribute ROW] \
                      -column  [$parent getAttribute COL] \
                      -ipadx   [$child getAttribute IPADX 0] \
                      -ipady   [$child getAttribute IPADY 0] \
                      -padx    [$child getAttribute PADX 0] \
                      -pady    [$child getAttribute PADY 0] \
                      -sticky  [$child  getAttribute STICKY nsew] \
                      -rowspan [$child getAttribute ROWSPAN 1] \
                      -columnspan [$child getAttribute COLSPAN 1] 

     # If requested, save the name of this newly created widget in a 
     # global (or namespace'd) variable
     if {[$child hasAttribute WIDGETVAR]} {
         set ::[$child getAttribute WIDGETVAR] $widget

     # If requested, save the name of this newly created widget as an
     # attribute of a node in a tDOM DOM tree
     if {[$child hasAttribute WIDGETNODE] && 
         [$child hasAttribute WIDGETATTR]} {
         [$child getAttribute WIDGETNODE] setAttribute \
             [$child getAttribute WIDGETATTR] $widget

     # Add additional bindtags.  A + (for add) must come at either the beginning
     # or end of the additional bindtag(s).  If at the beginning then the
     # bindtags are added before any existing ones; otherwise, bindtags are
     # added after any existing ones.
     if {[$child hasAttribute BINDTAGS]} {
         set tags [$child getAttribute BINDTAGS]
         set pos [lsearch -exact $tags +]
         if {$pos != -1} {
             set tags [lreplace $tags $pos $pos]
             if {$pos} {
                 bindtags $widget [concat [bindtags $widget] $tags]
             } else {
                 bindtags $widget [concat $tags [bindtags $widget]]

 # create -- Create a GUI from an xml description
 # This is this packages sole public method.
 proc ::xml2gui::create xml {
     set doc  [dom parse $xml]
     set root [$doc documentElement]
     set parent [$root selectNodes ..]

     $parent setAttribute PATH ""
     $parent setAttribute ROW 0
     $parent setAttribute COL 0

     $root setAttribute ROW 0
     $root setAttribute COL 0

     Create $root $parent
     $doc delete

 package provide xml2gui 1.0

[ Category XML | Category GUI | Category Package ]