"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 threw this together. 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! ;)
Ok, well here's some to try:
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
Gub
#! /bin/sh
# \
exec tclsh "$0" ${1+"$@"}
# Stuart Cassoff
# November 2008
namespace eval gub {
package provide gub 0.1
#
#
#
proc gub {wheat} {
set rg {}
array set N {b -1 l -1 t -1 c -1 s -1 > -1 < -1 ^ -1 v -1 f -1 o -1 e -1}
array set W [list \
b button \
l label \
t text \
c canvas \
s scrollbar \
f frame \
o listbox \
e entry \
]
array set C {}
array set R {}
set toprocess {}
foreach l [split $wheat \n] {
if {$l eq ""} { continue }
if {[string index $l 0] eq "."} {
set i [string first " " $l]
set P([string range $l 1 $i-1]) [string range $l $i end]
} elseif {[string index $l 0] eq ":"} {
set i [string first " " $l]
set G([string range $l 1 $i-1]) [string range $l $i end]
} elseif {[string index $l 0] eq "|"} {
set i [string first " " $l]
set v [string range $l $i end]
if {$v eq ""} { set v "-weight 1" }
set C([string range $l 1 $i-1]) $v
} elseif {[string index $l 0] eq "-"} {
set i [string first " " $l]
set v [string range $l $i end]
if {$v eq ""} { set v "-weight 1" }
set R([string range $l 1 $i-1]) $v
} else {
lappend toprocess $l
}
}
set fr {}
foreach l $toprocess {
set zl {grid}
if {[string length $l] % 2 != 0} { append l " " }
set start 1
foreach {c m} [split $l ""] {
if {$c eq " " && $m eq " "} { set start 0;continue } elseif {$start} { set fr {} }
set start 0
set d {[}
#set cc $c
#switch -exact -- $c { < - > - ^ - v { set c s } }
lappend d $W($c)
lappend d { $w.} $fr
lappend d $c
lappend d [set n [incr N($c)]]
array unset p
array set p {}
if {[info exists P($c)]} {
array set p $P($c)
}
if {[info exists P($c$n)]} {
array set p $P($c$n)
}
if {$m ne "" && $m ne " " && [info exists P($c$m)]} {
array set p $P($c$m)
}
lappend d { }
lappend d [array get p]
lappend d {]}
if {[info exists G($c$m)]} {
lappend d $G($c$m)
}
if {[llength $d] > 0} { lappend zl [join $d ""]; set d {} }
if {$c eq "f"} { set fr $c$n.; lappend rg [join $zl]; set zl grid }
}
if {[llength $zl] > 1} { lappend rg [join $zl] }
}
lappend rg {}
foreach {n v} [array get C] {
lappend rg "grid columnconfigure \$w$n $v"
}
foreach {n v} [array get R] {
lappend rg "grid rowconfigure \$w$n $v"
}
return [join $rg \n]
}
###
}; # End of gub namespace
# EOFTkGub
#! /bin/sh
# \
exec tclsh "$0" ${1+"$@"}
# Stuart Cassoff
# November 2008
namespace eval tkgub {
package require Tk
package require gub
#
#
#
proc gui {} {
variable gui
set w [set gui(w) {}]
set W [set gui(W) $w.]
foreach t {in out} {
grid [set gui($t) [text $w.$t -height 10]] -sticky news
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(out) [linsert [bindtags $gui(in)] end b]
bind $W <Control-q> exit; bind $W <Control-Q> exit
grid columnconfigure $W 0 -weight 1
grid rowconfigure $W 0 -weight 1
grid rowconfigure $W 1 -weight 1
focus $gui(in)
}
###
#
#
#
proc gubrun {} {
variable gui
$gui(out) delete 1.0 end
if {[catch {
$gui(out) insert end [gub::gub [$gui(in) get 1.0 end]]
run
} err]} {
$gui(out) delete 1.0 end
$gui(out) 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(out) get 1.0 end-1c]
after 20 [list focus $gui(out)]
}
###
gui
}; # End of gub namespace
# EOF