[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 $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 {break} bind $widgetName {break} bind $widgetName {break} bind $widgetName {break} bind $widgetName {::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 ;). ---- !!!!!! %| [Category GUI] | [Category Dev. Tools] |% !!!!!!