"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! ;)
----
[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.
----
Here is something similar [Laying out widgets in a grid]
----
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
======
----
[http://img249.imageshack.us/img249/7812/gubscrld0.png]
----
**Gub**
======
#! /bin/sh
# \
exec tclsh "$0" ${1+"$@"}
namespace eval gub {
package provide gub 0.2
#
#
#
proc gub {gob {var {gui}}} {
set rg {}
foreach a {N C R S P G V H} { array set $a {} }
array set W [list \
b button \
c canvas \
k checkbutton \
e entry \
f frame \
l label \
z labelframe \
o listbox \
r radiobutton \
y 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 \
Z ttk::labelframe \
N ttk::notebook \
R ttk::radiobutton \
Y ttk::scale \
S ttk::scrollbar \
V ttk::treeview \
]
foreach w [array names W] { set N([string tolower $w]) -1 }
array set wigs {. $W}
set toprocess {}
foreach l [split $gob \n] {
set l [string trimright $l]
set ll [string trimleft $l]
if {$ll eq "" || [string index $ll 0] eq "#"} { continue }
foreach l [split $l \;] {
set l [string trimright $l]
set ll [string trimleft $l]
if {[set c [string index $ll 0]] ni {. / : = ^ | -}} {
lappend toprocess $l
} else {
if {[set i [string first " " $ll]] != -1} {
set n [string range $ll 1 $i-1]
set v [string range $ll $i+1 end]
} else {
set n [string range $ll 1 end]
set v ""
}
set vv [string trimright $v]
foreach n [split $n +] {
set v $vv
switch -exact -- $c {
. { lappend P($n) {*}$v }
/ { set S($n) $v }
: { if {$v eq ""} {set v "-sticky nsew"}; set G($n) $v }
= { set H($n) $v }
^ { set V($n) $v }
| { if {$v eq ""} {set v "0 -weight 1"}; lappend C($n) $v }
- { if {$v eq ""} {set v "0 -weight 1"}; lappend R($n) $v }
default {}
}
}
}
}
}
set row 0
set col 0
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 {[}
lappend d $W($c)
lappend d { }
set wig \$w.$fr[set lc [string tolower $c]][set n [incr N($lc)]]
lappend d $wig
set wigs($c$n) $wig
if {$m ne "" && $m ne " "} { set wigs($c$m) $wig }
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)
}
if {[llength [array names p]] > 0} {
lappend d { }
lappend d [array get p]
}
lappend d {]}
if {[info exists S($c$m)]} {
set d [linsert $d 0 "\[set ${var}($S($c$m)) "]
lappend d {]}
} elseif {[info exists S($c$n)]} {
set d [linsert $d 0 "\[set ${var}($S($c$n)) "]
lappend d {]}
}
array unset g
array set g {}
if {[info exists G($c)]} { array set g $G($c) }
if {[info exists G($c$n)]} { array set g $G($c$n) }
if {$m ne "" && $m ne " " && [info exists G($c$m)]} {
array set g $G($c$m)
}
if {[llength [array names g]] > 0} {
lappend d { }
lappend d [array get g]
}
if {[llength $d] > 0} {
lappend zl [join $d ""]
set d {}
}
if {$c in "f F"} {
set fr [string tolower $c]$n.
lappend rg [join $zl]
set zl grid
}
}
if {[llength $zl] > 1} {
lappend rg [join $zl]
}
}
if {[llength [array names C]] > 0 || [llength [array names R]] > 0} { lappend rg {} }
foreach {n v} [array get C] { foreach o $v {
lappend rg "grid columnconfigure $wigs($n) $o"
}}
foreach {n v} [array get R] { foreach o $v {
lappend rg "grid rowconfigure $wigs($n) $o"
}}
if {[llength [array names H]] > 0 || [llength [array names V]] > 0} { lappend rg {} }
foreach {n v} [array get H] {
lappend rg "$wigs($n) configure -command \[list $wigs($v) xview\]"
lappend rg "$wigs($v) configure -xscroll \[list $wigs($n) set\]"
}
foreach {n v} [array get V] {
lappend rg "$wigs($n) configure -command \[list $wigs($v) yview\]"
lappend rg "$wigs($v) configure -yscroll \[list $wigs($n) set\]"
}
return [regsub -line -all {^\t$} [join $rg \n\t] {}]
}
###
#
#
#
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" "" $blob "" {return $W}] \n\t]\n\} {}]
}
###
}; # End of gub namespace
# EOF
======
----
**TkGub**
======
#! /bin/sh
# \
exec tclsh "$0" ${1+"$@"}
#
# TkGub - GUI frontend to Gub
#
# Stuart Cassoff
# Fall/Winter 2008
#
# Version 0.2
#
namespace eval tkgub {
package require Tk
package require Ttk
package require gub
#
#
#
proc gui {} {
variable gui
set w [set gui(w) {}]
set W [set gui(W) $w.]
eval [gub::gub "
# TkGub gui
fitisv
sh
fotosv
sh
.t -height 10 -wrap none
.sh -orient horizontal
^s0 t0 ; =s1 t0
^s2 t1 ; =s3 t1
:sv
:sh -sticky ew
:f
|fi+fo+.
-fi+fo+.
-. 1 -weight 1
/ti in
/to out
"]
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 out} { bind $gui($t) [namespace current]::run\;break }
bind a [namespace current]::gubrun
bind a [namespace current]::gubrun\;break
bind b [namespace current]::run\;break
bindtags $gui(in) [linsert [bindtags $gui(in)] end a]
bindtags $gui(out) [linsert [bindtags $gui(in)] end b]
bind $W exit; bind $W exit
bind $W [list [namespace current]::domenu %W [mwowm $w] %X %Y]
$W configure -menu $M
wm title $W TkGub\ 0.2
focus $gui(in)
}
###
#
#
#
proc mwowm {w} {
set widgets [list button canvas checkbutton entry frame label labelframe listbox radiobutton scale scrollbar spinbox text]
lappend widgets {*}[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 \
]
# Collect
array set z {}
foreach wg $widgets {
$wg .wg
foreach ol [.wg configure] {
lappend z([lindex $ol 0]) $wg
}
destroy .wg
}
# Sprackulate
foreach wg [linsert $widgets 0 common] { set [string map {: _} $wg] {} }
# Iplifiy
foreach o [lsort [array names z]] {
if {[llength $z($o)] == [llength $widgets]} {
lappend common $o
} else {
foreach wg $z($o) { lappend [string map {: _} $wg] $o }
}
}
catch {grid . -banana yellow} cow
foreach moo [split $cow ,] { lappend grid [lindex [regexp -inline {^.*(-.+)$} $moo] 1] }
# Plorfinize
set M [menu $w.moptions -tearoff 0]
foreach wg [linsert $widgets 0 common grid] {
set m [menu $M.m[string map {: _} $wg] -tearoff 0]
foreach i [set [string map {: _} $wg]] {
$m add command -label [string totitle $i] -command [list [namespace current]::insert [string map {: _} $i]]
}
$M add cascade -label [string totitle $wg] -menu $m
}
$M add separator
$M add command -label "Close Menu"
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 {} {
catch {destroy .q}
wm group [toplevel .q] .
{*}[gub::gubProc [gub::gub "l\nl\nl\nb
.l0 -text {TkGub 0.2}
.l1 -text {Stuart Cassoff}
.l2 -text {Fall/Winter 2008}
.b0 -text Ok -command {destroy .q}
/b0 ok
" aboot] widget aboot]
widget .q
wm title .q "TkGub 0.2 - About"
::tk::PlaceWindow .q widget .
variable aboot
focus $aboot(ok)
unset aboot
}
###
#
#
#
proc readme {} {
set var readmeGUI
catch {destroy .q}
wm group [toplevel .q] .
{*}[gub::gubProc [gub::gub "
f t s
s
b
.b0 -text Ok -command {destroy .q}
.t0 -wrap none
.s1 -orient horizontal
:s0
:s1 -sticky ew
:f0
^s0 t0
=s1 t0
|f0
-f0
|.
-.
/t0 text
/b0 button
" $var] widget $var]
widget .q
wm title .q "TkGub 0.2 - Readme"
variable $var
[set ${var}(text)] insert end "TkGub 0.2
Stuart Cassoff
Fall/Winter 2008
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
y scale Y 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)
?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 )
Shortcuts:
:l0 same as :l0 -sticky nsew
|f0 same as |f0 0 -weight 1
-f0 same as -f0 0 -weight 1
Use '+' to apply an option/control to multiple widgets:
.b0+l0 -bg red
|f0+f1+f2
:t0+t1 -stricky nsew
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 ';'.
"
focus [set ${var}(button)]
unset $var
}
###
#
#
#
proc Load {} {
variable gui
set fn [tk_getOpenFile]
if {$fn eq ""} { return }
$gui(in) delete 1.0 end
$gui(in) insert end [read [set f [open $fn]]][close $f]
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 {} {
variable gui
$gui(out) delete 1.0 end
if {[catch {
$gui(out) insert end [gub::gubProc [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 exit; bind $w exit
eval [$gui(out) get 1.0 end-1c]
widget $w
after 20 [list focus $gui(out)]
}
###
gui
}; # End of tkgub namespace
# EOF
======
----
!!!!!!
%| [Category Application] | [Category GUI] |%
!!!!!!