Basic GUI Builder

Arjen Markus (14 april 2009) Here are the humble beginnings of a basic GUI builder. It is not ready for actual use yet, consider it a proof of concept, but I thought I'd publish it rightaway, rather than develop it up to a point that it is really useable. This way I may get comments quickly :).

Design goal: make a simple-to-use tool for developing stragihtforward GUIs. Only the more common features are supported directly.

One point of interest: the GUI for the GUI builder itself has been set up using the same technique to design any GUI with this tool.

Note: the whole thing consists of several files!


Here is a very simple example:

The code generated by saving the two windows in the designer:

proc toplevelMain {} {
    ::BGB::createToplevel . {Default window}

    ::BGB::createWidget . label {0 0 1 1 1 1 1 1} {"(empty)" "" 0 ""}
    ::BGB::createWidget . label {1 0 1 1 1 1 1 1} {"(empty)" "" 0 ""}
    ::BGB::createWidget . label {0 1 1 1 1 1 1 1} {"(empty)" "" 0 ""}
    ::BGB::createWidget . label {1 1 1 1 1 1 1 1} {"(empty)" "" 0 ""}
}
defineToplevel Main
proc toplevelinput {} {
    ::BGB::createToplevel .input {{Input data}}

    ::BGB::createWidget .input entry {1 1 1 1 0 0 0 0} {{} yvalue 0 {}}
    ::BGB::createWidget .input entry {1 0 1 1 0 0 0 0} {{} xvalue 0 {}}
    ::BGB::createWidget .input label {0 1 1 1 0 0 0 0} {{Y value} {} 0 {}}
    ::BGB::createWidget .input label {0 0 1 1 0 0 0 0} {{X value} {} 0 {}}
}
defineToplevel input 

The program to show at least the input window:

source bgb.tcl
source x.gui
toplevelinput

Here is the code:

First file: guibuild.tcl

# guibuild.tcl --
#     Straightforward interactive GUI builder
#
#     Note:
#     To make life easier and to test the API at the same time, the
#     GUI for the GUI builder is set up using essentially the same
#     techniques as the generated GUIs.
#     The exception is that the code was written manually and uses
#     a few private features
#
#     TODO:
#     - Quasi-modal dialogs
#     - Size (gridwise) of main window - values stay where they are
#     - Properties of a filled-in cells must be kept in the properties
#       window
#     - Display properties in the same window as the layout options
#     - Implement "NewFile"
#     - NewWindow (grid size) first dialog, gives you chance to change
#       the grid size and title
#

# BGB --
#     Namespace for the GUI builder
#
namespace eval ::BGB {}

source bgb.tcl
source bgb_action.tcl

# toplevelBGBMain --
#     Create the main window - not "."
#
# Arguments:
#     None
# Result:
#     None
# Side effects:
#     Creates the main window for the BGB GUI builder
#
proc ::BGB::toplevelBGBMain {} {
    createToplevel .bgbmain "Basic GUI Builder"

    createWidget .bgbmain label {0 0 1 1 1 1 1 1} {"Available windows and frames" "" 0 ""}
    createWidget .bgbmain listbox {0 1 1 1 1 1 1 1} \
        {"::BGB::SelectWindow $widgetName" ::BGB::windowsList 20 10}
    createWidget .bgbmain frame {0 2 1 1 0 0 0 0} {"Buttons"}

    createWidget .bgbmain.buttons button {0 0 1 1 0 0 0 0} {"Open" ::BGB::OpenWindow 1 8}
    createWidget .bgbmain.buttons button {1 0 1 1 0 0 0 0} \
        {"New" "::BGB::showWindow BGBNewWindow" 1 8}
    createWidget .bgbmain.buttons button {2 0 1 1 0 0 0 0} {"Delete" ::BGB::DeleteWindow 1 8}

    rowWeight    .bgbmain 1 1
    columnWeight .bgbmain 1 1

    addMenu .bgbmain File {
        New           ::BGB::NewFile
        "Open..."     ::BGB::OpenFile
        separator     -
        Save          {::BGB::SaveFile 0}
        "Save as ..." {::BGB::SaveFile 1}
        separator     -
        "Exit"        ::BGB::ExitCmd
    }

    addMenu .bgbmain Help {
        Information   ::BGB:ShowInfo
        separator     -
        About         {::BGB::showWindow BGBAbout}
    }
}

# toplevelBGBNewWindow --
#     Create the main window - not "."
#
# Arguments:
#     None
# Result:
#     None
# Side effects:
#     Creates the main window for the BGB GUI builder
#
proc ::BGB::toplevelBGBNewWindow {} {
    createToplevel .bgbnewwindow "Set up new window"

    createWidget .bgbnewwindow label {0 0 1 1 1 1 1 1} {"Window name:" "" 0 ""}
    createWidget .bgbnewwindow entry {1 0 1 1 1 1 1 1} \
        {"" ::BGB::windowName 1 20}
    createWidget .bgbnewwindow label {0 1 1 1 1 1 1 1} {"Title:" "" 0 ""}
    createWidget .bgbnewwindow entry {1 1 1 1 1 1 1 1} \
        {"" ::BGB::windowTitle 1 20}
    createWidget .bgbnewwindow label {0 2 1 1 1 1 1 1} {"Number of rows:" "" 0 ""}
    createWidget .bgbnewwindow entry {1 2 1 1 0 0 1 0} {"" ::BGB::gridRows 1 4}
    createWidget .bgbnewwindow label {0 3 1 1 1 1 1 1} {"Number of columns:" "" 0 ""}
    createWidget .bgbnewwindow entry {1 3 1 1 0 0 1 0} {"" ::BGB::gridColumns 1 4}
    createWidget .bgbnewwindow okcancel {0 4 1 1 0 0 0 0} \
        {"::BGB::CreateWindow .bgbnewwindow $::BGB::windowName 1"
         "::BGB::CreateWindow .bgbnewwindow $::BGB::windowName 0"}

    columnWeight .bgbnewwindow 1 1
}

