[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. ''[escargo] 16 May 2003'' - I have sometimes wondered whether Tcl could have a binding for XUL[http://www.mozilla.org/xpfe/xulref/]. XUL does have definitions for menubars and menus. I suppose that creating a xul2gui would be a straightforward extension of xml2gui. ''[Brett Schwarz] 16 May 2003'' - The GNU enterprise project does something like this, but with other toolkits. I was tempted to add the ability to read their XML files with Tcl, but never followed through. They also just use place as a geometry manager, which kind of deterred me. Here is the web site: http://www.gnu.org/projects/gnue/gnue.html ''[escargo]'' Are you referring to the GNUe Form Definition XML files? I was thinking more in terms of XUL as used in Mozilla. Come to think of it, maybe [ActiveState] uses such files in [Komodo]. Anybody know? (The chain of speculation goes like this. Mozilla uses XUL; Komodo is based on Mozilla; implies Komodo knows about XUL.) It seems like the next step is to choose an XML schema suitable for use with one of the [GUI Building Tools] and then add the capability for one of the tools to read and write XML files following that scheme to define the GUI being built. Here's a more far-out question? Is there a way to serialize an existing GUI into XML (for some schema yet to be determined)? I can see where this would be extremely difficult in the general case, but extremely useful in large special cases. (For example, with Tcl-only [megawidget]s or object systems like [Snit], the implementation boundaries of widgets versus subwidgets becomes unclear. Somehow you need to know when an relevent object boundary is being crossed. ---- '''TAGS''' There are five tags that receive special treatment; all others are assumed to be the name of a type of widget. The five special tags are: * * * * * ---- '''ATTRIBUTES''' Generally, attributes in all uppercase are used by xml2gui while any lowercase or mixed-case attributes are passed as configuration parameters to the widget. ---- '''SPECIAL TAGS AND THEIR ATTRIBUTES''' The only optional attribute for and is "weight" which will default to 0 if not specified. has no special attributes; it is used to configure the widget referenced by its parent tag. 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 ".foo.bar" and NAME might equal "bar". has no special attributes. It's textnode() is evaluated as Tcl code. @PARENT@ is replaced with the widget path of 's parent widget, and @SELFNODE@ is replaced with the tDOM node command of the element in the DOM tree. ---- '''UPPERCASE ATTRIBUTES''' All widgets except , and children of 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 's have attributes of: * FILL (defaults to both) * ANCHOR (defaults to center) Children of widgets (i.e., , , 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 [http://sourceforge.net/cvs/?group_id=63662]). #------------------------------------------------------------------------------- # # xml2gui, version 1.0 # # PURPOSE: # # 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 , 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 ... 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 & # 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 (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 # @PARENT@ with the widget name of our parent, and # @SELFNODE@ 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 @PARENT@ $path @SELFNODE@ $child] \ [$child getAttribute $attribute]] } return $command } #------------------------------------------------------------------------------- # Configure the $child of a $parent for some # proc ::xml2gui::Configure {child parent} { set path [$parent getAttribute PATH] set widget [string map [list @PARENT@ $path] [$child getAttribute NAME]] set command [BuildCommand $child $path] if {[llength $command]} { eval [list $widget] configure $command } } #------------------------------------------------------------------------------- # Special handling for ... # proc ::xml2gui::TclCode {child parent} { # If 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 @PARENT@ $path @SELFNODE@ $child] [$node data]] } #------------------------------------------------------------------------------- # Create a # 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 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 $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 's & non-'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 ---- And here is an example from an application I'm working on (should be ''reapable'' with [wish-reaper], though it does require [BLT] and [Tktable]). set xml {