Gub - The World's Fastest GUI Builder.
Gub is for laying out widgets in a grid and applying Tk properties, gridding etc. Widgets can be Tk, ttk, snot, bwidget, etc.
If you are writing GUIs in Tk and get tired of keeping track of widget paths and stuff and get really tired of the drudgery of making changes to a GUI then Gub is for you.
Jeff Smith 2022-08-27 : Below is an online demo using CloudTk. This demo runs "Gub" in an Alpine Linux Docker Container. It is a 50.7MB image which is made up of Alpine Linux + tclkit + Gub1.0a1.kit + libx11 + libxft + fontconfig + ttf-dejavu + i3wm. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories.
Versions 0.9 and up can be found at https://chiselapp.com/user/stwo/repository/gub
Older versions can be found at http://www3.bell.net/stwo/software
Stu 2018-05-25 Added Guhb tutorial to this page.
Stu 2012-08-11 Added tutorial #2 to this page.
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:
Release notes
Spring 2018 - Version 0.9 Gub 0.9: Reclaimed 'gub' as the main Gub command! New gub param and goob key 'offsets' Removed gubProc New command 'guhb' for higher-level gubbing New command 'gubOperatorNames' Tidying and code cleanup Tcl 8.6 now required Spring 2015 - Version 0.7 Gub 0.7: Better ampersand underlining Grid options now double as add options Auto underlines More capable brace expansion Tutorial bits Gubtool 0.6: Consolidate help -> program info Add [subst] capabilities Fix tut tag bug Spring 2015 - Version 0.6 Gub: Source code generation for: Tcl New exported procs: gubLangs - List available languages gubUA - Underline Ampersand ngub - newer interface to Gub. Offers more control. Use it. New exported 'gob' procs: gubOpGob, gubBindGob, gubAddGob, gubWrapToggleGob, gubOpListGob Better gubbing New: up operator "^" New: brace "{}" expansion More better expansion in more places Autoscrollbars can be disabled with "!%-" and "!%|" More/improved docs and examples New: tutorials Updated spite.conf for newer SPITE Fixed bug in binds: "." being used instead of "in" GUB INCOMPATIBILITIES The "script" key of the dict returned by [ngub] has been replaced by "$lang src" where $lang is one of tcl Horizontal scrollbar link has changed from "=" to "%-" Vertical scrollbar link has changed from "^" to "%|" Gubtool: Now requires Meb Removed notes Added tutorials Added source tab More/better arg processing Spring 2012 - Version 0.5 Summer 2009 - Version 0.4 Fall/Winter 2008 - Version 0.3
README
Gub: The World's Fastest GUI Builder. Gub is a GUI builder Tcl extension that takes a simple spec and generates GUI code. GubTool is a command-line tool and interactive GUI builder based on Gub. Requires Tcl/Tk 8.5+ Installation: Put the files gub.tcl and pkgIndex.tcl in a directory in the ::auto_path. or Copy gub.tcl to gub-0.6.tm in a directory in the [::tcl::tm::path list]. or Install with SPITE: $ spite | sh -s -- --install For SPITE install help: $ spite | sh -s -- --help or With SPITE'd Gub: $ gzcat gub-0.6.spite.gz | sh -s -- --install
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 |. -. # end
Twig for 'd':
# Twig for TkGub test gui 21911 4 66C6D4817EB7CC475DE76AD1DE8CEA4F
Loading into GubTool with Twig:
echo '21911 4 66C6D4817EB7CC475DE76AD1DE8CEA4F' | twig -c - | gubtool -
A common widget layout is a frame containing a text widget connected to two scrollbar widgets. Looking at the default widget map, we can see that 'f' is [frame], 't' is [text] and 's' is [scrollbar]. Notice that 'f' in the default widget map has 'container' in its 'properties'. All widgets to the right of a container will be children of that container. So we make this little gob: f t s s Which will make 't' and 's' children of 'f'. The 't' will be at -row 0, -column 0 of 'f'. The first 's' will be at -row 0, -column 1 of 'f'. The second 's' will be at -row 1, -column 0 of 'f'. Digression... Gub understands a grid-style layout. Every widget is represented by one character which maps to a widget command. Every widget in the layout is two columns wide by one row high. The first position is the widget character, the second is a single-character label. The wrong way to grid two rows of three buttons: bbb bbb The right way to grid two rows of three buttons: b b b b b b Gridding two rows of three buttons with single-character labels: bjbkbl bxbybz This tutorial will not go into further detail on this subject; read gub_referring.txt for more information. Continued ... Looking at the default widget map entry for 't', we can see that is has 'scrollable' in its 'properties'. Looking at the default widget map entry for 's', we can see that is has 'scroller' in its 'properties'. Gub will automatically attach a 'scroller' to 'scrollable' if the 'scroller' is immediately to the right or immediately below the 'scrollable'. Gub will also set the orientation and grid options of the 'scroller' The result of running this through Gub: grid [frame .f0] -row 0 -column 0 grid [text .f0.t0 -xscrollcommand [list .f0.s1 set] -yscrollcommand [list .f0.s0 set]] -row 0 -column 0 grid [scrollbar .f0.s0 -orient vertical -command [list .f0.t0 yview]] -sticky ns -row 0 -column 1 grid [scrollbar .f0.s1 -orient horizontal -command [list .f0.t0 xview]] -sticky ew -row 1 -column 0 This is nice but there is still something missing: We want the widgets to change size when the toplevel is resized. For grid options we use the ':' grid operator, so we add: :t0 Which is Gub shorthand for 'grid this widget -sticky nsew'. We specified the widget as 't0' which is the first 't'. We could have written: :t0 -sticky nsew Which would accomplish the same thing. When no grid options are supplied, Gub will automatically generate '-sticky nsew'. Gub tries to provide defaults for the most common usages. We also need to row and column configure the frame ('f0'). For this we use the '|' columnconfigure and '-' rowconfigure operators. |f0 -f0 We could have written: |f0 0 -weight 1 -f0 0 -weight 1 With no options, these operators automatically generate '0 -weight 1'. Gub tries to provide defaults for the most common usages. So now we have: f t s s :t0 |f0 -f0 Which is better but still not fully working. We have to take care of 'f' inside its parent. We need to add: :f0 |. -. Gub treats '.' as the parent window, not the root ('.') window. In this case the parent is the root. Gub expands widget specifications, so instead of writing: :t0 :f0 We can write (order unimportant): :t0,f0 So now we have: f t s s :f0,t0 |.,f0 -.,f0 Which results in what we want: grid [frame .f0] -sticky nsew -row 0 -column 0 grid [text .f0.t0 -xscrollcommand [list .f0.s1 set] -yscrollcommand [list .f0.s0 set]] -sticky nsew -row 0 -column 0 grid [scrollbar .f0.s0 -orient vertical -command [list .f0.t0 yview]] -sticky ns -row 0 -column 1 grid [scrollbar .f0.s1 -orient horizontal -command [list .f0.t0 xview]] -sticky ew -row 1 -column 0 grid rowconfigure .f0 0 -weight 1 grid rowconfigure . 0 -weight 1 grid columnconfigure .f0 0 -weight 1 grid columnconfigure . 0 -weight 1 Now let's add a few things: a label and a checkbutton on top, a button on the bottom and a button binding. We'll be using the '.' property operator, a 'reference' (specified with '//') and we'll have to change some of the row/column configures. Well make the checkbutton change the word wrap type of the text widget and the button exit the program. First let's add the widgets. Looking at the default widget map, we can see that 'l' is [label], 'k' is [checkbutton] and 'b' is [button]. f l k t s s b :f0,t0 |.,f0 -.,f0 Not bad, but we need a rowconfigure adjustment, so change: -.,f0 To: -. -f0 1 With a single option, these row/column configure operators automatically generate '-weight 1'. We also need to set some widget options, for example, the button should say and do things. For this, we use the property ('.') operator: .b0 -text Exit -command exit And the label should have some text: .l0 -text Input We'd also like the label to be on the left :l0 -sticky w We'd also like to be able to exit on a kepyress so let's use the '&' binding operator: &b0 Control+q The binding operator works differently depending on the options given. What we're asking for here is for the keypress to invoke the button's -command. Notice that we've used 'Control+q' when we'd be expecting to see 'Control-q'. Gub will expand bindings that contain '+' into both upper and lower case. The above gob will generate: bind . <Control-q> ".b0 invoke" bind . <Control-Q> ".b0 invoke" Lastly, let's have the checkbutton control the word wrap mode of the text widget. For this we need a 'reference' which is a widget spec in slashes. The 'reference' will be replaced by the actual widget name. Also, we don't want the checkbutton to take focus: .k0 -takefocus 0 -command {/t0/ configure -wrap [expr {[/t0/ cget -wrap] eq "none" ? "word" : "none"}]} Let's also add a binding: &k0 Alt+w Putting it all together, we have: f l k t s s b .l0 -text Input .b0 -text Exit -command exit .k0 -takefocus 0 -command {/t0/ configure -wrap [expr {[/t0/ cget -wrap] eq "none" ? "word" : "none"}]} :l0 -sticky w :f0,t0 |.,f0 -. -f0 1 &b0 Control+q &k0 Alt+w Running this through Gub gives: grid [frame .f0] -sticky nsew -row 0 -column 0 grid [label .f0.l0 -text Input] -sticky w -row 0 -column 0 grid [checkbutton .f0.k0 -command {.f0.t0 configure -wrap [expr {[.f0.t0 cget -wrap] eq "none" ? "word" : "none"}]} -takefocus 0] -row 0 -column 1 grid [text .f0.t0 -xscrollcommand [list .f0.s1 set] -yscrollcommand [list .f0.s0 set]] -sticky nsew -row 1 -column 0 grid [scrollbar .f0.s0 -orient vertical -command [list .f0.t0 yview]] -sticky ns -row 1 -column 1 grid [scrollbar .f0.s1 -orient horizontal -command [list .f0.t0 xview]] -sticky ew -row 2 -column 0 grid [button .b0 -command exit -text Exit] -row 1 -column 0 grid rowconfigure .f0 1 -weight 1 grid rowconfigure . 0 -weight 1 grid columnconfigure .f0 0 -weight 1 grid columnconfigure . 0 -weight 1 bind . <Control-q> ".b0 invoke" bind . <Control-Q> ".b0 invoke" bind . <Alt-w> ".f0.k0 invoke" bind . <Alt-W> ".f0.k0 invoke" Notice that we didn't have to fiddle with widget paths or rows and columns. Gub does a lot of the drudge work for us.
Let's build something! A directory and file browser. What we need: A treeview widget for directory names. A treeview widget for directory contents. A text widget for file contents. Panedwindows, scrollbars, etc. Layout: +--------------------------+ | dir names | dir contents | +--------------------------+ | file contents | +--------------------------+ We'll use Ttk widgets. Check the standard Tk widget map for details. Let's start with a treeview and scrollbars: V S S Easy-peasy. And a text widget with scrollbars: t S S Notice we're mixing Tk and Ttk. That's ok. Now let's put things into panedwindows. We'll need two; one horizontal for the text and second panedwindow, and the second panedwindow for the two treeviews. Referencing the standard Tk widget map we can see that a panedwindow has a property of 'adder'. An adder is a form of container with the difference that widgets are added whereas with containers they are gridded. Let's start simple, with one panedwindow containing the two treeviews. We'll need to put the treeviews and their corresponding scrollbars into frames so that we can set up the grid parameters needed to make things nice. Also, a panedwindow can only add one thing into any one pane (I think). Ok, so one Ttk frame containing a treeview and two Ttk scrollbars: F V S S Adding that to a panedwindow: P F V S S Adding two sets of frame/treeview/scrollbars: P F V S S F V S S Putting that into another panedwindow, and adding a frame/text/scrollbars to the other panedwindow: P P F V S S F V S S F t S S That's our layout! We can paste that into GubTool and see that we do indeed get our widgets. Now we need to make some adjustments. The inner panedwindow needs to be horizontal so using the '.' (properties) operator: .P1 -orient horizontal Now we need to take care of gridding. We want to grid -sticky nsew the outer panedwindow, the two treeviews and the text widget: :P0,V0,1,t0 Also, we want to row and column configure the main window and all Ttk frames. -.,F |.,F Once we've created all these widgets we'll only really need to work with three of them: the two treeviews and the text widget. We'll use the '/' (save) operator and give our widgets names: /V0 dirs /V1 files /t0 text By default, widgets are saved in a dict named 'gui'. This is all well and good but now let's look at using Gub in a program. Remember: Gub splits input into lines on semicolons and newlines. Leading tabs are stripped. Gub returns a script. A simple invocation, creating a label and an entry: eval [gub "l e"] Here's how I like to write Gub-using code, showing a frame containing two buttons: eval [gub " F B B "] I consider this to be a bit dangerous since a change in whitespace can disrupt the layout, so I use semicolons: eval [gub " ;F B ; B "] The above could also be written as: eval [gub "F B; B"] Here's our complete file browser gui in a program, notice how using semicolons also lines up the layout and the operators for improved clarity: eval [gub " ;P P F V S ; S ; F V S ; S ; F t S ; S .P1 -orient horizontal :P0,V0,1,t0 -.,F ; |.,F /V0 dirs /V1 files /t0 text "] Notice that the row and column configures are on the same line, separated by semicolons. This is a matter of taste. After running this we now have our dict with the saved widgets. No more setting up or trying to keep track of widget path names with Gub! % set gui dirs .p0.p1.f0.v0 files .p0.p1.f1.v1 text .p0.f2.t0 And we can use it, of course: [dict get $gui text] insert end Gub! One last thing to mention is how the '&' binding operator can be helpful here: &V0 <<TreeviewSelect>> mySelector That's the end of this tutorial. Actually writing the code for a working file browser program is left as an exercise for the reader. :) Addendum. With comments: eval [gub " ;P P F V S ;# Gui layout for ; S ;# file browser ; F V S ;# ; S ;# Strange how these comments ; F t S ;# make this look like assembly code ; S .P1 -orient horizontal ;# Relax :P0,V0,1,t0 ;# Grid 'em good -.,F ; |.,F ;# Make sure things'll stretch /V0 dirs ;# We'll need these for later /V1 files /t0 text "]
Guhb makes it easier to make big guis with Gub. When Gub guis are big it can be difficult to refer to widgets by number and short labels get used up quickly. Later modifications can prove to be difficult due to the likely need for recounting and expansion rewriting. Guhb allows splitting a gui into smaller, independent pieces. A Guhb 'gohb' is a series of Gub gobs separated by lines beginning with the Guhb operator '>' which is called the Guhb 'in' operator. The Guhb 'in' operator takes a saved widget name or a label as an argument. Whitespace is optional between the operator and the argument. The Guhb 'in' operator doesn't have to be used in any particular order but must reference an already processed saved or labelled widget. In the absence of Guhb operators, Guhb behaves exactly like Gub. Simple gui with three frames each containing a label and a button. Gub: f l b f l b f l b .l0 -text A .l1 -text B .l2 -text C .b0 -text 1 .b1 -text 2 .b2 -text 3 Guhb: f f f /f0 topFrame @f1 midFrame @f2 > topFrame l b .l0 -text A .b0 -text 1 > midFrame l b .l0 -text B .b0 -text 2 > f2 l b .l0 -text C .b0 -text 3 Adding a frame/label/button to the second row involves more rewriting/recounting/renumbering with Gub than with Guhb. Gub: f l b f l b f l b f l b .l0 -text A .l1 -text _ .l2 -text B .l3 -text C .b0 -text 1 .b1 -text 0 .b2 -text 2 .b3 -text 3 Guhb: f f f f /f0 topFrame @f1 @f2 midFrame @f3 > topFrame l b .l0 -text A .b0 -text 1 > midFrame l b .l0 -text B .b0 -text 2 > f3 l b .l0 -text C .b0 -text 3 > f1 l b .l0 -text _ .b0 -text 0
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