# toplevelBGBDefaultWindow --
#     Create a default window
#
# Arguments:
#     name       Name of the new window
# Result:
#     None
# Side effects:
#     Creates a default main window
#
proc ::BGB::toplevelBGBDefaultWindow {name title} {

    set name [string tolower $name]

    if { $name != "" } {
        toplevel .$name
    }

    wm title .$name $title

    for {set row 0} {$row < $::BGB::gridRows} {incr row} {
        for {set column 0} {$column < $::BGB::gridColumns} {incr column} {
            createWidget .$name label [list $column $row 1 1 1 1 1 1] \
                {"(empty)" "" 0 ""}
        }
    }
}

# toplevelBGBEditWidget --
#     Edit the widget that was pressed
#
# Arguments:
#     None
# Result:
#     None
# Side effects:
#     Brings up a dialog to edit the widget's properties and the layout
#
proc ::BGB::toplevelBGBEditWidget {} {

    createToplevel .bgbeditwidget "Edit widget"

    createWidget .bgbeditwidget label       {0 0 1 1 1 1 1 1} {"Type of widget:" "" 0 ""}
    createWidget .bgbeditwidget combobox    {1 0 1 1 1 1 1 1} {::BGB::widgetType ::BGB::availableTypes 1 20}
    createWidget .bgbeditwidget label       {0 1 1 1 1 1 1 1} {"Number of columns:" "" 0 ""}
    createWidget .bgbeditwidget entry       {1 1 1 1 1 1 1 1} {"" ::BGB::numberCols 1 5}
    createWidget .bgbeditwidget label       {0 2 1 1 1 1 1 1} {"Number of rows:" "" 0 ""}
    createWidget .bgbeditwidget entry       {1 2 1 1 1 1 1 1} {"" ::BGB::numberRows 1 5}
    createWidget .bgbeditwidget checkbutton {0 3 1 1 0 0 1 0} {"Stick to left (west)" ::BGB::w 0 ""}
    createWidget .bgbeditwidget checkbutton {0 4 1 1 0 0 1 0} {"Stick to right (east)" ::BGB::e 0 ""}
    createWidget .bgbeditwidget checkbutton {0 5 1 1 0 0 1 0} {"Stick to top (north)" ::BGB::n 0 ""}
    createWidget .bgbeditwidget checkbutton {0 6 1 1 0 0 1 0} {"Stick to bottom (south)" ::BGB::s 0 ""}
    createWidget .bgbeditwidget button      {0 7 1 1 0 0 1 0} {"Edit" ::BGB::EditProperties 1 6}
    createWidget .bgbeditwidget label       {1 7 1 1 0 0 1 0} {"widget-specific properties" "" 0 ""}
    createWidget .bgbeditwidget okcancel    {0 8 1 1 1 1 1 1} \
        {"::BGB::SaveWidget 1" "::BGB::SaveWidget 0"}
}

# toplevelBGBAbout --
#     Show a simple About box
#
# Arguments:
#     None
# Result:
#     None
#
proc ::BGB::toplevelBGBAbout {} {

    createToplevel .bgbabout "About BGB GUI Builder"

    createWidget .bgbabout label       {0 0 1 1 0 0 0 0} {"" "" 0 ""}
    createWidget .bgbabout label       {0 1 1 1 0 0 0 0} {"Basic GUI Builder" "" 0 ""}
    createWidget .bgbabout label       {0 2 1 1 0 0 0 0} {"" "" 0 ""}
    createWidget .bgbabout label       {0 3 1 1 0 0 0 0} {"Created by Arjen Markus" "" 0 ""}
    createWidget .bgbabout label       {0 4 1 1 0 0 0 0} {"april, 2009" "" 0 ""}
    createWidget .bgbabout label       {0 5 1 1 0 0 0 0} {"" ::BGB::version 0 ""}
    createWidget .bgbabout label       {0 6 1 1 0 0 0 0} {"" "" 0 ""}
    createWidget .bgbabout button      {0 7 1 1 0 0 0 0} \
        {"OK" "destroy .bgbabout" 1 6}
}

# toplevelBGBPropslabel --
#     Show the properties dialog for labels
#
# Arguments:
#     None
# Result:
#     None
#
proc ::BGB::toplevelBGBPropslabel {} {

    createToplevel .bgbpropslabel "Edit $::BGB::widgetType properties"

    createWidget .bgbpropslabel label       {0 0 1 1 0 0 1 0} {"Text:" "" 0 ""}
    createWidget .bgbpropslabel entry       {1 0 1 1 0 0 1 0} {"" ::BGB::labelText 0 ""}
    createWidget .bgbpropslabel label       {0 1 1 1 0 0 1 0} {"Or: text variable:" "" 0 ""}
    createWidget .bgbpropslabel entry       {1 1 1 1 0 0 1 0} {"" ::BGB::labelTextVar 0 ""}
    createWidget .bgbpropslabel checkbutton {0 2 1 1 0 0 1 0} {"Fixed width" ::BGB::labelFixed 0 ""}
    createWidget .bgbpropslabel entry       {1 2 1 1 0 0 1 0} {"" ::BGB::labelWidth 1 4}
    createWidget .bgbpropslabel okcancel    {3 0 1 1 0 0 0 0} \
        {"::BGB::SaveProperties 1" "::BGB::SaveProperties 0"}
}

