Gub - Gui Builder
Directions to find it at Stu
"I have a gub" - Woody Allen
Stu 2008-11-13
Gub is a simple GUI builder that takes a simple spec and generates GUI code.
TkGub is an interactive GUI builder based on Gub.
Inspired by cool web tools like build-html or build-regexp as-you-type, I (initially) threw this together.
JBR - Here is something similar Laying out widgets in a grid
Stu 2008-11-13 They're both in a highly raw, experimental and possibly volatile state right now.
No docs - the source and screenshot should help get you on your way - have fun! ;)
Stu 2008-12-20 New version 0.2 with full complement of widgets and more/improved functionality.
The screenshot is a bit dated now but is still a working example.
Stu 2008-12-29 Version 0.3.
Some notes about Gub:
Gub generates code.
Gub is a learning tool.
Gub requires knowing what you're doing.
Gub is a minimal and fast notation for describing (parts of) GUIs.
Gub currently works fairly well. Nested frames are still buggy and the row/columnconfigures aren't exactly right either. As I continue to actually attempt to use Gub in other programs, it is subject to change based on my needs and whims (probably a good thing :).
The screenshot is less applicable to the current state of Gub so it's now a link instead of an inline image.
http://img249.imageshack.us/img249/7812/gubscrld0.png
Stu 2012-06-17 Version 0.5.
After a period of actually using and developing Gub, a new version is ready for mass consumption.
Notable changes/additions:
Gobs (a 'gob' being what you feed to Gub):
a)
b e b b b b b
b)
f b e b b f b b b
c)
b bqb .b -text moo -bg red .b2 -text cow .bq -bg green
d)
# TkGub test gui f t sv sh .t -width 20 .t -height 10 .s1 -orient horizontal :s0 -sticky ns :s1 -sticky ew :t0,f0 |f0 -f0 |. -. ^sv t0 =sh t0 # end
Twig for 'd':
# Twig for TkGub test gui 21911 4 66C6D4817EB7CC475DE76AD1DE8CEA4F
Loading into TkGub with Twig:
echo '21911 4 66C6D4817EB7CC475DE76AD1DE8CEA4F' | twig -c - | tkgub -z -
Old code:
#! /bin/sh
# \
exec tclsh "$0" ${1+"$@"}
#
# Gub - GUiBuilder
#
# Stuart Cassoff
# Fall/Winter 2008
#
# Version 0.3
#
#
# "I have a gub." - Woody Allen
#
namespace eval gub {
package provide gub 0.3
namespace export gub gubParse gubAssemble gubProc
#
#
#
proc gub {gob {var {gui}}} {
return [join [gubAssemble {*}[gubParse $gob] $var] \n]
}
###
#
#
#
proc gubParse {gob} {
array set W [list b button c canvas k checkbutton e entry f frame l label \
m labelframe o listbox p panedwindow r radiobutton a scale s scrollbar \
i spinbox t text B ttk::button K ttk::checkbutton X ttk::combobox E ttk::entry \
F ttk::frame L ttk::label M ttk::labelframe N ttk::notebook P ttk::panedwindow \
R ttk::radiobutton A ttk::scale S ttk::scrollbar V ttk::treeview]
set containers [list f F m M]
foreach w [array names W] { set N([string tolower $w]) -1 }
foreach a {N C R S P G V H X} { array set $a {} }
array set wigs {. {}}
set todo {}
foreach l [split $gob \n] {
set ll [string trimleft [set l [string trimright $l]]]
if {$ll eq "" || [string index $ll 0] eq "#"} { continue }
foreach l [split $l \;] {
set ll [string trimleft [set l [string trimright $l]]]
if {[set c [string index $ll 0]] ni {/ = ^ ! . : - |}} {
if {[string length $l] % 2 != 0} { append l " " }
lappend todo $l
continue
}
if {[set i [string first " " $ll]] == -1} {
set n [string range $ll 1 end]
set v ""
} else {
set n [string range $ll 1 $i-1]
set v [string range $ll $i+1 end]
}
set vv [string trimright $v]
if {$n eq ""} { set n all }
foreach n [split $n ,] {
set v $vv
switch -exact -- $c {
/ { set S($n) $v }
= { set H($n) $v }
^ { set V($n) $v }
! { set X($n) $v }
. { lappend P($n) {*}$v }
: {
if {$v eq ""} {
set v "-sticky nsew"
} elseif {$v eq "-sticky"} {
append v " nsew"
}
set G($n) $v
}
- - | {
if {$v eq ""} {
set v "0 -weight 1"
} elseif {[string is integer $v]} {
append v " -weight 1"
}
lappend [string map {- R | C} $c]($n) $v
}
default {}
}
}
}
}
set weegs {}
set rccs {}
set x -1
set y -1
set z {}
set row -1
set col 0
set in ""
foreach l $todo { incr y; set x -1; incr row; set col 0;foreach {c m} [split $l ""] { incr x;
if {$c eq " " && $m eq " "} {
if {$in eq ""} {
incr col
}
continue
}
if {$x == 0 && [llength $z] > 0} {
lassign [lindex $z end] in row col
set z [lreplace $z end end]
incr row
}
if {![info exists W($c)]} { continue } ;#meh
# command window options element gridoptions row col
set dd [list "" "" "" "" "" -1 -1]
lset dd 0 $W($c)
set wig .$in[set lc [string tolower $c]][set n [incr N($lc)]]
lset dd 1 $wig
set wigs($c$n) $wig
if {$m ne "" && $m ne " "} { set wigs($c$m) $wig }
set these [list all $c]; if {$m ne "" && $m ne " "} { lappend these $c$m }; lappend these $c$n
foreach a {p g} A {P G} i {2 4} {
unset -nocomplain $a; array set $a {}
foreach what $these { if {[info exists ${A}($what)]} { array set $a [set ${A}($what)] } }
if {[llength [array names $a]] > 0} { lset dd $i [array get $a] }
}
set those [list $c$n]; if {$m ne "" && $m ne " "} { lappend those $c$m }; lappend those $c all
foreach what $those { if {[info exists S($what)]} {
if {$S($what) eq ""} {
if {$what eq "all" || $what eq $c} {
set name $c$n
} else {
set name $what
}
} else {
set name $S($what)
}
lset dd 3 $name
break
}}
lset dd 5 $row; lset dd 6 $col
lappend weegs $dd
set container false
if {$c in $containers} {
set container true
foreach what $those { if {[info exists X($what)]} { set container false; break } }
}
if {$container} {
lappend z [list $in $row $col]
set in $in[string tolower $c]$n.
set row 0
set col 0
} else {
incr col
}
}}
foreach a {H V} q {x y} { foreach {k v} [array get $a] {
if {[set ki [lsearch -index 1 $weegs $wigs($k)]] == -1 || [set vi [lsearch -index 1 $weegs $wigs($v)]] == -1} { continue }
lset weegs $ki [linsert [lindex $weegs $ki] end -command $wigs($v) ${q}view]
lset weegs $vi [linsert [lindex $weegs $vi] end -${q}scrollcommand $wigs($k) set]
}}
foreach a {R C} q {row column} { foreach {k v} [array get $a] { foreach o $v {
if {![info exists wigs($k)]} { continue } ;#meh
lappend rccs [list ${q}configure $wigs($k) $o]
}}}
return [list $weegs $rccs]
}
###
#
#
#
proc gubAssemble {weegs {rccs {}} {var {gui}}} {
set zz {}
foreach weeg $weegs {
set links [lassign $weeg command window options element gridoptions row col]
set z grid
if {$element ne ""} { append z " " "\[set ${var}($element)" }
append z " " "\[" $command " " \$w$window
if {$options ne ""} { append z " " $options }
foreach {opt win cmd} $links { append z " " $opt " " "\[list \$w$win $cmd]" }
if {$element ne ""} { append z "]" }
append z "]"
if {$gridoptions ne ""} { append z " " $gridoptions }
if {$row != -1} { append z " " -row " " $row }
if {$col != -1} { append z " " -column " " $col }
lappend zz $z
}
foreach rcc $rccs {
lassign $rcc command window options
set z grid
lappend zz [append z " " $command " " \$W$window " " $options]
}
return $zz
}
###
#
#
#
proc gubProc {blob {name {widget}} {var {gui}}} {
return [regsub -line -all {^\t$} [join [list "proc $name {{w {.}}} \{" {set W $w; if {$w eq "."} {set w ""}} "variable $var" "" [join [split $blob \n] \n\t] "" {return $W}] \n\t]\n\} {}]
}
###
}; # End of gub namespace
# EOF#! /bin/sh
# \
exec tclsh "$0" ${1+"$@"}
#
# TkGub - GUI frontend to Gub
#
# Stuart Cassoff
# Fall/Winter 2008
#
# Version 0.3
#
namespace eval tkgub {
package require Tk
package require Ttk
package require gub
namespace import ::gub::*
#
#
#
proc gui {} {
variable cfg
variable gui
set w [set gui(w) {}]
set W [set gui(W) $w.]
set gui(auto) 1
eval [gub "f k b\np;.k0 -text Auto;.b0 -text Go;.p0 -orient vertical -showhandle 1;.k0 -variable [namespace current]::gui(auto);:;/p0 mainPane;/b0 goButton;/k0;|.;-. 1 -weight 1"]
$gui(goButton) configure -command [list [namespace current]::gubrun no]
$gui(k0) configure -command [namespace current]::gubrun
foreach what {in run} {
$gui(mainPane) add [set f [labelframe $gui(mainPane).f$what -text [string totitle $what]]] -sticky nsew -stretch always
{*}[gubProc [gub "
t s
s
.t -height 10 -wrap none
.s1 -orient horizontal
^s0 t0 ; =s1 t0
:s0 -sticky ns
:s1 -sticky ew
:t
|.;-.
/t0 $what
"]];widget $f
}
set M [menu $w.mMain -tearoff 0]
set menu file
set mm [menu $M.$menu -tearoff 0]
$mm add command -label Load -command [namespace current]::Load
$mm add command -label Save -command [namespace current]::Save
$mm add command -label Exit -command exit
$M add cascade -label [string totitle $menu] -menu $mm
set menu help
set mm [menu $M.$menu -tearoff 0]
$mm add command -label About -command [namespace current]::about
$mm add command -label Readme -command [namespace current]::readme
$M add cascade -label [string totitle $menu] -menu $mm
foreach t {in run} { bind $gui($t) <Control-Return> [namespace current]::run\;break }
bind a <Key> [namespace current]::gubrun
bind a <Control-Return> [namespace current]::gubrun\;break
bind b <Control-Return> [namespace current]::run\;break
bindtags $gui(in) [linsert [bindtags $gui(in)] end a]
bindtags $gui(run) [linsert [bindtags $gui(in)] end b]
bind $W <Control-q> exit; bind $W <Control-Q> exit
bind $W <Button-3> [list [namespace current]::domenu %W [mwowm $w] %X %Y]
$W configure -menu $M
wm title $W $cfg(fullname)
focus $gui(in)
}
###
#
#
#
proc mwowm {w} {
set M [menu $w.moptions -tearoff 0]
foreach widgets [list \
[list button canvas checkbutton entry frame label labelframe \
listbox radiobutton scale scrollbar spinbox text] \
[list ttk_button ttk_checkbutton ttk_combobox ttk_entry \
ttk_frame ttk_label ttk_labelframe ttk_notebook \
ttk_radiobutton ttk_scale ttk_scrollbar ttk_treeview] \
] tk {Tk Ttk} {
unset -nocomplain z; array set z {}
foreach wg $widgets {
[string map {_ ::} $wg] .wg
foreach ol [.wg configure] {
lappend z([lindex $ol 0]) $wg
}
destroy .wg
}
foreach wg [linsert $widgets 0 common] { set $wg {} }
foreach o [lsort [array names z]] {
if {[llength $z($o)] == [llength $widgets]} {
lappend common $o
} else {
foreach wg $z($o) { lappend $wg $o }
}
}
set mm [menu $M.m$tk -tearoff 0]
$M add cascade -label $tk -menu $mm
foreach wg [linsert $widgets 0 common] {
set m [menu $mm.m$wg -tearoff 0]
foreach i [set $wg] {
$m add command -label [string totitle $i] -command [list [namespace current]::insert $i]
}
$mm add cascade -label [string totitle $wg] -menu $m
}
}
catch {grid . -banana yellow} cow
foreach moo [split $cow ,] { lappend grid [lindex [regexp -inline {^.*(-.+)$} $moo] 1] }
set wg grid
set m [menu $M.m$wg -tearoff 0]
foreach i [set $wg] {
$m add command -label [string totitle $i] -command [list [namespace current]::insert $i]
}
$M add cascade -label [string totitle $wg] -menu $m
catch {grid rowconfigure . 0 -banana} cow
foreach moo [split $cow ,] { lappend gridrcc [lindex [regexp -inline {^.*(-.+)$} $moo] 1] }
set wg gridrcc
set mm [menu $m.m$wg -tearoff 0]
foreach i [set $wg] {
$mm add command -label [string totitle $i] -command [list [namespace current]::insert $i]
}
$m add cascade -label RowColConf -menu $mm
return $M
}
###
#
#
#
proc insert {what} {
variable where
$where insert insert "$what "
}
###
#
#
#
proc domenu {w m x y} {
variable where $w
tk_popup $m $x $y
}
###
#
#
#
proc about {} {
variable cfg
catch {destroy .q}
wm group [toplevel .q] .
{*}[gubProc [gub "l\nl\nl\nb
.l0 -text {$cfg(fullname)}
.l1 -text {$cfg(author)}
.l2 -text {$cfg(when)}
.b0 -text Ok -command {destroy .q}
/b0 ok
" aboot] widget aboot]
widget .q
wm title .q "$cfg(fullname) - About"
::tk::PlaceWindow .q widget .
variable aboot
focus $aboot(ok)
unset aboot
}
###
#
#
#
proc readme {} {
variable cfg
set var readmeGUI
catch {destroy .q}
wm group [toplevel .q] .
{*}[gubProc [gub "
f t s
s
b
.b0 -text Ok -command {destroy .q}
.t0 -wrap none
.s1 -orient horizontal
^s0 t0 ; =s1 t0
:s1 -sticky ew
:f0,s0
|f0,. ; -f0,.
/t0 text
/b0 button
" $var] widget $var]
widget .q
wm title .q "$cfg(fullname) - Readme"
variable $var
[set ${var}(text)] insert end "$cfg(fullname)
$cfg(author)
$cfg(when)
<Button-3> for widget options
Widgets:
b button B ttk::button
c canvas
k checkbutton K ttk::checkbutton
e entry E ttk::entry
f frame F ttk::frame
l label L ttk::label
z labelframe Z ttk::labelframe
o listbox
r radiobutton R ttk::radiobutton
a scale A ttk::scale
s scrollbar S ttk::scrollbar
i spinbox
t text
X ttk::combobox
N ttk::notebook
V ttk::treeview
Line format:
Spacing is important.
Two (2) positions per widget.
Generally: widget ?tag? ?widget ?tag? ...?
wtwtwt
Tags can be empty:
w w w w
Put things in a frame (note the positioning):
f t s
s
Options/Controls:
General form:
? == option/control described below
w == one of the above widget types
n == nth widget of type w
a == widget of type w tagged 'a'
d == option/parm/data (one or more)
? For all
?w d For all w
?wn d For nth w
?wa d For w tagged 'a'
Tags are one char, user supplied.
Indexes (nth) are generated for
each widget type, starting at 0.
. Widget options ( .l0 -text Hello )
: Grid options ( :l0 -sticky nsew )
^ Scrollbar Ylink ( ^s0 t0 )
= Scrollbar Xlink ( =s0 t0 )
| Rowconfigure ( |f0 0 -weight 1 )
- Columnconfigure ( -f0 0 -weight 1 )
/ Save widget as ( /t0 inputText )
! Select alternate 'gub' behaviour.
Shortcuts:
:l0 same as :l0 -sticky nsew
|f0 same as |f0 0 -weight 1
-f0 1 same as -f0 1 -weight 1
:f0 same as :f0 -sticky, same as :f0 -sticky nsew
/f0 same as /f0 f0
Short-shorts:
: (grid all widgets -sticky nsew)
. -cursor trek (set all widgets to have the 'trek' cursor)
/ (save all)
! (alternate all)
Use ',' to apply an option/control to multiple widgets:
.b0,l0 -bg red
|f0,f1,f2
:t0,t1 -sticky nsew
Use '!' to select alternate widget behaviour.
Currently applies only to containers,
makes them not containers. Useful for putting
containers side-by-side rather than into each other.
Notes:
The tag of parent window is '.'.
'.' options aggregate, all others tend to override.
Lines starting with '#' and blank lines are ignored.
Lines can be joined with ';'. Whitepace around ';'
is significant for layout, ignored for options.
Some things that can be applied to more than one
widget don't make much sense but you can still do them.
(/f f for example, scrollbar links, row/column configures)
Complex GUIs can be built out of little gub gobs.
"
focus [set ${var}(button)]
unset $var
}
###
#
proc openIt {fn} { return [expr {($fn eq {-} || $fn eq {stdin}) ? {stdin} : [open $fn r]}] }
proc closeIt {f} { return [expr {$f eq {stdin} ? {} : [close $f]}] }
proc inhaleIt {fn} { return [read [set f [openIt $fn]]][closeIt $f] }
#
#
#
#
proc autoload {} {
variable cfg
if {$cfg(loadthis) ne ""} { Load $cfg(loadthis) }
}
###
#
#
#
proc Load {{fn {}}} {
variable gui
if {$fn eq ""} { set fn [tk_getOpenFile] }
if {$fn eq ""} { return }
$gui(in) delete 1.0 end
$gui(in) insert end [inhaleIt $fn]
gubrun
}
###
#
#
#
proc Save {} {
variable gui
set fn [tk_getSaveFile]
if {$fn eq ""} { return }
set f [open $fn w]
puts -nonewline $f [$gui(in) get 1.0 end-1c]
close $f
}
###
#
#
#
proc gubrun {{auto {yes}}} {
variable gui
if {!$gui(auto) && $auto} { return }
$gui(run) delete 1.0 end
if {[catch {
$gui(run) insert end [gubProc [gub [$gui(in) get 1.0 end]]]
run
} err]} {
$gui(run) delete 1.0 end
$gui(run) insert end $::errorInfo
}
after 20 [list focus $gui(in)]
}
###
#
#
#
proc run {} {
variable gui
catch {destroy [set w $gui(w).test]}
toplevel $w; bind $w <Control-q> exit; bind $w <Control-Q> exit
eval [$gui(run) get 1.0 end-1c]
widget $w
after 20 [list focus $gui(run)]
}
###
#
#
#
proc args {} {
if {$::argc == 0} { return }
variable cfg
set state opt
foreach arg $::argv {
switch -exact -- $state {
opt {
switch -exact -- $arg {
-z { set state $arg }
default { puts stderr "Huh?"; exit 1 }
}
}
-z { set state opt; set cfg(loadthis) $arg }
}
}
}
###
#
#
#
proc setup {} {
variable cfg
set cfg(name) TkGub
set cfg(ver) 0.3
set cfg(author) "Stuart Cassoff"
set cfg(when) "Fall/Winter 2008"
set cfg(fullname) $cfg(name)\ $cfg(ver)
set cfg(loadthis) ""
}
###
#
setup; args; gui; autoload
#
}; # End of tkgub namespace
# EOF