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:
But not all is really finished yet - and it is not polished at all ;).