# toplevelBGBPropsentry --
#     Show the properties dialog for entries
#
# Arguments:
#     None
# Result:
#     None
#
proc ::BGB::toplevelBGBPropsentry {} {

    createToplevel .bgbpropsentry "Edit $::BGB::widgetType properties"

    createWidget .bgbpropsentry label       {0 1 1 1 0 0 1 0} {"Text variable:" "" 0 ""}
    createWidget .bgbpropsentry entry       {1 1 1 1 0 0 1 0} {"" ::BGB::entryTextVar 0 ""}
    createWidget .bgbpropsentry checkbutton {0 2 1 1 0 0 1 0} {"Fixed width" ::BGB::entryFixed 0 ""}
    createWidget .bgbpropsentry entry       {1 2 1 1 0 0 1 0} {"" ::BGB::entryWidth 1 4}
    createWidget .bgbpropsentry okcancel    {3 0 1 1 0 0 0 0} \
        {"::BGB::SaveProperties 1" "::BGB::SaveProperties 0"}
}

# toplevelBGBPropscheckbutton --
#     Show the properties dialog for checkbuttons
#
# Arguments:
#     None
# Result:
#     None
#
proc ::BGB::toplevelBGBPropscheckbutton {} {

    createToplevel .bgbpropscheckbutton "Edit $::BGB::widgetType properties"

    createWidget .bgbpropscheckbutton label       {0 0 1 1 0 0 1 0} {"Text:" "" 0 ""}
    createWidget .bgbpropscheckbutton entry       {1 0 1 1 0 0 1 0} {"" ::BGB::checkbuttonText 0 ""}
    createWidget .bgbpropscheckbutton label       {0 1 1 1 0 0 1 0} {"Variable:" "" 0 ""}
    createWidget .bgbpropscheckbutton entry       {1 1 1 1 0 0 1 0} {"" ::BGB::checkbuttonVar 0 ""}
    createWidget .bgbpropscheckbutton checkbutton {0 2 1 1 0 0 1 0} {"Fixed width" ::BGB::checkbuttonFixed 0 ""}
    createWidget .bgbpropscheckbutton entry       {1 2 1 1 0 0 1 0} {"" ::BGB::checkbuttonWidth 1 4}
    createWidget .bgbpropscheckbutton okcancel    {3 0 1 1 0 0 0 0} \
        {"::BGB::SaveProperties 1" "::BGB::SaveProperties 0"}
}

# toplevelBGBPropsradiobutton --
#     Show the properties dialog for radiobuttons
#
# Arguments:
#     None
# Result:
#     None
#
proc ::BGB::toplevelBGBPropsradiobutton {} {

    createToplevel .bgbpropsradiobutton "Edit $::BGB::widgetType properties"

    createWidget .bgbpropsradiobutton label       {0 0 1 1 0 0 1 0} {"Text:" "" 0 ""}
    createWidget .bgbpropsradiobutton entry       {1 0 1 1 0 0 1 0} {"" ::BGB::radiobuttonText 0 ""}
    createWidget .bgbpropsradiobutton label       {0 1 1 1 0 0 1 0} {"Variable:" "" 0 ""}
    createWidget .bgbpropsradiobutton entry       {1 1 1 1 0 0 1 0} {"" ::BGB::radiobuttonVar 0 ""}
    createWidget .bgbpropsradiobutton label       {0 2 1 1 0 0 1 0} {"Associated value:" "" 0 ""}
    createWidget .bgbpropsradiobutton entry       {1 2 1 1 0 0 1 0} {"" ::BGB::radiobuttonValue 0 ""}
    createWidget .bgbpropsradiobutton checkbutton {0 3 1 1 0 0 1 0} {"Fixed width" ::BGB::radiobuttonFixed 0 ""}
    createWidget .bgbpropsradiobutton entry       {1 3 1 1 0 0 1 0} {"" ::BGB::radiobuttonWidth 1 4}
    createWidget .bgbpropsradiobutton okcancel    {0 4 1 1 0 0 0 0} \
        {"::BGB::SaveProperties 1" "::BGB::SaveProperties 0"}
}

# toplevelBGBPropslistbox --
#     Show the properties dialog for listboxes
#
# Arguments:
#     None
# Result:
#     None
#
proc ::BGB::toplevelBGBPropslistbox {} {

    createToplevel .bgbpropslistbox "Edit $::BGB::widgetType properties"

    createWidget .bgbpropslistbox label       {0 0 1 1 0 0 1 0} \
        {"Variable holding widget name:" "" 0 ""}
    createWidget .bgbpropslistbox entry       {1 0 1 1 0 0 1 0} {"" ::BGB::containerWidgetVar 0 ""}
    createWidget .bgbpropslistbox label       {0 1 1 1 0 0 1 0} \
        {"Selection command:" "" 0 ""}
    createWidget .bgbpropslistbox entry       {1 1 1 1 0 0 1 0} {"" ::BGB::containerCmd 0 ""}
    createWidget .bgbpropslistbox checkbutton {0 2 1 1 0 0 1 0} \
        {"Fixed width (pixels)" ::BGB::containerWidthFixed 0 ""}
    createWidget .bgbpropslistbox entry       {1 2 1 1 0 0 1 0} {"" ::BGB::containerWidth 0 ""}
    createWidget .bgbpropslistbox checkbutton {0 3 1 1 0 0 1 0} \
        {"Fixed height (lines)" ::BGB::containerHeightFixed 0 ""}
    createWidget .bgbpropslistbox entry       {1 3 1 1 0 0 1 0} {"" ::BGB::containerHeight 0 ""}
    createWidget .bgbpropslistbox okcancel    {0 4 1 1 0 0 0 0} \
        {"::BGB::SaveProperties 1" "::BGB::SaveProperties 0"}
}

