"I have a gub" - Woody Allen

Directions to find it at [Stu]

[Stu] 2008-11-13

Gub is a simple GUI builder that takes a simple spec and generates GUI code.<<br>>
TkGub is an interactive GUI builder based on Gub.<<br>>
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.<<br>>
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.<<br>>
The screenshot is a bit dated now but is still a working example.
----
[Stu] 2008-12-29 Version 0.3.<<br>>
Some notes about Gub:<<br>>
Gub generates code.<<br>>
Gub is a learning tool.<<br>>
Gub requires knowing what you're doing.<<br>>
Gub is a minimal and fast notation for describing (parts of) GUIs.<<br>>

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.<<br>>
http://img249.imageshack.us/img249/7812/gubscrld0.png
----
[Stu] 2012-06-17 Version 0.5.<<br>>
After a period of actually using and developing Gub, a new version is ready for mass consumption.<<br>>
Notable changes/additions:
    * Widget map, allowing any Tk-style widget to be used.
    * Automatic scrollbar linking.
    * Automatic handling of panedwindows and notebooks.
    * Powerful expansion syntax; saves typing.
    * TkGub has been replaced with GubTool; a command-line and gui tool.
    * More code generation options.
    * Slightly better docs and examples.
----
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:
----
**Gub**
======
#! /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
======
----
**TkGub**
======
#! /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
======
----
!!!!!!
%| [Category Application] | [Category GUI] |%
!!!!!!