# toplevelBGBPropstext --
#     Show the properties dialog for text widgets
#
# Arguments:
#     None
# Result:
#     None
#
proc ::BGB::toplevelBGBPropstext {} {

    createToplevel .bgbpropstext "Edit $::BGB::widgetType properties"

    createWidget .bgbpropstext label       {0 0 1 1 0 0 1 0} \
        {"Variable holding widget name:" "" 0 ""}
    createWidget .bgbpropstext entry       {1 0 1 1 0 0 1 0} {"" ::BGB::containerWidgetVar 0 ""}
    createWidget .bgbpropstext checkbutton {0 1 1 1 0 0 1 0} \
        {"Fixed width (characters)" ::BGB::containerWidthFixed 0 ""}
    createWidget .bgbpropstext entry       {1 1 1 1 0 0 1 0} {"" ::BGB::containerWidth 0 ""}
    createWidget .bgbpropstext checkbutton {0 2 1 1 0 0 1 0} \
        {"Fixed height (lines)" ::BGB::containerHeightFixed 0 ""}
    createWidget .bgbpropstext entry       {1 2 1 1 0 0 1 0} {"" ::BGB::containerHeight 0 ""}
    createWidget .bgbpropstext okcancel    {0 3 1 1 0 0 0 0} \
        {"::BGB::SaveProperties 1" "::BGB::SaveProperties 0"}
}

# toplevelBGBPropstree --
#     Show the properties dialog for tree widgets
#
# Arguments:
#     None
# Result:
#     None
#
proc ::BGB::toplevelBGBPropstree {} {

    createToplevel .bgbpropstree "Edit $::BGB::widgetType properties"

    createWidget .bgbpropstree label       {0 0 1 1 0 0 1 0} \
        {"Variable holding widget name:" "" 0 ""}
    createWidget .bgbpropstree entry       {1 0 1 1 0 0 1 0} {"" ::BGB::containerWidgetVar 0 ""}
    createWidget .bgbpropstree checkbutton {0 1 1 1 0 0 1 0} \
        {"Fixed width (characters)" ::BGB::containerWidthFixed 0 ""}
    createWidget .bgbpropstree entry       {1 1 1 1 0 0 1 0} {"" ::BGB::containerWidth 0 ""}
    createWidget .bgbpropstree checkbutton {0 2 1 1 0 0 1 0} \
        {"Fixed height (lines)" ::BGB::containerHeightFixed 0 ""}
    createWidget .bgbpropstree entry       {1 2 1 1 0 0 1 0} {"" ::BGB::containerHeight 0 ""}
    createWidget .bgbpropstree okcancel    {0 3 1 1 0 0 0 0} \
        {"::BGB::SaveProperties 1" "::BGB::SaveProperties 0"}
}

# toplevelBGBPropscanvas --
#     Show the properties dialog for canvas widgets
#
# Arguments:
#     None
# Result:
#     None
#
proc ::BGB::toplevelBGBPropscanvas {} {

    createToplevel .bgbpropscanvas "Edit $::BGB::widgetType properties"

    createWidget .bgbpropscanvas label       {0 0 1 1 0 0 1 0} \
        {"Variable holding widget name:" "" 0 ""}
    createWidget .bgbpropscanvas entry       {1 0 1 1 0 0 1 0} {"" ::BGB::containerWidgetVar 0 ""}
    createWidget .bgbpropscanvas checkbutton {0 1 1 1 0 0 1 0} \
        {"Width (pixels)" ::BGB::containerWidthFixed 0 ""}
    createWidget .bgbpropscanvas entry       {1 1 1 1 0 0 1 0} {"" ::BGB::containerWidth 0 ""}
    createWidget .bgbpropscanvas checkbutton {0 2 1 1 0 0 1 0} \
        {"Height (pixels)" ::BGB::containerHeightFixed 0 ""}
    createWidget .bgbpropscanvas entry       {1 2 1 1 0 0 1 0} {"" ::BGB::containerHeight 0 ""}
    createWidget .bgbpropscanvas okcancel    {0 3 1 1 0 0 0 0} \
        {"::BGB::SaveProperties 1" "::BGB::SaveProperties 0"}
}

# main --
#     Get it all started
#

set ::BGB::version "Version 0.1"
set ::BGB::filename ""
set ::BGB::gridRows    2
set ::BGB::gridColumns 2
set ::BGB::availableTypes {label entry checkbutton radiobutton combobox listbox text canvas tree okcancel frame}


::BGB::toplevelBGBMain

proc toplevelMain {} {
    ::BGB::toplevelBGBDefaultWindow "" "Default window"
}

set ::BGB::windows [list Main]
set ::BGB::windowTitles(Main) "Default window"
$::BGB::windowsList insert end Main

after 100 {
    raise .bgbmain
}

#console show 

Second file: bgb_action.tcl

# bgb_action.tcl --
#     Actions for the Basic GUI builder
#

# SelectWindow --
#     Store the selected window name
#
# Arguments:
#     widget       Name of the widget
#
# Result:
#     None
#
# Side effects:
#     Selected window is shown
#
proc ::BGB::SelectWindow {widget} {
    variable selected

    set selected [$widget get [lindex [$widget curselection] 0]]
}

# OpenWindow --
#     Show the selected window in design mode
#
# Arguments:
#     None
#
# Result:
#     None
#
# Side effects:
#     Selected window is shown
#
proc ::BGB::OpenWindow {} {
    variable selected
    variable design

    if { [info exists selected] } {
        if { $selected == "Main" } {
            set windowName .
        } else {
            set windowName .[string tolower $selected]
        }
        set design 1
        showWindow $selected
        set design 0
        after 100 [list raise $windowName]
    }
}

# DeleteWindow --
#     Delete the selected window
#
# Arguments:
#     None
#
# Result:
#     None
#
# Side effects:
#     Ask for confirmation, then remove the window
#
proc ::BGB::DeleteWindow {} {

    tk_messageBox -type ok -icon info -message "Delete function not implemented yet"
}

# CreateWindow --
#     Create the new empty window
#
# Arguments:
#     dialog       Name of the dialog
#     name         Name of the new window
#     create       Whether to create it (OK) or not (Cancel)
#
# Result:
#     None
#
# Side effects:
#     New window is shown, dialog disappears and administration is ready
#
proc ::BGB::CreateWindow {dialog name create} {
    variable windows
    variable windowsList
    variable selected

    if { $create } {
        #
        # First check the name
        #
        if { [lsearch $windows $name] >= 0 } {
            tk_messageBox -icon error -type ok -message \
                "A window by this name already exists\nPlease chose a different name"
            return
        }

        #
        # Handle the administration
        #
        lappend windows $name
        $windowsList insert end $name
        $windowsList selection clear 0 end
        $windowsList selection set end

        #
        # Create a new empty window
        #
        set ::BGB::design 1
        toplevelBGBDefaultWindow $name $::BGB::windowTitle
        set ::BGB::design 0

        lappend ::BGB::windowTitles($name) $::BGB::windowTitle

        proc toplevelinput {} {
            ::BGB::RecreateWindow input
        }
    }

    destroy $dialog
}

# HandleButton --
#     Handle the selection of a cell
#
# Arguments:
#     widget       Name of the widget
#
# Result:
#     None
#
# Side effects:
#     Edit widget dialog appears
#
proc ::BGB::HandleButton {widget} {
    variable availableTypes
    variable column
    variable row
    variable oldWidget
    variable columnRowWidget
    variable properties

    foreach {column row} $columnRowWidget($widget) {break}
    set oldWidget  $widget
    set properties {}

    foreach var   {widgetType numberCols numberRows n e w s} \
            value {label      1          1          0 0 0 0} {
        set ::BGB::$var $value
    }

    # TODO: a lot

    showWindow BGBEditWidget
}

# SaveWidget --
#     Save the new properties of the widget (or not)
#
# Arguments:
#     save         Save the new widget properties?
#
# Result:
#     None
#
# Side effects:
#     Widget in the cell updated
#
proc ::BGB::SaveWidget {save} {
    foreach var {n e w s widgetType numberCols numberRows column row properties oldWidget design} {
        variable $var
    }

    if { $save } {
        set parent [winfo parent $oldWidget]
        grid forget $oldWidget
        destroy $oldWidget

        set posNumber [expr {[string last .w $oldWidget] + 2}]
        unset ::BGB::widgets($parent,widget,[string range $oldWidget $posNumber end])

        set design 1
        createWidget $parent $widgetType \
            [list $column $row $numberCols $numberRows $n $e $w $s] \
            $properties
        set design 0
    }

    destroy .bgbeditwidget
}

# OpenFile --
#     Open a file with a GUI definition
#
# Arguments:
#     None
#
# Result:
#     None
#
# Side effects:
#     File loaded
#
proc ::BGB::OpenFile {} {
    variable filename
    variable design

    set newname [tk_getOpenFile -defaultextension "gui" \
        -initialfile $filename -parent .bgbmain \
        -filetypes {{{Tcl GUI Files} .gui} {{All Files} *}}]
    if { $newname != "" } {
        $::BGB::windowsList delete 0 end
        set filename $newname
        set design 1
        source $filename
        set design 0
    } else {
        return
    }
}

# SaveFile --
#     Save the windows, widgets and their properties
#
# Arguments:
#     ask          Ask for a file name?
#
# Result:
#     None
#
# Side effects:
#     File written with the definitions
#
# Note:
#     TODO: write the names of the variables too
#
proc ::BGB::SaveFile {ask} {
    variable filename
    variable windows
    variable windowTitles
    variable widgets

    if { $ask || $filename == "" } {
        set newname [tk_getSaveFile -defaultextension "gui" \
            -initialfile $filename -parent .bgbmain \
            -filetypes {{{Tcl GUI Files} .gui} {{All Files} *}}]
        if { $newname != "" } {
            set filename $newname
        } else {
            return
        }
    }

    #
    # Now the actual writing starts
    #

    set guifile [open $filename w]

    foreach name $windows {
        if { $name == "Main" } {
            set window "."
        } else {
            set window ".[string tolower $name]"
        }

        puts $guifile "proc toplevel$name {} {"
        puts $guifile "    ::BGB::createToplevel $window $windowTitles($name)"
        puts $guifile ""

        foreach widget [array names widgets "$window,widget,*"] {
            puts $guifile "    ::BGB::createWidget $window $widgets($widget)"
        }

        parray widgets
        foreach row [array names widgets "$window,row,*"] {
            puts $guifile "    ::BGB::rowWeight $window $row"
        }

        foreach column [array names widgets "$window,column,*"] {
            puts $guifile "    ::BGB::columnWeight $window $column"
        }

        puts $guifile "}"

        puts $guifile "defineToplevel $name"
    }
    close $guifile

    #
    # Examine what action procedures were defined:
    # Create a template for these
    #
    set tplfile [open $filename.actions w]

    puts "# Dummy implementations for all action procedures\n"

    foreach window $windows {

        foreach widget [array names widgets "$window,widget,*"] {
            set type [lindex $widget 0]
            switch -- $type {
                "okcancel" {
                    WriteDummyActionProc $tplfile [lindex $widget 2 0]
                    WriteDummyActionProc $tplfile [lindex $widget 2 1]
                }
                "button" {
                    WriteDummyActionProc $tplfile [lindex $widget 2 1]
                }
                "listbox" {
                    WriteDummyActionProc $tplfile [lindex $widget 2 0]
                }
                default {
                    # No action procedure defined
                }
            }
        }
    }
    close $tplfile
}

# ExitCmd --
#     Stop the program
#
# Arguments:
#     None
#
# Result:
#     None
#
# Side effects:
#     Program stops
#
# Note:
#     TODO: check that all was saved
#
proc ::BGB::ExitCmd {} {

    exit
}

# SetDefault --
#     Set default values for the properties
#
# Arguments:
#     var         Name of the variable
#     value       Default value
#
# Result:
#     None
#
# Side effects:
#     Variable is set only when it does not exist yet
#
# Note:
#     TODO: the previous values for the widget must be retrieved!
#
proc ::BGB::SetDefault {var value} {

    if { ![info exists $var] } {
        set $var $value
    }
}

# EditProperties --
#     Edit the widget-specific properties
#
# Arguments:
#     None
#
# Result:
#     None
#
proc ::BGB::EditProperties {} {
    variable widgetType

    switch -- $widgetType {
        "label" {
            SetDefault ::BGB::labelText    ""
            SetDefault ::BGB::labelTextVar ""
            SetDefault ::BGB::labelFixed   0
            SetDefault ::BGB::labelWidth   ""
        }
        "entry" {
            SetDefault ::BGB::entryText    ""
            SetDefault ::BGB::entryTextVar ""
            SetDefault ::BGB::entryFixed   0
            SetDefault ::BGB::entryWidth   ""
        }
        "checkbutton" {
            SetDefault ::BGB::checkbuttonText    ""
            SetDefault ::BGB::checkbuttonVar     ""
            SetDefault ::BGB::checkbuttonFixed   0
            SetDefault ::BGB::checkbuttonWidth   ""
        }
        "radiobutton" {
            SetDefault ::BGB::radiobuttonText    ""
            SetDefault ::BGB::radiobuttonVar     ""
            SetDefault ::BGB::radiobuttonValue   ""  ;# TODO: values must be unique
            SetDefault ::BGB::radiobuttonFixed   0
            SetDefault ::BGB::radiobuttonWidth   ""
        }
        "text" -
        "canvas" -
        "listbox" -
        "tree" {
            SetDefault ::BGB::containerWidgetVar   ""
            SetDefault ::BGB::containerCmd         ""
            SetDefault ::BGB::containerWidthFixed  0
            SetDefault ::BGB::containerWidth       ""
            SetDefault ::BGB::containerHeightFixed 0
            SetDefault ::BGB::containerHeight      ""
        }
        default {
            # TODO: the rest
        }
    }

    showWindow BGBProps$widgetType
}

# SaveProperties --
#     Save the widget-specific properties
#
# Arguments:
#     save          Whether to save them or simply destroy the window
#
# Result:
#     None
#
proc ::BGB::SaveProperties {save} {
    variable widgetType
    variable properties

    if { $save } {
        switch -- $widgetType {
            "label" {
                if { ![string is integer -strict $::BGB::labelWidth] ||
                     $::BGB::labelWidth < 1 } {
                    set ::BGB::labelWidth 1
                }
                if { ! $::BGB::labelFixed } {
                    set ::BGB::labelWidth ""
                }

                set properties [list $::BGB::labelText  $::BGB::labelTextVar \
                                     $::BGB::labelFixed $::BGB::labelWidth]
            }
            "entry" {
                if { ![string is integer -strict $::BGB::entryWidth] ||
                     $::BGB::entryWidth < 1 } {
                    set ::BGB::entryWidth 1
                }
                if { ! $::BGB::entryFixed } {
                    set ::BGB::entryWidth ""
                }

                set properties [list $::BGB::entryText  $::BGB::entryTextVar \
                                     $::BGB::entryFixed $::BGB::entryWidth]
            }
            "checkbutton" {
                if { ![string is integer -strict $::BGB::checkbuttonWidth] ||
                     $::BGB::checkbuttonWidth < 1 } {
                    set ::BGB::checkbuttonWidth 1
                }
                if { ! $::BGB::checkbuttonFixed } {
                    set ::BGB::checkbuttonWidth ""
                }

                set properties [list $::BGB::checkbuttonText  $::BGB::checkbuttonVar \
                                     $::BGB::checkbuttonFixed $::BGB::checkbuttonWidth]
            }
            "radiobutton" {
                if { ![string is integer -strict $::BGB::radiobuttonWidth] ||
                     $::BGB::radiobuttonWidth < 1 } {
                    set ::BGB::radiobuttonWidth 1
                }
                if { ! $::BGB::radiobuttonFixed } {
                    set ::BGB::radiobuttonWidth ""
                }

                set properties [list $::BGB::radiobuttonText  $::BGB::radiobuttonVar \
                                     $::BGB::radiobuttonValue \
                                     $::BGB::radiobuttonFixed $::BGB::radiobuttonWidth]
            }
            "listbox" -
            "canvas"  -
            "text"    -
            "tree"    {
                if { ![string is integer -strict $::BGB::containerWidth] ||
                     $::BGB::containerWidth < 1 } {
                    set ::BGB::containerWidth 1
                }
                if { ! $::BGB::containerWidthFixed } {
                    set ::BGB::containerWidth ""
                }
                if { ![string is integer -strict $::BGB::containerHeight] ||
                     $::BGB::containerHeight < 1 } {
                    set ::BGB::containerHeight 1
                }
                if { ! $::BGB::containerHeightFixed } {
                    set ::BGB::containerHeight ""
                }

                if { $widgetType == "listbox" } {
                    set properties [list $::BGB::containerWidgetVar   $::BGB::containerCmd   \
                                         $::BGB::containerWidth       $::BGB::containerHeight]
                } else {
                    set properties [list $::BGB::containerWidgetVar   \
                                         $::BGB::containerWidth       $::BGB::containerHeight]
                }
            }
            default {
                # TODO: all the rest
            }
        }
    }
    destroy .bgbprops$widgetType
} 

Third file: bgb.tcl

# bgb.tcl --
#     Code for the Basic GUI builder: the runtime version
#
namespace eval ::BGB {
    variable widgetCount 0
    variable design      0
    namespace export showWindow
}

# defineToplevel --
#     Define a new toplevel window - no-op if not running in design mode
#
# Arguments:
#     name           Name of the window
#
# Result:
#     None
#
proc ::BGB::defineToplevel {name} {
    variable design

    if { $design } {
        rename createWidget _createWidget
        proc createWidget {parent type layout properties} {
            set ::BGB::widgets($parent,widget,$::BGB::widgetCount) \
                [list $type $layout $properties]
            incr ::BGB::widgetCount
        }

        rename createToplevel _createToplevel
        proc createToplevel {name title} {

            lappend ::BGB::windows $name
            if { $name == "." } {
                $::BGB::windowsList insert end "Main"
            } else {
                $::BGB::windowsList insert end [string range $name 1 end]
            }
            set ::BGB::windowTitles($name) $title
        }

        toplevel$name

        rename createWidget    {}
        rename _createWidget   createWidget
        rename createToplevel  {}
        rename _createToplevel createToplevel
    }
}

# createToplevel --
#     Create a new toplevel window
#
# Arguments:
#     name           Name of the window
#     title          Title for the window
#
# Result:
#     None
#
proc ::BGB::createToplevel {name title} {

    if { $name != "." } {
        toplevel $name
    }
    wm title $name $title

    return $name
}

# showWindow --
#     Show the window
#
# Arguments:
#     name           Name of the window
#
# Result:
#     None
#
proc ::BGB::showWindow {name} {

    if { ![winfo exists .[string tolower $name]] } {
        toplevel$name
    } else {
        raise .[string tolower $name]
    }
}

# rowWeight --
#     Set the weight for a row
#
# Arguments:
#     widget         Widget containing the row
#     row            Row number
#     weight         Weight to be used
#
# Result:
#     None
#
proc ::BGB::rowWeight {widget row weight} {

    grid rowconfigure $widget $row -weight $weight

}

# columnWeight --
#     Set the weight for a column
#
# Arguments:
#     widget         Widget containing the column
#     column         Column number
#     weight         Weight to be used
#
# Result:
#     None
#
proc ::BGB::columnWeight {widget column weight} {

    grid columnconfigure $widget $column -weight $weight

}

# addMenu --
#     Add a menu to the given window
#
# Arguments:
#     window         Name of the window
#     title          Title of the menu
#     entries        List of text-command pairs, defining the menu
#
# Result:
#     None
#
proc ::BGB::addMenu {window title entries} {

    set menu $window.menu
    if { ![winfo exists $window.menu] } {
        menu $menu -tearoff 0
        $window configure -menu $menu
    }

    set cascade $menu.m$::BGB::widgetCount
    menu $cascade -tearoff 0
    $menu add cascade -label $title -menu $cascade

    foreach {text cmd} $entries {
        if { $text != "separator" } {
            $cascade add command -label $text -command $cmd
        } else {
            $cascade add separator
        }
    }

    incr ::BGB::widgetCount
}

# createWidget --
#     Create the widget with all layout options and properties
#
# Arguments:
#     parent         Parent widget
#     type           Type of widget
#     layout         Layout options
#     properties     Properties of the widget
#
# Result:
#     Name of the widget
#
# Note:
#     Should be split up into individual procedures, so that
#     it is easier to expand the collection with special-purpose
#     widgets (megawidgets for instance)
#
proc ::BGB::createWidget {parent type layout properties} {
    variable design

    set orgparent $parent
    if { $parent == "." } {
        set parent ""
    }

    set widgetName $parent.w$::BGB::widgetCount

    switch -- $type {
        "label" -
        "entry" {
             set options ""
             foreach var {text textvariable fixed width} value $properties {
                 if { $value != "" && $var != "fixed" } {
                     lappend options -$var $value
                 }
             }
             ::ttk::$type $widgetName {*}$options
        }
        "button" {
             set options ""
             foreach var {text command fixed width} value $properties {
                 if { $value != "" && $var != "fixed" } {
                     lappend options -$var $value
                 }
             }
             ::ttk::$type $widgetName {*}$options
        }
        "combobox" {
             set options ""
             foreach var {textvariable values fixed width} value $properties {
                 if { $value != "" && $var != "fixed" && $var != "values" } {
                     lappend options -$var $value
                 }
                 set values [lindex $properties 1]
                 lappend options -values [set $values]
             }
             ::ttk::$type $widgetName {*}$options
        }
        "checkbutton" {
             set options ""
             foreach var {text variable fixed width} value $properties {
                 if { $value != "" && $var != "fixed" } {
                     lappend options -$var $value
                 }
             }
             ::ttk::$type $widgetName {*}$options
        }
        "canvas" {
             set options ""
             set widgetVar [lindex $properties 0]
             foreach var {width height} value [lrange $properties 1 end] {
                 if { $value != "" } {
                     lappend options -$var $value
                 }
             }
             $type $widgetName {*}$options
        }
        "listbox" {
             set frameName  $widgetName
             set widgetName $widgetName.list

             set command   [subst -nocommands [lindex $properties 0]]
             set widgetVar [lindex $properties 1]
             set ::$widgetVar $widgetName

             set options ""
             foreach var {width height} value [lrange $properties 2 end] {
                 if { $value != "" } {
                     lappend options -$var $value
                 }
             }

             # Note: no themed widget for listboxes

             ::ttk::frame $frameName

             $type $widgetName {*}$options \
                 -xscrollcommand [list $frameName.x set] \
                 -yscrollcommand [list $frameName.y set]
             scrollbar $frameName.x -orient horizontal \
                 -command [list $widgetName xview]
             scrollbar $frameName.y -orient vertical \
                 -command [list $widgetName yview]

             grid $widgetName     $frameName.y -sticky news
             grid $frameName.x                 -sticky news
             grid rowconfigure    $frameName 0 -weight 1
             grid columnconfigure $frameName 0 -weight 1

             bind $widgetName <ButtonRelease-1> $command

             #
             # To make the frame appear ...
             #
             set widgetName $frameName
        }
        "frame" {
             set name [string tolower [string map {" " _} [lindex $properties 0]]]
             set widgetName $parent.$name
             ::ttk::$type $widgetName
        }
        "okcancel" {
             set nocolumns  [lindex [grid size $orgparent] 0]
             set norows     [lindex [grid size $orgparent] 1]
             if { $nocolumns < 1 } { set nocolumns 1 }
             if { $norows    < 1 } { set norows    1 }

             set okcmd      [lindex $properties 0]
             set cancelcmd  [lindex $properties 1]

             #::ttk::frame $parent.fbot
             frame $parent.fbot

             createWidget $parent.fbot button [list 0 0 1 1 0 0 0 0] \
                 [list OK $okcmd 1 8]
             createWidget $parent.fbot button [list 1 0 1 1 0 0 0 0] \
                 [list Cancel $cancelcmd 1 8]

             grid columnconfigure $parent.fbot 0 -pad 20
             grid configure $parent.fbot -column 0 -row $norows -columnspan $nocolumns
             #$parent.fbot configure -background green
             return
        }
        default {
             error "Unknown type: $type"
        }
    }

    foreach {column row colcount rowcount n e w s} $layout {break}

    if { $colcount < 1 } { set colcount 1 }
    if { $rowcount < 1 } { set rowcount 1 }

    set sticky ""
    foreach char {n e w s} value [list $n $e $w $s] {
        if { $value } {
            append sticky $char
        }
    }

    grid configure $widgetName -column $column -row $row \
        -columnspan $colcount -rowspan $rowcount -sticky $sticky

    if { $design } {
        bind $widgetName <KeyPress>      {break}
        bind $widgetName <KeyRelease>    {break}
        bind $widgetName <ButtonPress>   {break}
        bind $widgetName <ButtonRelease> {break}
        bind $widgetName <Button-1>      {::BGB::HandleButton %W}

        set ::BGB::columnRowWidget($widgetName) [list $column $row]
        set ::BGB::widgets($orgparent,widget,$::BGB::widgetCount) \
            [list $type $layout $properties]
    }

    incr ::BGB::widgetCount
}

package provide bgb 0.1 

Fabricio Rocha 14-Apr-09 - That's an interesting concept, Arjen, even though there are no widgets to put on the window (at least I could not find them). I have downloaded it and will study it ASAP -- for now, I just had an error when clicking the "Information" menu item under "Help". I am working ("struggling" would be best applied) to do a basic visual IDE, but it will be based in dicts and a second-stage code generation. I hope to publish it soon as well. Good to know there is someone else with a goal in common :)

AM (15 april 2009) The "information" item is not filled in yet. The idea is simple:

  • Open the window of your choice or create a new one (you can specify how many rows and columns you need then)
  • That will open a (toplevel) window with text like "(empty)" indicating the free cells in the grid
  • Click on the string and a new dialogue appears: that allows you to choose the type of widget and some layout options
  • The "Edit" widget properties gives a dialogue where you can edit the properties important for that type of widget

But not all is really finished yet - and it is not polished at all ;).