Index: README
==================================================================
--- README
+++ README
@@ -15,5 +15,16 @@
     tcltags - ctags(1) clone for Tcl
 
     modules - various general-purpose pure-Tcl modules
 
     hacks   - interesting hacks that are too experimental to be useful yet
+
+Where stuff is demo'able, I've included "boot.tcl" which will stuff the
+appropriate dirs into $::auto_path and tcl::tm::path so that it can find its
+modules.  Just put that in the command-line:
+
+    $ tclsh boot.tcl hacks/Window-0.tm
+
+
+!NOTE!:  the contents of this repository often lag dreadfully behind what I'm
+actually using in live projects.  If anything seems particularly funky, or
+simply fails to work, ping me with a ticket (or on the chat) to update it.

ADDED   boot.tcl
Index: boot.tcl
==================================================================
--- /dev/null
+++ boot.tcl
@@ -0,0 +1,23 @@
+#!/usr/bin/env tclsh
+#
+#lappend auto_path [file normalize [info script]/../modules]
+#::tcl::tm::path add [file normalize [info script]/../modules]
+proc boot {args} [format {
+    {*}$args [list lappend auto_path %1$s]
+    {*}$args [list ::tcl::tm::path add %1$s]
+} [list [file normalize [info script]/../modules]]]
+boot eval
+package provide boot 0.1
+
+if {$::argv ne ""} {
+    proc info_cmdline {} [list list [info nameofexe] $::argv0 $::argv]      ;# hack for restartability
+    set ::argv [lassign $::argv ::argv0]
+    source $::argv0
+} else {
+    return
+    # async repl:
+    package require repl
+    coroutine main repl::chan stdin stdout stderr
+    trace add command main delete {unset ::forever; #}
+    vwait forever
+}

Index: ebnf/README.md
==================================================================
--- ebnf/README.md
+++ ebnf/README.md
@@ -57,5 +57,10 @@
     [token]      - consume (space then) a literal without reporting (doesn't appear in $0)
     [token!]     - consume (space then) a literal and push its value onto $0
     [opt script] - attempt script.  If it fails, push a single empty result onto $0.
     [any s0 ...] - attempt each script until one succeeds.  The successful script's results will appear on $0.
     [many script]- try script repeatedly until it fails.  Results are collected into a list and pushed.
+
+
+** References
+
+http://www.garshol.priv.no/download/text/bnf.html

Index: ebnf/parser-1.tm
==================================================================
--- ebnf/parser-1.tm
+++ ebnf/parser-1.tm
@@ -34,18 +34,18 @@
     }
 ;# commands to define parsers:
     proc space {} {}    ;# default space is a noop
     proc space {} { ;# for RC we want a better space
         upvar 1 s s i i
-        incr i [string length {*}[regexp -inline -start $i {\s*} $s]]
+        incr i [string length [lindex [regexp -inline -start $i {\s*} $s] 0]]
         return
     }
     proc %space {re} {
         set re \\A(?:$re)
         tailcall proc space {} [format {
             upvar 1 s s i i
-            incr i [string length {*}[regexp -inline -start $i %s $s]]
+            incr i [string length [lindex [regexp -inline -start $i %s $s] 0]]
             return
         } [list $re]]
     }
 
     proc %token {name re {result "set 0"}} {

Index: go/README.md
==================================================================
--- go/README.md
+++ go/README.md
@@ -50,5 +50,14 @@
     proc waiton {args} { subscribe $args [info coroutine] }
     notify event
     delete event
 
 unrelated margin note: [yieldto _ [info coroutine]] ~= (call/cc)
+
+
+Further refinements might be had from examining:
+
+  http://jlongster.com/Taming-the-Asynchronous-Beast-with-CSP-in-JavaScript
+
+Note that his [go] returns a one-shot channel for the generator's final result.
+[take [timeout 100]] vs [sleep 100] is a tidy identity too.
+Sliding and Dropping channels are missing from securitykiss CSP and this implementation.

Index: hacks/Window-0.tm
==================================================================
--- hacks/Window-0.tm
+++ hacks/Window-0.tm
@@ -14,45 +14,103 @@
 # snit provides -default -verifier -configuremethod -cgetmethod
 # I think options belong in class definition, whilst this is (so far) object definition
 #
 # making classes out of these is going to be the kicker!
 #
-# Hierarchical bindtags a la bindtags(n) example looks interesting
+# Hierarchical bindtags (bubbling) a la bindtags(n) example looks interesting
+#
+# method upvar is indeed cool, but I've broken [my variable].
+#
+#  Do we want instead [myvariable] and [mymethod] ?  I think we do, because [variable] is a useful method name.
+#
+#
+# w container constructor ?...? {script}] can put things in a container
+# gridconfigure to hide things
+#
+# containers make visible hierarchies, which will be interesting
+#
+#
+# To make forms:
+#   * frames (also panes and tabs)
+#   * onchange and condition need a bit of work
+#   * collections are still a bit icky
+#
+# Some tidy up is due:
+#   * widget/varnames should be Upper Cased but the Tk name has to be .lOwer
+#   * options want to come from a metaclass.  But remember I want item options too.
+#   * a trace mixin would tidy thing some
+#
+# I almost want to make these namespace ensembles rather than objects
+#
+# TODO:
+#   * ttk-ify everything
+#     * panedwindow container
+#     * notebook container
+#   * tooltips!
+#   * some kind of options support
 #
+package require Tk
+package require snidgets
 
 package require pkg
 package require tests
-package require debug
+package require adebug
+#package require repl
 
-pkg -export * Window {
+package require tkImprover
+
+
+pkg -export {[A-Z]*} Window {
+
+    proc putl args {puts $args}
+
+    proc callback {args} {
+        tailcall namespace code $args
+    }
 
     proc windowcontext {} {}
 
     oo::class create Widget {
         variable w
         constructor {cmd args} {
-            set w [uplevel 1 windowcontext].[namespace tail [self object]]
-            $cmd $w {*}$args
+            namespace path [linsert [namespace path] end ::ttk]
+            # if the first argument is a window path, we adopt that window
+            # otherwise, it is a window constructor
+            if {[string match .* $cmd]} {
+                set w $cmd
+                $w configure {*}$args
+            } else {
+                set w [uplevel 1 windowcontext].[namespace tail [self object]]
+                $cmd $w {*}$args
+            }
+            # move the window into this object's namespace
             rename $w [namespace current]::$w
             namespace export $w
             namespace eval :: [list namespace import [namespace current]::$w]
-            proc windowcontext {} [list return $w]
+
+            # init vars
+            if {$w eq "."} {
+                proc windowcontext {} {return ""}
+            } else {
+                proc windowcontext {} [list return $w]
+            }
             set griddefaults {}
-            bind $w <Destroy> [list catch [my callback Reaper %W]]  ;# we still need to catch
+
+            bind $w <Destroy> [list catch [callback my Reaper %W]]  ;# we still need to catch
                                                                     ;# because tear-down order
-            self
+            return [self]
         }
+
         destructor {
             bind $w <Destroy> {}
             catch next
         }
 
-
         export varname  ;# this will be useful for consumers
-                        ;# as will this:
-        method callback {method args} {
-            namespace code [list my $method {*}$args]
+
+        method eval {script} {
+            try $script
         }
 
         method Reaper {W} {
             if {$W eq $w} {
                 debug log {[self] Dying on <Destroy>}
@@ -65,25 +123,34 @@
         method w {} {return $w}
         method widget {cmd name args} {
             Widget create $name $cmd {*}[my WidgetArgs $args]
             oo::objdefine [self] forward $name $name
             oo::objdefine [self] export $name
-            return $name
+            if {[info exists autolayout] && $autolayout ne ""} {
+                set largs [lassign $autolayout method]
+                my $method $name {*}$largs
+            }
+            return [namespace which $name]
         }
         method WidgetArgs {arglist} {
             set q 0
             lmap a $arglist {
                 if {$q} {
                     if {![string match ::* $a]} {
-                        debug assert {$a in [info object variables [self]]}
+                        if {[string match *(*) $a]} {   ;# unwrap array name
+                            set n [lindex [split $a (] 0]
+                        } else {
+                            set n $a
+                        }
+                        debug assert {$n in [info object variables [self]]}
                         set q 0
                         my varname $a
                     } else {
                         set a
                     }
                 } else {
-                    if {[string match -*variable $a]} {
+                    if {[string match -*variable $a] || [string match -*var $a]} {
                         set q 1
                     }
                     set a
                 }
             }
@@ -106,60 +173,139 @@
                 next    ;# destroy self, taking window with
             } else {
                 destroy {*}[my ItemArgs $args]
             }
         }
+
+        variable autolayout
+        method autolayout args {
+            multiargs {
+                {packer args} {
+                    my GM $packer [my GetIn $args]
+                    set autolayout [list $packer {*}$args]
+                }
+                {} {
+                    return $autolayout
+                }
+            }
+        }
 
         variable griddefaults
         method griddefaults args {
             set griddefaults $args
         }
         method packdefaults args {
             set griddefaults $args
         }
+
+        method GM args {
+            multiargs {
+                {} {
+                    list [self] [dict get $GM $w]
+                }
+                {packer container} {
+                    if {![string match .* $container]} {
+                        set container [$container w]
+                    }
+                    if {[info exists GM] && [dict exists $GM $container]} {
+                        set gm [dict get $GM $container]
+                        if {$gm ne $packer} {
+                            throw {GM CONFLICT} "Geometry manager is already $gm!"
+                        }
+                    }
+                    dict set GM $container $packer
+                }
+            }
+        }
+        method GetIn {opts} {
+            set idx [lsearch -exact $opts -in]
+            if {$idx == -1} {
+                return $w
+            } else {
+                lindex $opts $idx+1
+            }
+        }
 
         method grid {cmd args} {
-            if {$cmd in "anchor bbox location size propagate slaves configure rowconfigure columnconfigure"} {
+            my GM grid [my GetIn $args]
+            if {$cmd eq "anchor"} {
+                multiargs {
+                    {slave} {
+                        grid $cmd [my WinArg $slave]
+                    }
+                    {slave anchor} {
+                        grid $cmd [my WinArg $slave] $anchor
+                    }
+                }
+            } elseif {$cmd in "bbox location size propagate slaves configure rowconfigure columnconfigure forget"} {
+                putl grid $cmd $w {*}[my ItemArgs {*}$args]
                 grid $cmd $w {*}[my ItemArgs {*}$args]
             } else {
-                grid {*}[my GridArgs $cmd {*}$args] -in $w
+                grid {*}[my GridArgs $cmd {*}$args] ;#-in $w
             }
         }
         method pack {cmd args} {
-            if {$cmd in "propagate slaves"} {
+            my GM pack [my GetIn $args]
+            if {$cmd in "propagate slaves forget"} {
                 pack $cmd $w {*}[my ItemArgs {*}$args]
             } else {
-                pack {*}[my GridArgs $cmd {*}$args] -in $w
+                pack {*}[my GridArgs $cmd {*}$args] ;#-in $w
             }
         }
         method ItemArgs {args} {
-            set i 0
-            set args [lmap a $args {
-                if {[string match -* $a]} {
-                    incr i
-                }
-                expr {$i ? $a : [$a w]}
-            }]
+            set j [lsearch -glob $args -*]
+            if {$j == -1} {
+                set preargs $args
+                set opts {}
+            } else {
+                set preargs [lrange $args 0 [expr {$j-1}]]
+                set opts [lrange $args $j end]
+            }
+            puts "preargs = $preargs"
+            set preargs [lmap a $preargs {my WinArg $a}]
+            puts "postargs = $preargs"
+            if {[dict exists $opts -in]} {
+                dict set opts -in [my WinArg [dict get $opts -in]]
+            }
+            concat $preargs $opts
         }
         method GridArgs {args} {
-            set i 0
-            array set def $griddefaults
-            set args [lmap a $args {
-                if {[string match -* $a]} {
-                    unset -nocomplain def($a)
-                    incr i
-                }
-                expr {$i ? $a : [$a w]}
-            }]
-            concat $args [array get def]
-        }
-
-        method bind {event argspec body args} {
-            oo::objdefine [self] method $event [my BindArgs $argspec] $body
-            oo::objdefine [self] export $event
-            set cmdargs [my BindCmdArgs $argspec]
-            bind [my w] $event [list [self] $event {*}$cmdargs {*}$args]
+            set j [lsearch -glob $args -*]
+            if {$j == -1} {
+                set preargs $args
+                set opts {}
+            } else {
+                set preargs [lrange $args 0 [expr {$j-1}]]
+                set opts [lrange $args $j end]
+            }
+            set preargs [lmap a $preargs {my WinArg $a}]
+            set opts [dict merge $griddefaults $opts]
+            if {[dict exists $opts -in]} {
+                dict set opts -in [my WinArg [dict get $opts -in]]
+            }
+            concat $preargs $opts
+        }
+        method WinArg {w} {
+            if {[string match .* $w]} {
+                return $w
+            } else {
+                return [$w w]
+            }
+        }
+
+        method bind args {
+            multiargs {
+                {event script} {
+                    bind [my w] $event $script
+                }
+                {event argspec body args} {
+                    oo::objdefine [self] method $event [my BindArgs $argspec] $body
+                    oo::objdefine [self] export $event
+                    set cmdargs [my BindCmdArgs $argspec]
+                    bind [my w] $event [list [self] $event {*}$cmdargs {*}$args]
+                }
+            }
         }
         method BindArgs {argspec} {
             lmap a $argspec {
                 string trimleft $a %
             }
@@ -172,10 +318,48 @@
         }
 
         method bindtags args {
             tailcall bindtags [my w] {*}$args
         }
+
+        method dialog {args} {
+            if {[llength $args]%2} {
+                set args [linsert $args end-1 -message]
+            }
+            if {![dict exists $args -parent]} {
+                dict set args -parent [my w]
+            }
+            tk_messageBox {*}$args
+        }
+
+        method choosefile {args} {
+            if {[llength $args]%2} {
+                set args [linsert $args 0 -type]
+            }
+            if {![dict exists $args -type]} {
+                throw {TCL BADARGS} "Must specify -type!"
+            }
+            switch -exact $type {
+                "multi" {
+                    set cmd tk_getOpenFile
+                    dict set args -multiple yes
+                }
+                "open" {
+                    set cmd tk_getOpenFile
+                }
+                "save" {
+                    set cmd tk_getSaveFile
+                }
+                "dir" - "folder" {
+                    set cmd tk_chooseDirectory
+                }
+            }
+            if {![dict exists $args -parent]} {
+                dict set args -parent [my w]
+            }
+            $cmd {*}$args
+        }
 
         variable options
         method options {} {
             lsort -dictionary [concat [array values options] [$w configure]]
         }
@@ -190,12 +374,28 @@
             oo::objdefine [self] export $name
         }
         method variable args {
             oo::objdefine [self] variable {*}$args
         }
-        method get {name} {
-            set [my varname $name]
+
+        method upvar {name} {   ;# this wants more arguments, but their selection is subtle
+            oo::objdefine [self] variable $name
+            set upvar [uplevel 1 namespace current]::$name 
+            set myvar [my varname $name]
+            upvar 0 $upvar $myvar
+            return $myvar
+        }
+
+        method get args {
+            if {[llength $args] eq 1} {
+                set [my varname $name]
+            } elseif {$args eq ""} {
+                my getdict
+            } else {
+                throw {TCL WRONGARGS} [list [self class] get ?name?]
+            }
+
         }
         method set args {
             foreach {name val} $args {
                 set [my varname $name] $val
             }
@@ -206,21 +406,20 @@
             }
         }
 
         method unknown {args} {
             if {$args eq ""} {
-                return [my w]
+                return [self] ;#[my w]
             } else {
                 tailcall [my w] {*}$args
             }
         }
     }
 }
 
-if 1 {
-    package require Tk
 
+# used in the "notebook class" demo
     catch {rename After {}}
     oo::class create After {    ;# a mixin that cancels afters when the object is destroyed
         variable Afters
         method AfterCancel {id} {
             if {[info exists Afters($id)]} {
@@ -241,10 +440,20 @@
             }
             catch next    ;# eww .. but it's a mixin
         }
     }
 
+
+if 0 {  ;# shell
+    chan configure stdin -blocking 0
+    chan configure stdout -buffering none
+    coroutine repl repl::chan stdin stdout
+    puts vwaiting
+    vwait forever
+}
+
+if 0 {
     oo::class create Notebook {
         variable w
         constructor {} {
             set w [Widget win]
             w griddefauts -sticky nsew
@@ -264,79 +473,441 @@
         method remove {index} {
         }
         method move {id index} {
         }
     }
-
-    oo::class create Winspector {
-        superclass Widget
-        mixin After
-        constructor {} {
-            next toplevel
-#            proc windowcontext {} [list return [namespace tail [self]]]
-
-            #Widget create w toplevel
-            #oo::objdefine [self] forward w w
-            my variable name
-            my variable class
-            my variable bindtags
-            my widget label _name -textvariable name
-            my widget label _class -textvariable class
-            my widget label _bindtags -textvariable bindtags
-            my griddefaults -sticky nsew
-            my grid _name _class
-            my grid _bindtags -
-            #bind all <Enter> [namespace code {my Enter %W}]
-            my Refresh
-        }
-        method Refresh {} {
-            try {
-                set xy [winfo pointerxy .]
-                set name [winfo containing {*}$xy]
-                if {$name eq ""} return
-        #        if {[string match [[self]]* $name]} return
-                set class [winfo class $name]
-                set bindtags [bindtags $name]
-                my set xy $xy name $name class $class bindtags $bindtags
-            } finally {
-                my After refresh 300 {my Refresh}
-            }
-        }
-    }
-    Winspector create win
-
-}
-if 0 {
-    Widget create t toplevel
-    t widget entry e1
-    t widget button b1 -command {puts hello}
-    t griddefaults -sticky nsew
-    t grid e1
-    t grid b1   ;# -weight 1
-    t grid [t widget button b2 -text okde]
-    t grid rowconfigure b1 -weight 1
-    t e1 insert end "lalala"
-    t configure b1 -text "Press me"
-    t bind <1> {%W %x %y a} {           ;# implicitly creates a method on the object ..
-        puts "$W $x $y: $ack ($a)"      ;# that can resolve object variables!
-    } five                              ;# remember: % args must come first!
-    t variable ack
-    t configure e1 -textvariable ack    ;# ack is resolved in t's scope!
-}
-
-if 0 {
-    package require repl
-    chan configure stdin -blocking 0
-    chan configure stdout -buffering none
-    coroutine repl repl::chan stdin stdout
-    puts vwaiting
-    vwait forever
-}
-
-if 0 {
-
-    Window create notebook toplevel
-    notebook widget tabs frame
-    notebook widget main frame
-    set tabs [notebook tabs]
-}
-
+}
+
+
+set demos {
+    "winspector" {
+        oo::class create Winspector {
+            superclass Widget
+            mixin After
+            constructor {} {
+                next toplevel
+    #            proc windowcontext {} [list return [namespace tail [self]]]
+
+                #Widget create w toplevel
+                #oo::objdefine [self] forward w w
+                my variable name
+                my variable class
+                my variable bindtags
+                my widget label _name -textvariable name
+                my widget label _class -textvariable class
+                my widget label _bindtags -textvariable bindtags
+                my griddefaults -sticky nsew
+                my grid _name _class
+                my grid _bindtags -
+                #bind all <Enter> [namespace code {my Enter %W}]
+                my Refresh
+            }
+            method Refresh {} {
+                try {
+                    set xy [winfo pointerxy .]
+                    set name [winfo containing {*}$xy]
+                    if {$name eq ""} return
+            #        if {[string match [[self]]* $name]} return
+                    set class [winfo class $name]
+                    set bindtags [bindtags $name]
+                    my set xy $xy name $name class $class bindtags $bindtags
+                } finally {
+                    my After refresh 300 {my Refresh}
+                }
+            }
+        }
+        Winspector create win
+    }
+    "tabs" {
+        Widget create notebook toplevel
+        notebook widget frame tabs
+        notebook widget frame main
+        set tabs [notebook tabs]
+    }
+
+    "basic multi-function Tk example" {
+        Widget create t toplevel
+        t widget entry e1
+        t widget button b1 -command {puts hello}
+        t griddefaults -sticky nsew
+        t grid e1
+        t grid b1   ;# -weight 1
+        t grid [t widget button b2 -text okde]
+        t grid rowconfigure b1 -weight 1
+        t e1 insert end "lalala"
+        t configure b1 -text "Press me"
+        t bind <1> {%W %x %y a} {           ;# implicitly creates a method on the object ..
+            puts "$W $x $y: $ack ($a)"      ;# that can resolve object variables!
+        } five                              ;# remember: % args must come first!
+        t variable ack
+        t configure e1 -textvariable ack    ;# ack is resolved in t's scope!
+    }
+
+    "container widgets" {
+        Widget create t toplevel
+        t widget ttk::labelframe one -text "First set"
+        t widget entry e1
+        t widget checkbutton cb1 -text "Really?"
+        t widget ttk::labelframe two -text "Next set"
+        t widget entry e2
+        t widget checkbutton cb2 -text "are you sure?"
+        t grid one
+        t grid two
+        puts [t e1]
+        t one grid [t e1]
+        t one grid [t cb1]
+        t two grid [t e2]
+        t two grid [t cb2]
+    }
+
+
+    "choiceform with method upvar" {
+        oo::class create ChoiceForm {
+            variable choices
+            constructor {dict} {
+                Widget create w toplevel
+                w upvar choices         ;# shares this variable with the Widget
+                dict for {k v} $dict {
+                    set b b[incr i]
+                    w widget checkbutton $b -text $k -variable choices($v)
+                    w grid $b -
+                }
+                w widget button invert -command [namespace code {my Invert}] -text "Invert selections"
+                w widget button print -command [namespace code {my Print}] -text "Print values"
+                w grid invert print
+            }
+            method Invert {} {
+                dict for {k v} [array get choices] {
+                    set choices($k) [expr {!$v}]
+                }
+            }
+            method Print {} {
+                parray choices
+            }
+        }
+        ChoiceForm create c {"One fine day" tomorrow "Never comes" around "There once was a" "little blue pony"}
+    }
+
+    "a basic form" {
+        oo::class create ::FormWidget {
+            superclass Widget
+
+            variable OnChange
+            variable Conditions
+
+            constructor args {
+                namespace path [linsert [namespace path] end ::ttk]
+                set OnChange {}
+                set Conditions {}
+                next {*}$args
+            }
+
+            method onchange {varname script} {
+                my SetTrace $varname
+                variable OnChange
+                dict set OnChange $varname $script
+            }
+            method condition {w option expr args} {
+                my SetTrace {}  ;# hack?
+                variable Conditions
+                multiargs {
+                    {}              { set true true; set false false }
+                    {true}          { set false "" }
+                    {true false}    {  }
+                }
+                dict set Conditions $expr [list w $w option $option expr $expr true $true false $false]
+            }
+
+            method SetTrace {varname} {
+                trace remove variable [my varname $varname] write "[callback my HandleTrace $varname]; --"
+                trace remove variable [my varname $varname] unset "[callback my SetTrace $varname]; --"
+                trace add variable [my varname $varname] write "[callback my HandleTrace $varname]; --"
+                trace add variable [my varname $varname] unset "[callback my SetTrace $varname]; --"
+            }
+
+            method HandleTrace {varname} {
+                variable Triggers
+                dict incr Triggers $varname
+                after 0 [list after idle [callback my Trigger]]
+            }
+            method Trigger {} {
+                variable Triggers
+                variable OnChange
+                variable Conditions
+                if {![info exists Triggers]} return
+                foreach varname [dict keys $Triggers] {
+                    if {[dict exists $OnChange $varname]} {
+                        my Apply [dict get $OnChange $varname]
+                    }
+                    dict unset Triggers $varname
+                }
+                my update
+            }
+            method update {} {
+                dict for {expr cond} $Conditions {
+                    dict with cond {}
+                    set new [expr {[my Apply expr $expr] ? $true : $false}]
+                    set old [$w cget $option]
+                    if {$new ne $old} {
+                        my configure $w $option $new
+                    }
+                }
+            }
+            method Apply {cmd args} {
+                variable {}
+                try [concat $cmd $args]
+            }
+
+        }
+
+
+        oo::class create ::FormBase {
+
+            variable {} ;# the form
+
+            constructor {args} {
+                namespace path [linsert [namespace path] end ::ttk]
+                proc windowcontext {} {}        ;# FIXME: this is a dirty hack
+                FormWidget create w {*}$args    ;# FIXME: use args better than just for this
+                #array set {} {}
+                w upvar {}
+                w method frame {name args} {
+                    if {[llength $args] % 2} {
+                        set script [lindex $args end]
+                        set args [lreplace $args end end]
+                    } else {
+                        set script ""
+                    }
+                    if {[dict exists $args -text] || [dict exists $args -labelwidget]} {
+                        set win [my widget ::ttk::labelframe $name {*}$args]
+                    } else {
+                        set win [my widget ::ttk::frame $name {*}$args]
+                    }
+                    set win [$name w]
+
+                    if {$script ne ""} {
+                        set al [my autolayout]
+                        my autolayout {*}$al -in $win
+                        try {
+                            my eval $script
+                        } finally [callback my autolayout {*}$al]
+                    }
+                }
+
+                my Construct
+
+                w bind <<Submit>> [callback my Submit]
+                w bind <<Cancel>> [callback my Cancel]
+                w update
+                my Defaults
+            }
+
+            forward dialog w dialog
+
+            method buttons {script} {
+                w frame buttons
+                set w [w buttons w]
+                set al [w autolayout]
+                puts "Autolayout was: $al"
+                w autolayout pack -in $w -side left -expand yes -fill x
+                puts "Autolayout is: [w autolayout]"
+                try {
+                    my eval $script
+                } finally [callback w autolayout {*}$al]
+            }
+
+            method button {text args} {
+                set name b$text
+                if {![dict exists $args -command]} {
+                    if {$text in [info object methods [self] -all -private]} {
+                        dict set args -command [callback my $text]
+                    } else {
+                        dict set args -command [callback my Return $text]
+                    }
+                }
+                w widget button $name -text $text {*}$args
+            }
+
+            method Defaults {} {
+                variable Defaults
+                set Defaults [array get {}]
+            }
+
+            method changed? {} {
+                variable Defaults
+                dict for {k v} $Defaults {
+                    if {$v ne $($k)} {
+                        return true
+                    }
+                }
+                return false
+            }
+
+            method Cancel {} {
+                if {![my changed?] || [my ConfirmCancel]} {
+                    my Return ""
+                }
+            }
+
+            method Submit {} {
+                if {![my Validate]} {
+                    # highlight errors
+                    my dialog -type okay -message "Please complete the form before pressing Okay"
+                    return
+                }
+                my Return [my get]
+            }
+
+
+            method ConfirmCancel {} {
+                my dialog -type yesno -message "Really cancel?"
+            }
+
+            method Validate {} {
+                return true
+            }
+            
+            method wait {} {    ;# wait is to be called in a coroutine
+                my ReturnTo  [info coroutine]
+                return [yield]
+            }
+
+            method get {} {
+                array get {}
+            }
+
+            method ReturnTo {args} {
+                variable ReturnTo
+                set ReturnTo $args
+            }
+
+            method Return {what} {
+                variable ReturnTo
+                # after idle?
+                tailcall {*}$ReturnTo $what
+            }
+        }
+
+        oo::class create ::FormClass {
+            superclass oo::class
+            self method create {name script} {
+                set script "superclass ::FormBase; variable {}; $script"
+                next $name $script
+            }
+
+            method run {{w toplevel} args} {
+                set i [my new $w {*}$args]
+                try {
+                    $i wait
+                } finally {
+                    $i destroy
+                }
+            }
+        }
+
+        FormClass create Inliner {
+
+            method Construct {} {
+                w autolayout grid -sticky nsew
+                w frame wrapper -padding 10 
+                w grid anchor wrapper center
+                w autolayout grid -sticky nsew -in [w wrapper w]
+                w eval {
+                    my widget FilesChooser   files   -listvariable (files) -text "Choose HTML file"   -multiple yes
+                    my frame selections -text " Selections: " {
+                        # the -variable args work because of [w upvar ""] in the constructor
+                        my widget checkbutton    do_toc  -variable (do_toc)    -text "Generate ToC"
+                        my widget checkbutton    do_js   -variable (do_js)     -text "Inline JS"
+                        my widget checkbutton    do_css  -variable (do_css)    -text "Inline CSS"
+                        my widget checkbutton    do_img  -variable (do_img)    -text "Inline images"
+                    }
+                }
+
+                w onchange (do_js) {puts lalala:\$(do_js)}
+                w condition do_js -state {$(do_toc)} normal disabled
+                #w condition selections 
+
+                set (do_toc) 0
+                set (do_js)  1
+                set (do_css) 1
+                set (do_img) 1
+
+                w autolayout grid -sticky nsew
+                my buttons {
+                    my button "Cancel"
+                    my button "Show"
+                    my button Submit -text "Okay"    -default active
+                }
+            }
+
+            method Show {} {
+                my dialog "[array get {}]"
+            }
+
+
+        }
+
+        coroutine main {*}[namespace code {
+            set d [Inliner run toplevel]
+            if {$d eq ""} {
+                puts "Form cancelled!"
+            } else {
+                puts "Form submitted!"
+                pdict $d
+            }
+        }]
+
+        catch {
+            source [file normalize [info script]/../../modules/inspect-0.tcl]
+            puts "== inspecting Inliner =="
+            pdict [inspect Inliner]
+            puts ""
+        }
+    }
+}
+
+# run demos
+
+proc restart {} {
+    try {
+        set cmd [info_cmdline]
+    } on error {} {
+        set cmd [list [info nameofexe] $::argv0 {*}$::argv]
+    }
+    puts "Executing: $cmd"
+    exec {*}$cmd &
+    exit
+}
+
+proc run_demo {key} {
+    set script [dict get $::demos $key]
+    catch {namespace delete ::demo}
+    namespace eval ::demo {}
+    apply [list {} $script ::demo]
+}
+
+if 1 {
+    package require tkcon
+    tkcon show
+}
+
+if {$::argv eq ""} {
+    Widget create main .    ;# adopt the root window
+    main griddefaults -sticky nsew
+    set i 0
+    dict for {label script} $demos {
+        main widget button b[incr i] -text $label -command [list run_demo $label]
+        main grid b$i
+    }
+    main grid [main widget button bRestart -text "Restart" -command restart]
+    main grid [main widget button bQuit -text "Quit" -command exit]
+} else {
+    coroutine main apply {{} {
+        foreach a $::argv {
+            foreach k [dict keys $::demos $a] {
+                puts "** running demo: \"$a\""
+                run_demo $a
+                yieldto after 1000 [info coroutine]
+            }
+        }
+    }}
+}

ADDED   hacks/aes-test.tcl
Index: hacks/aes-test.tcl
==================================================================
--- /dev/null
+++ hacks/aes-test.tcl
@@ -0,0 +1,97 @@
+#!/bin/sh
+#
+# AES sampler
+#
+package require aes
+
+proc randbytes {n} {
+    set r {}
+    while {$n > 0} {
+        lappend r [expr {int(rand()*256)}]
+        incr n -1
+    }
+    binary format c* $r
+}
+
+# PKCS-style padding
+proc pad {data {mul 16}} {
+    set len [string length $data]
+    set n [expr {$mul - ($len % $mul)}]
+    append data [binary format c* [lrepeat $n $n]]
+}
+
+proc unpad {data {mul 16}} {
+    binary scan [string index $data end] c n
+    set pad [string replace $data 0 end-$n]
+    set expect [binary format c* [lrepeat $n $n]]
+    if {$pad ne $expect} {
+        error "Bad padding! [list [binary encode hex $pad] != [binary encode hex $expect]]"
+    }
+    string range $data 0 end-$n
+}
+
+proc encrypt {key data} {
+    set fd [file tempfile fn]
+    try {
+        chan configure $fd -translation binary
+        aes::aes -mode cbc -dir encrypt -key $key -out $fd [pad $data]
+        return $fn
+    } finally {
+        close $fd
+    }
+}
+
+proc decrypt {key filename} {
+    set fd [open $filename r]
+    try {
+        chan configure $fd -translation binary
+        unpad [aes::aes -mode cbc -dir decrypt -key $key -in $fd]
+    } finally {
+        close $fd
+    }
+}
+
+proc readbinary {filename} {
+    set fd [open $filename r]
+    try {
+        chan configure $fd -translation binary
+        read $fd
+    } finally {
+        close $fd
+    }
+}
+
+namespace eval main {
+    proc enc {key filename} {
+        puts -nonewline [encrypt [binary decode base64 $key] [readbinary $filename]]
+    }
+    proc dec {key filename} {
+        puts -nonewline [decrypt [binary decode base64 $key] $filename]
+    }
+
+    proc test {filename} {
+        puts "Generating key"
+        set key [randbytes 32]
+        puts "Reading file"
+        set data [readbinary $filename]
+        puts "Encrypting"
+        set file [encrypt $key $data]
+        puts "Decrypting"
+        set data2 [decrypt $key $file]
+        puts "Encrypted file: $file"
+        puts "Key (base64): [binary encode base64 $key]"
+        puts --
+        puts -nonewline "Verifying: "
+        if {$data eq $data2} {
+            puts "OK!"
+        } else {
+            puts "Error!"
+            puts "data = [binary encode hex $data]"
+            puts "data2 = [binary encode hex $data2]"
+        }
+    }
+    namespace export *
+    namespace ensemble create
+}
+
+main {*}$argv

ADDED   hacks/configtcl.tcl
Index: hacks/configtcl.tcl
==================================================================
--- /dev/null
+++ hacks/configtcl.tcl
@@ -0,0 +1,80 @@
+# tclconfig is configuration for tcl; configtcl is tcl for configuration!
+#
+# mini config script with a slave interp, for https://pastebin.mozilla.org/8883694
+#
+# If terminals were dicts with a key of {} (or lists of length 1), the config
+# could be pretty-printed quite easily.
+
+proc loadconf {filename} {
+    set cint [interp create -safe]
+    foreach cmd [$cint eval {info commands}] {
+        # you can expose commands if you like:
+        if {$cmd ni "foreach if"} {
+            $cint hide $cmd
+        }
+    }
+    # I like to expose [source] as [Include]:
+    interp alias $cint Include {} interp invokehidden $cint source
+    # give unknown handler a funny name so it doesn't collide:
+    interp alias $cint #unknown {} cunk $cint
+    interp invokehidden $cint namespace unknown #unknown
+    # expose these for the lambda:
+    foreach cmd {try set} {
+        if {$cmd in [interp hidden $cint]} {
+            interp alias $cint #$cmd {} interp invokehidden $cint $cmd
+        } else {
+            interp alias $cint #$cmd $cint $cmd
+        }
+    }
+    interp invokehidden $cint set Config {}
+    try {
+        interp invokehidden $cint source $filename
+    } on error {e o} {
+        puts "Config error: $e"
+    } finally {
+        interp delete $cint
+    }
+}
+
+proc readfile {filename} {
+    try {
+        set fd [open $filename r]
+        read $fd
+    } finally {
+        close $fd
+    }
+}
+
+proc cunk {cint args} {
+    switch [llength $args] {
+        1   {
+            cerror $cint "Expected value for \"$args\""
+        }
+        2 {
+            lassign $args key value
+            set keys [list $key]
+        }
+        3 {
+            lassign $args key1 key2 value
+            set keys [list $key1 $key2]
+        }
+        default {
+            cerror $cint "Too many arguments for [lindex $args 0]"
+        }
+    }
+    if {[dict exists [interp invokehidden $cint set Config] {*}$keys]} {
+        cerror $cint "Redefinition of $keys"
+    }
+    if {[string match \n* $value]} {
+        set value [interp invokehidden $cint apply [list {{Config {}}} [list #try $value on ok {} {\#set Config}]]]
+    }
+    interp invokehidden $cint dict set Config {*}$keys $value
+}
+
+proc cerror {cint msg} {
+    set ctx [interp invokehidden $cint info frame 0]
+    set ctx "[dict get $ctx file]:[dict get $ctx line]"
+    interp invokehidden $cint return -code error "$msg!\n  at $ctx"
+}
+
+puts [loadconf test.conf]

ADDED   hacks/core-widgets.tcl
Index: hacks/core-widgets.tcl
==================================================================
--- /dev/null
+++ hacks/core-widgets.tcl
@@ -0,0 +1,75 @@
+# first, ensure the package autoload commands are all initialised:
+catch {package require nonexistent}
+
+# get all the toplevel commands
+set before [info commands ::*]
+
+# load Tk
+package require Tk
+wm withdraw .
+
+# see what commands exist now
+set after [info commands ::*]
+
+set commands [lmap c $after {
+    expr {$c in $before ? [continue] : $c}
+}]
+
+proc is_widget {c} {
+    try {
+        info args $c
+    } on ok {} {
+        return false    ;# it's a proc, not a widget
+    } on error {} {
+        ;# it might be a widget!  Carry on ..
+    }
+    try {
+        $c
+    } trap {TCL WRONGARGS} {e o} {
+        if {[string match "wrong # args: should be \"$c pathName ?-option value ...?\"" $e]} {
+            return true         ;# it's a widget!
+        } else {
+            puts stderr "Probably not $c"
+        }
+    } trap { * } {} {
+        ;# any other error - not a widget
+    } on ok {} {
+        ;# no error - oops!
+        puts stderr "Sorry!  Shouldn't have run $c"
+    }
+    return false
+}
+
+set widgets [lmap c $commands {
+    expr {[is_widget $c] ? $c : [continue]}
+}]
+
+
+# now try Ttk:
+package require Ttk
+set commands [info commands ::ttk::*]
+
+lappend widgets {*}[lmap c $commands {
+    expr {[is_widget $c] ? $c : [continue]}
+}]
+
+puts "** Widgets **"
+puts [join [lsort $widgets] \n]
+
+# now inspect their runtime state:
+foreach w $widgets {
+    destroy .test
+    $w .test
+    set class($w) [winfo class .test]
+    set opts [.test configure]
+    set opts [lmap o $opts {
+        expr {[llength $o] == 2 ? [continue] : [lindex $o 0]}   ;# skip aliases
+    }]
+    set opts [lsort -dictionary $opts]
+    set options($w) $opts
+}
+parray class
+#parray options
+#
+
+exit

ADDED   hacks/cuppa/billy.tcl
Index: hacks/cuppa/billy.tcl
==================================================================
--- /dev/null
+++ hacks/cuppa/billy.tcl
@@ -0,0 +1,75 @@
+::tcl::tm::path add [pwd]
+package require db
+
+namespace eval billy {
+
+    db::reset {
+        db eval {
+            drop if exists table packages;
+        }
+    }
+    db::setup {
+        if {[db::exists packages]} return
+        puts "Setting up billy"
+        db eval {
+            create table if not exists packages (
+                name text,
+                ver text collate vcompare,
+                arch text,
+                filedata blob,
+                primary key (name, ver, arch)
+            );
+        }
+    }
+
+    proc add_tms {path} {
+        set re {([_[:alpha:]][:_[:alnum:]]*)-([[:digit:]].*)\.tm}
+        foreach file [glob -tails -dir $path *.tm] {
+            if {[regexp $re $file -> pkg ver]} {
+                set fd [open [file join $path $file] r]
+                fconfigure $fd -encoding binary -translation binary
+                set filedata [read $fd]
+                close $fd
+                db eval {
+                    insert into packages (name, ver, arch, filedata)
+                    values (:pkg, :ver, 'tcl', @filedata);
+                }
+            }
+        }
+    }
+
+    proc gen_tpm {} {
+        set result {}
+        db eval {
+            select name, ver, arch from packages
+        } {
+            lappend result [list package $name $ver $arch 0]
+        }
+        return $result
+    }
+
+    proc serve {req} {
+        if {[regexp {^/package/list/?$} $req]} {
+            set tpm [gen_tpm]
+            return [subst -noc {<!--[[TPM[[$tpm]]MPT]] -->}]
+        }
+        if {[regexp {^/package/name/(.*)/ver/(.*)/arch/(.*)/file$} $req -> name ver arch]} {
+            db eval {
+                select filedata from packages where
+                    name = :name and ver = :ver and arch = :arch
+                ;
+            } {
+                return $filedata
+            }
+        }
+    }
+
+    proc test {args} {
+        ::db::init billy.db
+        add_tms {*}$args
+        puts [serve /package/name/mainscript/ver/1/arch/tcl/file]
+        puts [serve /package/list]
+    }
+}
+
+billy::test {*}$argv

ADDED   hacks/cuppa/cuppa.tcl
Index: hacks/cuppa/cuppa.tcl
==================================================================
--- /dev/null
+++ hacks/cuppa/cuppa.tcl
@@ -0,0 +1,286 @@
+package require sqlite3
+package require geturl
+package require vfs::zip
+::tcl::tm::path add [pwd]
+package require db
+package require lib
+
+package require platform
+
+namespace eval cuppa {
+
+    variable map_os {
+        tcl         %
+        linux-%     linux
+        win32       windows
+        solaris%    {solaris sunos}
+        freebsd     freebsd_%
+        irix        irix_%
+        macosx%     darwin
+    }
+    variable map_cpu {
+        ix86        {x86 intel i_86 i86pc}
+        sparc       sun4%
+        sparc64     {sun4u sun4v}
+        universal   %
+        ""          %
+        powerpc     ppc
+    }
+
+    db::reset {
+        db eval {
+            drop table if exists servers;
+            drop table if exists packages;
+            drop table if exists map_os;
+            drop table if exists map_cpu;
+        }
+    }
+    db::setup {
+        if {[db::exists servers]} return
+        log::info {setting up cuppa}
+        db eval {
+            create table if not exists servers (
+                server text not null, uri text not null,
+                last_checked integer default 0,
+                pri integer default 100,
+                primary key (server),
+                unique (uri)
+            );
+            insert or replace
+                into servers (pri, server,    uri)
+                values  ( 1, 'activestate',  'http://teapot.activestate.com'
+                ),      ( 2, 'rkeene',       'http://teapot.rkeene.org'
+                );
+            create table if not exists packages (
+                name    text,
+                ver     text collate vcompare,
+                arch    text, os text, cpu text,
+                server  text,
+                pkgurl  text,
+                primary key (name, ver, arch, os, cpu, server),
+                foreign key (server) references servers (server)
+            );
+
+            create table if not exists map_os ( teapot text, local text );
+            create table if not exists map_cpu ( teapot text, local text );
+        }
+        init_maps
+    }
+
+    proc init_maps {} {
+        puts "setting up CPU/OS mappings"
+
+        variable map_os
+        variable map_cpu
+
+        db eval {delete from map_os; delete from map_cpu;}
+
+        foreach {teapot local} $map_os {
+            foreach t $teapot {
+                foreach l $local {
+                    db eval {
+                        insert into map_os (teapot, local) values (:t, :l)
+                    }
+                }
+            }
+        }
+
+        foreach {teapot local} $map_cpu {
+            foreach t $teapot {
+                foreach l $local {
+                    db eval {
+                        insert into map_cpu (teapot, local) values (:t, :l)
+                    }
+                }
+            }
+        }
+    }
+
+    proc join_url {args} {
+        set url [join $args /\0/]
+        regsub -all {/*\0/*} $url / url
+        return $url
+    }
+
+    proc server_uri {server args} {
+        db eval {select uri from servers where server = :server} {
+            return [join_uri $uri {*}$args]
+        }
+    }
+    proc update_cache {{limit 604800}} {
+        set now [clock seconds]
+        set last [expr {[clock seconds]-$limit}]
+        log::info {updating servers since $last}
+        db eval {select server, uri, last_checked from servers where last_checked < :last} {
+            set when [clock format $last_checked]
+            log::info {Updating cache for $server (last: $when)}
+            cache_server $server $uri
+        }
+    }
+
+    proc cache_server {server uri} {
+        set data [geturl [join_url $uri /package/list]]
+        set now [clock seconds]
+        if { ![regexp {\[\[TPM\[\[(.*)\]\]MPT\]\]} $data -> data]} {
+            throw {CUPPA BADTPM} "No TPM data at $uri"
+        }
+        if {  [catch {llength $data}] } {
+            throw {CUPPA BADTPM} "TPM data not a list at $uri"
+        }
+        db eval {
+            delete from packages where server = :server
+        }
+        foreach record $data {
+            lassign $record type pkg ver arch
+            if {$type ne "package"} continue
+            if {$arch eq "source"}  continue
+            regexp {^(.*)(?:-(.*))?$} $arch -> os cpu
+            try {
+                package vsatisfies $ver 0-
+            } on error {e o} {
+                log::warn {Bad version: ignoring! $pkg $ver @ $server}
+                continue
+            }
+            set pkgurl [join_url $uri package name $pkg ver $ver arch $arch file]
+            db eval {
+                insert or replace
+                into packages (name, ver, arch, os, cpu, server, pkgurl)
+                values (:pkg, :ver, :arch, :os, :cpu, :server, :pkgurl);
+            }
+        }
+        db eval {
+            update servers set last_checked = :now where server = :server;
+        }
+    }
+
+    db::qproc Find {
+        name %  ver 0-  arch %  os %  cpu %
+    } {
+            with t as (
+                select distinct name, ver, arch, os, cpu, server, pkgurl, pri
+                from packages
+                 inner join servers using (server)
+                   -- inner join map_cpu on ( cpu like teapot and :cpu like local )
+                where name like :name
+                  and vsatisfies(ver, :ver)
+                  and (cpu like :cpu
+                    or exists (select * from map_cpu where cpu like teapot and :cpu like local))
+                  and (os like :os
+                    or exists (select * from map_os  where os  like teapot and :os  like local))
+            )
+            select * from t
+            -- where ver = (select max(ver) from t)
+            order by ver desc, pri;
+    }
+
+    proc find {args} {
+        Find {pkgurl} $args {
+            puts "Found at $pkgurl"
+        }
+    }
+
+    proc platform {} {
+        split [platform::generic] -
+    }
+
+    proc download {path uri} {
+        set data [geturl $uri]
+        set fd [open $path w]
+        fconfigure $fd -encoding binary
+        puts -nonewline $fd $data[unset data]
+        close $fd
+        puts "Wrote $path"
+    }
+
+    proc check_exists {dir name ver} {
+        foreach cmd [info commands [namespace current]::Path:*] {
+            set path [$cmd $dir $name $ver]
+            if {[file exists $path]} {return $path}
+        }
+    }
+
+    proc Path:dl {dir name ver} {
+        set name [string trimleft $name ::]
+        file join $dir [string map {:: _ _ __} "$name-$ver.zip"]
+    }
+    proc Path:tm {dir name ver} {
+        set name [string trimleft $name ::]
+        file join $dir [string map {:: /} "$name-$ver.tm"]
+    }
+    proc Path:dir {dir name ver} {
+        set name [string trimleft $name ::]
+        file join $dir [string map {:: _ _ __} "$name-$ver"]
+    }
+
+    proc install {dir pkg args} {
+        lassign [platform] os cpu
+        lib::dictargs args {
+            os  $os
+            cpu $cpu
+            ver 0-
+        }
+        if {$os eq "tcl"} {
+            set cpu %
+        }
+        Find {name ver uri} {name $pkg ver $ver os $os cpu $cpu} {
+            set loc [check_exists $dir $name $ver]
+            if {$loc ne ""} {
+                throw [list CUPPA EXISTS $loc] "Package (maybe?) exists at \"$loc\""
+            }
+            set path [Path:dl $dir $name $ver]
+            puts "Trying $uri -> $path"
+            try {
+                download $path $uri
+            } on error {e o} {
+                puts "geturl $uri -- $e"
+                continue
+            } on ok {} {
+                break
+            }
+        }
+        if {![info exists path]} {
+            throw {CUPPA NOTFOUND} "No candidate $pkg for $os-$cpu"
+        }
+        if {![file exists $path]} {
+            throw {CUPPA ERROR} "Failed to install $path"
+        }
+        try {
+            set vfsd [vfs::zip::Mount $path $path]
+        } on error {} {
+            set dest [Path:tm $dir $name $ver]
+            file rename $path $dest
+            set path $dest
+            puts "$path is a tcl module: finished!"
+            return $path
+        }
+        try {
+            set dest [file rootname $path]
+            if {[file exists $dest]} {
+                error "Destination path exists: [list $dest]"
+            }
+            set dest [Path:dir $dir $name $ver]
+            file copy $path $dest
+        } finally {
+            vfs::zip::Unmount $vfsd $path
+        }
+        file delete $path
+        set path $dest
+        puts "$path is a tcl package: finished"
+        return $path
+    }
+
+    namespace ensemble create -map {
+        update  update_cache
+        check   check_exists
+        find    find
+        install install
+    }
+
+}
+
+
+#::cuppa::main {*}$argv
+lib::main args {
+    db::init cuppa.db
+    puts [cuppa {*}$args]
+}

ADDED   hacks/cuppa/db-0.tm
Index: hacks/cuppa/db-0.tm
==================================================================
--- /dev/null
+++ hacks/cuppa/db-0.tm
@@ -0,0 +1,119 @@
+package require sqlite3
+package require log 0
+
+namespace eval db {
+    namespace export *
+
+    proc db {args} { init; tailcall db {*}$args }
+
+    proc glob {s} {
+        string map {* % ? _} $s
+    }
+    proc qn {s} {
+        return \"[string map {\" ""} $s]\"
+    }
+    proc qs {s} {
+        return '[string map {' ''} $s]'
+    }
+
+    # decodes a list like {a b:bee c}
+    # into "a as a, b as bee, c as c"
+    proc sargs {fields} {
+        join [lmap f $fields {
+            lassign [split $f :] name alias
+            if {$alias eq ""} {
+                string cat "[qn $name]"
+            } else {
+                string cat "[qn $name] as [qn $alias]"
+            }
+        }] ,
+    }
+    proc vargs {fields} {
+        lmap f $fields {regsub {^.*:} $f {}}
+    }
+
+    # declare an sql-backed procedure
+    # a qproc takes arguments: fields where ??varName? script?
+    #  - fields is a list of names to select, or name:alias to project [sarg]/[farg]
+    #  - where is a [lib::subl] dict of parameters to the query
+    # additional args are like the ??row? script? args to sqlite
+    proc qproc {name defaults sqlquery} {
+        set name [lib::upns 1 $name]
+
+        dict set map @SQL   [list $sqlquery]
+        dict set map @DEF   [list $defaults]
+
+        set args {fields where args}
+        set body [string map $map {
+            set _FIELDS [db::sargs $fields]
+            set _VARS   [db::vargs $fields]
+            set _SQL    [string map [list * $_FIELDS] @SQL]
+            set _ARGS   [lib::updo lib::lsub $where]
+            lib::dictargs _ARGS @DEF
+            lib::dictable $_VARS [db eval $_SQL {*}$args]
+        }]
+        proc $name $args $body
+    }
+
+    proc init {{filename ""}} {
+        if {[running]} {
+            return
+        }
+        log::info {$filename}
+        sqlite3 [namespace current]::db $filename
+        db collate  vcompare    {package vcompare}
+        db function vsatisfies  {package vsatisfies}
+        Setup
+    }
+
+    proc stat {} {
+        if {![running]} {
+            puts "not running"
+            return
+        }
+        db eval {select name from sqlite_master where type = 'table'} {
+            db eval "select count(1) count from [qn $name]" {
+                puts "$name: $count records"
+            }
+        }
+    }
+
+    proc tables {{pattern}} {
+        db eval {select name from sqlite_master where type = 'table' and name like :pattern}
+    }
+
+    proc exists {table} {
+        db exists {select 1 from sqlite_master where type = 'table' and name = :table}
+    }
+
+    proc running {} {
+        expr {[info procs [namespace current]::db] eq {}}
+    }
+
+    variable Setup_scripts {}
+    proc Setup {} {
+        variable Setup_scripts
+        foreach {namespace script} $Setup_scripts {
+            log::info {setup $namespace}
+            apply [list {} $script $namespace]
+        }
+    }
+    proc setup {script} {
+        variable Setup_scripts
+        set ns [uplevel 1 {namespace current}]
+        dict set Setup_scripts $ns $script              ;# register a setup script
+        if {[running]} {
+            log::info {late setup $namespace}
+            apply [list {} $script $ns]                 ;# apply immediately
+        }
+        tailcall namespace import [namespace which db]  ;# make db accessible
+    }
+
+    variable Reset_scripts
+    proc reset script {
+        variable Reset_scripts
+        set ns [uplevel 1 {namespace current}]
+        dict set Reset_scripts $ns $script
+    }
+
+}

ADDED   hacks/cuppa/leaves.tcl
Index: hacks/cuppa/leaves.tcl
==================================================================
--- /dev/null
+++ hacks/cuppa/leaves.tcl
@@ -0,0 +1,347 @@
+# leaves reads teapot descriptions
+#
+# SYNOPSIS:
+#
+#  $ leaves.tcl scan lib/
+#  $ leaves.tcl find path lib/%
+#  $ leaves.tcl deps lib/snit-2.3.2
+#
+::tcl::tm::path add [pwd]
+package require db
+package require lib
+package require vfs::mk4
+package require vfs::tar
+package require vfs::zip
+
+namespace eval leaves {
+    db::reset {
+        db eval {
+            drop table if exists teapkgs;
+            drop table if exists teameta;
+        }
+    }
+    db::setup {
+        if {[db::exists teapkgs]} return
+        puts "Setting up leaves"
+        db eval {
+            create table if not exists teapkgs (
+                name text,
+                ver text collate vcompare,
+                arch text,
+                path text,
+                primary key (path),
+                -- index teapkgs_i_nvp (name, ver, arch),
+                unique (path)
+            );
+            create table if not exists teameta (
+                path text,
+                field text,
+                value text,
+                primary key (path, field),
+                foreign key (path)
+                  references pkg_meta (path)
+                    on delete cascade
+            );
+        }
+        #subject description require platform summary recommend category license
+    }
+
+    proc db_insert {args} {
+        set keys {key name version platform path}
+        set d [dict filter $args {*}$keys]
+        dict with d {
+            db eval {
+                insert or replace
+                    into teapkgs ( name,  ver,      arch,      path)
+                          values (:name, :version, :platform, :path);
+            }
+        }
+        foreach {field value} $args {
+            if {$field in $keys} continue
+            if {$field in {require recommend}} {
+                set value [parse_reqs $value]
+            }
+            db eval {
+                insert or replace
+                    into teameta ( path,  field,  value)
+                          values (:path, :field, :value);
+            }
+        }
+    }
+
+    proc scan {topdir args} {
+        foreach path [glob $topdir/*] {
+            try {
+                parse_teapot $path
+            } on ok {teameta} {
+                log::info {Found teameta in $path}
+                foreach {key meta} $teameta {
+                    log::info { + inserting record for $key}
+                    db_insert path $path {*}$args {*}$meta
+                }
+            } on error {e o} {
+                if {[file isdirectory $path]} {
+                    log::info {Recursing into $path}
+                    scan $path {*}$args
+                }
+            }
+        }
+        set n [db onecolumn {select count(1) from teapkgs}]
+        set m [db onecolumn {select count(1) from teameta}]
+        log::info {Scanned $n packages, learned $m facts}
+    }
+
+    # simplifies a set of version bounds into a single bound
+    proc vsimplify {vers} {
+        set vers [lassign $vers first]
+        set first [split $first -]
+        lassign $first A B
+        foreach ver $vers {
+            lassign [split $ver -] a b
+            if {[package vcompare $A $a] < 0} { set A $a }
+            if {$B eq ""} {set B $b}
+            if {$b eq ""} continue
+            if {[package vcompare $b $B] < 0} { set B $b }
+        }
+        return $A-$B
+    }
+    #puts [vsimplify {8 8.4- 7.2-8.7.9 8.7.5-8.8}]; exit
+
+    # parses a {Meta require} argument into a dictionary
+    #
+    # result always contains:   {name version}
+    #           may contain:    {is platform archglob}
+    proc parse_reqs {reqlist} { lmap r $reqlist { parse_req {*}$r } }
+    proc parse_req {name args} {
+
+        # ?ver ...? ?-opt val ...?
+        set i -1
+        foreach v $args {
+            if {[string match -* $v]} break
+            incr i
+        }
+        set vers [lrange $args 0 $i]
+        set opts [lrange $args $i+1 end]
+
+        # defaults:
+        set o(-name)    $name
+        set o(-exact)   false
+        set o(-is)      package
+
+        foreach {key val} $opts {
+            if {$key ni {-archglob -is -platform -require  -version -exact}} {
+                error "Invalid entity reference in \"$name\": $key"
+            }
+            if {$key eq "-require"} {
+                lappend vers $val
+            } else {
+                set o($key) $val
+            }
+        }
+
+        # backward-compatibility:
+        if {[info exists o(-version)]} {
+            if {$vers ne ""} {
+                error "Cannot use -version with versions or -require"
+            }
+            lappend vers $o(-version)
+            unset o(-version)
+        }
+
+        set vers [lmap v $vers {join $v -}]  ;# legacy list notation
+
+        if {$o(-exact)} {
+            if {[string match {*[- ]*} $vers]} {
+                error "Can only use -exact with a single version! \"$name $vers\""
+            }
+            set v [lindex $vers 0]
+            set v1 [split $v .]
+            # FIXME: behaviour on a.b versions may be dodgy
+            # NOTE: npm uses ^ for a similar (?) meaning:
+            #     ^1.2.3 := >=1.2.3 <2.0.0
+            #     ^0.2.3 := >=0.2.3 <0.3.0
+            #     ^0.0.3 := >=0.0.3 <0.0.4
+            #  see https://nodesource.com/blog/semver-tilde-and-caret/
+            lset v1 end [expr {1+[lindex $v1 end]}]
+            set v1 [join $v1 .]
+            lset vers 0 $v-$v1
+        }
+        unset o(-exact)
+
+        # normalise versions into vcompare strings
+        set vers [lmap v0 $vers {
+            if {[string match *-* $v0]} {
+                string cat $v0
+            } else {    ;# synthesise upper bound
+                set v1 [split $v0 .]
+                set v1 [lindex $v1 0]
+                incr v1
+                string cat $v0-$v1
+            }
+        }]
+
+        if {[info exists o(-platform)]} {
+            if {$o(-platform) ni {unix windows macosx}} {
+                error "Invalid -platform $o(-platform) ($name)"
+            }
+        }
+
+        if {$vers ne ""} {
+            set o(-version) [vsimplify $vers]
+        }
+
+        if {$o(-is) eq "package"} {
+            unset o(-is)
+        }
+
+        # result:
+        dict map {k v} [array get o] {
+            set k [string trimleft $k -]
+            set v
+        }
+    }
+
+    # returns a dict which ALWAYS has   {name version}
+    #   and MAY have more               {platform require ...}
+    proc parse_teapot {path} {
+        set meta [get_meta $path]
+        set meta [string trim $meta]
+        foreach line [split $meta \n] {
+            set line [string trimleft $line #]
+            set line [string trim $line]
+            if {$line eq ""} {continue}
+            try {
+                set args [lassign $line cmd]
+            } on error {} {
+                error "Malformed teapot"
+            }
+            set cmd [string tolower $cmd]
+            if {$cmd in {package profile application}} {
+                lassign $args name version
+                set pkgInfo($name-$version) [dict create name $name version $version]
+                continue
+            } elseif {$cmd ni {meta}} {
+                error "Unknown TEAPOT.txt cmd: $cmd $args"
+            }
+            set args [lassign $args field]
+            set field [string tolower $field]
+            dict lappend pkgInfo($name-$version) $field {*}$args
+        }
+        array get pkgInfo
+    }
+
+    proc get_meta {path} {
+        if {[file isdirectory $path]} {
+            set fd [open $path/teapot.txt r]
+            set meta [read $fd]
+            close $fd
+            return $meta
+        }
+        set fd [open $path r]
+        if {[get_meta_text $fd meta]} {
+            return $meta
+        }
+        seek $fd 0
+        if {[get_meta_bin $fd meta]} {
+            return $meta
+        }
+        close $fd
+        set unmount [try_mount $path]
+        if {$unmount ne ""} {
+            try {
+                return [get_meta $path]
+            } finally {
+                {*}$unmount
+            }
+        }
+    }
+    proc get_meta_text {fd _meta} {
+        upvar 1 $_meta meta
+        gets $fd line0
+        if {![catch {llength $line0} r] && $r == 3} {
+            gets $fd line1
+            if {![catch {lindex $line1 0} r] && $r eq "Meta"} {
+                set meta $line0\n$line1\n[read $fd]
+                return true
+            }
+        }
+        return false
+    }
+    proc get_meta_bin {fd _meta} {
+        upvar 1 $_meta meta
+        fconfigure $fd -encoding binary
+        set block [read $fd 16384]
+        return [regexp {# @@ Meta Begin(.*)# @@ Meta End} $block -> meta]
+    }
+
+    proc try_mount {path} {
+        foreach ext {zip mk4 tar} {
+            try {
+                set fd [::vfs::${ext}::Mount $path $path]
+            } on error {e o} {
+                puts "Failed to mount ${ext}://$path"
+                continue
+            } on ok {fd} {
+                puts "Mounted ${ext}://$path"
+                return [list ::vfs::${ext}::Unmount $fd $path]
+            }
+        }
+        return ""   ;# failed to mount
+    }
+
+    db::qproc Find {
+        pkg     %
+        ver     0-
+        path    %
+    } {
+        select *
+          from teapkgs
+         where name like :pkg
+           and vsatisfies(ver, :ver)
+           and path like :path || '%'
+    }
+    proc find args {
+        Find {path} $args
+    }
+
+    db::qproc Deps {
+        pkg     %
+        ver     0-
+        path    %
+    } {
+        select *
+          from teameta
+          natural join teapkgs
+        where name like :pkg
+          and vsatisfies(ver, :ver)
+          and path like :path || '%'
+          and field = ('require')
+    }
+    proc deps {args} {
+        set table [Deps {name arch path value:reqs} $args]
+        switch [llength $table] {
+            0 {
+                log::warn {No match for $args}
+            }
+            1 {
+                lassign $table rec
+                dict with rec {}
+                log::warn {Deps from: $path}
+                return $reqs
+            }
+            default {
+                log::warn {Ambiguous match for $args}
+                foreach rec $table {
+                    log::warn { + Candidate:  $rec}
+                }
+            }
+        }
+    }
+
+    namespace ensemble create -subcommands {scan deps find}
+}
+
+lib::main args {
+    db::init leaves.db
+    puts [leaves {*}$args]
+}

ADDED   hacks/cuppa/lib-0.tm
Index: hacks/cuppa/lib-0.tm
==================================================================
--- /dev/null
+++ hacks/cuppa/lib-0.tm
@@ -0,0 +1,95 @@
+package require platform
+
+namespace eval lib {
+
+    proc putl args {puts $args}
+
+    proc main {arglist body} {      ;# lib::main {args} {puts "Invoked directly, with $args"}
+        set m [expr {[info exists ::argv0]
+                && [file dirname [file normalize $::argv0/...]]
+                eq [file dirname [file normalize [lib::updo info script]/...]]}]
+        if {$m} {
+            package require log 0   ;# fixme - circular dependency too!
+            set ns [lib::upns]
+            set s [updo info script]
+            log::warn "$s - running on [platform::identify] ([platform::generic])"
+            tailcall apply [list $arglist $body $ns] {*}$::argv
+        }
+    }
+    
+    proc lsub script {              ;# [sl] from the wiki
+        set res {}
+        set parts {}
+        foreach part [split $script \n] {
+            lappend parts $part
+            set part [join $parts \n]
+            #add the newline that was stripped because it can make a difference
+            if {[info complete $part\n]} {
+                set parts {}
+                set part [string trim $part]
+                if {$part eq {}} {
+                    continue
+                }
+                if {[string index $part 0] eq {#}} {
+                    continue
+                }
+                #Here, the double-substitution via uplevel is intended!
+                lappend res {*}[uplevel list $part]
+            }
+        }
+        if {$parts ne {}} {
+            error [list {incomplete parts} [join $parts]]
+        }
+        return $res
+    }
+
+    proc my {cmd args} {            ;# create cmdprefixes with local commands
+        list [namespace current]::$cmd {*}$args
+    }
+
+    proc dictargs {_args defaults} {
+        upvar 1 $_args args
+        set defaults [uplevel 1 [my lsub $defaults]]
+        set bad [dict filter $args script {k _} {
+            expr {![dict exists $defaults $k]}
+        }]
+        if {$bad ne ""} {
+            tailcall tailcall throw {TCL BADARGS} "Unexpect arguments \"$bad\"\naccepted arguments are ([dict keys $defaults])"
+        }
+        set args [dict merge $defaults $args]
+        tailcall dict with $_args {}
+    }
+
+    ;# lang-utils
+    proc alias {alias cmd args} {
+        set alias   [upns 1 $alias]
+        set cmd     [upns 1 $cmd]
+        interp alias    {} $alias   {} $cmd {*}$args
+    }
+
+    proc upns {{lvl 1} args} {  ;# doubles as resolve-cmdname-in-caller
+        if {$args eq ""} {
+            tailcall uplevel $lvl {namespace current}
+        } else {
+            set cargs [lassign $args cmd]
+            if {[string match :* $cmd]} {
+                return $args
+            }
+            set ns [uplevel [expr {$lvl+1}] {namespace current}]
+            set ns [string trimright $ns :]
+            return [list ${ns}::$cmd {*}$cargs]
+        }
+    }
+    proc updo {{lvl 1} args} {
+        tailcall uplevel $lvl $args
+    }
+
+    proc dictable {names list} {
+        set args [join [lmap name $names {
+            set name [list $name]
+            subst -noc {$name [set $name]}
+        }] " "]
+        lmap $names $list "dict create $args"
+    }
+
+}

ADDED   hacks/cuppa/log-0.tm
Index: hacks/cuppa/log-0.tm
==================================================================
--- /dev/null
+++ hacks/cuppa/log-0.tm
@@ -0,0 +1,117 @@
+# SYNOPSIS:
+#
+#  output control
+#
+#   log::to stderr
+#   log::copy chan ?name?
+#   loc::close chan
+#
+#  Levels set by namespace from {debug info warn error}
+#
+#   log::level ?level?
+#
+#  Messages are not substituted if level not exceeded - beware side effects
+#
+#   log::info {message $subst string}
+#
+::tcl::tm::path add [pwd]
+package require lib
+
+namespace eval log {
+
+    variable to {stderr}
+    lib::alias to set [namespace current]::chan
+
+    variable levels { error warn info debug }   ;# wtf is "notice" anyway?
+    variable profiles { :: 2 }      ;# default (root ns) gets {error warn}
+
+    apply {{levels {i -1}} {
+        foreach l $levels {
+            lib::updo 1 lib::alias $l log [incr i] $l
+        }
+    }} $levels
+
+    proc never {args} {
+        foreach level $args {
+            log::warn {suppressing $level}
+            catch {
+                lib::alias $level list
+            }
+        }
+    }
+
+    proc level {{n ""}} {
+        variable levels
+        variable profiles
+        set ns [lib::upns]
+        if {$n eq ""} {
+            return [Getlevel $ns]
+        } elseif {$n in {0 1 2 3}} {
+        } elseif {-1 != [set i [lsearch -exact $levels $n]]} {
+            set n $i
+        } else {
+            error "Invalid level \"$n\": should be an integer or in ($levels)"
+        }
+        dict set profiles $ns $n
+        return $n
+    }
+
+    proc Getlevel {ns} {
+        variable profiles
+        while {![dict exists $profiles $ns]} {
+            set ns [namespace parent $ns]
+        }
+        dict get $profiles $ns
+    }
+
+    variable start [clock milliseconds]
+    proc runtime {} {
+        variable start
+        set now [clock milliseconds]
+        set elapsed [expr {$now - $start}]
+        set s  [expr {$elapsed / 1000}]
+        set ms [expr {$elapsed % 1000}]
+        set ms [format %03d $ms]
+        #string trimleft [clock format $s -gmt 1 -format "%H:%M:%S.$ms"] 0:
+        clock format $s -gmt 1 -format "%H:%M:%S.$ms"
+    }
+
+    variable copies {}
+    proc copy {chan {name ""}} {
+        if {$name eq ""} {set name $chan}
+        variable copies
+        dict set copies $chan $name
+    }
+    proc close {chan} {
+        variable copies
+        dict unset copies $chan
+    }
+
+    proc log {l level args} {
+        variable to
+        variable copies
+        set ns [lib::upns]
+        set t [Getlevel $ns]
+        if {$l > $t} return
+        set args [lmap a $args {lib::updo 1 subst $a}]
+        if {[llength $args] == 1} {lassign $args args}
+        set context [lib::updo namespace which [lindex [::info level -1] 0]]
+        set lvl [dict get {
+            debug   "d   "
+            info    "in  "
+            warn    "wrn "
+            error   "ERR!"
+        } $level]
+        set msg "[runtime] $lvl $context | $args"
+        puts $to $msg
+        dict for {copy name} $copies {
+            try {
+                puts $copy $msg
+            } on error {e o} {
+                puts $to "[runtime]: warn: closed $name due to $e"
+                close $copy
+            }
+        }
+    }
+
+}

ADDED   hacks/cuppa/percha.tcl
Index: hacks/cuppa/percha.tcl
==================================================================
--- /dev/null
+++ hacks/cuppa/percha.tcl
@@ -0,0 +1,34 @@
+package require tdom
+
+set fd [open ref/packages.xml r]
+fconfigure $fd -encoding utf-8
+set data [read $fd]
+set dom [dom parse $data]
+
+proc dump {_d} {
+    set _n [dict get $_d name]
+    if {$_n ne "tdom"} return
+    array set $_n $_d
+    parray $_n
+}
+foreach p [$dom selectNodes {/gutter/package}] {
+    set pkg {}
+    dict set pkg name [$p @id]
+    foreach c [$p childNodes] {
+        set attr [$c nodeName]
+        set text [$c asText]
+        if {$attr in {author license requires homepage summary description}} {
+            dict set pkg $attr $text
+        }
+        if {$attr in {link}} {
+            dict lappend pkg $attr [$c @rel] $text
+        }
+        if {$attr in {release}} {
+            dict lappend pkg $attr [$c @version] $text
+        }
+        if {$attr in {depends}} {
+            dict lappend pkg $attr {*}[split $text ,]
+        }
+    }
+    dump $pkg
+}

ADDED   hacks/events.tcl
Index: hacks/events.tcl
==================================================================
--- /dev/null
+++ hacks/events.tcl
@@ -0,0 +1,213 @@
+# The goal here is to redirect events from one window to another, while preserving all of
+# their fields.  To decide what fields, we parse the text of event(n).
+#
+# this uncovered a BUG:  [event generate . <<Cut>> -serial 1 -bar   returns the wrong error
+
+package require Tk
+package require Ttk
+
+namespace eval Event {
+
+    # copied from http://www.tcl.tk/man/tcl/TkCmd/event.htm#M9
+    variable Manual {
+-above window
+    Window specifies the above field for the event, either as a window path name or as an integer window id. Valid for Configure events. Corresponds to the %a substitution for binding scripts.
+
+-borderwidth size
+    Size must be a screen distance; it specifies the border_width field for the event. Valid for Configure events. Corresponds to the %B substitution for binding scripts.
+
+-button number
+    Number must be an integer; it specifies the detail field for a ButtonPress or ButtonRelease event, overriding any button number provided in the base event argument. Corresponds to the %b substitution for binding scripts.
+
+-count number
+    Number must be an integer; it specifies the count field for the event. Valid for Expose events. Corresponds to the %c substitution for binding scripts.
+
+-data string
+    String may be any value; it specifies the user_data field for the event. Only valid for virtual events. Corresponds to the %d substitution for virtual events in binding scripts.
+
+-delta number
+    Number must be an integer; it specifies the delta field for the MouseWheel event. The delta refers to the direction and magnitude the mouse wheel was rotated. Note the value is not a screen distance but are units of motion in the mouse wheel. Typically these values are multiples of 120. For example, 120 should scroll the text widget up 4 lines and -240 would scroll the text widget down 8 lines. Of course, other widgets may define different behaviors for mouse wheel motion. This field corresponds to the %D substitution for binding scripts.
+
+-detail detail
+    Detail specifies the detail field for the event and must be one of the following:
+
+        NotifyAncestor
+            
+
+        NotifyNonlinearVirtual
+
+        NotifyDetailNone
+            
+
+        NotifyPointer
+
+        NotifyInferior
+            
+
+        NotifyPointerRoot
+
+        NotifyNonlinear
+            
+
+        NotifyVirtual
+
+    Valid for Enter, Leave, FocusIn and FocusOut events. Corresponds to the %d substitution for binding scripts.
+
+-focus boolean
+    Boolean must be a boolean value; it specifies the focus field for the event. Valid for Enter and Leave events. Corresponds to the %f substitution for binding scripts.
+
+-height size
+    Size must be a screen distance; it specifies the height field for the event. Valid for Configure events. Corresponds to the %h substitution for binding scripts.
+
+-keycode number
+    Number must be an integer; it specifies the keycode field for the event. Valid for KeyPress and KeyRelease events. Corresponds to the %k substitution for binding scripts.
+
+-keysym name
+    Name must be the name of a valid keysym, such as g, space, or Return; its corresponding keycode value is used as the keycode field for event, overriding any detail specified in the base event argument. Valid for KeyPress and KeyRelease events. Corresponds to the %K substitution for binding scripts.
+
+-mode notify
+    Notify specifies the mode field for the event and must be one of NotifyNormal, NotifyGrab, NotifyUngrab, or NotifyWhileGrabbed. Valid for Enter, Leave, FocusIn, and FocusOut events. Corresponds to the %m substitution for binding scripts.
+
+-override boolean
+    Boolean must be a boolean value; it specifies the override_redirect field for the event. Valid for Map, Reparent, and Configure events. Corresponds to the %o substitution for binding scripts.
+
+-place where
+    Where specifies the place field for the event; it must be either PlaceOnTop or PlaceOnBottom. Valid for Circulate events. Corresponds to the %p substitution for binding scripts.
+
+-root window
+    Window must be either a window path name or an integer window identifier; it specifies the root field for the event. Valid for KeyPress, KeyRelease, ButtonPress, ButtonRelease, Enter, Leave, and Motion events. Corresponds to the %R substitution for binding scripts.
+
+-rootx coord
+    Coord must be a screen distance; it specifies the x_root field for the event. Valid for KeyPress, KeyRelease, ButtonPress, ButtonRelease, Enter, Leave, and Motion events. Corresponds to the %X substitution for binding scripts.
+
+-rooty coord
+    Coord must be a screen distance; it specifies the y_root field for the event. Valid for KeyPress, KeyRelease, ButtonPress, ButtonRelease, Enter, Leave, and Motion events. Corresponds to the %Y substitution for binding scripts.
+
+-sendevent boolean
+    Boolean must be a boolean value; it specifies the send_event field for the event. Valid for all events. Corresponds to the %E substitution for binding scripts.
+
+-serial number
+    Number must be an integer; it specifies the serial field for the event. Valid for all events. Corresponds to the %# substitution for binding scripts.
+
+-state state
+    State specifies the state field for the event. For KeyPress, KeyRelease, ButtonPress, ButtonRelease, Enter, Leave, and Motion events it must be an integer value. For Visibility events it must be one of VisibilityUnobscured, VisibilityPartiallyObscured, or VisibilityFullyObscured. This option overrides any modifiers such as Meta or Control specified in the base event. Corresponds to the %s substitution for binding scripts.
+
+-subwindow window
+    Window specifies the subwindow field for the event, either as a path name for a Tk widget or as an integer window identifier. Valid for KeyPress, KeyRelease, ButtonPress, ButtonRelease, Enter, Leave, and Motion events. Similar to %S substitution for binding scripts.
+
+-time integer
+    Integer must be an integer value; it specifies the time field for the event. Valid for KeyPress, KeyRelease, ButtonPress, ButtonRelease, Enter, Leave, Motion, and Property events. Corresponds to the %t substitution for binding scripts.
+
+-warp boolean
+    boolean must be a boolean value; it specifies whether the screen pointer should be warped as well. Valid for KeyPress, KeyRelease, ButtonPress, ButtonRelease, and Motion events. The pointer will only warp to a window if it is mapped.
+
+-width size
+    Size must be a screen distance; it specifies the width field for the event. Valid for Configure events. Corresponds to the %w substitution for binding scripts.
+
+-when when
+    When determines when the event will be processed; it must have one of the following values:
+
+    now
+        Process the event immediately, before the command returns. This also happens if the -when option is omitted.
+
+    tail
+        Place the event on Tcl's event queue behind any events already queued for this application.
+
+    head
+        Place the event at the front of Tcl's event queue, so that it will be handled before any other events already queued.
+
+    mark
+        Place the event at the front of Tcl's event queue but behind any other events already queued with -when mark. This option is useful when generating a series of events that should be processed in order but at the front of the queue.
+
+-x coord
+    Coord must be a screen distance; it specifies the x field for the event. Valid for KeyPress, KeyRelease, ButtonPress, ButtonRelease, Motion, Enter, Leave, Expose, Configure, Gravity, and Reparent events. Corresponds to the %x substitution for binding scripts. If Window is empty the coordinate is relative to the screen, and this option corresponds to the %X substitution for binding scripts.
+
+-y coord
+    Coord must be a screen distance; it specifies the y field for the event. Valid for KeyPress, KeyRelease, ButtonPress, ButtonRelease, Motion, Enter, Leave, Expose, Configure, Gravity, and Reparent events. Corresponds to the %y substitution for binding scripts. If Window is empty the coordinate is relative to the screen, and this option corresponds to the %Y substitution for binding scripts. 
+    }
+
+    variable Options
+    variable Fields
+
+    apply [list {} {
+        variable Manual
+        #set Manual [exec man --nh --nj event]
+        regexp {\nEVENT FIELDS\n(.*?)(?=\n[A-Z])} $Manual -> Manual
+        variable Options
+        variable Fields
+
+        foreach {_ option desc} [regexp -all -inline -lineanchor {^\s*?(-\S*) [^\n]*\n(.*)\.$} $Manual] {
+
+            regsub -all {\s\s+} $desc " " desc
+            set codes [regexp -all -inline {%.} $desc]
+            regexp -nocase {Valid for (.*?) events.} $desc -> kinds
+            set kinds [string map {"," "" " and " " "} $kinds]
+
+            switch -exact $option {
+                -warp - -when {continue}
+                debug {
+                    puts "option $option"
+                    puts "desc $desc"
+                    puts "codes $codes"
+                    puts "kinds $kinds"
+                }
+            }
+
+            foreach kind $kinds {
+                dict lappend Fields $kind $option
+            }
+
+            switch -exact $option {
+                -x  {
+                    # FIXME: %x, %y should be relative to %W, so they need to be adjusted here!
+                    dict set Options -x { -x [expr {$win eq "" ? %X : %x}]}
+                }
+                -y {
+                    # FIXME: %x, %y should be relative to %W, so they need to be adjusted here!
+                    dict set Options -y { -y [expr {$win eq "" ? %Y : %y}]}
+                }
+                default {
+                    if {[lassign $codes code] ne ""} {
+                        error "Bad codes for $option: $codes"
+                    }
+                    dict set Options $option " {*}\[if {{$code} ne {??}} {list [list $option $code]}\]"
+                }
+            }
+        }
+    } [namespace current]]
+
+    proc redirect_script {event target} {
+        variable Fields
+        variable Options
+        set script "event generate $target $event"
+        set options [dict get $Fields "all"]
+        if {[string match <<*>> $event]} {
+            lappend options {*}[dict get $Fields "virtual"]
+        }
+        catch {
+            lappend options {*}[dict get $Fields $event]
+        }
+        foreach opt $options {
+            append script [dict get $Options $opt]
+        }
+        #set script "puts [list $script]"
+        #puts $script
+        return $script
+    }
+
+    proc redirect {win event target} {
+        set script [redirect_script $event $target]
+        append script ";break"
+        bind $win $event $script
+    }
+}
+
+if 0 {
+    namespace path ::ttk
+    pack [labelframe .f -text "Container"]
+    pack [entry .e -textvariable str] -in .f
+    bindtags .e {.e Entry .f all}
+    set str "Hello"
+    bind .f <<Cut>> {puts "<<Cut>> @ %W"}
+    puts [Event::redirect .e <<Cut>> .f]
+}

Index: hacks/geturl.tcl
==================================================================
--- hacks/geturl.tcl
+++ hacks/geturl.tcl
@@ -1,9 +1,12 @@
 package require http
 package require uri
-package require tls
-http::register https 443 ::tls::socket
+catch {
+    package require tls
+    http::register https 443 ::tls::socket
+}
+::tls::init -tls1 1 -tls1.2 1 -tls1.1 0 -ssl3 0 -ssl2 0
 
 #http::config -useragent poop   ;# ?? I think this was to get around sourceforge?
 
 # -- simple wrapper for http::geturl
 #  FIXME:  add wget (getfile, binary mode)
@@ -114,5 +117,11 @@
 #    }
 #    namespace export *
 #    namespace ensemble create
 #}
 
+if {[info script] eq $::argv0 && $::argv ne ""} {
+    foreach url $::argv {
+        puts "Getting $url"
+        geturl $url
+    }
+}

ADDED   hacks/iterate.tcl
Index: hacks/iterate.tcl
==================================================================
--- /dev/null
+++ hacks/iterate.tcl
@@ -0,0 +1,122 @@
+# coroutines are famously good at two things:
+#  - asynchronous code that yields to the event loop
+#  - generators
+#
+# I was lamenting the fact that these can't be combined, when a legitimate
+# use of [yieldto yield] occurred to me.  This is that nightmare.
+#
+# Particularly fun:  draw what happens to the coroutine stack when
+# [::iterators::yieldfor] is used!
+
+namespace eval iterators {
+
+    namespace export {iterate iterator}
+
+    # define an interator that uses the "standard" protocol.
+    # see also tcllib generator
+    proc iterator {name arglist body} {
+        proc $name $arglist "
+            ::yield \[info coroutine\]
+            try {
+                $body
+                return -code break
+            }
+        "
+    }
+
+    # start an iterator.
+    proc iterate {cmd args} {
+        variable NUM
+        coroutine iter#[incr NUM] $cmd {*}$args
+    }
+
+    # this is the magic.  Example:  [yieldfor fileevent $chan readable]
+    proc ::yieldfor {cmd args} {
+        set cmd [uplevel 1 [list namespace which -command $cmd]]
+        $cmd {*}$args [info coroutine]
+        yield
+    }
+
+    # but when used inside an iterator, [yieldfor] means something else
+    proc yieldfor {cmd args} {
+        set cmd [uplevel 1 [list namespace which -command $cmd]]
+        yieldto try "
+            [list yieldfor $cmd {*}$args]
+            continue
+        "
+    }
+
+    # so we need coroutine::util analogues that use [yieldfor]
+    # for any asynchronous functions we want to use in our generators
+    # this is the 80% solution
+    proc gets {chan varname} {
+        upvar 1 $varname var
+        while 1 {
+            if {[::gets $chan x] >= 0} {
+                tailcall set $varname $x
+            }
+            if {[::chan eof $chan]} {
+                return -1
+            }
+            if {[::chan blocked $chan]} {
+                yieldfor ::chan event $chan readable
+            }
+        }
+    }
+
+    proc after {ms args} {
+        if {$args eq "" && ($ms eq "idle" || [string is digit -strict $ms])} {
+            tailcall yieldfor ::after $ms
+        } else {
+            tailcall ::after $ms {*}$args
+        }
+    }
+
+    # now we just define some iterators to test with.
+    # notice this one uses asynchronous gets!
+    iterator input {{chan stdin}} {
+        while {[gets $chan line] >= 0} {
+            yield $line
+        }
+    }
+
+    iterator range {{n 10}} {
+        while {[incr i] < 10} {
+            yield $i
+        }
+    }
+
+    iterator double {iterator} {
+        while 1 {
+            set x [$iterator]
+            yield $x$x
+        }
+    }
+    iterator squares {iterator} {
+        while 1 {
+            set x [$iterator]
+            yield [expr {$x*$x}]
+        }
+    }
+}
+
+namespace path ::iterators
+
+# notice that
+chan configure stdin -blocking 0
+
+proc main {} {
+    set iter [iterate input stdin]
+    set iter [iterate double $iter]
+    set iter [iterate double $iter]
+    puts "Innermost iter: $iter"
+    while 1 {
+        set i [$iter]
+        puts "Got: $i"
+    }
+    puts done
+    exit
+}
+coroutine Main main
+vwait ::forever
+exit

ADDED   hacks/loop-0.tm
Index: hacks/loop-0.tm
==================================================================
--- /dev/null
+++ hacks/loop-0.tm
@@ -0,0 +1,62 @@
+# an experiment in how hard we can overload [loop]
+# nb: args are not tip288-decomposable!
+proc loop args {
+    tailcall loop/[llength $args] {*}$args
+}
+
+proc loop/1 script {
+    tailcall while 1 $script
+}
+
+proc loop/2 {iters script} {
+    for {set i 0} {$i < $iters} {incr i} {
+        uplevel 1 $script
+    }
+}
+
+proc loop/3 {varName iters script} {
+    upvar 1 $varName i
+    for {set i 0} {$i < $iters} {incr i} {
+        uplevel 1 $script
+    }
+}
+
+proc loop/4 {varName from to script} {
+    upvar 1 $varName i
+    set i $from
+    set incr [expr {$to > $from ? 1 : -1}]
+    set cont [expr {$from > $to}]
+    for {set i $from} {($i > $to) == $cont} {incr i $incr} {
+        uplevel 1 $script
+    }
+
+}
+
+proc loop/5 {varName from to incr script} {
+    upvar 1 $varName i
+    set i $from
+    set cont [expr {$from > $to}]
+    for {set i $from} {($i > $to) == $cont} {incr i $incr} {
+        uplevel 1 $script
+    }
+}
+
+proc test {} {
+    loop {  ;# would loop forever
+        loop 2 {
+            puts "Do this twice"
+        }
+        loop i 2 {
+            puts "Twice with index: $i"
+        }
+        loop i 9 7 {
+            puts "Nine and Eight: $i"
+        }
+        loop i 9 0 -2 {
+            puts "Descending odd digits: $i"
+        }
+        break   ;# otherwise loop forever
+    }
+}
+
+test

ADDED   hacks/pkgmap.tcl
Index: hacks/pkgmap.tcl
==================================================================
--- /dev/null
+++ hacks/pkgmap.tcl
@@ -0,0 +1,115 @@
+# first, hook package:
+oo::class create PkgMapper {
+    variable Chain 
+    variable Deps
+    variable Cmd
+    constructor {cmd args} {
+        set Cmd $cmd
+        set Chain {}
+        set Deps {}
+    }
+    method info {} {
+        array set deps $Deps
+        parray deps
+    }
+    method package {cmd args} {
+        switch $cmd {
+            "require" {
+                set reqs [lassign $args pkg]
+                if {$pkg eq "-exact"} {
+                    set reqs [lassign $reqs pkg]
+                }
+                lappend Chain $pkg
+                set rc [catch {uplevel 1 [list $Cmd $cmd {*}$args]} e o]
+                if {[llength $Chain] > 1} {
+                    dict lappend Deps {*}[lrange $Chain end-1 end]
+                }
+                set Chain [lreplace $Chain end end]
+                if {$rc != 0} {
+                    dict unset Deps $pkg
+                }
+                if {[dict exists $o -level]} {
+                    dict incr o -level 1
+                }
+                return {*}$o $e
+            }
+            "provide" {
+                lassign $args pkg version
+                dict lappend Known $pkg $version
+                tailcall $Cmd $cmd {*}$args
+            }
+            default {
+                tailcall $Cmd $cmd {*}$args
+            }
+        }
+    }
+}
+
+if 1 {
+    proc test {args} {
+        # get the packages already known:
+        catch {package require { none such }}
+        set before [package names]
+
+        # redirect [package]:
+        set pm [PkgMapper new :package]
+        rename package :package
+        interp alias {} package {} $pm package
+
+        # add to the path
+        lappend ::auto_path {*}$args
+        ::tcl::tm::path add {*}$args
+
+        # get the new package names:
+        catch {package require { none too }}
+        set after [package names]
+
+        # take the difference:
+        set names [lmap a $after {
+            if {$a in $before} continue
+            set a
+        }]
+        puts [llength $before]-[llength $after]
+        puts $names
+        foreach pkg $names {
+            if {$name in {console}} {
+                puts "Skipping blacklisted: $name"
+                continue
+            }
+            try {
+                package require $pkg
+            } on error {e o} {
+                puts "! $e"
+            }
+        }
+        $pm info
+    }
+
+
+    test {*}$argv
+}
+
+if 0 {
+    set pm [PkgMapper new :package]
+    rename package :package
+    interp alias {} package {} $pm package
+
+    puts [package names]
+    catch {package require { none such }}
+    #catch {package require gpx}
+    set names [package names]
+    puts "+ $names"
+    $pm info
+    puts " ---- "
+    puts -nonewline [llength $names]:
+    foreach pkg [lrange $names 0 50] {
+        catch {
+            package require $pkg
+            puts -nonewline .
+            flush stdout
+        }
+    }
+    puts ""
+
+    $pm info
+}

ADDED   hacks/tablelist-drag.tcl
Index: hacks/tablelist-drag.tcl
==================================================================
--- /dev/null
+++ hacks/tablelist-drag.tcl
@@ -0,0 +1,89 @@
+# the point of this package is to have a two-level tablelist whose second-level items can be dragged around to anywhere on that second level
+# the problem is in the last line of a level 1 entry:
+#
+#  ` foo
+#    ` bar
+#         <-- bad here
+#  ` baz
+#    ` qux
+#         <-- ok here
+#
+# In the "bad" location, tablelist will only treat the drop as a root-level drop, which is not what we want.  So by binding the <<TablelistRowMoved>>
+# event, we redirect the item.
+#
+# after idle after 0 ... seems to avoid Tcl_Panic("TkBTreeLinesTo couldn't find line"); .. and is a good idea anyway.
+#
+package require Tk
+package require tablelist
+namespace import tablelist::tablelist
+
+proc acceptChildCmd {tbl targetParent sourceRow} {
+#    try {
+        set pdepth [$tbl depth $targetParent]
+        expr { $pdepth <= 1 }
+#    } on ok {r} {
+#        puts "Child: $tbl $sourceRow -> $targetParent ($pdepth) (result: $r)"
+#        return $r
+#    }
+}
+proc acceptDropCmd {tbl targetRow sourceRow} {
+#    try {
+        set rowCount [$tbl size]
+        if {$targetRow == 0} {
+            expr 0  ;# never accept a drop at the top
+        } elseif {$targetRow >= $rowCount} {
+            expr 1  ;# always accept a drop at the end
+        } else {
+            set depth [$tbl depth $targetRow]
+        }
+#    } on ok {r} {
+#        puts "Drop: $tbl $sourceRow -> $targetRow [if {[info exists depth]} {string cat ($depth)}] (result: $r)"
+#        return $r
+#    }
+}
+
+proc <<TablelistRowMoved>> {data} {
+    lassign $data sourceIndex targetParent targetIndex
+    if {$targetParent eq "root" && $targetIndex > 0} {
+        set siblingKeys [.t childkeys "root"]
+        set parent [lindex $siblingKeys $targetIndex-1]
+        # special case for dragging to the end:
+        if {$parent eq $sourceIndex} {
+            set parent [lindex $siblingKeys $targetIndex-2]
+        }
+        # re-move the row:
+        #puts "TablelistRowMoved:  .t move $sourceIndex $parent end"
+        after idle [list after 0 [list .t move $sourceIndex $parent end]]
+    }
+}
+
+grid [tablelist .t \
+            -treestyle plastik \
+            -columns {0 table 0 filename} \
+            -movablerows 1 \
+            -selectmode single \
+            -acceptdropcommand acceptDropCmd \
+            -acceptchildcommand acceptChildCmd \
+            -stretch all \
+            ;#
+] -sticky nsew
+grid rowconfigure    . 0 -weight 1
+grid columnconfigure . 0 -weight 1
+bind .t <<TablelistRowMoved>> {<<TablelistRowMoved>> %d}
+
+set r1 [.t insertchild root end {"Foo" ""}]
+.t insertchild $r1 end {"" "foo_1.csv"}
+.t insertchild $r1 end {"" "foo_2.csv"}
+set r [.t insertchild $r1 end {}]
+#.t rowconfigure $r -hide 1
+set r2 [.t insertchild root end {"Bar" ""}]
+.t insertchild $r2 end {"" "bar_1.csv"}
+.t insertchild $r2 end {}
+#puts "r1 = $r1; r2 = $r2"
+
+#
+# |   Table Name: | [ foo     ]   | [x] - inspect    |
+# |        `file: | bar_1.csv     |  [x] - headings  |
+# |        `file: | bar_2.csv     |  [x] - headings  |
+# |   Table Name: | [ foo     ]   | [x] - inspect    |
+# |        `file: | bar_1.csv     |  [x] - headings  |

ADDED   hacks/tk-ttk.tcl
Index: hacks/tk-ttk.tcl
==================================================================
--- /dev/null
+++ hacks/tk-ttk.tcl
@@ -0,0 +1,59 @@
+# DEMO:  differences between Tk and Ttk widgets
+#
+# == -variable options ==
+#
+#  Tk widgets will create the var if it doesn't exist;  ttk won't.
+#
+# == radiobutton default -value ==
+#
+#  Tk's default is "";  ttk's is "1"
+#
+# == tri-state ==
+#
+#  Tk's radio/check have configurable -tristatevalue (default "") and -tristateimage;
+#  ttk tristate on the variable being unset and indicate it with "selected" or "alternate" in [$w state]
+#
+#
+# == notebook style ==
+#
+#  Tk radio/check are easier for notebook-like behaviour using simple options:
+#    -indicatoron false  -relief -offrelief -image -selectimage -tristateimage
+#
+#  ttk's require ttk::style hackery to do the same.
+#
+package require Tk
+package require Ttk
+namespace eval foo {    ;# just to prove we don't have clever var resolution
+    variable {}
+    pack [checkbutton .c -variable (c) -text checkbutton]
+    pack [ttk::checkbutton .tc -variable (tc) -text ttk::checkbutton]
+    pack [radiobutton .r -variable (r) -text radiobutton]
+    pack [ttk::radiobutton .tr -variable (tr) -text ttk::radiobutton]
+    pack [entry .e -textvariable (e)]
+    pack [ttk::entry .te -textvariable (te)]
+}
+puts "\n== exists check =="
+foreach name {(c) (tc) (r) (tr) (e) (te)} {
+    if {![info exists $name]} {
+        puts "::$name\t--"
+    } else {
+        puts "::$name\t\"[set $name]\""
+    }
+}
+puts "\n== values =="
+foreach w {.c .tc .r .tr} {
+    foreach o {-value -tristatevalue} {
+        catch {puts $w:\t[$w configure $o]}
+    }
+}
+puts "\n== ttk::state =="
+foreach w {.tc .tr} {
+    puts [list $w state]:\t[$w state]
+}
+puts "\n== trace =="
+trace add variable {} write {apply {{_ name op} {
+    puts "TRACE: $name = $::($name)"
+    if {[string match t* $name]} {
+        puts [list .$name state]:\t[.$name state]
+    }
+}}}

ADDED   hacks/ttk-demo.tcl
Index: hacks/ttk-demo.tcl
==================================================================
--- /dev/null
+++ hacks/ttk-demo.tcl
@@ -0,0 +1,290 @@
+if 0 {
+
+    This is a simple visual demo for most of the Ttk widgets.
+
+    Use the "theme" treeview to select themes, and see what different ones look like.
+
+    Widgets *not* (yet) included are:
+
+        ::ttk::frame
+        ::ttk::notebook
+        ::ttk::panedwindow
+        ::ttk::scrollbar
+        ::ttk::sizegrip
+
+    Missing features include:
+
+      * progress bar animation
+      * menus for the menu buttons
+      * showing off more of treeview
+      * compound buttons and other stuff with images
+      * included images and dialogs
+      * colour-scheme selection
+
+    Included widgets are:
+
+        ::ttk::button
+        ::ttk::checkbutton
+        ::ttk::combobox
+        ::ttk::entry
+        ::ttk::label
+        ::ttk::labelframe
+        ::ttk::menubutton
+        ::ttk::progressbar
+        ::ttk::radiobutton
+        ::ttk::scale
+        ::ttk::separator
+        ::ttk::spinbox
+        ::ttk::treeview
+}
+
+package require Tk
+package require Ttk
+
+grid [
+    ttk::labelframe .lf -text "Label relief" -padding 4
+] - [
+    ttk::labelframe .tvf -text "Treeview" -padding 4
+] -padx 6 -pady 6 -sticky nsew
+
+    set rs {flat groove raised ridge solid sunken}
+    set i 0
+    grid {*}[lmap r $rs {
+        ttk::label .lf.l[incr i] -text [string totitle $r] -relief $r
+    }] -padx 4 -pady 4 -sticky nsew
+
+grid [
+    ttk::labelframe .bf -text "Buttons" -padding 4
+] - ^ -padx 6 -pady 6 -sticky nsew
+
+    grid [
+        ttk::button .bf.b1 -text "Normal Button"
+    ] [
+        ttk::button .bf.b2 -text "Disabled Button" -state disabled
+    ] [
+        ttk::button .bf.b3 -text "Undefaultable" -default disabled
+    ] [
+        ttk::button .bf.b4 -text "Default" -default active
+    ] -sticky nsew
+
+grid [
+    ttk::labelframe .tbf -text "Toolbuttons" -padding 4
+] - ^ -padx 6 -pady 6 -sticky nsew
+
+    grid [
+        ttk::button .tbf.bt1 -text "Tool 1" -style Toolbutton
+    ] [
+        ttk::button .tbf.bt2 -text "Disabled 2" -style Toolbutton -state disabled
+    ] [
+        ttk::button .tbf.bt3 -text "Undefaultable 3" -style Toolbutton -default disabled
+    ] [
+        ttk::button .tbf.bt4 -text "Default 4" -style Toolbutton -default active
+    ] -sticky nsew
+
+grid [
+    ttk::labelframe .cf -text "Checkbuttons" -padding 4
+] - [
+    ttk::labelframe .kf -text "Keypress display" -padding 4
+] -padx 6 -pady 6 -sticky nsew
+
+    grid [
+        ttk::checkbutton .cf.b1 -text "Normal Button"
+    ] [
+        ttk::checkbutton .cf.b2 -text "Disabled Button" -state disabled
+    ] [
+        ttk::checkbutton .cf.bt1 -text "Tool 1" -style Toolbutton
+    ] [
+        ttk::checkbutton .cf.bt2 -text "Tool 2" -style Toolbutton
+    ] [
+        ttk::checkbutton .cf.bt3 -text "Disabled 3" -style Toolbutton -state disabled
+    ] -sticky nsew
+
+    grid [
+        ttk::label .kf.key -anchor center
+    ] -sticky nsew
+
+grid [
+    ttk::labelframe .rf -text "Radiobuttons" -padding 4
+] - ^ -padx 6 -pady 6 -sticky nsew
+
+    grid [
+        ttk::radiobutton .rf.b1 -value b1 -variable radio1 -text "Normal Button"
+    ] [
+        ttk::radiobutton .rf.b2 -value b2 -variable radio1 -text "Disabled Button" -state disabled
+    ] [
+        ttk::radiobutton .rf.bt1 -value bt1 -variable radio1 -text "Tool 1" -style Toolbutton
+    ] [
+        ttk::radiobutton .rf.bt2 -value bt2 -variable radio1 -text "Tool 2" -style Toolbutton
+    ] [
+        ttk::radiobutton .rf.bt3 -value bt3 -variable radio1 -text "Disabled 3" -style Toolbutton -state disabled
+    ] -sticky nsew
+
+grid [
+    ttk::labelframe .ef -text "Entries" -padding 4
+] - - -padx 6 -pady 6 -sticky nsew
+    set e1 "Normal"
+    set e2 "Disabled"
+    set e3 "Readonly"
+    grid [
+        ttk::label .ef.l1 -text $e1
+    ] [
+        ttk::entry .ef.e1 -textvariable e1
+    ] [
+        ttk::label .ef.l2 -text $e2
+    ] [
+        ttk::entry .ef.e2 -textvariable e2 -state disabled
+    ] [
+        ttk::label .ef.l3 -text $e3
+    ] [
+        ttk::entry .ef.e3 -textvariable e3 -state readonly
+    ] -sticky nsew -padx 4
+
+    # justification
+    set e4 "Left"
+    set e5 "Right"
+    set e6 "Center"
+    grid [
+        ttk::label .ef.l4 -text $e4
+    ] [
+        ttk::entry .ef.e4 -textvariable e4 -justify [string tolower $e4]
+    ] [
+        ttk::label .ef.l5 -text $e5
+    ] [
+        ttk::entry .ef.e5 -textvariable e5 -justify [string tolower $e5]
+    ] [
+        ttk::label .ef.l6 -text $e6
+    ] [
+        ttk::entry .ef.e6 -textvariable e6 -justify [string tolower $e6]
+    ] -sticky nsew -padx 4
+
+    
+grid [
+    ttk::labelframe .vf -text "Validated Entries (max length 8)" -padding 4
+] [
+    ttk::labelframe .cbf -text "Comboboxes" -padding 4
+] - -padx 6 -pady 6 -sticky nsew
+
+    set vcmd {expr {!(%d && ([string length %s]>7))}}
+    set ivcmd {%W delete 0 end; %W insert end [string range %s 0 7]}
+    set vmodes {none focus focusin focusout key all}
+
+    set ev0 "Password"
+    grid [
+        ttk::label .vf.lp0 -text $ev0
+    ] [
+        ttk::entry .vf.p0 -textvariable ev0 -validate "all" -validatecommand $vcmd  -show *
+    ] -sticky nsew
+
+    grid [
+        ::ttk::separator .vf.sep0 -orient horiz
+    ] - -pady 6 -sticky nsew
+
+    set spin 12.5
+    grid [
+        ttk::label .vf.ls0 -text "Spinbox"
+    ] [
+        ::ttk::spinbox .vf.s0 -from 0.0 -to 100.0 -increment 12.5 -textvariable spin -format %.1f
+    ] -sticky nsew
+
+    grid [
+        ::ttk::separator .vf.sep1 -orient horiz
+    ] - -pady 6 -sticky nsew
+
+    set i 0
+    foreach vmode $vmodes {
+        set ev[incr i] $vmode
+        grid [
+            ttk::label .vf.l$i -text [set ev$i]
+        ] [
+            ttk::entry .vf.e$i -textvariable ev$i -validate $vmode -validatecommand $vcmd -invalidcommand $ivcmd
+        ] -sticky nsew
+    }
+
+
+# comboboxes
+    set values "One Two Buckle My Shoe"
+    grid [
+        ::ttk::label .cbf.l1 -text "Combobox"
+    ] [
+        ::ttk::combobox .cbf.c1 -values $values     -width 10
+    ] [
+        ::ttk::label .cbf.l2 -text "Readonly"
+    ] [
+        ::ttk::combobox .cbf.c2 -values $values -state readonly     -width 10
+    ] [
+        ::ttk::label .cbf.l3 -text "Disabled"
+    ] [
+        ::ttk::combobox .cbf.c3 -values $values -state disabled     -width 10
+    ] -sticky nsew
+
+grid ^ [
+    ttk::labelframe .mf -text "Menubuttons" -padding 4
+] [
+    ttk::labelframe .pf -text "Scale and Progressbar" -padding 4
+] -padx 6 -pady 6 -sticky nsew
+
+    set menu {}
+    set dirs {above below left right flush}
+    set i 0
+    foreach dir $dirs {
+        set mb[incr i] $dir
+        grid [
+            ttk::label .mf.l$i -text [set mb$i]
+        ] [
+            ttk::menubutton .mf.e$i -text [set mb$i] -direction $dir -menu $menu
+        ] -sticky nsew
+    }
+
+    set p0 10
+    set p1 10
+    set pv0 10
+    set pv1 10
+    grid [
+        ::ttk::progressbar .pf.p0 -orient horiz -mode determinate -variable p0
+    ] [
+        ::ttk::separator .pf.sep -orient vert
+    ] [
+        ::ttk::progressbar .pf.pv0 -orient vert -mode determinate -variable pv0
+    ] [
+        ::ttk::scale .pf.sv0 -orient vert -from 0 -to 100 -variable pv0
+    ] [
+        ::ttk::progressbar .pf.pv1 -orient vert -mode indeterminate -variable pv1
+    ] [
+        ::ttk::scale .pf.sv1 -orient vert -from 0 -to 100 -variable pv1
+    ] -sticky nsew -padx 6 -pady 6
+
+    grid [
+        ::ttk::scale .pf.s0 -orient horiz -from 0 -to 100 -variable p0
+    ] ^ ^ ^ ^ ^ -sticky nsew -padx 6 -pady 6
+    grid [
+        ::ttk::progressbar .pf.p1 -orient horiz -mode indeterminate -variable p1
+    ] ^ ^ ^ ^ ^ -sticky nsew -padx 6 -pady 6
+    grid [
+        ::ttk::scale .pf.s1 -orient horiz -from 0 -to 100 -variable p1
+    ] ^ ^ ^ ^ ^ -sticky nsew -padx 6 -pady 6
+
+
+grid [
+    ::ttk::treeview .tvf.tv -columns {Theme} -show {headings}
+] -sticky nsew -padx 4 -pady 4
+
+set styles [::ttk::style theme names]
+.tvf.tv configure -height [llength $styles]
+
+foreach style $styles {
+    .tvf.tv insert {} end -id $style -text $style -values [list "Use the \"$style\" theme"]
+}
+
+.tvf.tv heading Theme -text Theme
+.tvf.tv selection set [list [::ttk::style theme use]]
+
+bind .tvf.tv <<TreeviewSelect>> {
+    ::ttk::style theme use [%W selection]
+}
+
+bind all  <Key> {
+    .kf.key configure -text "You pressed %K\n(keycode %k)"
+}
+bind all  <Button> {
+    .kf.key configure -text "Button %b"
+}

ADDED   hacks/widgets.tcl
Index: hacks/widgets.tcl
==================================================================
--- /dev/null
+++ hacks/widgets.tcl
@@ -0,0 +1,42 @@
+package require Tk
+
+package require tkImprover
+#source tkImprover-0.tm
+
+#bind . <Escape> {puts Escape:%M}
+#bind . <Return> {puts Return:%M}
+
+pack [button .b -text button -command {puts Button!}]
+pack [checkbutton .c -text check -command {puts Check!}]
+pack [radiobutton .r1 -text radio\ 1 -variable radio -value 1 -command {puts Radio:$::radio}]
+pack [radiobutton .r2 -text radio\ 2 -variable radio -value 2 -command {puts Radio:$::radio}]
+pack [entry .e]
+
+pack [ttk::button .tb -text button -command {puts Button!}]
+pack [ttk::checkbutton .tc -text check -command {puts Check!}]
+pack [ttk::radiobutton .tr1 -text radio\ 1 -variable radio -value 1 -command {puts Radio:$::radio}]
+pack [ttk::radiobutton .tr2 -text radio\ 2 -variable radio -value 2 -command {puts Radio:$::radio}]
+pack [ttk::entry .te]
+
+pack [text .t -undo 1]
+
+.e insert end "the sun always"
+.t insert end "
+    byteOrder - is the most significant, or least significant, byte first
+    machine - some info specific to the kind of hardware
+    os - a string identifying the operating system
+    osVersion - the version of the os
+    pathSeparator — character used to split variables like env(PATH) into a proper Tcl list (from 8.6)
+    platform - which of the major types of computers is this
+    pointerSize - bytes taken up by a void pointer (from 8.5)
+    user - user's login id
+    wordSize - number of bytes for a machine-word (actually, a long)
+"
+
+puts "\n\n====\n\n"
+foreach w {. .b .c .r1 .e .t .tb .tc .tr1 .te} {
+    puts "bindtags $w: [bindtags $w]"
+    puts "class $w: [set class [winfo class $w]]"
+    #puts "bind $class <Return>: [bind $class <Return>]"
+}
+

Index: inet/inet.tcl
==================================================================
--- inet/inet.tcl
+++ inet/inet.tcl
@@ -6,26 +6,28 @@
 # Probably a good example for benchmarking too.
 #
 # See http://networksorcery.com/enp/protocol/ip/ports00000.htm for assignments and references.
 #
 # Currently represented:
-#   tcpmux/1    rfc1078
-#   echo/7      rfc862
-#   discard/9   rfc863
-#   systat/11   rfc866
-#   daytime/13  rfc867
-#   netstat/15
-#   qotd/17     rfc865
-#   chargen/19  rfc864
-#   time/37     rfc868
-#   ident/113   rfc1413
-#   finger/79   rfc1288, 4146
-#   pwdgen/129  rfc972
+#   1     tcpmux   rfc1078
+#   7     echo     rfc862
+#   9     discard  rfc863
+#   11    systat   rfc866
+#   13    daytime  rfc867
+#   15    netstat  rfc866?
+#   17    qotd     rfc865
+#   19    chargen  rfc864
+#   37    time     rfc868
+#   43    whois    rfc3912
+#   79    finger   rfc1288, 4146
+#   113   ident    rfc1413
+#   129   pwdgen   rfc972
+#   1080  socks5   rfc1928 (outbound tcp only)
+#   8080  proxy    rfc2616(ish)
 #
 # Potentially interesting to add:
 #   telnet/23   (illustrate handling telnet \xff codes in a transchan)
-#   socks/1080  (socks4a out is almost trivial, see tcpmux) rfc1928
 #
 #   sntp/123    rfc5905     $ date -r$((16#`printf "\xb%-47.s"|nc -uw1 ntp.metas.ch 123|xxd -s40 -l4 -p`-2208988800))
 #       0b[string cat 00 001 011 ][ string repeat \x00 47]
 #       binary scan $resp a40I _ epoch
 #       incr epoch [clock scan {00:00 January 1, 1900 UTC}]     ;# -2208988800
@@ -38,25 +40,46 @@
 #     * schelte's upnp/ssdp could plug in nicely
 #   * a chat protocol (irc? ntalk?) would be fun
 #   * make qotd more efficient by caching, or by using fortune.dat
 #   * telnet?  With a stubborn client that WONT?
 #     * feeds into serial-over-tcp, which is useful
-#   * dustmote for http?
-#   * http proxy?
+#   * how simple http can get away with? dustmote?
 #
-package require coroutine
 
 namespace eval inet {
     variable BASEPORT 0         ;# offset from declared port
     namespace eval sockets {}   ;# we will keep coroutines here
 
     # our coros need to accept multiple arguments (tcpmux - for chan copy)
     proc yieldm args {yieldto string cat {*}$args}
 
-    # coroutine-friendly IO proxies:
-    proc gets args {tailcall coroutine::util gets {*}$args}
-    proc read args {tailcall coroutine::util read {*}$args}
+    # this is handy for cleanup
+    proc finally {script} {
+        tailcall trace add variable :#finally#: unset [list apply [list args $script]]
+    }
+
+    # coroutine-friendly IO proxies - like coroutine::util:
+    proc gets {chan args} {
+        if {![chan configure $chan -blocking]} {
+            set was [chan event $chan readable]
+            chan event $chan readable [list catch [info coroutine]]
+            yield
+            chan event $chan readable $was
+        }
+        tailcall ::gets $chan {*}$args
+    }
+
+    proc read {chan args} {
+        if {![chan configure $chan -blocking]} {
+            set was [chan event $chan readable]
+            chan event $chan readable [list catch [info coroutine]]
+            yield
+            chan event $chan readable $was
+        }
+        tailcall ::read $chan {*}$args
+    }
+
     proc after args {   ;# needs to wrap with [catch] in case the socket is killed while we're waiting
         if {[llength $args] == 1} {
             ::after {*}$args [list catch [info coroutine]]
             yield
         } else {
@@ -65,11 +88,13 @@
     }
 
     # accept and dispatch a new connection
     proc accept {handler chan host port} {
         chan configure $chan -blocking 0 -buffering line -translation auto
-        coroutine sockets::[namespace tail $handler]:$host:$port $handler $chan
+        # :: (as in ipv6 addresses) is not permissible in command names, except as a namespace separator
+        set coname [namespace tail $handler]:[string map {: _} $host]:$port
+        coroutine sockets::$coname $handler $chan
     }
 
     # set up all listening ports
     proc listen {{baseport 0}} {
         variable BASEPORT
@@ -84,18 +109,17 @@
 
     # declare a service
     proc service {name body} {
         set body [format {
             puts "Start [info coroutine]"
+            finally [list catch [list close $chan]]
             try {
                 %s
             } on error {e o} {
-                puts "Error on $chan: $e"
-            } finally {
-                catch {close $chan}
+                puts "Error in [info coroutine]: $e"
             }
-            puts "Close [info coroutine]"
+            puts "End [info coroutine]"
         } $body]
         tailcall proc $name {chan} $body
     }
 
 # HELP is a special method for tcpmux.  It doesn't listen on a port, so /*
@@ -145,11 +169,11 @@
     }
 
     service discard/9 {
         while {![eof $chan]} {
             # discard result
-            coroutine::util read $chan
+            read $chan
         }
     }
 
 # chargen, qotd send some data:
     service chargen/19 {
@@ -157,14 +181,14 @@
         set max [string length $chargen]
         append chargen $chargen
         set i 0
         while {![eof $chan]} {
             while {[chan pending output $chan]} {
-                coroutine::util after idle
+                after idle
             }
             puts $chan [string range $chargen $i $i+71]
-            coroutine::util after idle      ;# make sure other clients get serviced!
+            after idle      ;# make sure other clients get serviced!
             incr i
             if {$i >= $max} {incr i -$max}
         }
     }
 
@@ -246,11 +270,11 @@
                 puts $chan "$remote, $local : USERID : $opsys, $charset : $userid"
             }
         }
         # FIXME: this can continue to accept requests, timing out after 60-180s idle
     }
-    
+
     service pwdgen/129 { ;# rfc972
         package require base64
         for {set i 0} {$i < 6} {incr i} {
             set bits [lmap _ {1 2 3} {expr {entier((2**16)*rand())}}]
             set pw [base64::encode [binary format ttt {*}$bits]]
@@ -276,10 +300,180 @@
     service netstat/15 {
         foreach cmd [info commands sockets::*] {
             puts $chan $cmd
         }
     }
+
+# socks5 is pretty simple - outbound TCP only
+    service socks5/1080 {
+        chan configure $chan -encoding binary -bufferin none
+
+        # authentication
+        scan [read $chan 2] %c%c ver nmeth
+        if {$ver != 5} return
+        binary scan [read $chan $nmeth] c* meths
+        if {0 in $meths} {          ;# no authentication! yay
+            # do nothing?
+        } elseif {2 in $meths} {    ;# user/passwd
+            scan [read $chan 2] %c%c ver len
+            if {$ver != 1} return
+            set username [read $chan $len]
+            scan [read $chan 1] %c len
+            set password [read $chan $len]
+            puts -nonewline $chan \1\0  ;# success!
+        } else {                    ;# no supported auth methods
+            puts -nonewline $chan \x05\xff
+            return
+        }
+
+        # request
+        scan [read $chan 4] %c%c%c%c ver cmd z atyp
+        if {$ver != 5 || $z != 0} return
+
+        if {$atyp == 1} {
+            scan [read $chan 4] %c%c%c%c a b c d
+            set dst $a.$b.$c.$d
+        } elseif {$atyp == 3} {
+            scan [read $chan 1] %c alen
+            set dst [read chan $alen]
+        } elseif {$atyp == 4} {
+            binary scan [read $chan 16] c* dst
+            set dst [join $dst :]
+        }
+
+        binary scan [read $chan 2] Su dpt
+
+        if {$cmd == 3} {        ;# UDP
+            puts -nonewline $chan \5\7\0\3\0\0\0    ;# cmd not supported ":0"
+            return
+        } elseif {$cmd == 2} {  ;# bind
+            puts -nonewline $chan \5\7\0\3\0\0\0    ;# cmd not supported ":0"
+            return
+        } elseif {$cmd == 1} {  ;# connect
+
+            set upchan [socket -async $dst $dpt]
+            finally [list catch [list close $upchan]]
+
+            yieldto chan event $upchan writable [info coroutine]
+            chan event $upchan writable ""
+
+            set err [chan configure $upchan -error]
+            if {$err ne ""} {
+                # 1 generic 2 notallowed
+                # 3 netunreach 4 hostunreach
+                # 5 connrefused 6 ttlexpired
+                puts -nonewline $chan \5\5\0\1\0\0\0    ;# connection refused
+                return
+            }
+
+            lassign [chan configure $upchan -peername] myaddr _ myport
+
+            if {[scan $myaddr %d.%d.%d.%d a b c d] == 4} {
+                set myaddr [format %c%c%c%c 3 $a $b $c $d]  ;# ipv4
+            } else {
+                # pack an IPv6 address
+                lassign [split $myaddr ::] a b
+                set myaddr [lrepeat 16 0]
+                set i -1
+                foreach octet $a {
+                    lset $myaddr [incr i] $octet
+                }
+                set i 16
+                foreach octet [lreverse $b] {
+                    lset $myaddr [incr i -1] $octet
+                }
+                set myaddr [binary format cc* 4 $myaddr]    ;# ipv6
+            }
+            set myport [binary format Su $myport]
+            puts -nonewline $chan \5\0\0$myaddr$myport      ;# OK
+
+            chan configure $upchan -translation binary
+
+            chan copy $chan $upchan -command [info coroutine]
+            chan copy $upchan $chan -command [info coroutine]
+            lassign [yieldm] nbytes err     ;# twice to catch both events
+            lassign [yieldm] nbytes err
+        }
+    }
+
+# a web proxy is a very nice thing to have, and not really much more complex:
+    service proxy/8080 {
+
+        chan configure $chan -translation crlf  -encoding iso8859-1
+
+        # read first line
+        gets $chan request
+
+        # read until \n\n
+        set preamble ""
+        while {[gets $chan line] > 0} {
+            append preamble $line\n
+        }
+        # note $preamble doesn't include the extra \n
+
+        # parse request line
+        if {![regexp {^([A-Z]+) (.*) (HTTP/.*)$} $request -> verb dest httpver]} {
+            throw {PROXY BAD_REQUEST} "Bad request: $request"
+        }
+
+        if {[regexp {^(\w+)://\[([^\]/ ]+)\](?::(\d+))?(.*)$} $dest -> scheme host port path]} {
+            # IPv6 URL
+        } elseif {[regexp {^(\w+)://([^:/ ]+)(?::(\d+))?(.*)$} $dest -> scheme host port path]} {
+            # normal URL
+        } elseif {[regexp {^([^:/ ]+)(?::(\d+))?$} $dest -> host port]} {
+            # CONNECT-style host:port
+        } elseif {[regexp {^\[([^\]/ ]+)\](?::(\d+))?$} $dest -> host port]} {
+            # CONNECT-style host:port IPv6
+        } else {
+            throw {PROXY BAD_URL} "Bad URL: $dest"
+        }
+
+        if {$port eq ""} {set port 80}
+
+        # open outgoing conn
+        set upchan [socket -async $host $port]  ;# -async ensures we don't block other clients.
+                                                ;# But beware:  DNS lookup blocks!
+
+        chan configure $upchan -blocking 0 -translation crlf -buffering none   -encoding iso8859-1
+
+        # wait till we're connected:
+        yieldto chan event $upchan writable [info coroutine]
+        chan event $upchan writable ""
+
+        # .. or did connection fail?
+        set err [chan configure $upchan -error]
+        if {$err ne ""} {
+            # FIXME: smarter responses
+            puts $chan "$httpver 502 Bad Gateway"
+            puts $chan "Content-type: text/plain"
+            puts $chan ""
+            puts $chan "Error connecting to $host port $port:"
+            puts $chan "  $err"
+            return
+        }
+        finally [list close $upchan]
+
+        if {$verb eq "CONNECT"} {
+            # for CONNECT, we need to synthesise a response:
+            puts $chan "$httpver 200 OK"
+            puts $chan ""
+        } else {
+            # else, forward the request headers:
+            puts $upchan $request
+            puts $upchan $preamble  ;# extra newline is wanted here!
+        }
+
+        # revert to binary mode, and hand over to [chan copy]:
+        chan configure $chan   -buffering none -translation binary -encoding binary
+        chan configure $upchan -buffering none -translation binary -encoding binary
+        chan copy $chan $upchan -command [info coroutine]
+        chan copy $upchan $chan -command [info coroutine]
+        lassign [yieldm] nbytes err     ;# twice to catch both events
+        lassign [yieldm] nbytes err
+
+        # and we're done!  Cleanup is automatic.
+    }
 
 }
 
 ::inet::listen 10000
 vwait forever

Index: modules/README
==================================================================
--- modules/README
+++ modules/README
@@ -28,5 +28,8 @@
 
 totp-0.tm       -- simple totp/hotp implementation
 
 tdbcplus-0.1.tm -- monkey patches for TDBC.  Illustrates [mixin] well.
 
+sql-0.tm        -- helpers for safely composing SQL queries
+
+snidgets/       -- various (mega-)widgets using the wonderful snit

ADDED   modules/adebug-0.tm
Index: modules/adebug-0.tm
==================================================================
--- /dev/null
+++ modules/adebug-0.tm
@@ -0,0 +1,273 @@
+# Usage:
+#   try {package require debug} on error {} {proc debug args {}}
+#
+package require fun     ;# ?
+package require extend  ;# dict get?
+
+# this is intended to help with transcripts, but it ain't there yet
+proc % args {
+    #puts L:[info level [info level]]
+    #puts F:[info frame -1]
+    puts [dict get [info frame -1] cmd]
+    #puts "% [debug level -1]"
+    set rc [catch {uplevel 1 $args} e o]
+    if {$rc} {
+        ei
+    } elseif {$e ne ""} {
+        puts $e
+    }
+    return {*}$o $e
+}
+
+namespace eval debug {
+    # gather context information for display:
+    proc what {} {
+        lograw [string repeat " " [info level]][uplevel 1 namespace current]::[info level -1]
+    }
+    proc level {{l -1}} { ;# this doesn't seem to work in the repl, and I'm not sure why
+        incr l [info level]
+        for {set f 1} {1} {incr f} {
+            set fr [info frame $f]
+            if {[dict exists $fr level] && [dict get $fr level]==$l} {
+                return [dict get $fr cmd]
+            }
+        }
+    }
+
+    proc watch {varName} {
+        set varName [uplevel 1 [list namespace which -variable $varName]]
+        debug log {WATCH- tracing $varName}
+        trace add variable $varName write [lambda {varName args} {
+            debug log {WATCH: $varName = [set $varName]}
+            debug log {WATCH  in [debug stack]}
+        }]
+    } 
+    proc watcharray {varName} {
+        set varName [uplevel 1 [list namespace which -variable $varName]]
+        debug log {WATCH- tracing $varName}
+        trace add variable $varName write [lambda {varName key args} {
+            debug log {WATCH: ${varName}($key) = [set ${varName}($key)]}
+            debug log {WATCH  in [debug stack]}
+        }]
+    }
+    proc stack {} {
+        set l [info level]
+        set res {}
+        while {[incr l -1] >= 0} {
+            lappend res [info level $l]
+        }
+        set res
+    }
+    proc frames {} {
+        set l [info frame]
+        set res {}
+        while {[incr l -1] >= 0} {
+            lappend res [info frame $l]
+        }
+        set res
+    }
+
+    proc vars {{patterns *}} {
+        set res {}
+        foreach varName [concat {*}[map {uplevel 1 info vars} $patterns]] {
+            if {![uplevel 1 [list info exists $varName]]} {
+                # declared but uninitialised variables - ignore them
+            } elseif {[uplevel 1 [list array exists $varName]]} {
+                # ignore arrays
+            } else {
+                dict set res $varName [uplevel 1 [list set $varName]]
+            }
+        }
+        set res
+    }
+
+    proc locals {{patterns *}} {
+        foreach varName [concat {*}[map {uplevel 1 info locals} $patterns]] {
+            if {[Uplevel 1 array exists $varName]} {
+                Uplevel 1 parray $varName
+            } else {
+                Uplevel 1 debug show \$[list $varName]
+            }
+        }
+    }
+
+    proc getproc {name} {
+        set argList [info args $name]
+        set args [lmap arg [info args $name] {
+            if {[info default $name $arg default]} {
+                list $arg $default
+            } else {
+                set arg
+            }
+        }]
+        set body [info body $name]
+        return [list proc $name $args $body]
+    }
+
+    # just dumps info to stdout.  Here because introspection is fun.
+    proc dumpns {{ns ::}} {
+        # transitive closure:
+        foreach ns [tclose {namespace children} ::] {
+            foreach cmd [info commands ${ns}::*] {
+                puts [list command $cmd]
+            }
+            foreach var [info vars ${ns}::*] {
+                try {
+                    if {[array exists $var]} {
+                        puts [list array $var [array get $var]]
+                    } else {
+                        puts [list variable $var [set $var]]
+                    }
+                } on error {} {
+                    puts [list UNREADABLE $var]
+                }
+            }
+        }
+    }
+
+    proc ::noop args {}     ;# this goes in global space
+    proc ::no-op args {}    ;# some call it no-op
+
+    # like assert.h's NDEBUG: make everything a noop
+    proc ndebug {} {
+        interp alias {} ::debug {} ::noop
+    }
+    proc off {} {
+        interp alias {} [uplevel 1 namespace current]::debug {} ::noop
+    }
+
+    proc show {args} {
+        foreach s $args {
+            try {
+                puts "\[DEBUG\]: [list $s -> [uplevel 1 subst [list $s]]]"
+            } on error e {
+                puts "\[DEBUG-ERROR\]: $e evaluating [list $s]"
+            }
+        }
+    }
+
+    proc pdict {d} {
+        dict for {k v} $d {
+            if {[string length $v] > 100} {
+                set v [string range $v 0 99]\u2026
+            }
+            debug log { $k -> $v}
+        }
+    }
+
+    proc transcript {args} {
+        foreach cmd [cmdsplit [concat {*}$args]] {
+            debug log "% $cmd\n"
+            try {
+                set res [uplevel 1 $cmd]
+                if {$res ne ""} {debug log "#  $res"}
+            } on error {e o} {
+                debug perror $e $o
+            }
+        }
+    }
+
+    # this should support logging to a different chan
+    # facilities and level filtering ..
+    # facility: namespace of caller?  first known namespace on call stack?
+    proc lograw {args} {
+        puts "\[DEBUG\]: $args"
+    }
+
+    proc ms {} {
+        clock format [clock seconds] -format %M:%S
+    }
+    proc log {args} {
+        try {
+            puts "[ms]:\[DEBUG\]: [uplevel 1 subst [list $args]]"
+        } on error e {
+            puts "\[DEBUG-ERROR\]: $e evaluating [list $args]"
+        }
+        return
+        try {
+            puts "\[DEBUG\]: [uplevel 1 subst [list $s]]"
+        } on error e {
+            puts "\[DEBUG-ERROR\]: $e evaluating [list $s]"
+        }
+    }
+
+    proc assert {x {msg ""}} {
+        if {![uplevel 1 expr [list $x]]} {
+            catch {
+                set y [uplevel 1 [list subst -noc $x]]
+                if {$y ne $x} {
+                    set x "{$y} from {$x}"
+                }
+            }
+            throw ASSERT "[concat "Assertion failed!" $msg] $x"
+        }
+    }
+
+    proc demo args {
+        log {% $args}
+        set rc [catch {uplevel 1 $args} e o]
+        if {$rc} {
+            log {  --> ERROR($rc): $e [dict get $o -errorcode]}
+        } else {
+            log {  --> $e}
+        }
+        return {*}$o $e
+    }
+    proc where {{lvl 0}} {
+        incr lvl -1
+        set d [info frame $lvl]
+        string cat "[dict get? $d type] [dict get? $d proc] at [dict get? $d file]:[dict get? $d line]"
+    }
+    proc do args {
+        set where [debug where -1]
+        log {DOING at $where: {$args}}
+        set rc [catch {uplevel 1 $args} e o]
+        log {RESULT : $rc {$e}}
+        return {*}$o $e
+    }
+    proc eval {args} {
+        log {TRACE => {$args}}
+        set rc [catch {uplevel 1 $args} e o]
+        log {TRACE <= $rc {$e}}
+        return {*}$o $e
+    }
+
+    namespace eval tracer {
+        namespace path [namespace parent [namespace current]]
+        variable depth
+        proc enter {command _} {
+            variable depth
+            log {TRACE [string repeat \  $depth]$command}
+            incr depth
+        }
+        proc leave {command code result _} {
+            variable depth
+            incr depth -1
+            log {TRACE [string repeat \  $depth]= ($code) {$result}}
+        }
+    }
+
+    proc tracecmd {cmd} {
+        set cmd [uplevel 1 [list namespace which $cmd]]
+        trace add execution $cmd enter ::[namespace current]::tracer::enter
+        trace add execution $cmd leave ::[namespace current]::tracer::leave
+    }
+
+    proc errorproc {tid error} {
+        debug log {THREAD ERROR from $tid: $error}
+    }
+
+    proc bgerror {err opts} {
+        debug log {BGERROR $err}
+        debug pdict $opts
+    }
+
+    proc perror {err opts} {
+        debug log {ERROR: $err}
+        debug pdict $opts
+    }
+
+    namespace export {[a-z]*}
+    namespace ensemble create
+}
+

Index: modules/asciipacket-0.tm
==================================================================
--- modules/asciipacket-0.tm
+++ modules/asciipacket-0.tm
@@ -1,6 +1,6 @@
-source bitnary-0.tm
+package require bitnary
 
 namespace eval asciipacket {
     proc assert {expr} {    ;# for "static" assertions that throw nice errors
         if {![uplevel 1 [list expr $expr]]} {
             raise {ASSERT ERROR} "{$expr} {[subst -noc $expr]}"
@@ -75,10 +75,12 @@
         }
         return $result
     }
 }
  
+package require mainscript
+if {[mainscript?]} {
 proc test {} {
     set header {
         +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
         |                      ID                       |
         +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
@@ -116,5 +118,6 @@
     dict for {k v} $values {
         debug assert {$v == [dict get $decoded $k]}
     }
 }
 test
+}

Index: modules/bitnary-0.tm
==================================================================
--- modules/bitnary-0.tm
+++ modules/bitnary-0.tm
@@ -89,11 +89,12 @@
         tailcall ::try [join $script \n\t]
     }
 }
 
 
-if 1 {
+package require mainscript
+if {[mainscript?]} {
     proc h2b args { binary format H* [join $args ""] }
     proc b2h {data} { binary scan $data H* hex; set hex }
     proc frombinary args { binary format B* [join $args ""] }
     proc tobinary {s} { binary scan $s B* d; set d }
 

Index: modules/chans-0.tm
==================================================================
--- modules/chans-0.tm
+++ modules/chans-0.tm
@@ -46,10 +46,71 @@
         proc flush {what x}              { }
         namespace export *
         namespace ensemble create -parameters what
     }
 
+    oo::class create fifo {
+        variable Block
+        variable Watch
+        variable Data
+        variable Size
+        constructor {{size 1}} {
+            set Block 1
+            set Watch {}
+            set Size $size
+            set Data {}
+        }
+        method Postevent {chan event} {
+            if {$event in $Watch} {
+                # FIXME: after idle? (see http://core.tcl.tk/tcl/tktview?name=67a5eabbd3)
+                chan postevent $chan $event
+            }
+        }
+        method data {} {
+            return $Data
+        }
+        method initialize {chan mode} {
+            return {initialize finalize blocking watch read write}
+        }
+        method finalize {chan} {
+            my destroy
+        }
+        method blocking {chan mode} {
+            set Block $mode
+        }
+        method watch {chan events} {
+            set Watch $events
+        }
+        method read {chan bytes} {
+            if {$Data eq ""} {
+                #puts REAGAIN
+                error EAGAIN
+            }
+            set data [lpop Data]
+            #puts "READ: $data"
+            if {[llength $Data] < $Size} {
+                my Postevent $chan "write"
+            }
+            if {$Data ne ""} {
+                my Postevent $chan "read"
+            }
+            return $data
+        }
+        method write {chan data} {
+            if {[llength $Data] >= $Size} {
+                #puts WEAGAIN
+                error EAGAIN
+            }
+            #puts "WRITE: $data"
+            lappend Data $data
+            my Postevent $chan "read"
+            if {[llength $Data] < $Size} {
+                my Postevent $chan "write"
+            }
+            string length $data
+        }
+    }
 
     proc eachobj {_obj chan script} {
         upvar 1 $_obj obj
         while {1} {
             if {[coroutine::util gets $chan line] < 1} {
@@ -95,5 +156,20 @@
         }
     }
 
 
 }
+
+if 0 {
+    chans::fifo create fi 2
+    set fd [chan create {read write} fi]
+    chan configure $fd -buffering line -blocking 0
+    foreach i {0 1 2} {
+        puts $fd lalala$i
+        puts put$i:[fi data]
+        flush $fd
+    }
+    foreach i {0 1 2 3} {
+        puts line$i:[gets $fd line]:$line
+        puts get$i:[fi data]
+    }
+}

DELETED modules/debug-0.tm
Index: modules/debug-0.tm
==================================================================
--- modules/debug-0.tm
+++ /dev/null
@@ -1,273 +0,0 @@
-# Usage:
-#   try {package require debug} on error {} {proc debug args {}}
-#
-package require fun     ;# ?
-package require extend  ;# dict get?
-
-# this is intended to help with transcripts, but it ain't there yet
-proc % args {
-    #puts L:[info level [info level]]
-    #puts F:[info frame -1]
-    puts [dict get [info frame -1] cmd]
-    #puts "% [debug level -1]"
-    set rc [catch {uplevel 1 $args} e o]
-    if {$rc} {
-        ei
-    } elseif {$e ne ""} {
-        puts $e
-    }
-    return {*}$o $e
-}
-
-namespace eval debug {
-    # gather context information for display:
-    proc what {} {
-        lograw [string repeat " " [info level]][uplevel 1 namespace current]::[info level -1]
-    }
-    proc level {{l -1}} { ;# this doesn't seem to work in the repl, and I'm not sure why
-        incr l [info level]
-        for {set f 1} {1} {incr f} {
-            set fr [info frame $f]
-            if {[dict exists $fr level] && [dict get $fr level]==$l} {
-                return [dict get $fr cmd]
-            }
-        }
-    }
-
-    proc watch {varName} {
-        set varName [uplevel 1 [list namespace which -variable $varName]]
-        debug log {WATCH- tracing $varName}
-        trace add variable $varName write [lambda {varName args} {
-            debug log {WATCH: $varName = [set $varName]}
-            debug log {WATCH  in [debug stack]}
-        }]
-    } 
-    proc watcharray {varName} {
-        set varName [uplevel 1 [list namespace which -variable $varName]]
-        debug log {WATCH- tracing $varName}
-        trace add variable $varName write [lambda {varName key args} {
-            debug log {WATCH: ${varName}($key) = [set ${varName}($key)]}
-            debug log {WATCH  in [debug stack]}
-        }]
-    }
-    proc stack {} {
-        set l [info level]
-        set res {}
-        while {[incr l -1] >= 0} {
-            lappend res [info level $l]
-        }
-        set res
-    }
-    proc frames {} {
-        set l [info frame]
-        set res {}
-        while {[incr l -1] >= 0} {
-            lappend res [info frame $l]
-        }
-        set res
-    }
-
-    proc vars {{patterns *}} {
-        set res {}
-        foreach varName [concat {*}[map {uplevel 1 info vars} $patterns]] {
-            if {![uplevel 1 [list info exists $varName]]} {
-                # declared but uninitialised variables - ignore them
-            } elseif {[uplevel 1 [list array exists $varName]]} {
-                # ignore arrays
-            } else {
-                dict set res $varName [uplevel 1 [list set $varName]]
-            }
-        }
-        set res
-    }
-
-    proc locals {{patterns *}} {
-        foreach varName [concat {*}[map {uplevel 1 info locals} $patterns]] {
-            if {[Uplevel 1 array exists $varName]} {
-                Uplevel 1 parray $varName
-            } else {
-                Uplevel 1 debug show \$[list $varName]
-            }
-        }
-    }
-
-    proc getproc {name} {
-        set argList [info args $name]
-        set args [lmap arg [info args $name] {
-            if {[info default $name $arg default]} {
-                list $arg $default
-            } else {
-                set arg
-            }
-        }]
-        set body [info body $name]
-        return [list proc $name $args $body]
-    }
-
-    # just dumps info to stdout.  Here because introspection is fun.
-    proc dumpns {{ns ::}} {
-        # transitive closure:
-        foreach ns [tclose {namespace children} ::] {
-            foreach cmd [info commands ${ns}::*] {
-                puts [list command $cmd]
-            }
-            foreach var [info vars ${ns}::*] {
-                try {
-                    if {[array exists $var]} {
-                        puts [list array $var [array get $var]]
-                    } else {
-                        puts [list variable $var [set $var]]
-                    }
-                } on error {} {
-                    puts [list UNREADABLE $var]
-                }
-            }
-        }
-    }
-
-    proc ::noop args {}     ;# this goes in global space
-    proc ::no-op args {}    ;# some call it no-op
-
-    # like assert.h's NDEBUG: make everything a noop
-    proc ndebug {} {
-        interp alias {} ::debug {} ::noop
-    }
-    proc off {} {
-        interp alias {} [uplevel 1 namespace current]::debug {} ::noop
-    }
-
-    proc show {args} {
-        foreach s $args {
-            try {
-                puts "\[DEBUG\]: [list $s -> [uplevel 1 subst [list $s]]]"
-            } on error e {
-                puts "\[DEBUG-ERROR\]: $e evaluating [list $s]"
-            }
-        }
-    }
-
-    proc pdict {d} {
-        dict for {k v} $d {
-            if {[string length $v] > 100} {
-                set v [string range $v 0 99]\u2026
-            }
-            debug log { $k -> $v}
-        }
-    }
-
-    proc transcript {args} {
-        foreach cmd [cmdsplit [concat {*}$args]] {
-            debug log "% $cmd\n"
-            try {
-                set res [uplevel 1 $cmd]
-                if {$res ne ""} {debug log "#  $res"}
-            } on error {e o} {
-                debug perror $e $o
-            }
-        }
-    }
-
-    # this should support logging to a different chan
-    # facilities and level filtering ..
-    # facility: namespace of caller?  first known namespace on call stack?
-    proc lograw {args} {
-        puts "\[DEBUG\]: $args"
-    }
-
-    proc ms {} {
-        clock format [clock seconds] -format %M:%S
-    }
-    proc log {args} {
-        try {
-            puts "[ms]:\[DEBUG\]: [uplevel 1 subst [list $args]]"
-        } on error e {
-            puts "\[DEBUG-ERROR\]: $e evaluating [list $args]"
-        }
-        return
-        try {
-            puts "\[DEBUG\]: [uplevel 1 subst [list $s]]"
-        } on error e {
-            puts "\[DEBUG-ERROR\]: $e evaluating [list $s]"
-        }
-    }
-
-    proc assert {x {msg ""}} {
-        if {![uplevel 1 expr [list $x]]} {
-            catch {
-                set y [uplevel 1 [list subst -noc $x]]
-                if {$y ne $x} {
-                    set x "{$y} from {$x}"
-                }
-            }
-            throw ASSERT "[concat "Assertion failed!" $msg] $x"
-        }
-    }
-
-    proc demo args {
-        log {% $args}
-        set rc [catch {uplevel 1 $args} e o]
-        if {$rc} {
-            log {  --> ERROR($rc): $e [dict get $o -errorcode]}
-        } else {
-            log {  --> $e}
-        }
-        return {*}$o $e
-    }
-    proc where {{lvl 0}} {
-        incr lvl -1
-        set d [info frame $lvl]
-        string cat "[dict get? $d type] [dict get? $d proc] at [dict get? $d file]:[dict get? $d line]"
-    }
-    proc do args {
-        set where [debug where -1]
-        log {DOING at $where: {$args}}
-        set rc [catch {uplevel 1 $args} e o]
-        log {RESULT : $rc {$e}}
-        return {*}$o $e
-    }
-    proc eval {args} {
-        log {TRACE => {$args}}
-        set rc [catch {uplevel 1 $args} e o]
-        log {TRACE <= $rc {$e}}
-        return {*}$o $e
-    }
-
-    namespace eval tracer {
-        namespace path [namespace parent [namespace current]]
-        variable depth
-        proc enter {command _} {
-            variable depth
-            log {TRACE [string repeat \  $depth]$command}
-            incr depth
-        }
-        proc leave {command code result _} {
-            variable depth
-            incr depth -1
-            log {TRACE [string repeat \  $depth]= ($code) {$result}}
-        }
-    }
-
-    proc tracecmd {cmd} {
-        set cmd [uplevel 1 [list namespace which $cmd]]
-        trace add execution $cmd enter ::[namespace current]::tracer::enter
-        trace add execution $cmd leave ::[namespace current]::tracer::leave
-    }
-
-    proc errorproc {tid error} {
-        debug log {THREAD ERROR from $tid: $error}
-    }
-
-    proc bgerror {err opts} {
-        debug log {BGERROR $err}
-        debug pdict $opts
-    }
-
-    proc perror {err opts} {
-        debug log {ERROR: $err}
-        debug pdict $opts
-    }
-
-    namespace export {[a-z]*}
-    namespace ensemble create
-}
-

ADDED   modules/easywin-0.1.tm
Index: modules/easywin-0.1.tm
==================================================================
--- /dev/null
+++ modules/easywin-0.1.tm
@@ -0,0 +1,573 @@
+# from http://wiki.tcl.tk/20619 revision 10 2015-12-01
+if 0 {
+    [NEM] 2008-01-11: Here is a little (ish) package that wraps up [toplevel], [wm], [winfo]
+    and [MacWindowStyle] into a single mega-widget using [snit]. The window is actually somewhat
+    more than just a toplevel, as it incorporates a toolbar ([ttk::frame]), menubar and a status/
+    progressbar, as these are frequently needed items (at least for the apps I like to develop).
+    I'm trying to put as much platform-specific knowledge into the implementation of this as
+    possible, while keeping the interface platform-independent. Options that only make sense on
+    a certain platform are ignored on others, etc.
+
+        easywin .ew -option value -option value ...
+
+    OPTIONS:
+
+    A rather large number of options are supported, and probably more will be added.
+
+        -title:         Set the title of the window (i.e. [wm title]).
+        -toolbar:       Boolean, indicates whether to display the toolbar or not.
+        -statusbar:     Whether to display the statusbar (and progressbar).
+        -document:      Use this to set the full path name of the file currently being viewed in the window (if it is being used in that way).
+                        On Mac this will set the -titlepath so that an appropriate proxy icon is displayed (very cool bit of polish).
+        -modified:      Indicates whether the contents of the window have been modified since last save.
+
+    Lots of other options which related to various [wm attributes] options for different platforms (and are no-ops on other platforms).
+
+        -windowclass:   Sets the window class on TkAqua (see [MacWindowStyle])
+        -attributes:    Sets the window attributes on TkAqua (see [MacWindowStyle])
+        -savecommand:   Sets a command to invoke to save the current window contents (see below).
+
+    METHODS:
+
+        $win status ?msg?:          Get or set the current status message displayed in the statusbar.
+        $win progress total done:   Set the current progress value. 
+            This will display a progress bar in the statusbar if one is not already visible.
+            If total==done then the progressbar is hidden again.
+        $win hide ?component?/show ?component?/hidden ?component/toggle ?component?:   Hide or show a particular component of the window or check the status of a component.
+            Valid component names are:
+                self (ie, the entire window) (default)
+                statusbar
+                toolbar
+        $win toolbar:               Returns the tk command of the toolbar frame widget, so you can add items to it.
+
+    In addition, direct access to the underlying widgets is provided through the commands
+
+        $win statusbar ...:   
+        $win progressbar ...:   
+        $win menu ...:   
+
+    So for example you can do
+        $win menu add cascade ...
+
+    Various other methods exist: essentially the whole of [wm] and [winfo] exist as methods on the window.
+
+    PROMPT TO SAVE FILE:
+
+    If you supply a ''-savecommand'' option then the widget will check the ''-modified'' flag when
+    a user attempts to close the window. If the contents have been modified then a dialog will be
+    displayed asking if the user wants to save first. If they click yes, then the -savecommand is
+    invoked passing the window name as an argument.
+}
+# easywin.tcl --
+#
+#       A wrapper around Tk's built-in toplevel command, providing support for
+#       toolbars etc.
+#
+# Author: 2008 Neil Madden (nem@cs.nott.ac.uk).
+# Public Domain.
+
+package require Tcl         8.5
+package require Tk          8.5
+package require snit        2.2
+
+snit::widgetadaptor easywin {
+    option -title       -default "" -configuremethod ChangeTitle
+    option -toolbar     -default 0  -configuremethod ChangeComponent
+    option -statusbar   -default 0  -configuremethod ChangeComponent
+    option -document    -default "" -configuremethod ChangeDocument \
+                                    -cgetmethod      GetDocument
+    option -modified    -default 0  -configuremethod ChangeAttribute \
+                                    -cgetmethod      GetAttribute
+    option -alpha       -default 1  -configuremethod ChangeAttribute \
+                                    -cgetmethod      GetAttribute
+    option -toolwindow  -default 0  -configuremethod ChangeAttribute \
+                                    -cgetmethod      GetAttribute
+    option -topmost     -default 0  -configuremethod ChangeAttribute \
+                                    -cgetmethod      GetAttribute
+    option -disabled    -default 0  -configuremethod ChangeAttribute \
+                                    -cgetmethod      GetAttribute
+    option -fullscreen  -default 0  -configuremethod ChangeAttribute \
+                                    -cgetmethod      GetAttribute
+    option -transparentcolor -default 0  -configuremethod ChangeAttribute \
+                                    -cgetmethod      GetAttribute
+    option -notify      -default 0  -configuremethod ChangeAttribute \
+                                    -cgetmethod      GetAttribute
+    option -transparent -default 0  -configuremethod ChangeAttribute \
+                                    -cgetmethod      GetAttribute
+    option -zoomed      -default 0  -configuremethod ChangeAttribute \
+                                    -cgetmethod      GetAttribute
+    option -aspect      -default "" -configuremethod ChangeAspect
+    option -client      -default [info hostname] \
+                        -configuremethod ChangeClient
+    # Tk Aqua window class and attributes (no-ops on other platforms)
+    option -windowclass -default "document" -readonly 1
+    option -attributes  -default {toolbarButton standardDocument} \
+                        -readonly 1
+    option -transient   -default ""  -configuremethod ChangeTransient
+    option -savecommand -default ""
+    delegate option -orient to mainframe
+
+    component statusbar -public statusbar
+    component progress  -public progressbar
+    component menu      -public menu
+
+    component mainframe
+    component toolbar
+
+    delegate option * to hull
+    delegate method * to mainframe
+
+    variable hidden [dict create]
+
+    typevariable wmoptions
+    typeconstructor {
+        lappend ::snit::hulltypes window glib::window
+        set wmoptions(aqua)     {-fullscreen -topmost -modified -titlepath
+                                 -alpha -notify}
+        set wmoptions(win32)    {-fullscreen -alpha -toolwindow -topmost
+                                 -transparentcolor -disabled}
+        set wmoptions(x11)      {-fullscreen -topmost -zoomed}
+    }
+
+    constructor args {
+
+        # Extract options that must be supplied at creation time.
+        set class ArtclWindow
+        set orient vertical
+        foreach op {class orient} {
+            if {[set idx [lsearch -exact $args -$op]] >= 0} {
+                set $op [lindex $args [expr {$idx+1}]]
+                set args [lreplace $args $idx [incr idx]]
+            }
+        }
+
+        if {[tk windowingsystem] eq "aqua"} {
+            set tstyle Toolbar
+        } else {
+            set tstyle TFrame
+        }
+
+        # Construct components
+        installhull         using toplevel -class $class
+        wm withdraw $win
+        install menu        using menu $win.mb
+        install toolbar     using ttk::frame $win.tb -style $tstyle
+        install mainframe   using ttk::panedwindow $win.main \
+                                -orient $orient
+        install statusbar   using ttk::label $win.status \
+                                -font TkSmallCaptionFont \
+                                -padding 2
+        install progress    using ttk::progressbar $win.progress \
+                                -orient horizontal -mode determinate
+
+        $self configure -menu $menu
+        wm protocol $win WM_DELETE_WINDOW [mymethod close]
+        bind $win <<ToolbarButton>> [mymethod toggle toolbar]
+
+        # Layout
+        grid $toolbar       -sticky ew      -columnspan 2
+        grid [ttk::separator $win.tsep -orient vertical] \
+                            -sticky ew      -columnspan 2
+        grid $mainframe     -sticky nsew    -columnspan 2
+        grid [ttk::separator $win.bsep -orient vertical] \
+                            -sticky ew      -columnspan 2
+        grid $statusbar $progress -sticky ew
+
+        # Add some space to avoid the window resize grip on Aqua
+        grid configure $progress -padx {0 20}
+        grid remove $progress
+
+        grid columnconfigure $win 0 -weight 1
+        grid rowconfigure    $win 2 -weight 1
+
+        $self configurelist $args
+
+        # Apply the window style on Mac OS X before the window gets mapped.
+        if {[tk windowingsystem] eq "aqua"} {
+            ::tk::unsupported::MacWindowStyle style $win \
+                [$self cget -windowclass] [$self cget -attributes]
+        }
+        wm deiconify $win
+    }
+
+    # usage msg --
+    #
+    #       Convenience proc for creating wrong # args errors.
+    #
+    proc usage msg {
+        return -code error -level 2 -errorcode [list WRONGARGS $msg] \
+            "wrong # args: should be \"$msg\""
+    }
+
+
+    # status ?message? --
+    #
+    #       Get or set the status message for the window.
+    #
+    method status args {
+        switch -exact [llength $args] {
+            0       { $statusbar cget -text }
+            1       { $statusbar configure -text [lindex $args 0] }
+            default {
+                usage "$self status ?message?"
+            }
+        }
+    }
+
+    # progress total done --
+    #
+    #       Set the progress value for the window. This causes the progress
+    #       bar to be displayed in the status bar area (if the statusbar
+    #       itself is visible). If total == done then the progress bar is
+    #       removed.
+    #
+    method progress {total done} {
+        if {$total == $done} {
+            grid remove $progress
+        } else {
+            if {![$self hidden statusbar] &&
+                $progress ni [grid slaves $win]} { grid $progress }
+            $progress configure -maximum $total -value $done
+        }
+    }
+
+    method toolbar {} { return $toolbar }
+
+    # hide ?component? --
+    #
+    #       Hides the specified component (defaults to "self"). Valid
+    #       component names are "statusbar", "toolbar" or "self" (which hides
+    #       the entire window).
+    #
+    method hide {{component "self"}} {
+        if {$component eq "self"} {
+            wm withdraw $win
+        } else {
+            grid remove [set $component]
+        }
+        dict set hidden $component 1
+    }
+
+    # show ?component? --
+    #
+    #       Shows the specified component (defaults to "self"). Valid
+    #       component names are "statusbar", "toolbar" or "self" (which
+    #       deiconifies the entire window).
+    #
+    method show {{component "self"}} {
+        if {$component eq "self"} {
+            wm deiconify $self
+        } else {
+            grid [set $component]
+        }
+        dict set hidden $component 0
+    }
+
+    # hidden ?component? --
+    #
+    #       Returns 1 if the given component is hidden, or 0 otherwise.
+    #
+    method hidden {{component "self"}} {
+        if {[dict exists $hidden $component]} {
+            return [dict get $hidden $component]
+        } else {
+            return 0
+        }
+    }
+
+    # toggle ?component? --
+    #
+    #       Toggles the hidden/shown status of a component.
+    #
+    method toggle {{component "self"}} {
+        if {[$self hidden $component]} {
+            $self show $component
+        } else {
+            $self hide $component
+        }
+    }
+
+    # wm geometry ?newGeom? --
+    #
+    #       Wrapper around the [wm geometry] command.
+    #
+    method geometry args {
+        wm geometry $win {*}$args
+    }
+
+    # close --
+    #
+    #       Attempt to close the window. This method will first check to see
+    #       whether the contents of the window have been modified, and if so,
+    #       offer the user the chance to save the contents before closing. The
+    #       behaviour of this method is controlled by the -modified option and
+    #       the -savecommand option. The dialog will only be displayed if
+    #       -modified and a -savecommand has been specified. The save command
+    #       will be invoked passing in the object command of this window. If
+    #       the -savecommand returns 1 then closing of the window will be
+    #       aborted.
+    #
+    method close {} {
+        set command [$self cget -savecommand]
+        if {[$self cget -modified] && $command ne ""} {
+            set ans [tk_messageBox -icon warning -parent $win \
+                -title "Contents Modified" \
+                -message [concat \
+                    "The contents of this window have been modified."\
+                    "Do you want to save the changes before"\
+                    "closing?"] \
+                -type yesnocancel -default cancel]
+            if {$ans eq "cancel"} { return 0 }
+            if {$ans eq "yes"} {
+                if {[uplevel #0 $command $self] == 1} {
+                    # Save command aborted close
+                    return 0
+                }
+            }
+        }
+        destroy $win
+        return 1
+    }
+
+    # Various [wm] commands that I don't know how best to handle yet :-)
+    foreach op {forget frame grid group iconbitmask iconify iconmask iconname
+        iconphoto iconwindow manage maxsize minsize overrideredirect
+        positionfrom protocol resizable sizefrom stackorder state} {
+
+        method $op args [format { wm %s $win {*}$args } $op]
+    }
+
+    # And the same for [winfo] commands
+    foreach op {atom atomname cells children class colormapfull containing
+        depth exists fpixels height id interps ismapped manager name parent
+        pathname pixels pointerx pointerxy pointery reqheight reqwidth rgb
+        rootx rooty screen screencells screendepth screenheight screenmmheight
+        screenmmwidth screenvisual screenwidth server toplevel viewable visual
+        visualid visualsavailable vrootheight vrootwidth vrootx vrooty width x
+        y} {
+
+        method $op args [format { winfo %s $win {*}$args } $op]
+    }
+
+    #
+    #======================================================================
+    #
+    # PRIVATE METHODS
+    #
+    #======================================================================
+    #
+
+    # Change the title of the window (implements -title option)
+    method ChangeTitle {option value} {
+        set options($option) $value
+        wm title $win $value
+    }
+
+    # Change whether a particular component is displayed (-statusbar and
+    # -toolbar options).
+    method ChangeComponent {option value} {
+        set options($option) $value
+        set component [string range $option 1 end]
+        if {$value} {
+            $self show $component
+        } else {
+            $self hide $component
+        }
+    }
+
+    # Change a window attribute (implements most of the platform-specific
+    # options). Attributes that make no sense on a particular platform are
+    # simply ignored.
+    method ChangeAttribute {option value} {
+        set options($option) $value
+
+        if {$option in $wmoptions([tk windowingsystem])} {
+            wm attributes $win $option $value
+        }
+    }
+
+    # Return the current value of an option. This implements the cget method
+    # for various [wm attribute] options as these can be changed from outside
+    # the application itself (e.g. moving the file of a -document option in
+    # the finder will change the -document value).
+    method GetAttribute {option} {
+        if {$option in $wmoptions([tk windowingsystem])} {
+            return [wm attribute $win $option]
+        }
+        return $options($option)
+    }
+
+    # Maps the -document option to the rather more obscure -titlepath on
+    # TkAqua.
+    method ChangeDocument {option value} {
+        set options($option) $value
+        $self ChangeAttribute -titlepath $value
+    }
+    method GetDocument {option} {
+        $self GetAttribute -titlepath
+    }
+
+    # Implements changes to -windowclass and -attributes options. Not sure if
+    # you can actually change these after window creation, but might still be
+    # useful in some cases.
+    method ChangeWindow {option value} {
+        if {[tk windowingsystem] eq "aqua"} {
+            set class [$self cget -windowclass]
+            set attrs [$self cget -attributes]
+            ::tk::unsupported::MacWindowStyle style $win $class $attrs
+        }
+        set options($option) $value
+    }
+
+    # Implements -transient option
+    method ChangeTransient {option value} {
+        wm transient $win $value
+        set options($option) $value
+    }
+
+    # Implements -aspect option
+    method ChangeAspect {option value} {
+        wm aspect $win $value
+        set options($option) $value
+    }
+
+    # Implements -client option
+    method ChangeClient {option value} {
+        wm client $win $value
+        set options($option) $value
+    }
+}
+
+#  Demo:
+if {[info exists ::argv0] && $::argv0 eq [info script]} {
+    # editor.tcl --
+    #
+    #       A simple text editor application to demonstrate the glib library.
+    #
+    # Public domain.
+    #
+
+    package require Tcl     8.5
+    package require Tk      8.5
+
+    wm withdraw .
+
+    set edcount 0
+
+    proc editor w {
+        global edcount
+        # Create the editor window
+        set win [easywin $w -title "Text Editor" -savecommand file:save]
+
+        # Create the text component
+        set f [ttk::frame $win.f]
+        set t [text $f.t -highlightthickness 0 -yscrollcommand [list $f.vsb set]]
+        set v [ttk::scrollbar $f.vsb -orient vertical -command [list $f.t yview]]
+
+        bind $t <<Modified>> [list modified %W]
+
+        # Grid them
+        grid $t $v -sticky nsew
+        grid rowconfigure $f 0 -weight 1
+        grid columnconfigure $f 0 -weight 1
+
+        $win add $f -weight 1
+
+        # Create menu and toolbar entries
+        set file [menu $win.file -tearoff 0]
+        $win menu add cascade -label File -underline 0 -menu $file
+
+        action $win open "Open..." O 0 [list file:open $win]
+        $file add separator
+        action $win close "Close" W 0 [list file:close $win]
+        action $win save "Save" S 0 [list file:save $win]
+        action $win saveas "Save As..." A 5 [list file:saveas $win]
+        $file add separator
+        action $win quit "Exit" Q 1 [list file:quit $win]
+
+        $win status "Done"
+
+        incr edcount
+    }
+
+    proc modifier key {
+        switch -exact [tk windowingsystem] {
+            aqua    { return "Command-$key" }
+            win32   { return "Ctrl+$key"    }
+            default { return "Ctrl-$key"    }
+        }
+    }
+    proc binding key {
+        set key [string tolower $key]
+        switch -exact [tk windowingsystem] {
+            aqua    { return "<Command-$key>" }
+            default { return "<Control-$key>" }
+        }
+    }
+    proc action {win name label accel uline cmd} {
+        global col
+        $win.file add command -label $label \
+            -accelerator [modifier $accel] \
+            -underline $uline \
+            -command $cmd
+        set tb [$win toolbar]
+        ttk::button $tb.$name -text $label -command $cmd \
+            -style Toolbutton
+        grid $tb.$name -row 0 -column [incr col]
+        bind $win [binding $accel] $cmd
+    }
+
+    # Handle changes to the text widget modified status
+    proc modified w {
+        set win [winfo toplevel $w]
+        set text $win.f.t
+        set mod [$text edit modified]
+        $win configure -modified $mod
+        set state [expr {$mod ? "normal" : "disabled"}]
+        $win.file entryconfigure Save -state $state
+        [$win toolbar].save configure -state $state
+    }
+
+
+    proc file:open win {
+        set file [tk_getOpenFile -parent $win]
+        if {$file eq ""} { return }
+        set in [open $file]
+        $win.f.t delete 1.0 end
+        $win.f.t insert end [read $in]
+        close $in
+        $win.f.t see 1.0
+        $win configure -document [file normalize $file] -title [file tail $file]
+        $win.f.t edit modified 0
+        modified $win
+        $win status "Done"
+    }
+
+    proc file:save win {
+        set file [$win cget -document]
+        file:saveas $win $file
+    }
+
+    proc file:saveas win {
+        if {$file eq ""} {
+            set file [tk_getSaveFile -parent $win]
+        }
+        if {$file eq ""} { return 1 }
+        set out [open $file w]
+        puts $out [$win.f.t get 1.0 end-1c]
+        close $out
+        $win configure -document [file normalize $file]
+        $win.f.t edit modified 0
+        modified $win
+        $win status "Opened $file"
+    }
+
+    proc file:close win { $win close }
+
+    proc file:quit win {
+        global edcount
+        if {[$win close]} { incr edcount -1 }
+        if {$edcount <= 0} { exit }
+    }
+    editor .ed
+}

ADDED   modules/every-0.tm
Index: modules/every-0.tm
==================================================================
--- /dev/null
+++ modules/every-0.tm
@@ -0,0 +1,189 @@
+# taking some of the best wisdom from http://wiki.tcl.tk/9299 and putting it in an object
+# why an object?  Mostly for convenient variables.  Independent instances that can clean
+# up after themselves is possibly compelling too.
+#
+# Needs tests.
+#
+# Supports:
+#  - cancel from within script with [break].  [continue] is harmless.
+#  - [continue 100] - re-sets interval for 100ms
+#  - cancel by id(s)
+#  - kill (cancel all) - aka [cancel all] or [cancel *]
+#  - pause/resume by id(s).  The clock keeps ticking, but events are skipped until resumed.
+#  - info returns a dict
+
+namespace eval every {
+
+    # too nice to omit:
+    proc callback args {
+        tailcall namespace code $args
+    }
+
+    ::oo::class create namedclass {
+        superclass ::oo::class
+        self method create {name args} {
+            tailcall my createWithNamespace $name $name {*}$args
+        }
+
+        method create {name args} {
+            tailcall my createWithNamespace $name $name {*}$args
+        }
+    }
+
+    # suggest importing these if you can:
+    interp alias {} [namespace current]::continue   {}  ::return -level 0 -code continue
+    interp alias {} [namespace current]::break      {}  ::return -level 0 -code break
+
+    # might as well have a nice cleanup version of this too:
+    namedclass create After {
+        variable Afters
+
+        constructor {} {
+            set Afters [dict create]
+        }
+
+        destructor {
+            dict for {id aid} $Afters {
+                after cancel $aid
+            }
+        }
+
+        method idle {args} {
+            if {[llength $args] < 1} {
+                tailcall ::after {*}$args
+            }
+            set args [lassign $args cmd]
+            if { ! ([string is entier -strict $cmd] || $cmd in {idle}) } {
+                tailcall ::after $cmd {*}$args
+            }
+            variable AfterID
+            incr AfterID
+            dict set Afters $AfterID [::after idle [callback my Bang $AfterID {*}$args]]
+        }
+
+        method Bang {id args} {
+            dict unset Afters $ID
+            uplevel #0 {*}$args
+        }
+    }
+
+    namedclass create Every {
+        variable Cancel
+        variable Paused
+        variable Active
+        variable Afters
+
+        constructor {} {
+            set Active [dict create]
+            set Cancel [dict create]
+            set Paused [dict create]
+            set Afters [dict create]
+        }
+
+        destructor {
+            dict for {id aid} $Afters {
+                after cancel $id
+            }
+        }
+
+        # after <ms>
+        method unknown {ms script} {
+            variable EveryID
+            if {![string is entier -strict $ms]} {
+                return -code error "Invalid argument \"$ms\" - expected [join [info class methods Every] ", "] or an integer"
+            }
+            if {[string trim $script] eq ""} {return}
+            set id every#[incr evID]
+            dict set Active $id $script
+            # after idle?
+            dict set Afters $id [after 0 [callback my Tick $id $ms $script]]
+            return $id
+        }
+
+        # public methods:
+        method cancel {args} {
+            if {$args in {all *}} {
+                tailcall my kill
+            }
+            foreach id $args {
+                dict set Cancel $id {}
+            }
+        }
+        method kill {} {
+            dict for {id _} $Active {
+                dict set Cancel $id {}
+            }
+        }
+        method pause {args} {
+            foreach id $args {
+                dict set Paused $id {}
+            }
+        }
+        method resume {args} {
+            foreach id $args {
+                dict unset Paused $id
+            }
+        }
+        method info {args} {
+            if {$args eq ""} {
+                return $Active
+            }
+            foreach id $args {
+                dict set result $id [dict get $Active $id]
+            }
+            return $result
+        }
+
+        # internal implementation:
+        method Tick {id interval script} {
+            dict unset Afters $id
+            if {[dict exists $Cancel $id]} {
+                dict unset Active $id
+                dict unset Cancel $id
+                dict unset Paused $id   ;# to be safe
+                my Log Cancelled $id
+                return
+            }
+            set start   [clock milliseconds]
+            if {[dict exists $Paused $id]} {
+                my Log Paused $id
+            } else {
+                try {
+                    uplevel #0 $script
+                } on break {} {
+                    dict unset Active $id
+                    dict unset Cancel $id
+                    dict unset Paused $id   ;# to be safe
+                } on continue {r o} {
+                    if {$r ne ""} {
+                        set interval $r     ;# support [continue newIntervalMilliseconds]
+                    }
+                } on error {e o} {
+                    my Log BGERROR $id
+                    dict unset Active $id
+                    dict incr o -level -1
+                    return -code error -options $o $e   ;# pass to bgerror (?)
+                }
+            }
+            set end     [clock milliseconds]
+            set elapsed [expr {$end - $start}]
+            if {$elapsed > $interval} {
+                my Log TOO LONG $id - $elapsed vs $interval
+                set elapsed [expr {$elapsed % $interval}]
+            }
+            set delay [expr {$interval - $elapsed}]
+            dict set Afters $id [after $delay [callback my Tick $id $interval $script]]
+            return ""   ;# polite from event handlers.  Avoids bugs elsewhere.
+        }
+
+        method Log {args} {
+            #puts stderr "[self] $args"
+        }
+    }
+
+    Every create every
+
+    namespace export every
+}
+
+namespace import every::every

Index: modules/extend-0.tm
==================================================================
--- modules/extend-0.tm
+++ modules/extend-0.tm
@@ -3,29 +3,29 @@
 #
 # Putting procs in the namespace is a bit unpleasant, with generic/reused names
 #  (eg [array foreach])
 #
 package require fun
-package require debug
+package require adebug
 
 # helper to make quoting less odious
 if {[info commands Uplevel] eq ""} {
     proc Uplevel {n args} {tailcall uplevel $n $args}
 }
 
 proc extend {ens script} {
-    ::namespace eval $ens [concat {
+    namespace eval $ens [concat {
         proc _unknown {ens cmd args} {
             if {$cmd in [::namespace eval ::${ens} {::info commands}]} {
                 ::set map [::namespace ensemble configure $ens -map]
                 ::dict set map $cmd ::${ens}::$cmd
                 ::namespace ensemble configure $ens -map $map
             }
             ::return "" ;# back to namespace ensemble dispatch
         }
     }   \; $script]
-    ::namespace ensemble configure $ens -unknown ${ens}::_unknown
+    namespace ensemble configure $ens -unknown ${ens}::_unknown
 }
 
 extend dict {
 
     proc print {d args} {
@@ -44,10 +44,24 @@
     # note: this doesn't error if the 1st arg is not a dict
     proc get? {d args} {
         if {$args eq ""} {return $d}
         if {[dict exists $d {*}$args]} {dict get $d {*}$args}
     }
+
+    # like dict get, but matches with glob patterns in the dict
+    # *not* similar to [dict filter keys]
+    proc glob {dict key args} {
+        dict for {k v} $dict {
+            if {[string match $k $key]} {
+                if {$args eq ""} {
+                    return $v
+                } else {
+                    tailcall [glob $dict {*}$args]
+                }
+            }
+        }
+    }
 
     # will only set if the kye doesn't already exist
     # .. I'm unsure if I want an [info exists d] check
     proc set! {_d args} {
         upvar 1 $_d d
@@ -343,11 +357,11 @@
         uplevel 1 [list namespace export $cmd]
         namespace eval $namespace [list namespace import [uplevel 1 {namespace current}]::$cmd]
     }
 }
 
+# this breaks tcltags. !!??!!?
 extend ::oo::InfoObject {
     proc commands {o args} {
         map {::namespace tail} [info commands [info object namespace $o]::*]
     }
 }
-

Index: modules/fun-0.tm
==================================================================
--- modules/fun-0.tm
+++ modules/fun-0.tm
@@ -5,10 +5,12 @@
 # For a list of lists:
 #   [join $lol] eq [concat {*}$lol]
 #
 package require Tcl 8.6
 
+package require options
+
 namespace eval fun {
 
     proc K {a args} {set a}
     proc -- args {}    ;# pseudo-comment
 
@@ -18,15 +20,32 @@
             set %s [expr {%s}]
         } [list $name] $value]
     }
 
 
-    package require lambda
+    #package require lambda
+    # copied straight out of tcllib, to avoid the dependency
+    ## Originally (C) 2011 Andreas Kupries, BSD licensed.
+    proc lambda {arguments body args} {
+        list ::apply [list $arguments $body] {*}$args
+    }
+    proc lambda@ {namespace arguments body args} {
+        list ::apply [list $arguments $body $namespace] {*}$args
+    }
 
     ##namespace import ::tcl::mathop::*
     #namespace import ::tcl::mathfunc::*
     namespace path ::tcl::mathfunc
+
+    # convenience function for printing lists (handy for debugging!)
+    proc putl {args} {
+        puts $args
+    }
+
+    proc callback {args} {
+        tailcall namespace code $args
+    }
 
     # max and min should be able to take list arguments!
     proc max {args} {
         tailcall ::tcl::mathfunc::max {*}[concat {*}$args]
     }
@@ -48,10 +67,21 @@
                 return [string range $model 0 $i-1]
             }
         }
         return $model
     }
+
+    # mimic's textutil::adjust::undent
+    proc undent {text} {
+        set pres [regexp -inline -all -linestop -lineanchor {^.*?(?=\S)} $text]
+        set pre [common_prefix $pres]
+        regsub -all -linestop -lineanchor "^$pre" $text "" text
+        set text [string trimleft $text \n]
+        set text [string trimright $text " \t"]
+        return $text
+    }
+
 
     # local aliases that respect namespaces
     proc alias {alias cmd args} {
         if {![string match ::* $alias]} {
             set alias [uplevel 1 {namespace current}]::$alias
@@ -149,30 +179,79 @@
             }
         }
         return -code error "$cmd is not a namespace ensemble or object!"
     }
 
-
-    # these needs some options ..
-    proc readfile {filename} {
-        set fd [open $filename r]
-        try {
-            read $fd
-        } finally {
-            close $fd
+    # cd with automatic return
+    proc indir {dir script} {
+        set return [list ::cd [pwd]]
+        cd $dir
+        tailcall try $script finally $return
+    }
+
+
+    # we can't import ::readfile in safe interps created by interps-0.tm, so check for it:
+    if {[namespace which -command ::readfile] eq ""} {
+        proc readfile args {
+            options {-oflags RDONLY} {-encoding utf-8} {-translation auto} {-eofchar ""}    ;# sensible defaults
+            arguments {filename}
+
+            set fd [open $filename $oflags]
+            fconfigure $fd -encoding $encoding -translation $translation -eofchar $eofchar
+
+            try {
+                read $fd
+            } finally {
+                close $fd
+            }
         }
     }
-    proc writefile {filename data} {
+
+    proc writefile args {
+        options {-oflags {WRONLY CREAT}} {-encoding utf-8} {-translation auto} {-eofchar ""}    ;# sensible defaults
+        arguments {filename data}
+
         # always mkdir - some vfs's don't respond well if we don't
         file mkdir [file dirname $filename]
-        set fd [open $filename w]
+
+        set fd [open $filename $oflags]
+        fconfigure $fd -encoding $encoding -translation $translation -eofchar $eofchar
+
         try {
             puts -nonewline $fd $data
         } finally {
             close $fd
         }
     }
+
+    # ensures that $path is under $top (modulo symlinks - use [file normalize] for those)
+    proc path_contains {top path} {
+        # exact match is okay:
+        if {$path eq $top} {
+            return true
+        }
+        append top /
+        set len [string length $top]
+        # adjacent similarly-named directory is not okay
+        if {[string compare -length $len $top $path]} {
+            return false
+        }
+        # ensure no escape with ..
+        set path [string range $path $len end]
+        set depth 0
+        foreach part [file split $path] {
+            if {$part eq ".."} {
+                incr depth -1
+                if {$depth < 0} {return false}
+            } else {
+                incr depth
+            }
+        }
+        # otherwise, it's safe!
+        return true
+    }
+
 
     proc divmod {a b} {
         list [expr {$a/$b}] [expr {$a % $b}]
     }
 
@@ -220,11 +299,11 @@
     # http://wiki.tcl.tk/26079
     proc yieldm {{value {}}} {
         yieldto string cat $value
     }
 
-    -- proc func args {
+    proc func args {
         set expr [lindex $args end]
         set args [lrange $args 0 end-1]
         tailcall proc {*}$args [list expr $expr]
     }
 
@@ -313,10 +392,24 @@
     }
 
     proc ldiff {a b} {
         lmap elem $a { expr {$elem in $b ? [continue] : $elem} }
     }
+
+    proc union {a b} {
+        concat $a [lmap x $b {
+            if {$x in $a} continue
+            set x
+        }]
+    }
+
+    proc intersect {a b} {
+        lmap x $a {
+            if {$x ni $b} continue
+            set x
+        }
+    }
 
     # With 3+ arguments, this should be more like
     #  lmap $1 $2 [list expr $3]
     proc lfilter args {
         switch [llength $args] {
@@ -365,24 +458,53 @@
         set tail [lrange $ls $n end]
         set head [lrange $ls 0 $n-1]
         concat $tail $head
     }
 
-    # pop 1 or more items from the start of a list (into named args).  Returns last item popped.
-    -- proc lpop {_ls args} {
-        upvar 1 $_ls ls
-        if {$args eq ""} {
-            set ls [lassign $ls x]
-            return $x
-        }
-        tailcall try [script {*}[lmap a $args {
-            list set [list $a] \[[list lpop $_ls]\]
-        }]]
-    }
-
-    # for symetry, lpop needs lpush
+    # lpush list ?arg ...?
+    # set item [lpop list]
+    # lpop list -> a1 a2 a3
+    # lassign [lpop list 3] a1 a2 a3
+    #
+    # set list {the list}
+    # expr {[list {*}$list 1 2 3] eq [lpush list 1 2 3]}
+    # expr {[lpop list a b c] eq {the list}}
+    # expr {[list $a $b $c] eq {3 2 1}}     ;# note reversal!
+    # expr {[lpop list] eq "list"}
+
     interp alias {} lpush {} lappend
+    proc lpop {_list args} {
+        upvar 1 $_list list
+        multiargs {
+            {} {
+                try {
+                    lindex $list end
+                } finally {
+                    set list [lrange $list 0 end-1]
+                }
+            }
+            {n} {
+                if {$n <= 0} {return ""}
+                try {
+                    lreverse [lreplace $list 0 end-$n]
+                } finally {
+                    set list [lrange $list 0 end-$n]
+                }
+            }
+            {-> args} {
+                if {${->} ne {->}} {
+                    error "Invalid arguments: expected \[lpop listName N\] or \[lpop listName -> varName ..\] or \[lpop listName\]"
+                }
+                set values [lpop list [llength $args]]
+                tailcall lassign $values {*}$args   ;# set vars in caller
+            }
+        }
+    }
+
+    #
+    # expr {[list $a1 $a2 {*}$list] eq [lunshift list $a1 $a2]}
+    # for symetry, lpop needs lpush
 
     # pop items off the beginning of a list.
     # single argument form returns the item popped
     # multi-arg form assigns to varNames, returning the remaining list.
     proc lpop {_ls args} {
@@ -617,10 +739,25 @@
 
     proc zip! {args} {
         debug assert {[== [map {llength} $args]]}
         tailcall zip {*}$args
     }
+
+    proc transpose {lol} {
+        # zip {*}$lol
+        set res {}
+        set r [set c -1]
+        foreach row $lol {
+            incr r
+            foreach v $row {
+                incr c
+                lset res $c $r $v
+            }
+            set c -1
+        }
+        return $res
+    }
 
     # normal map, but does multiple arguments:
     #  % map {expr} {1 2 3} {+ - *} {2 4 5}
     #  {3 -2 15}
     #
@@ -819,10 +956,25 @@
             #lappend stack {*}[concat {*}[map {tclose $cmdPrefix} [{*}$cmdPrefix $el]]]
         }
         set stack
     }
 
+    # cartesian product of a list of lists
+    # adapted from http://wiki.tcl.tk/2546
+    proc cprod {lol} {
+        set xs {{}}
+        foreach ys $lol {
+            set result {}
+            foreach x $xs {
+                foreach y $ys {
+                    lappend result [list {*}$x $y]
+                }
+            }
+            set xs $result
+        }
+        return $xs
+    }
 
     proc ssplit {str substr} {
         set res {}
         set i 0
         set n [string length $substr]
@@ -905,23 +1057,31 @@
 
     proc chuck args {
         set args [lreverse [lassign [lreverse $args] msg code]]
         tailcall return {*}$args -code error -errorcode $code $msg
     }
+
+    proc quote_glob {s} {
+        regsub -all {[?*{}\[\]~\\]} $s {\\\0}
+    }
+    proc quote_regex {str} {
+        regsub -all {[][$^?+*()|\\.]} $str {\\\0}
+    }
 
     namespace export *
 }
 
 namespace import ::fun::*    ;# eeek!
 
-if {[info exists ::argv0] && $::argv0 eq [info script]} {
-    tcl::tm::path add [pwd]
+package require mainscript
+if {[mainscript?]} {
+    #tcl::tm::path add [pwd]
     package provide fun 0
     package require tests
     tests {
-        -- func odd? {n} {$n%2}
-        -- func even? {n} {![odd? $n]}
+        func odd? {n} {$n%2}
+        func even? {n} {![odd? $n]}
 
         test lfilter-1 "lfilter" -body {
             lfilter even? {1 2 3 4 5 6 7 8 9}
         } -result {2 4 6 8}
 
@@ -966,7 +1126,13 @@
             proc foo {} {
                 chuck {BAD JUJU} "your mojo is no good!"
             }
             list [catch foo r o] $r [dict get $o -errorcode]
         } -result {1 {your mojo is no good!} {BAD JUJU}}
+
+        test pathcontains-1 "path contains test battery" -body {
+            set top [pwd]
+            lappend tests ${top} ${top}a ${top}/a [string replace $top end end] [file join $top a b .. c .. ..] [file join $top a .. b .. ..]
+            lmap t $tests {path_contains $top $t}
+        } -result {true false true false true false}
     }
 }

ADDED   modules/geturl-0.tm
Index: modules/geturl-0.tm
==================================================================
--- /dev/null
+++ modules/geturl-0.tm
@@ -0,0 +1,35 @@
+package require http
+package require uri
+if {![catch {package require tls}]} {
+    http::register https 443 ::tls::socket
+}
+
+# simple wrapper for http::geturl
+# follows redirections and by returns the response body
+# _meta is a dict out param.
+proc geturl {url {_meta {}}} {
+    if {$_meta ne ""} {
+        upvar 1 $_meta meta
+    }
+    http::config -useragent moop    ;# thanks sourceforge!
+    set tok [::http::geturl $url]   ;# -headers {User-Agent moop} adds a 2nd user-agent header
+    try {
+        upvar 1 $tok state
+        if {[set status [::http::status $tok]] ne "ok"} {
+            error $status
+        }
+        set headers [dict map {key val} [::http::meta $tok] {
+            set key [string tolower $key]
+            set val
+        }]
+        if {[dict exists $headers location]} {
+            tailcall geturl [::uri::resolve $url [dict get $headers location]] $_meta
+        }
+        return [::http::data $tok]
+    } finally {
+        unset ${tok}(body)
+        # charset?  Content-Type {text/html;charset=UTF-8}
+        set meta [array get $tok]
+        ::http::cleanup $tok
+    }
+}

ADDED   modules/mainscript-1.tm
Index: modules/mainscript-1.tm
==================================================================
--- /dev/null
+++ modules/mainscript-1.tm
@@ -0,0 +1,6 @@
+# see http://wiki.tcl.tk/40097 - "..." means we resolve symlinks
+interp alias {} mainscript? {} expr {
+       [info exists ::argv0]
+    && [file dirname [file normalize $::argv0/...]]
+    eq [file dirname [file normalize [info script]/...]]
+}

Index: modules/metaclass-1.tm
==================================================================
--- modules/metaclass-1.tm
+++ modules/metaclass-1.tm
@@ -86,11 +86,11 @@
 
         oo::define Metaclass method $tail {cls args} [format {
             set cls [uplevel 1 [list namespace which $cls]]     ;# could avoid this with [tailcall]..
             debug log {defining %1$s on $cls}
             oo::define $cls %1$s {*}$args
-        } $tail]
+        } [list $tail]]
     }
 
     # The base class of all classes is an instance of Metaclass and a subclass of oo::class.
     # Got that?  No, neither have I.  But play along .. it works.
     #

ADDED   modules/record-0.tm
Index: modules/record-0.tm
==================================================================
--- /dev/null
+++ modules/record-0.tm
@@ -0,0 +1,378 @@
+# records:
+#  A record is a dictionary with a defined set of keys, a convenient constructor (${name}::create)
+#  and collection constructor (${name}::table).  These get their sugar from [dictargs] and [llsub].
+#  The values are just dicts.
+#
+#  Use [record::declare] to declare a record kind and create these two special methods.
+#
+#  % record::declare some id {-foo} {-bar $::tcl_version -baz ""} {
+#    if {$baz eq ""} {
+#      set baz [string reverse $bar]
+#    }
+#  }
+#  ::some
+#
+#  % some::create one -foo frop
+#  {-id one -foo frop -bar 8.6 -baz 6.8}
+#
+#  % some::table {
+#    one -foo frop
+#    two -foo twine -bar hello
+#    tre -foo food -baz 23
+#  }
+#  {one {-id one -foo frop -bar 8.6 -baz 6.8}
+#   two {-id two -foo twine -bar hello -baz hello}
+#   tre {-id tre -foo food -bar 8.6 -baz 23}}
+#
+#  [record::method] is a convenience wrapper for procs which see all the record's fields as local variables.
+#  Simply, it inserts an argument _ and wraps the body in [dict with _]:
+#
+#   % record::method some::foo {a b} {list $foo $bar $a $b}
+#
+#  is equivalent to:
+#
+#   % proc some::foo {_ a b} {dict with _ {list $foo $bar $a $b}}
+#
+#  and in fact I recommend making procedures alongside methods in this way.
+#
+#  Records are designed for immutable (create-once) use - mutator methods will need some care.
+#
+#
+#  [${name}::create]: returns a dictionary
+#   % ..::create id -field1 val1 -field2 val2
+#   {id id field default field1 val1 field2 val2}
+#
+#  [${name}::table] returns a dictionary whose keys are ids and values are full dicts as above
+#   % ..::table {
+#       id1 -field value
+#       id2 -field2 value2 -field3 [expr 40+2]
+#   }
+#   {id1 {id id1 field value field1 {} field2 {}}
+#    id2 {id id2 field1 default field2 value2 field3 42}}
+#
+namespace eval record {
+    # name  - the namespace in which to create the new record
+    # id    - the key that acts as an identifier
+    # req   - required arguments, as a list
+    # opt   - optional arguments, as a {name default} dictionary
+    # body  - an (optional) constructor script, which sees all fields as locals
+    proc declare {name id req opt {body ""}} {
+        if {![string match ::* $name]} {
+            set ns [string trimright [uplevel 1 {namespace current}] :]::$name
+        }
+        set req [lmap k $req {regsub ^- $k {}}]
+        set opt [lmap k $opt {regsub ^- $k {}}]
+        set map [dict create @REQ [list $req] @OPT [list $opt] @BODY $body]
+        namespace eval $ns {}
+        proc ${ns}::create [list $id args] [string map $map {
+            set args [dict map {_k _v} $args {
+                if {![regsub ^- $_k {} _k]} {
+                    throw {BAD ARGUMENT} "Invalid argument \"$_k\""
+                }
+                set _v
+            }]
+            unset _k; unset _v
+            set _ $args; unset args
+            ::record::dictargs _ @REQ @OPT
+            unset _
+            @BODY
+            return [::record::capture]
+        }]
+        alias ${ns}::table table ${ns}
+    }
+
+    proc method {name args body} {
+        tailcall proc $name [list _ {*}$args] [list dict with _ $body]
+    }
+
+    proc table {name table} {
+        set result {}
+        foreach arglist [updo [namespace which llsub] $table] {
+            dict set result [lindex $arglist 0] [${name}::create {*}$arglist]
+        }
+        return $result
+    }
+
+# essentials:
+    # compare:
+    #   interp alias {} [namespace current]::the_alias {} [namespace which -command target] arg
+    #   alias the_alias target arg
+    proc alias {alias cmd args} {
+        set alias   [upns 1 $alias]
+        set cmd     [upns 1 $cmd]
+        interp alias    {} $alias   {} $cmd {*}$args
+    }
+    # compare:
+    #   set x [uplevel 1 [list namespace which $command]]
+    #   set x [updo 1 namespace which $cmd]
+    #   set x [updo {namespace which} $cmd]   ;# lvl can be elided when safe; first word will be expanded
+    proc updo {{lvl 1} args} {
+        tailcall uplevel $lvl $args
+    }
+    # [upns]            - get namespace of caller
+    # [upns 2]          - get namespace of caller's caller
+    # [upns 1 cmd]      - qualify cmd with caller's namespace
+    # [upns 1 cmd 1 2]  - create a callback with two arguments
+    #  level can only be elided in the argless case
+    proc upns {{lvl 1} args} {  ;# doubles as resolve-cmdname-in-caller
+        if {$args eq ""} {
+            tailcall uplevel $lvl {namespace current}
+        } else {
+            set cargs [lassign $args cmd]
+            if {[string match :* $cmd]} {
+                return $args
+            }
+            set ns [uplevel [expr {$lvl+1}] {namespace current}]
+            set ns [string trimright $ns :]
+            return [list ${ns}::$cmd {*}$cargs]
+        }
+    }
+
+    # get current (local) environment as a dict
+    # arrays are ignored (bluntly, by [catch])
+    proc capture args {
+        if {$args eq ""} {
+            set args [uplevel 1 {info locals}]
+        }
+        set result {}
+        foreach arg $args {
+            catch { ;# ignore arrays
+                dict set result $arg [uplevel 1 [list set $arg]]
+            }
+        }
+        return $result
+    }
+
+    # cmdsplit splits a Tcl script into a list of commands and comments
+    proc cmdsplit {script} {
+        set chunk {}
+        set commands {}
+        foreach line [split $script \n] {
+            append chunk $line
+            if {![info complete $chunk\n]} {    ;# no end of cmd yet - put back the newline
+                append chunk \n
+                continue
+            }
+            set cmd ""
+            foreach part [split $chunk \;] {     ;# chunk may yet be split on semicolons
+                append cmd $part
+                if {![info complete $cmd\n]} {   ;# internal semicolon
+                    append cmd \;
+                    continue
+                }
+                set cmd [string trimleft $cmd]  ;# ignore leading whitespace
+                if {$cmd eq ""} {continue}      ;# skip empty commands
+                if {[string match #* $cmd]} {   ;# semicolon in comment
+                    append cmd \;
+                    continue
+                }
+                # else, we have a command!
+                lappend commands $cmd
+                set cmd ""
+            }
+            if {$cmd ne ""} {                   ;# if there's anything left, it will have an extra semicolon
+                set cmd [string range $cmd 0 end-1]
+                lappend commands $cmd
+            }
+            set chunk ""
+        }
+        if {![string is space $chunk]} {
+            throw {PARSE ERROR} "Can't parse script into a sequence of commands:\n\
+                                \tIncomplete command:\n\
+                                -----\n\
+                                $chunk
+                                -----"
+        }
+        return $commands
+    }
+
+    # wordsplit splits a Tcl command into a list of its constituent (unevaluated) words
+    proc wordsplit {cmd} {
+        if {![info complete $cmd\n]} {
+            throw {PARSE ERROR} "Not a complete command:\n-----\n$command\n-----"
+        }
+        # we can ignore leading whitespace, so the regex just has to pick up words
+        # with trailing space
+        set re { ( (?:\\.|[^\\\s])+ )        # backslash escapes or non-whitespace
+                 ( \s* )                     # space (greedy) }
+        set words {}    ;# result
+        set word ""     ;# current word
+        foreach {_ frag space} [regexp -all -inline -expanded $re $cmd] {
+            append word $frag
+            if {![info complete $word\n]} {                     ;# not yet a complete word
+                append word $space
+                continue
+            }
+            lappend words $word
+            set word ""
+        }
+        if {$word ne ""} {lappend words $word}                  ;# we can have leftovers
+        return $words
+    }
+
+    # [lsub] sits conceptually between [list] and [subst]:
+    #  its argument is tokenised into words according to Tcl command syntax,
+    #  and each word is substituted in the caller's environment.
+    #
+    # Example:
+    #   % apply {{{greeting "Hello, %s!\n"} {who world}} {
+    #     lsub { $greeting $who  ;# comments are allowed
+    #            # and so are newlines
+    #            [string toupper $who] }}}
+    #   {{Hello, %s!\n} world WORLD}
+    #
+    proc lsub script {              ;# [sl] from the wiki
+        # FIXME: this breaks badly on semicolons
+        set res {}
+        set parts {}
+        foreach part [split $script \n] {
+            lappend parts $part
+            set part [join $parts \n]
+            #add the newline that was stripped because it can make a difference
+            if {[info complete $part\n]} {
+                set parts {}
+                set part [string trim $part]
+                if {$part eq {}} {
+                    continue
+                }
+                if {[string index $part 0] eq {#}} {
+                    continue
+                }
+                #Here, the double-substitution via uplevel is intended!
+                lappend res {*}[uplevel list $part]
+            }
+        }
+        if {$parts ne {}} {
+            error [list {incomplete parts} [join $parts]]
+        }
+        return $res
+    }
+
+    # llsub is lsub's simpler big brother.  It tokenises its argument according to
+    # Tcl *script* syntax and returns a list of list, where each inner list is a
+    # (substituted) command from the input.  Unlike lsub, newlines and semicolons
+    # between elements are significant.
+    #
+    # This proc is a one-token change from lsub, but provided in full for
+    # easy bytecoding.
+    proc llsub script {              ;# tiny derivation from [lsub]
+        # FIXME: this breaks badly on semicolons
+        set res {}
+        set parts {}
+        foreach part [split $script \n] {
+            lappend parts $part
+            set part [join $parts \n]
+            #add the newline that was stripped because it can make a difference
+            if {[info complete $part\n]} {
+                set parts {}
+                set part [string trim $part]
+                if {$part eq {}} {
+                    continue
+                }
+                if {[string index $part 0] eq {#}} {
+                    continue
+                }
+                #Here, the double-substitution via uplevel is intended!
+                lappend res [uplevel list $part]    ;# the difference!  (no {*})
+            }
+        }
+        if {$parts ne {}} {
+            error [list {incomplete parts} [join $parts]]
+        }
+        return $res
+    }
+
+    # The named _args variable must have all requireds, and all keys must be in requireds OR defaults.
+    # _args is updated with defaults, and all req+opt are created in the calling environment.
+    #   * requireds is an ordinary list
+    #   * defaults is an lsub dict.
+    proc dictargs {_args requireds defaults} {
+        upvar 1 $_args args
+        set defaults [uplevel 1 [list [namespace which lsub] $defaults]]
+        # FIXME: handle unambiguous prefixes
+        set missing [lmap arg $requireds {
+            if {[dict exists $args $arg]} continue
+            set arg
+        }]
+        if {$missing ne ""} {
+            tailcall tailcall throw {TCL BADARGS} "Missing required arguments \"[join $missing {", "}]\""
+        }
+        set bad [dict filter $args script {k _} {
+            expr {($k ni $requireds) && ![dict exists $defaults $k]}
+        }]
+        if {$bad ne ""} {
+            tailcall tailcall throw {TCL BADARGS} "Unexpect arguments \"$bad\"\naccepted arguments are ([dict keys $defaults])"
+        }
+        set args [dict merge $defaults $args]
+        tailcall dict with $_args {}
+    }
+
+}
+
+
+if 0 {
+    record::declare option switch { } {
+        -studly     {}
+        -default    {}
+        -verifier   {}
+        -configuremethod {}
+        -cgetmethod {}
+
+        -delegate   {}
+    } {
+        if {$studly eq "" && $delegate eq ""} {
+            error "Must provide either -studly or -delegate!"
+        }
+        set resname     [string tolower $studly 0 0]
+        set resclass    $studly
+        unset studly
+    }
+
+    #proc option::resource {_ value}
+    record::method option::resource {value} {
+        list $switch $resname $resclass $default $value
+    }
+
+
+    proc putl args {puts $args}
+    putl ok
+    #putl proc option::create [info args option::create] [info body option::create]
+    #putl --
+
+    set win .CONSOLE
+    set options [option::table {
+         -readonly   -studly ReadOnly -default false -verifier {string is boolean}
+         -background -delegate $win.output
+         -ibg        -delegate [list $win.input -background]
+    }]
+    array set {} $options; parray {}
+    putl ok
+
+    array set v {-readonly TRYE -background FREEN -ibg YELLOF}
+    puts [join [lmap {o d} $options {option::resource $d $v($o)}] \n]
+}
+
+if 0 {
+    package require fun
+    foreach cmd [info procs ::fun::*] {
+        set parts [record::cmdsplit [info body $cmd]]
+        puts [list $cmd [llength $parts] $parts]
+        set subs [lmap p $parts {
+            if {[string match #* $p]} continue
+            lindex $p 0}]
+        puts [list $cmd [llength $parts] $subs]
+    }
+}
+package require tests
+tests {
+    test record::wordsplit-1 "wordsplit" -body {
+        join [record::wordsplit {{foo  bar}  "$baz   quz 23"   lel\ lal lka ${foo b  bar} froot\  bars bla[e {oo]}]lll}] "\n                "
+    } -result  {{foo  bar}
+                "$baz   quz 23"
+                lel\ lal
+                lka
+                ${foo b  bar}
+                froot\ 
+                bars
+                bla[e {oo]}]lll}
+}

ADDED   modules/snidgets/bettercombo.tcl
Index: modules/snidgets/bettercombo.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/bettercombo.tcl
@@ -0,0 +1,22 @@
+package require Tk
+package require Ttk
+
+# better selection behaviour
+proc ::ttk::combobox::TraverseIn w {
+    $w instate {!disabled} {
+        $w selection range 0 end
+        $w icursor end
+    }
+}
+proc ::ttk::combobox::TraverseOut w {
+    $w selection clear
+}
+bind TCombobox <<TraverseOut>> [list ::ttk::combobox::TraverseOut %W]
+
+# necessary on linux: (from http://wiki.tcl.tk/1959)
+ttk::style map TCombobox -fieldbackground {readonly white disabled #d9d9d9} 
+
+# jcowgar's improved completion
+#source misctcl/combobox/combobox.tcl
+
+;# FIXME: still weird selection behaviour on change

ADDED   modules/snidgets/buttentry.tcl
Index: modules/snidgets/buttentry.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/buttentry.tcl
@@ -0,0 +1,103 @@
+#
+# SYNOPSIS:
+#
+#  ButtEntry -command {tk_getOpenFile}
+#
+# A readonly entry which invokes -command on Invoke
+# the result of -command becomes the new value
+#
+package require snit
+package require vartrace
+
+snit::widgetadaptor ButtEntry {
+
+    option -command     -default {}
+
+    delegate option -variable to hull as -textvariable  ;# go team!
+
+    delegate option * to hull
+    delegate method * to hull
+
+    constructor args {
+        installhull using entry
+        $self configurelist $args
+        $self configure -state readonly ;# yuck
+        bind $win <1> [mymethod activate]
+        bind $win <Return> [mymethod activate]
+        bind $win <<Invoke>> [mymethod activate]
+    }
+    method activate args {
+        # after idle ?
+        set newval [uplevel #0 $options(-command) [list [$self get]]]  ;# how does this get arguments?
+        $self configure -state normal   ;# yuck
+        $self delete 0 end
+        $self insert 0 $newval
+        $self configure -state readonly ;# yuck
+        #debug show {$self $newval}
+        #debug show {[$self configure -textvariable]}
+    }
+}
+
+snit::widgetadaptor OnButton {
+
+    option -variable    -default {} -configuremethod setOpt
+    option -command     -default {} -configuremethod setOpt
+
+    delegate option * to hull
+    delegate method * to hull
+
+    variable var
+    variable var_
+
+    constructor args {
+        set var_ 0
+        upvar #0 [myvar var_] [myvar var]
+        vartrace add [myvar var] write [mymethod traceHandler]
+
+        installhull using ttk::button -command [mymethod activate]
+        $self configure -variable [myvar var_]
+        $self configurelist $args
+    }
+
+    destructor {
+        vartrace remove [myvar var] write [mymethod traceHandler]
+    }
+
+    method activate args {
+        debug what
+        # after idle ?
+        after idle [list set [myvar var] 1]
+        #set var 1
+        if {$options(-command) ne ""} {
+            $options(-command)
+        }
+    } 
+
+    method setOpt {name value} {
+        debug what
+        switch $name {
+            -variable {
+                vartrace suspend [myvar var] {
+                    upvar 0 $value [myvar var]
+                }
+                variable var
+                debug log {rebound to $value == $var [set [myvar var]]}
+                if {![string is boolean -strict $var]} {
+                    debug log {Initialising $value to 0!}
+                    set var 0
+                }
+            }
+            -command {
+            }
+            default {
+                error "Unknown option: $name"
+            }
+        }
+        set options($name) $value
+    }
+
+    method traceHandler args {
+        debug log {$self traceHandler $args: $var}
+        $self configure -state [expr {$var ? "disabled" : "normal"}]
+    }
+}

ADDED   modules/snidgets/checkset.tcl
Index: modules/snidgets/checkset.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/checkset.tcl
@@ -0,0 +1,158 @@
+#
+# SYNOPSIS:  a direct analogue of radioset
+#
+package require Tk
+package require snit
+package require adebug
+
+snit::widgetadaptor CheckSet {
+
+    option -command -default {} -configuremethod setOpt
+    option -variable -default {} -configuremethod setOpt    ;# this is a list
+    option -choices -default {} -configuremethod setOpt
+    option -choicesvariable -default {} -configuremethod setOpt
+    option -value -default {} -configuremethod setOpt
+
+    variable items
+    variable state      ;# this is an array, bound to the individual checkbuttons
+                        ;# a trace on state updates the -variable, if present
+    variable listvariable   ;# declared here so that methods see it
+
+    constructor args {
+        debug off
+        set var {}
+        set items {}
+        array set state {}
+        trace add variable [myvar state] write [mymethod stateTrace]
+        installhull using frame
+        $self configurelist $args
+    }
+
+    method get {} {return $listvariable}
+
+    method set {ls} {
+        set listvariable $ls
+    }
+
+    method setOpt {name value} {
+        debug what
+        switch $name {
+            -command {
+                $self configitems -command $value
+            }
+            -variable {
+                if {[info exists listvariable]} {
+                    unset listvariable  ;# takes traces with it
+                }
+                upvar #0 $value [myvar listvariable]
+                trace add variable [myvar listvariable] write [mymethod variableTrace]
+            }
+            -choicesvariable {
+                if {[info exists items]} {
+                    unset items
+                }
+                upvar #0 $value [myvar items]
+                trace add variable [myvar items] write [mymethod itemsTrace]
+                $self build
+            }
+            -choices {
+                set items $value
+                $self build
+            }
+            -value {
+                $self set $value
+                return
+            }
+        }
+        set options($name) $value
+    }
+
+    # this could do with insert and delete methods as well, to be complete as a container
+    method build {} {
+        map destroy [winfo children $win]
+        set n 0
+        dict for {value text} $items {
+            if {![info exists state($value)]} {
+                set state($value) 0
+            }
+            grid [checkbutton [$self widget $n] -text $text -anchor w \
+                    -variable [myvar state($value)] -command $options(-command)] -sticky nsew
+            grid rowconfigure $win $n -weight 1
+            incr n
+        }
+        grid columnconfigure $win 0 -weight 1
+    }
+
+    method widget {idx} {
+        if {[string is integer $idx]} {
+            if {($idx < 0) || ($idx >= [dict size $items])} {
+                return -code error "Index out of bounds: $idx"
+            }
+            return $win.r$idx
+        }
+        if {[dict exists $items $idx]} {
+            set n [dict search $items $idx]
+            tailcall $self widget $n
+        } elseif {$idx in {end last}} {
+            tailcall $self widget [expr {[dict size $items]-1}]
+        }
+        return -code error "Bad index: $idx"
+    }
+
+    method widgets {} {
+        lmap idx [range [dict size $items]] {
+            subst {$win.r$idx}
+        }
+    }
+
+    method configitems {args} {
+        lmap iw [$self widgets] {
+            $iw configure {*}$args
+        }
+    }
+    method itemconfig {idx args} {
+        [$self widget $idx] {*}$args
+    }
+
+    variable notrace 0
+    method notrace {script} {
+        if {!$notrace} {
+            incr notrace
+            try {
+                uplevel 1 $script
+            } finally {
+                incr notrace -1
+            }
+        }
+        debug log {notrace skipping!}
+    }
+
+    method variableTrace args {
+        debug log {variable changed}
+        $self notrace {
+            array set state [lconcat {k v} [array get state] {
+                list $k [expr {$k in $listvariable}]
+            }]
+        }
+    }
+
+    method itemsTrace args {
+        debug log {items changed}
+        after idle [list $self build]
+    }
+
+    method stateTrace args {
+        debug log {state changed}
+        $self notrace {
+            set listvariable [lmap {k v} [array get state] {
+                if {!$v} continue
+                set k
+            }]
+        }
+    }
+}
+
+if 0 {
+    package require Tk
+    pack [CheckSet .rs -choices {blue "The colour of the sky" green "at the gills with envy"} -variable foo -command {puts "You chose $::foo"}]
+}

ADDED   modules/snidgets/choicedialog-0.tm
Index: modules/snidgets/choicedialog-0.tm
==================================================================
--- /dev/null
+++ modules/snidgets/choicedialog-0.tm
@@ -0,0 +1,57 @@
+# not really a snidget, but widget::dialog is!
+# 
+package require widget::dialog
+
+proc choiceDialog {choices} {
+    set w .choiceDialog[llength [info commands .choiceDialog*]]
+    set dlg [widget::dialog $w -separator 1 -type custom]
+    set frame [frame $w.f]
+    label $frame.l -text "Choose target table"
+    set lb [listbox $frame.lb]
+    $lb insert end {*}$choices
+    grid $frame.l -sticky nsew
+    grid $frame.lb -sticky nsew
+    grid columnconfigure $frame 0 -weight 1
+    grid rowconfigure $frame 1 -weight 1
+    $dlg setwidget $frame
+    $dlg add button -text Okay -command [format {%s close [list ok [%s get active]]} [list $dlg] [list $lb]]
+    $dlg add button -text Cancel -command [list $dlg close cancel]
+    set result [$dlg display]
+    destroy $dlg
+    return [lindex $result 1]   ;# because widget::dialog binds <Escape> to {close cancel}
+}
+
+proc comboDialog {default choices} {
+    set w .choiceDialog[llength [info commands .choiceDialog*]]
+    set dlg [widget::dialog $w -separator 1 -type custom]
+    set frame [frame $w.f]
+    label $frame.l -text "Choose target table"
+    entry $frame.e -exportselection yes
+    $frame.e insert end $default
+    set lb [listbox $frame.lb -exportselection yes]
+    $lb insert end {*}$choices
+
+    grid $frame.l -sticky nsew
+    grid $frame.e -sticky nsew
+    grid $frame.lb -sticky nsew
+
+    grid columnconfigure $frame 0 -weight 1
+    grid rowconfigure $frame $frame.lb -weight 1
+
+    bind $frame.e <1> "$frame.e configure -state normal; $frame.lb configure -state disabled"
+    bind $frame.lb <1> "$frame.lb configure -state normal; $frame.e configure -state disabled"
+
+    $dlg setwidget $frame
+    $dlg add button -text Okay -command [list {*}[lambda {dlg} {
+        set f $dlg.f
+        if {[$f.e cget -state] ne "disabled"} {
+            $dlg close [list ok [$f.e get]]
+        } else {
+            $dlg close [list ok [$f.lb get [$f.lb curselection]]]
+        }
+    }] $dlg]
+    $dlg add button -text Cancel -command [list $dlg close cancel]
+    set result [$dlg display]
+    destroy $dlg
+    return [lindex $result 1]   ;# because widget::dialog binds <Escape> to {close cancel}
+}

ADDED   modules/snidgets/fileentry.tcl
Index: modules/snidgets/fileentry.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/fileentry.tcl
@@ -0,0 +1,141 @@
+package require Tk
+package require Ttk
+package require snit
+package require options
+
+
+snit::widgetadaptor FileEntry {
+
+    # one of {open save directory}
+    #  - also support directory?  less options
+    #  - also support multi?  doesn't work with a single [entry]
+    option          -type   -default {open} -configuremethod setOpt
+
+    # for tk_get*File:  see [method DlgOpts]
+    option      -confirmoverwrite   -default true
+    option      -defaultextension   -default ""
+    option      -filetypes          -default ""
+    option      -initialdir         -default ""
+    option      -message            -default "\ufffd"
+    option      -title              -default "\ufffd"
+    # -parent is automatic
+    # -typevariable is not used yet
+    # -multiple is with -type multi
+    # for tk_chooseDirectory
+    option      -mustexist          -default true
+
+    delegate option -width          to entry
+    delegate option -variable       to entry as -textvariable
+
+    delegate option -textvariable   to button
+    delegate option -text           to button
+
+    delegate method get             to entry
+
+    constructor args {
+        installhull using ttk::frame
+        install entry using entry $win.entry
+        install button using button $win.button -command [mymethod Invoke]
+        bind $entry <Return> [mymethod Invoke]
+        grid $entry $button -sticky nsew
+        if {![dict exists $args -text]} {
+            dict set args -text "Browse"
+        }
+        $self configurelist $args
+    }
+
+    method set {fn} {
+        $entry delete 0 end
+        $entry insert end $fn
+        after idle [mymethod SetSel]
+    }
+
+    method setOpt {opt val} {
+        switch -exact $opt {
+            -type {
+                if {$val ni {open save directory}} {
+                    return -code error "Illegal option -type \"$val\": must be in {open save directory}"
+                }
+            }
+            default {
+                return -code error "Unknown options $option"
+            }
+        }
+        set options($opt) $val
+    }
+
+    method DlgOpts {} {
+        lappend res -parent $win
+        set fn [$entry get]
+        if {$fn eq ""} {
+            set dir [pwd]
+        } else {
+            set dir [file dirname $fn]
+        }
+        lappend res -initialdir $dir
+        if {$options(-type) eq "directory"} {
+            set opts {
+                -mustexist
+            }
+        } else {
+            lappend res -initialfile $fn
+            set opts {
+                -defaultextension
+                -filetypes
+                -initialdir
+                -message
+                -title
+            }
+        }
+        if {$options(-type) eq "multi"} {
+            lappend res -multiple yes
+        }
+        if {$options(-type) eq "save"} {
+            lappend opts -confirmoverwrite
+        }
+        foreach opt $opts {
+            set val $options($opt)
+            if {$val ne "\ufffd"} {
+                lappend res $opt $val
+            }
+        }
+        return $res
+    }
+
+    method Invoke {} {
+        set fn [
+            switch -exact $options(-type) {
+                "open" - "multi" {
+                    tk_getOpenFile {*}[$self DlgOpts]
+                }
+                "save" {
+                    tk_getSaveFile {*}[$self DlgOpts]
+                }
+                "directory" {
+                    tk_chooseDirectory {*}[$self DlgOpts]
+                }
+            }
+        ]
+        if {$fn ne ""} {
+            set fn [file nativename $fn]
+            $entry delete 0 end
+            $entry insert end $fn
+            after idle [mymethod SetSel 1]
+        }
+    }
+
+    method SetSel {{focus 0}} {
+        set fn [$entry get]
+        set l [string length $fn]
+        set a [expr {$l - [string length [file tail $fn]]}]
+        set b [expr {$l - [string length [file extension $fn]]}]
+        $entry selection range $a $b
+        $entry xview end
+        $entry icursor $b
+        if {$focus} {
+            focus $entry
+        }
+    }
+}
+
+

ADDED   modules/snidgets/fileschooser.tcl
Index: modules/snidgets/fileschooser.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/fileschooser.tcl
@@ -0,0 +1,121 @@
+#
+# SYNOPSIS:
+#
+#   FilesChooser .fc -text "Choose some files" \
+#       -multiple yes \
+#       -filetypes {{txt *.txt} {common {*.csv *.tsv *.txt}} {all *.*}} \
+#       -listvariable filenames
+#
+package require fun ;# maxlen, format_size, isodate
+
+snit::widget FilesChooser {
+    hulltype ttk::labelframe
+
+    variable filenames  {}
+    variable display    {}
+
+    option -listvariable -default {} -configuremethod setOption
+    option -command      -default {}
+
+    # these are delegated to tk_get{Open,Save}File in chooseFiles
+    option -multiple -default {}    ;# yes
+    option -filetypes -default {}   ;# {{all *.*}}
+    option -defaultextension -default {}
+    option -initialdir -default {}
+    option -title -default {}
+    option -type -default tk_getOpenFile
+
+    delegate method * to hull
+    delegate option * to hull
+
+    constructor args {
+        $self buildWidgets
+        $self configurelist $args
+        $self setDisplay
+    }
+
+    method buildWidgets {} {
+        grid [label $win.filenames -anchor nw -justify left -font TkFixedFont -textvariable [myvar display]] \
+             [button $win.b_load -text "Choose Files" -command [mymethod chooseFiles]] \
+            -in $win -sticky nsew -padx 5 -pady 5
+        grid ^ \
+             [button $win.b_clear -text "Clear" -command [mymethod clearFiles]] \
+            -in $win -sticky nsew -padx 5 -pady {0 5}
+        grid ^ \
+             x \
+            -in $win -sticky nsew
+
+        grid columnconfigure $win 0 -weight 1
+        grid columnconfigure $win 1 -weight 0
+        grid rowconfigure $win 0 -weight 0
+        grid rowconfigure $win 1 -weight 0
+        grid rowconfigure $win 2 -weight 1
+    }
+
+    method setOption {option value} {
+        switch -exact -- $option {
+            -listvariable {
+                set options(-listvariable) $value
+                # it would be nice if we could simply:   upvar #0 $value filenames
+                upvar #0 $value it
+                if {[info exists it]} {
+                    set filenames $it
+                    $self setDisplay
+                } else {
+                    set it $filenames
+                }
+            }
+            default {
+                return -code error "Unknown option $option"
+            }
+        }
+    }
+
+    method chooseFiles {} {
+        set params {}
+        foreach opt {-multiple -filetypes -defaultextension -initialdir -title} {
+            if {$options($opt) ne ""} {
+                lappend params $opt $options($opt)
+            }
+        }
+        set fs [$options(-type) {*}$params]
+        if {$fs ne ""} {
+            set filenames $fs
+            if {$options(-listvariable) ne ""} {uplevel #0 [list set $options(-listvariable) $filenames]}
+            $self setDisplay
+        }
+    }
+
+    method setDisplay {} {
+        set display [$self formatFilenames $filenames]
+        if {$options(-command) ne ""} {
+            after 0 [list {*}$options(-command) $filenames]
+        }
+    }
+
+    method formatFilenames {fs} {
+        if {$fs eq ""} {
+            return "\nNo Files Chosen\n"
+        } else {
+            set dir [file dirname [lindex $filenames 0]]
+            set fs [map {file tail} $filenames]
+            set maxlen [maxlen $fs]
+            set n [llength $fs]
+            set files [expr {$n != 1 ? "files" : "file"}]
+            set txt "$n $files from $dir:\n"
+            foreach fn $filenames {
+                set size [format_size [file size $fn]]
+                set mtime [isodate [file mtime $fn]]
+                set fn [file tail $fn]
+                append txt [format "\n  %-${maxlen}s  %10s  %19s" $fn $size $mtime]
+            }
+            return $txt
+        }
+    }
+
+    method clearFiles {} {
+        set filenames {}
+        if {$options(-listvariable) ne ""} {uplevel #0 [list set $options(-listvariable) $filenames]}
+        $self setDisplay
+    }
+}

ADDED   modules/snidgets/indicators.tcl
Index: modules/snidgets/indicators.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/indicators.tcl
@@ -0,0 +1,71 @@
+package require tooltip ;# tklib
+package require snit
+
+snit::widgetadaptor Lamp {
+    variable State
+    delegate method * to hull
+    delegate option * to hull
+    constructor args {
+        installhull using label
+        # $self configure -text \u25c9    ;# FISHEYE
+        $self configure -text \u25cf      ;# LARGE BLACK CIRCLE
+        # $self configure -text \u2022    ;# BULLET
+        # $self configure -text *         ;# ultimate fallback
+        $self configure -fg gray50
+        $self configurelist $args
+    }
+    method state args {
+        tailcall $self state/[llength $args] {*}$args
+    }
+    method state/0 {} {
+        return $State
+    }
+    method state/1 {state} {
+        set State $state
+        $self configure -fg $State
+    }
+}
+
+# this expects to be given a container widget
+oo::class create Indicators {
+    variable W
+    variable Packer
+    variable I
+    variable Sym
+    variable Statemap
+    constructor {container {packer {pack -side right}}} {
+        set W $container
+        set Packer $packer
+        array set I {}
+        set Sym -1
+        set Statemap {}
+    }
+    method statemap {d} {
+        set Statemap [dict merge $Statemap $d]
+    }
+    method state args {
+        catch {lset args end [dict get $Statemap [lindex $args end]]}
+        tailcall my state/[llength $args] {*}$args
+    }
+    method delete {name} {
+        tooltip::tooltip clear $I($name)
+        destroy $I($name)
+        unset I($name)
+    }
+    method widget {name} {
+        if {![info exists I($name)] || $I($name) eq ""} {
+            set I($name) [Lamp ${W}.i#[incr Sym]]
+            tooltip::tooltip $I($name) $name
+            {*}[linsert $Packer 1 $I($name)]
+        }
+        return $I($name)
+    }
+    method state/1 {name} {
+        set w [my widget $name]
+        $w state
+    }
+    method state/2 {name colour} {
+        set w [my widget $name]
+        $w state $colour
+    }
+}

ADDED   modules/snidgets/labelled.tcl
Index: modules/snidgets/labelled.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/labelled.tcl
@@ -0,0 +1,69 @@
+#
+# SYNOPSIS:
+#
+#   pack [labelled .e button -label "Type stuff" -text "Press me" -command {puts [.e get]}]
+#
+package require snit
+
+proc otherside {side} {
+    dict get {
+        left right
+        right left
+        top bottom
+        bottom top
+    } $side
+}
+
+snit::widgetadaptor labelled {
+
+    component label
+    component widget
+
+    option -side -default left
+    option -state -default normal -configuremethod setOpt
+    delegate option -label to label as -text
+    delegate option * to widget
+    delegate method * to widget
+
+    method setOpt {opt value} {
+        switch -exact $opt {
+            -state {
+                $label configure -state [expr {$value eq "disabled" ? "disabled" : "normal"}]
+                $widget configure -state $value
+            }
+        }
+        set options($opt) $value
+    }
+
+    constructor {cons args} {
+        installhull using frame
+        install label  using label $win.label -anchor w
+        install widget using $cons $win.widget
+        $self configure -takefocus {}   ;# why is this needed?  seems to only be in FormDialogs??
+        $self configurelist $args
+        pack $widget -side [otherside $options(-side)] -fill none -expand no    -padx 2 -pady 2
+        pack $label  -side [otherside $options(-side)] -fill both -expand yes   -padx 2 -pady 2
+#        grid $label  -sticky nsew
+#        grid $widget -row 0 -column 1 
+#        grid columnconfigure $win 1 -weight 0
+#        grid columnconfigure $win 0 -weight 1
+#        grid rowconfigure $win 0 -weight 1
+        trace add command $widget delete "destroy $self; list"
+    }
+
+}
+
+package provide labelled 0.1
+
+if 0 {
+    package require Tk
+    grid [labelled .e button -label "This is a button" -text "Press me" -command {puts "aah!"}] -sticky nsew
+    grid [labelled .e2 button -label "So is this" -side right -text "Push It" -command {puts "so good"}] -sticky nsew
+    grid [labelled .e3 button -label "This is a button" -side top -text "Press me" -command {puts "aah!"}] -sticky nsew
+    grid [labelled .e4 button -label "So is this" -side bottom -text "Push It" -command {puts "so good"}] -sticky nsew
+    grid columnconfigure . 0 -weight 1
+    grid rowconfigure . 0 -weight 1
+    grid rowconfigure . 1 -weight 1
+    grid rowconfigure . 2 -weight 1
+    grid rowconfigure . 3 -weight 1
+}

ADDED   modules/snidgets/listchooser.tcl
Index: modules/snidgets/listchooser.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/listchooser.tcl
@@ -0,0 +1,87 @@
+package require snit
+package require adebug
+package require tests
+package require vartrace
+
+snit::widgetadaptor ListChooser {
+
+    option -variable    -default {} -configuremethod setOpt
+    option -command     -default {} -configuremethod setOpt
+
+    delegate option * to hull
+    delegate method * to hull
+
+    variable var
+    variable var_
+
+    constructor args {
+        set var_ 0
+        upvar #0 [myvar var_] [myvar var]
+        vartrace add [myvar var] write [mymethod traceHandler]
+
+        installhull using listbox
+        bind $win <<ListboxSelect>> [list after idle [mymethod lbSelect]]
+        $self configure -variable [myvar var_]
+        $self configurelist $args
+    }
+
+    destructor {
+        vartrace remove [myvar var] write [mymethod traceHandler]
+    }
+
+    method lbSelect {} {
+        debug what
+        set var [$self get [$self curselection]]
+
+        if {$options(-command) ne ""} {
+            after idle [list {*}$options(-command) $var]
+        }
+    } 
+
+    method setOpt {name value} {
+        debug what
+        switch $name {
+            -variable {
+                vartrace suspend [myvar var] {
+                    upvar 0 $value [myvar var]
+                }
+                variable var
+                debug log {rebound to $value == $var [set [myvar var]]}
+                if {$var ni [$self get 0 end]} {
+                    debug log {Initialising $value to 0!}
+                    set var [$self get 0]
+                }
+            }
+            -command {
+            }
+            default {
+                error "Unknown option: $name"
+            }
+        }
+        set options($name) $value
+    }
+
+    method select {val} {
+        set idx [lsearch -exact [$self get 0 end] $val]
+        $self selection clear 0 end
+        $self activate $idx
+        $self selection set $idx $idx
+    }
+
+    method traceHandler args {
+        debug log {$self traceHandler $args: $var}
+        $self select $var
+        #$self configure -state [expr {$var ? "disabled" : "normal"}]
+    }
+}
+
+tests {
+    proc test {} {
+        package require Tk
+        set ::l {one two three four five six}
+        set ::v four
+        pack [ListChooser .l -listvariable ::l -variable ::v -command {debug log CHOSE}]
+        #pack [listbox .lb -listvariable ::l]
+    }
+    test
+}

ADDED   modules/snidgets/misc.tcl
Index: modules/snidgets/misc.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/misc.tcl
@@ -0,0 +1,168 @@
+package provide mysnits 0.1
+
+package require Tk
+package require ctext
+package require snit
+
+#
+# A readonly entry which invokes -command on Invoke
+# the result of -command becomes the new value
+#
+snit::widgetadaptor TouchInput {
+
+    option -command     -default {}
+
+    delegate option -variable to hull as -textvariable  ;# go team!
+
+    delegate option * to hull
+    delegate method * to hull
+
+    constructor args {
+        installhull using entry
+        $self configurelist $args
+        bind $win <1> [mymethod activate]
+        bind $win <Return> [mymethod activate]
+        bind $win <<Invoke>> [mymethod activate]
+    }
+    method activate args {
+        # after idle ?
+        $self configure -state normal   ;# yuck
+        $self delete 0 end
+        $self insert 0 [uplevel #0 $options(-command)]  ;# how does this get arguments?
+        $self configure -state readonly ;# yuck
+    }
+}
+
+#bind Ctext <Control-y> {%W edit redo}
+#bind Ctext <Control-z> {%W edit undo}
+# adds a -textvariable param to ctext (using traces)
+snit::widgetadaptor Ctext {
+    option -textvariable -default {} -configuremethod setOption
+    option -maxheight    -default {} ;# -configuremethod setOption
+    delegate method ins to hull as insert
+    delegate method del to hull as delete
+    delegate method rp to hull as replace
+    delegate method * to hull
+    delegate option * to hull
+    constructor {args} {
+        installhull using ctext
+        $self configurelist $args
+        bind $self <<Modified>> [mymethod <<Modified>>]   ;# this isn't quite right
+        bind $self <FocusIn> [mymethod takeFocus]
+        bind $self <Control-y> {%W edit redo} ;# doesn't belong here!
+    }
+    destructor {
+        if {[info exists options(-textvariable)] && $options(-textvariable) ne ""} {
+            trace remove variable $options(-textvariable) read [mymethod readTrace]
+            trace remove variable $options(-textvariable) write [mymethod writeTrace]
+        }
+    }
+    method insert args { $self ins {*}$args ; $self updateVar }
+    method delete args { $self del {*}$args ; $self updateVar }
+    method replace args { $self rp {*}$args ; $self updateVar }
+
+    method updateVar args {
+        if {[info exists options(-textvariable)] && $options(-textvariable) ne ""} {
+            trace remove variable $options(-textvariable) write [mymethod writeTrace]
+            set $options(-textvariable) [$self getText]
+            if {[info exists options(-maxheight)] && $options(-maxheight) ne ""} { ;# c&p from below
+                set h [llength [split [$self getText] \n]]
+                $self configure -height [expr {min($h,$options(-maxheight))}]
+            }
+            trace add variable $options(-textvariable) write [mymethod writeTrace]
+        }
+    }
+
+    method takeFocus {} { ;# work around ctext's broken focus
+        debug log {taking focus}
+        focus $self.t
+    }
+    method setOption {option value} {
+        switch -exact -- $option {
+            -textvariable {
+                if {[info exists options(-textvariable)] && $options(-textvariable) ne ""} {
+                    trace remove variable $options(-textvariable) read [mymethod readTrace]
+                    trace remove variable $options(-textvariable) write [mymethod writeTrace]
+                }
+                set options(-textvariable) $value
+                $self writeTrace
+                trace add variable $value write [mymethod writeTrace]
+                trace add variable $value read [mymethod readTrace]
+            }
+            default {
+                return -code error "Unknown options $option"
+            }
+        }
+    }
+    method <<Modified>> args {
+        #log info "<<Modified>> $self"
+        set modified [$self edit modified]
+        $self configure -linemapbg [expr {$modified ? "#fcc" : "#ffc"}]
+        trace remove variable $options(-textvariable) read [mymethod readTrace]
+        trace remove variable $options(-textvariable) write [mymethod writeTrace]
+        set cur $options(-textvariable) ;# BUGBUG
+        if {$cur ne ""} {
+            # this would probably be better done by calling the cb with a flag
+            set text [$self getText]
+            if {$text ne $cur} {
+                set $options(-textvariable) $text
+            }
+        }
+        if {[info exists options(-maxheight)] && $options(-maxheight) ne ""} {
+            set h [llength [split [$self getText] \n]]
+            $self configure -height [expr {min($h,$options(-maxheight))}]
+        }
+        trace add variable $options(-textvariable) write [mymethod writeTrace]
+        trace add variable $options(-textvariable) read [mymethod readTrace]
+        #$self configure -linemapbg #fcc
+    }
+    method readTrace args {
+        set $options(-textvariable) [$self getText]
+    }
+    method writeTrace args {
+        $self setText [set $options(-textvariable)]
+    }
+    method getText {} {
+        string range [$self get 1.0 end] 0 end-1 ;# !!
+    }
+    method setText {text} {
+        $self del 1.0 end
+        $self ins 1.0 $text
+        event generate $self <<Modified>>
+    }
+}
+
+
+
+snit::widgetadaptor CollapsingFrame {
+    component b
+    delegate option -text to b
+    delegate option -textvariable to b
+    delegate option * to hull
+    delegate method * to hull
+    constructor args {
+        installhull using labelframe
+        install b using label $win.b
+        $self configurelist $args
+        $self configure -labelwidget $b
+        bind $b <1> [mymethod collapse]
+    }
+    method collapse {} {
+        set C "+" ;#\u25ba
+        set O "-" ;#\u25bc
+        set h [winfo height $b]
+        incr h 2
+        set f [winfo parent $b]
+        set title [$b cget -text]
+        set title [string trimleft $title "$C$O "]
+        if {[grid propagate $f]} {
+            grid propagate $f 0
+            $f configure -height $h
+            $b configure -text "$C $title"
+        } else {
+            grid propagate $f 1
+            $f configure -height 0
+            $b configure -text "$O $title"
+        }
+    }
+}

ADDED   modules/snidgets/notebook.tcl
Index: modules/snidgets/notebook.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/notebook.tcl
@@ -0,0 +1,36 @@
+# WORK IN PROGRESS - NOT USABLE
+snit::widgetadaptor Notebook {
+    option -command     -default {}     -configuremethod setOpt
+    variable tabs
+    variable current
+
+    constructor args {
+        installhull using ttk::frame
+        grid [RadioSet $win.panes -packside left -itemstyle Toolbutton] -sticky new
+        set tabs {}
+        set current {}
+        $self configurelist $args
+        $self build
+    }
+    method build {} {
+        $win.panes configure -choices $tabs
+        if {[dict exists $pages $current]} {
+            set page [dict get $pages $current]
+            grid $page -in $win -sticky nsew
+            grid rowconfigure $win $slave -weight 1
+            grid columnconfigure $win $slave -weight 1
+        }
+    }
+    method add {name w} {
+        if {[dict exists $pages $name]} {
+            return -code error "Already have an entry called $name"
+        }
+        dict set pages $name $w
+        dict set tabs  $name $w
+        if {![dict exists $tabs $current]} {
+            set current $name
+        }
+        $self build
+    }
+}
+

ADDED   modules/snidgets/password.tcl
Index: modules/snidgets/password.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/password.tcl
@@ -0,0 +1,28 @@
+package require snit
+
+snit::widgetadaptor passwordentry {
+
+    component entry
+    component checkbox
+
+    delegate option * to entry
+    delegate method * to entry
+
+    constructor {args} {
+        installhull using frame
+        install entry using ttk::entry $win.entry -show *
+        install checkbox using checkbutton $win.checkbox -command [mymethod toggle]
+        grid $entry $checkbox
+        grid columnconfigure $win 0 -weight 1
+    }
+
+    method toggle {} {
+        set show [$self cget -show]
+        if {$show eq ""} {
+            set show "*"
+        } else {
+            set show ""
+        }
+        $self configure -show $show
+    }
+}

ADDED   modules/snidgets/pkgIndex.tcl
Index: modules/snidgets/pkgIndex.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/pkgIndex.tcl
@@ -0,0 +1,10 @@
+package ifneeded snidgets 0.1 [list apply {{dir} {
+    package require Tk
+    package require Ttk
+    package require snit
+    foreach file [glob -dir $dir *.tcl *.tm] {
+        if {[file tail $file] eq "pkgIndex.tcl"} continue
+        source $file
+    }
+    package provide snidgets 0.1
+}} $dir]

ADDED   modules/snidgets/radioset.tcl
Index: modules/snidgets/radioset.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/radioset.tcl
@@ -0,0 +1,156 @@
+#
+# SYNOPSIS:
+#
+#   RadioSet -choices {blue "The colour of the sky" green "at the gills with envy"}
+#
+# TODO:
+#  give it a -dictvariable
+#  think about indices
+#
+#  add = insert idx (key value ?-tabopt ...?)
+#
+#
+package require Tk
+package require snit
+#tcl::tm::path add ..
+package require fun
+
+snit::widgetadaptor RadioSet {
+
+    option -command     -default {}     -configuremethod setOpt
+    option -variable    -default {}     -configuremethod setOpt
+    option -choices     -default {}     -configuremethod setOpt
+    option -packside    -default left   -configuremethod setOpt
+    option -itemstyle   -default {}     -configuremethod setOpt
+
+    #variable var   ;# we don't keep a local stash of var, because upvar+traces killed me
+    variable items
+
+    constructor args {
+        set var {}
+        set items {}
+        installhull using ttk::frame
+        $self configurelist $args
+    }
+
+    method get {} {return $var}
+
+    method setOpt {name value} {
+        switch $name {
+            -command {
+                $self configitems -command $value
+            }
+            -variable {
+                $self configitems -variable $value
+            }
+            -choices {
+                set items $value
+                $self build
+            }
+            -packside {
+                set options($name) $value
+                $self build
+            }
+            -itemstyle {
+                $self configitems -style $value
+            }
+        }
+        set options($name) $value
+    }
+
+    # this could do with insert and delete methods as well, to be complete as a container
+    method build {} {
+        map destroy [winfo children $win]
+        set n 0
+        dict for {value text} $items {
+            set r [ttk::radiobutton [$self widget $n] -text $text -value $value \
+                    -variable $options(-variable) -command $options(-command)]
+            if {$options(-itemstyle) ne ""} {
+                $r configure -style $options(-itemstyle)
+            }
+            bindtags $r [list $win {*}[bindtags $r]]
+            pack $r -side $options(-packside)
+            incr n
+        }
+    }
+
+    method inputvar args {
+        switch [llength $args] {
+            0 {
+                my varname inputs
+            }
+            1 {
+                my varname inputs([lindex $args 0])
+            }
+            default {
+                error "Incorrect arguments - expected 0 or 1"
+            }
+        }
+    }
+
+    method widget {idx} {
+        if {[string is integer $idx]} {
+            if {($idx < 0) || ($idx >= [dict size $items])} {
+                return -code error "Index out of bounds: $idx"
+            }
+            return $win.r$idx
+        }
+        if {[dict exists $items $idx]} {
+            set n [dict search $items $idx]
+            tailcall $self widget $n
+        } elseif {$idx in {current selected}} {
+            # lookup by value
+            tailcall $self widget $var
+        } elseif {$idx in {end last}} {
+            tailcall $self widget [expr {[dict size $items]-1}]
+        }
+        return -code error "Bad index: $idx"
+    }
+
+    method widgets {} {
+        lmap idx [range [dict size $items]] {
+            subst {$win.r$idx}
+        }
+    }
+
+    method configitems {args} {
+        lmap iw [$self widgets] {
+            $iw configure {*}$args
+        }
+    }
+    method itemconfig {idx args} {
+        [$self widget $idx] {*}$args    ;# configure ?
+    }
+
+    method under {x y} {
+        ;# FIXME
+    }
+    method insert {idx ...} {
+        ;# FIXME
+    }
+    method delete {idx} {
+        ;# FIXME
+    }
+
+    method traceHandler args {
+        debug log {tracing $args: $var}
+        if {"" ne $options(-command)} {
+            after idle [list {*}$options(-command) $var]
+        }
+    }
+}
+
+if 0 {
+    set side left
+    pack [RadioSet .side -variable side -choices {left left right right top top bottom bottom} -command {.rs configure -packside $::side}]
+    pack [RadioSet .rs -choices {blue "The colour of the sky" green "at the gills with envy"} -variable foo -command {puts "You chose $::foo"}]
+    set choices [.rs cget -choices]
+    pack [text .t]
+    .t insert end $choices
+    pack [button .b -command {.rs configure -choices [.t get 1.0 end]}]
+    #.side configitems -style Toolbutton
+    .side configure -itemstyle Toolbutton
+    bind .side <Button-2> {puts Three}
+    after 1000 {set foo blue}
+    after 2000 {set foo green}
+}

ADDED   modules/snidgets/table.tcl
Index: modules/snidgets/table.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/table.tcl
@@ -0,0 +1,394 @@
+#
+# The design choice here is for each row to have an explicit name, thus [insert] must take pairs.
+#
+# An alternative would be for [lindex 0] of each inserted list to be a key, but that raises
+# indexing questions (0- or 1-based?) for columns so is better avoided.  Dicts are king!
+#
+# -command takes %-substitution:
+#  %W %x %y %X %Y %j %i
+#  %C(olumn name)
+#  %V(alue)
+#  %N(ame)
+#
+package require adebug
+package require snit
+package require tablelist
+package require sql
+package require adebug
+package require tests
+
+#package require autoscroll
+#::autoscroll::wrap
+
+snit::widgetadaptor easytable {
+
+    delegate method Get     to hull as get  ;# these methods are overridden
+    delegate method Insert  to hull as insert
+    delegate method *       to hull
+
+    option          -command    -default {puts {%W activate %N (%j) %C (%i) %V}}
+    delegate option -tlcolumns  to hull as -columns 
+    option          -columns    -configuremethod SetOpt
+    option          -rightmenu  -default "" ;# -configuremethod SetOpt
+    delegate option *           to hull
+
+    constructor args {
+        set args [dict merge {
+                -labelcommand tablelist::sortByColumn
+                -labelcommand2 tablelist::addToSortColumns
+                -snipstring \u2026
+                -stretch all
+                -resizablecolumns yes
+                -showseparators yes
+                -stripebackground #ccccff
+                -selecttype cell
+                -selectmode extended
+                -exportselection 1
+            } $args]
+        installhull using tablelist::tablelist
+        $self configurelist $args
+        bind $win.body <Double-Button-1> [mymethod Activate mouse]
+        bind $win.body <Return> [mymethod Activate active]
+        bind $win.body <Button-3> [mymethod Rightmenu]
+        # bind $win.body <Control-a> [mymethod selection set 0 end] ;# ??? FIXME
+    }
+
+    method Rightmenu {} {
+        if {[set spec $options(-rightmenu)] eq ""} {
+            return
+        }
+        if {[winfo exists $win.rm]} {
+            destroy $win.rm
+        }
+        set cell [$self mousecell]
+        mkmenu $win.rm [$self CmdSub $spec $cell]
+        set xy [winfo pointerxy $win]
+        ;# [map ::tcl::mathop::+ [winfo pointerxy $win] [list [winfo rootx $win] [winfo rooty $win]]]
+        tailcall tk_popup $win.rm {*}$xy
+    }
+
+    method SetOpt {name value} {
+        switch $name {
+            -columns {
+                set tlc [lconcat c $value {list 0 $c}]
+                $self configure -tlcolumns $tlc
+            }
+            default {
+                error "Unknown option: $name"
+            }
+        }
+        set options($name) $value
+    }
+
+    method columns {names} {
+        $win configure -columns $names  ;# $win instead of $self for dynamic dispatch /~inheritance
+    }
+
+    method set args {
+        switch [llength $args] {
+            2 { $self set/2 {*}$args }
+            3 { $self set/3 {*}$args }
+            default { raise {BADARGS} "FIXME: multiargs" }
+        }
+    }
+    method set/2 {j values} {
+        foreach i [range [$self columncount]] value $values {
+            $self cellconfigure [$self RowId $j],$i -text $value
+        }
+    }
+    method set/3 {j i value} {
+        $self cellconfigure [$self RowId $j],$i -text $value
+    }
+
+    method get args {
+        switch [llength $args] {
+            0 {
+                tailcall $self Get 0 end
+            }
+            1 { lassign $args j
+                set j [$self RowId $j]
+                tailcall $self Get $j
+            }
+            2 { lassign $args j i
+                set j [$self RowId $j]
+                tailcall $self getcells $j,$i
+            }
+            default {
+                raise {BAD_ARGS} "FIXME: this should be a proper error"
+            }
+        }
+    }
+
+    ;# return "" if the key is invalid
+    method RowId {key} {
+        set i [$hull findrowname n$key]
+        if {$i == -1} {
+            lassign [$hull getfullkeys $key] i
+        }
+        return $i
+    }
+
+    ;# same for insert* would be great!
+    method insert {index args} {
+        debug assert {[llength $args]%2==0}
+        set names   [lmap {a b} $args {set a}]
+        set values  [lmap {a b} $args {set b}]
+        set values [lmap v $values {
+            set diff [expr {[$self columncount] - [llength $v]}]
+            if {$diff > 0} {
+                lappend v [lrepeat $diff {}]
+            } elseif {$diff < 0} {
+                throw {EASYTABLE TOOMANY} "Too many values by [expr -$diff]"
+            }
+            set v
+        }]
+        set rowids [$self Insert $index {*}$values]
+        foreach name $names rowid $rowids {
+            if {$name ne ""} {  ;# ??
+                $self rowconfigure $rowid -name n$name
+            }
+        }
+        return $rowids  ;# not names, because we haven't shimmed ::tablelist::rowIndex
+    }
+
+    method mousecell {} {
+        foreach {x y} [winfo pointerxy $win] {}
+        incr x [expr {-[winfo rootx $win]}]
+        incr y [expr {-[winfo rooty $win]}]
+        $self containingcell $x $y
+       # lassign [split [$self cellindex @$x,$y] ,] y x
+       # set y [$self rowcget $y -name]
+       # return "$y,$x"
+       # [self findcolumnname $x]
+       # $self cellindex @$x,$y  ;# WARNING: this is indices!
+    }
+
+    method activecell {} {
+        $self cellindex active
+    }
+
+    method selected {} {
+        set cellsel [$self curcellselection]
+        set xs [lmap xy $cellsel {lindex [split $xy ,] 1}]
+        set xs [lsort -uniq $xs]
+        set xs [llength $xs]
+        if {$xs eq [$self columncount]} {
+            $self Get [$self curselection]
+        } else {
+            lgroup [$self getcells $cellsel] $xs
+        }
+    }
+
+    method Activate {what} {
+        debug assert {$what in {active mouse}}  ;# activecell mousecell
+        set cell [$self ${what}cell]
+        #puts "Activated [$self getcells $cell]"
+        if {$options(-command) ne ""} {
+            set script [$self CmdSub $options(-command) $cell]
+            after idle [list after 0 $script]
+        }
+    }
+
+    method CmdSub {script cellIndex} {
+        set W $self
+        lassign [split $cellIndex ,] j i
+        lassign [winfo pointerxy $win] x y
+        # FIXME: check xyXY
+        set X [expr {$x+[winfo rootx $win]}]
+        set Y [expr {$y+[winfo rooty $win]}]
+        set V [$self get $j $i]
+        set N [$self rowcget $j -name]
+        set N [string range $N 1 end]
+        set C [$self columncget $i -title]
+        set % %%
+        foreach var [info locals ?] {
+            dict set map %$var [list [set $var]]
+        }
+        string map $map $script
+    }
+}
+
+snit::widgetadaptor edittable {
+
+    # maintaining an always-blank row for adding entries?
+    option -editcommand -default {debug log {Edit:}}
+    option -addcommand -default {debug log {Add:}}
+    option -delcommand -default {debug log {Delete:}}
+    option -columns -default {} -configuremethod SetOpt
+
+    delegate option * to hull
+    delegate method * to hull
+
+    constructor args {
+        installhull using easytable
+        $self configure -editselectedonly true
+        $self configure -editstartcommand [list $self EditStart]
+        $self configure -editendcommand   [list $self EditEnd]
+        #$self configure -titlecolumns 1
+        $self configurelist $args
+        $self Editable
+    }
+
+    method SetOpt {name value} {
+        switch $name {
+            -columns {
+                #$hull configure -columns $value  ;# propagate the change to hull
+                $hull configure -columns [linsert $value 0 ""]  ;# implicit column 0
+                $hull configure -titlecolumns 1
+                $hull columnconfigure 0 -width 1 -labelcommand [list $self AddEvent]
+                after idle [list after 0 [list $self Editable $value]]
+            }
+            default {
+                error "Unknown option: $name"
+            }
+        }
+        set options(-columns) $value
+    }
+
+    # deal with the icky implicit column 0
+    method insert {index args} {
+        set args [join [lmap {a b} $args {
+            list $a [list "" {*}$b]
+        }]]
+        set keys [$hull insert $index {*}$args]
+        set j 0
+        foreach row $keys {
+            $hull cellconfigure ${row},0 -window [list $self DelButton] -stretchwindow true
+        }
+    }
+    method set args {
+        if {[llength $args] != 3} {
+            tailcall $hull set {*}$args
+        } else {
+            lassign $args j i value
+            incr i
+            $hull set $j $i $value
+        }
+    }
+    method get args {
+        if {[llength $args] != 3} {
+            tailcall $hull get {*}$args
+        } else {
+            lassign $args j i value
+            incr i
+            $hull get $j $i $value
+        }
+    }
+
+    method DelButton {tl row col w} {
+        button $w -padx 0 -pady 0 -width 1 -height 1 -takefocus 0 -text "X" -command [list $self DelEvent $row]
+        return $w
+    }
+    method AddEvent {tl col} {
+        uplevel #0 $options(-addcommand)
+    }
+    method DelEvent {row} {
+        set rowid [$hull rowcget $row -name]
+        set rowid [string range $rowid 1 end]
+        uplevel #0 $options(-delcommand) $rowid
+    }
+
+    method Editable args {
+        set ncols [$self columncount]
+        for {set i 1} {$i < $ncols} {incr i} {
+            $self columnconfigure $i -editable true
+        }
+    }
+
+    method EditStart {tl row col value} {
+        variable OrigVal
+        set OrigVal $value
+        return $value
+    }
+    method EditEnd {tl row col value} {
+        variable OrigVal
+        set rowid [$self rowcget $row -name]
+        set rowid [string range $rowid 1 end]
+        set colname [$self columncget $col -title]
+        try {   ;# FIXME: this is a bit presumptuous
+            uplevel #0 $options(-editcommand) [list $rowid $colname $OrigVal $value]
+        } on break {} {
+            $win cancelediting
+            return ""
+        } on return {v o} {
+            set value $v
+        }
+        unset OrigVal
+        return $value
+    }
+}
+
+# tableedit .q -table regex -key rowid -columns {pattern category}
+#   -where {sqlcond}
+#   -highlight {rowexpr}
+snit::widgetadaptor tableedit {
+    option -db
+    option -table
+    option -key
+    option -columns
+    option -where -default 1
+    option -query -default ""
+    delegate option * to hull
+    delegate method * to hull
+    constructor args {
+        installhull using edittable
+        $hull configure -addcommand [list $self Add]
+        $hull configure -delcommand [list $self Del]
+        $hull configure -editcommand [list $self Edit]
+        $self configurelist $args
+    }
+    method Add {} {
+        debug log {$self Add}
+    }
+    method Del {rowid} {
+        debug log {$self Del $rowid}
+    }
+    method Edit {rowid column prev value} {
+        debug log {$self Edit $rowid $column $value <- $prev}
+    }
+    method SqlSelect {} {
+        if {$options(-query) ne ""} {
+            return $options(-query)
+        }
+        return [Sql select $options(-table) [list $options(-key) {*}$options(-columns)] $options(-where)]
+    }
+    method refresh {} {
+        $hull delete 0 end
+        $hull configure -columns $options(-columns)
+        $options(-db) eval [$self SqlSelect] row {
+            $hull insert end $row($options(-key)) [
+                lmap c $options(-columns) {set row($c)}
+            ]
+            # highlight? apply rowstyle?
+        }
+        # restore sorting?
+    }
+    method delete {rowid} {
+        $options(-db) eval [Sql delete $options(-table) $options(-key) $rowid
+    }
+    method update {rowid args} {
+        $options(-db) eval [Sql update $table $args [list $options(-key) $rowid]]
+    }
+}
+
+tests {
+    if 0 {
+        pack [edittable .t] -fill both -expand yes
+        wm deiconify .
+        .t columns "left middle right"
+        .t insert end english {one two three}
+        .t insert end deutsch {eins zwei drei} thai {nung song sarm}
+        .t set english 1 TWO
+    } else {
+        package require sqlight
+        Sqlite create sqlite ../../../aeu_20150427.db
+        puts aa
+        set cols [sqlite columns foo]
+        puts oo
+        pack [tableedit .t -table foo -key rowid -columns $cols -db sqlite] -fill both -expand yes
+        puts ok
+        .t refresh
+        package require repl
+        coroutine mainrepl repl::chan stdin stdout
+    }
+}

ADDED   modules/snidgets/tablechooser.tcl
Index: modules/snidgets/tablechooser.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/tablechooser.tcl
@@ -0,0 +1,173 @@
+#
+# SYNOPSIS:
+#
+#   TableChooser .tc \
+#       -variable current_choice \
+#       -columns {0 digit 0 word 0 Roman} \
+#       -options {1 one I 2 two II 3 three III 4 four IV} \
+#       -addmessage "Add another transation" \
+#       -addefault {five} \
+#       -addvalidate {string length} \
+#       -addverify {string length}
+#
+# TODO:
+#   * rename -options to -choices
+#
+package provide tablechooser 0.1
+package require Tk
+package require snit
+package require tablelist
+
+snit::widgetadaptor TableChooser {
+    #hulltype tablelist::tablelist
+
+    # beware: we hijack some of these!
+    option -options      -default {} -configuremethod setOption
+    option -listvariable -default {} -configuremethod setOption
+    option -variable     -default {} -configuremethod setOption
+    option -columns      -default {} -configuremethod setOption
+
+    # for "New xxx"
+    option -addmessage   -default {} -configuremethod setOption
+    option -adddefault   -default {} -configuremethod setOption
+    option -addverify    -default {} -configuremethod setOption
+    option -addcommand   -default {} -configuremethod setOption
+
+    delegate method * to hull
+    delegate option * to hull
+
+    constructor args {
+        installhull using tablelist::tablelist
+        $self configure -stretch 0 \
+                -exportselection 1 \
+                -selectmode browse \
+                -height 0 \
+                -width 0 \
+                -editstartcommand [mymethod editStart] \
+                -editendcommand [mymethod editEnd] \
+                -forceeditendcommand 1 \
+        ;#
+        $self configurelist $args
+        bind $self <<TablelistSelect>> [mymethod select]
+        bind $self <<TablelistCellUpdated>> [mymethod editFinish]
+    }
+
+    method setOption {option value}  {
+        switch -exact -- $option {
+            -columns {
+                set c [concat {*}[map {list 0} $value]]
+                $hull configure -columns $c
+                set options(-columns) $value
+            }
+            -listvariable {
+                debug assert {[string match ::* $value]}    ;# I thought I knew how to handle this
+                if {$options(-listvariable) ne ""} {
+                    trace remove variable $value write [
+                        lambda args [
+                            list $self displayOptions
+                        ]
+                    ]
+                }
+                uplevel 1 [
+                    list trace add variable $value write [
+                        lambda args [
+                            list $self displayOptions
+                        ]
+                    ]
+                ]
+                set options(-listvariable) $value
+                after idle [mymethod displayOptions]
+            }
+            -options {
+                set options(-options) $value
+                if {$options(-listvariable) ne ""} {
+                    set $options(-listvariable) $value
+                } else {    ;# the trace will handle it
+                    $self displayOptions
+                }
+            }
+            -variable {
+                set options($option) $value
+            }
+            -addmessage - -adddefault - -addvalidate - -addcommand - -addverify {
+                set options($option) $value
+                $self displayOptions
+            }
+        }
+    }
+
+    method displayOptions {} {
+        if {$options(-columns) eq ""} {
+            return
+            #return -code error "Can't insert values without configuring columns!"
+        }
+        $self delete 0 end
+        if {$options(-listvariable) ne ""} {
+            set options(-options) [set $options(-listvariable)]
+        }
+        set value $options(-options)
+        while {$value ne {}} {
+            set vals [lshift value [llength $options(-columns)]]
+            set idx [$self insert end $vals]
+            $self rowconfigure $idx -name [lindex $vals 0]
+        }
+        ## special handling for adding a new item, which should probably be optional
+        if {$options(-addmessage) ne ""} {
+            set idx [$self insert end [list $options(-addmessage)]] ;# 1-elem list ok?
+            $self rowconfigure $idx -name {}
+            $self cellconfigure $idx,0 -image ::images(add) -editable 1
+        }
+    }
+
+    # start editing
+    method editStart {w row col value} {
+        return $options(-adddefault)
+    }
+
+    # verify edit result
+    method editEnd {w row col value} {
+        if {($options(-addverify) eq "")} {
+            $w rowconfigure $row -name $value
+            return $value
+        } else {
+            set rc [catch {
+                set value [uplevel 0 $options(-addverify) [list $value]]
+            } err]
+            if {$rc} { ;# an error occurred - blank the value
+                tk_messageBox -icon error -type ok -message $err
+                $w rowconfigure $row -name {}
+                return ""
+            } else {
+                $w rowconfigure $row -name $value
+                return $value
+            }
+        }
+    }
+
+    # end editing
+    method editFinish {} {
+        set value [$self rowcget end -name]
+        if {$value ne ""} {
+            $self cellconfigure end,0 -image ""
+            if {$options(-addcommand) ne ""} {
+                uplevel 0 $options(-addcommand) [list $value]
+            }
+            $self selection clear 0 end
+            $self selection set $value
+            $self select
+        } else {
+            $self displayOptions
+        }
+    }
+
+    method select {} {
+        set idx [$self curselection] 
+        set val [$self rowcget $idx -name]
+        if {$val eq ""} {
+            return  ;# selected the -add option
+        }
+        if {$options(-variable) ne ""} {
+            uplevel #0 [list set $options(-variable) $val]
+        }
+    }
+}

ADDED   modules/snidgets/textsearch.tcl
Index: modules/snidgets/textsearch.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/textsearch.tcl
@@ -0,0 +1,72 @@
+#package require opts
+#
+# SYNOPSIS
+#
+#  bind_textsearch .textwidget
+#
+
+
+bind TextSearch.TEntry <Key-Escape>      {close_textsearch %W; break}
+bind TextSearch.TEntry <Control-f>       {do_textsearch -next %W; break}
+bind TextSearch.TEntry <Control-r>       {do_textsearch -prev %W; break}
+bind TextSearch.TEntry <Shift-Control-f> {do_textsearch -prev %W; break}
+
+# ??
+#ttk::style element create Entry.star [ttk::image create photo -file foo] -border {2 0} -sticky e
+#ttk::style layout TextSearch.TEntry {
+#    Entry.field -sticky nswe -border 1 -children {
+#        Entry.padding -sticky nswe -children {
+#            Entry.star -side e
+#            Entry.textarea -sticky nswe
+#        }
+#    }
+#}
+
+proc bind_textsearch {w {event <Control-f>}} {
+    bind $w $event [list open_textsearch $w]
+    $w tag configure ts_match -background yellow
+    $w configure -insertunfocussed hollow
+}
+
+proc open_textsearch {w} {
+    ttk::entry ${w}._search -validate key -validatecommand {do_textsearch %W %P} ;#-class TextSearch.TEntry
+    bindtags $w._search [list TextSearch.TEntry {*}[bindtags $w._search]]
+
+    place ${w}._search -in $w -anchor s -relx 0.5 -rely 1.0
+    focus ${w}._search
+}
+
+proc close_textsearch {w} {
+   focus [set W [winfo parent $w]]
+   destroy $w
+   $W tag remove ts_match 1.0 end
+}
+
+proc do_textsearch args {
+    options {-next} {-prev}
+    arguments {w {s ""}}
+    if {$s eq ""} {
+        set s [$w get]
+    }
+    set w [winfo parent $w]
+    set idx "insert"
+    set dir -forwards
+    if {$next} {
+        append idx " + 1 chars"
+    } elseif {$prev} {
+        append idx " - 1 chars"
+        set dir -backwards
+    }
+    set idx [$w search -exact $dir $s $idx]
+    if {$idx eq ""} {
+        return 0
+    } else {
+        $w mark set insert $idx
+        $w tag remove ts_match 1.0 end
+        $w tag add ts_match $idx [set i2 "$idx + [string length $s] chars"]
+        $w see $i2
+        $w see $idx
+        return 1
+    }
+}
+

ADDED   modules/snidgets/themeswitcher.tcl
Index: modules/snidgets/themeswitcher.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/themeswitcher.tcl
@@ -0,0 +1,23 @@
+package require snit
+
+snit::widgetadaptor ThemeSwitcher {
+
+    delegate method * to hull
+    delegate option * to hull
+
+    constructor args {
+        installhull using listbox
+        bind $win <<ListboxSelect>> [mymethod Select]
+        set names [::ttk::style theme names]
+        set cur [::ttk::style theme use]
+        set idx [lsearch -exact $names $cur]
+        $win insert end {*}$names
+        $win selection set $idx
+    }
+
+    method Select {} {
+        set theme [$self get [$self curselection]]
+        ::ttk::style theme use $theme
+    }
+
+}

ADDED   modules/snidgets/topleveled.tcl
Index: modules/snidgets/topleveled.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/topleveled.tcl
@@ -0,0 +1,32 @@
+package require snit
+
+snit::widgetadaptor topleveled {
+    component widget
+    option -modal -default 0 -configuremethod setOpt
+    delegate option * to widget
+    delegate method * to widget
+
+    constructor {cons args} {
+        debug log {creating topleveled $cons $win}
+        installhull using toplevel
+        install widget using $cons $win.widget {*}$args
+        grid $widget -sticky nsew
+        grid rowconfigure $win 0 -weight 1
+        grid columnconfigure $win 0 -weight 1
+        trace add command $widget delete "destroy $self; list"
+    }
+
+    destructor {
+        debug log {Destroying topleveled $win $self}
+    }
+
+    method setOpt {opt value} {
+        switch -exact $opt {
+            -modal {
+                throw {UNIMPLEMENTED}
+                # wm configure ...
+            }
+        }
+        set options($opt) $value
+    }
+}

ADDED   modules/snidgets/winspector.tcl
Index: modules/snidgets/winspector.tcl
==================================================================
--- /dev/null
+++ modules/snidgets/winspector.tcl
@@ -0,0 +1,187 @@
+#
+# A silly inspector for ttk widgets
+#
+package require Tk
+package require Ttk
+package require snit
+
+
+# this is just awfully painful
+namespace eval parse_ttk_layout {
+    proc parse_layout {layout {parent ""}} {
+        set opts [lassign $layout element]
+        set key [linsert $parent end $element]
+        set result [list $key [nokids $opts]]
+        set kids [getkids $opts]
+        foreach kid [getkids $opts] {
+            lappend result {*}[parse_layout $kid $key]
+        }
+        return $result
+    }
+
+    proc nokids {o} {
+        dict unset o -children
+    }
+
+    proc getkids {o} {
+        if {![dict exists $o -children]} {
+            return ""
+        }
+        set kids [dict get $o -children]
+        set k $kids
+        set result {}
+        for {set i 1} {$i < [llength $kids]} {incr i 2} {
+            if {![string match -nocase -* [lindex $kids $i]]} {
+                lappend result [lrange $kids 0 $i-1]
+                set kids [lrange $kids $i end]
+            }
+        }
+        if {$kids ne ""} {
+            lappend result $kids
+        }
+        return $result
+    }
+}
+proc parse_ttk_layout {l} {
+    parse_ttk_layout::parse_layout $l
+}
+
+snit::widgetadaptor Winspector {
+
+    variable Target
+    variable Current
+
+    component tframe
+    component   current
+    component   gobutton
+    component   target
+
+    component bframe
+    component   bindings
+
+    component sframe
+    component   styles
+
+    constructor {args} {
+        installhull     using toplevel
+
+        install tframe      using ttk::frame      $win.tframe
+        install current     using ttk::label      $win.current  -textvariable [myvar Current] -anchor center
+        install gobutton    using ttk::button     $win.gobutton -command [mymethod StartChoose] -text "Choose widget"
+        install target      using ttk::entry      $win.target   -textvariable [myvar Target] -state readonly
+
+        install bframe      using ttk::labelframe $win.bframe   -text "Bindings"
+        install sframe      using ttk::labelframe $win.sframe   -text "Style"
+
+        install bindings    using ttk::treeview   $win.bindings -columns {Tag Event Script} -show {tree}
+        install styles      using ttk::treeview   $win.styles   -columns {Attr Data} -show {headings tree}
+
+        grid $tframe    -           -sticky nsew
+        grid $bframe    $sframe     -sticky nsew
+        grid rowconfigure $win 1 -weight 1
+        grid columnconfigure $win {0 1} -weight 1
+
+            grid $current   -           -sticky nsew -in $tframe
+            grid $gobutton  $target     -sticky nsew -in $tframe
+
+            grid $bindings              -sticky nsew -in $bframe
+            grid $styles                -sticky nsew -in $sframe
+
+        grid rowconfigure $bframe 0 -weight 1
+        grid rowconfigure $sframe 0 -weight 1
+        grid columnconfigure $bframe 0 -weight 1
+        grid columnconfigure $sframe 0 -weight 1
+
+        grid anchor $tframe center
+        grid anchor $current center
+
+
+        bind all <Enter> [mymethod Enter %W]
+    }
+
+    method StartChoose {} {
+        $gobutton configure -text "Click on target widget"
+        grab $target
+        bind $target <1> [mymethod ChooseTarget]
+    }
+
+    method Enter {w} {
+        set Current $w
+        #puts "Entered $w"
+    }
+
+    method ChooseTarget {} {
+        set Target [winfo containing {*}[winfo pointerxy .]]
+        $gobutton configure -text "Choose widget"
+        grab release $target
+        bind $target <1> {}
+        after idle [mymethod RefreshDisplay]
+    }
+
+    method RefreshDisplay {} {
+        puts "Refreshing display for $Target"
+        $self RefreshBindings
+        $self RefreshStyles
+    }
+
+    method RefreshBindings {} {
+        $bindings delete [$bindings children {}]
+        foreach bindtag [bindtags $Target] {
+            $bindings insert {} end -id $bindtag -text $bindtag -values [list]
+            foreach event [lsort [bind $bindtag]] {
+                set script [bind $bindtag $event]
+                set script [string trim $script \n]
+                $bindings insert $bindtag end -text $event -values [list $script]
+                # FIXME: needs tooltip on hover
+            }
+        }
+    }
+
+    method RefreshStyles {} {
+        set class [winfo class $Target]
+        set style [$Target cget -style]
+
+        $styles delete [$styles children {}]
+        $styles insert {} end -id name   -text "name"   -values [list $Target]
+        $styles insert {} end -id class  -text "class"  -values [list $class]
+        $styles insert {} end -id style  -text "style"  -values [list $style]
+        $styles insert {} end -id map    -text "map"    -values [list]
+        $styles insert {} end -id layout -text "layout" -values [list]
+        $styles insert {} end -id opts   -text "opts"   -values [list]
+        if {$style eq ""} {
+            set style $class
+        }
+
+        set map [ttk::style map $style]
+        set layout [ttk::style layout $style]
+        set parts [parse_ttk_layout $layout]
+        set odict {}
+        foreach {part opts} $parts {
+            set part [lindex $part end]
+            set opts [ttk::style element options $part]
+            foreach opt $opts {
+                dict set odict $part $opt [ttk::style lookup $style $opt]
+            }
+        }
+
+        dict for {opt d} $map {
+            $styles insert "map" end -id [list "map" $opt] -text $opt -values [list]
+            dict for {st val} $d {
+                $styles insert [list "map" $opt] end -text $st -values [list $val]
+            }
+        }
+
+        dict for {key opts} $parts {
+            set pkey [lrange $key 0 end-1]
+            $styles insert [list "layout" {*}$pkey] end -id [list "layout" {*}$key] -text [lindex $key end] -value $opts
+        }
+
+        dict for {key opts} $odict {
+            $styles insert "opts" end -id [list "opts" $key] -text $key
+            foreach {k v} $opts {
+                $styles insert [list "opts" $key] end -text $k -values [list $v]
+            }
+        }
+    }
+}
+

ADDED   modules/sql-0.tm
Index: modules/sql-0.tm
==================================================================
--- /dev/null
+++ modules/sql-0.tm
@@ -0,0 +1,214 @@
+# this also wants a less conflicty name.  For the package, not the object.
+#
+# I want this:
+#
+#    [sql {from [qn $table] [qn $t1] inner join [qn $table] [qn $t2]}]
+#
+# but to get local variables requires much trickery (capture unbound? + namespace unknown)
+#
+# SYNOPSIS
+#
+#  Sql select table columns ?sql?
+#  Sql select sql columns ?sql?
+#  Sql select ::sqlobj columns ?sql?
+# 
+#  Sql count ( table | sql | ::sqlobj )
+#  Sql distinct (..) ?columns?
+#  Sql columns ::sqlobj
+# 
+#  Sql trim sql
+#  Sql format sql
+# 
+#  Sql qstr
+#  Sql qname part ?part?
+#  Sql qcols
+#
+# .. this is not ready to use
+#
+
+package require pkg
+pkg -export Sql sql {
+    oo::class create SqlClass {
+
+if 0 {
+        method tokenise {sql} {
+            # words
+            # 'quo''ted'
+            # "quot""ed"
+            # `quot``ed`
+            # /* comment */
+            # -- comment
+            # , ( ) ;
+        }
+}
+        method trim {sql} {
+            # FIXME: get a real tokeniser
+            regsub -all -line {^--\s.*$}    $sql {} sql     ;# -- comments
+            regsub -all {/\*((?!\*/).)*\*/} $sql {} sql     ;# /* comments */
+            string trim $sql "; \n"
+        }
+
+        method kind {sql} {
+            regexp {^(\w+)} [my trim $sql] -> word
+            set word [string tolower $word]
+            catch {debug assert {$word in "select insert update create drop delete alter"}}
+            if {$word eq "select"} {
+                if {[regexp -nocase {^select\s+count\s*\([^\)]*\)\s+from\s+} $sql]} {
+                    lappend word "count"
+                }
+                if {[regexp -nocase {^select\s+distinct\s} $sql]} {
+                    lappend word "distinct"
+                }
+            }
+            if {$word in "create drop"} {
+                regexp {^\w+\s*(\w+)} $sql -> what
+                catch {debug assert {$what in "table index"}}
+                lappend word $what
+            }
+            return $word    ;# this could do with some metadata ...
+        }
+
+    # simple query generation:
+        method select {table cols {sql "1"}} {
+            return "SELECT \
+                [my qcols $cols] \
+                FROM [my qname $table] \
+                WHERE $sql"
+        }
+        method count {table {sql "1"}} {
+            return "SELECT count(1) \
+                FROM [my qname $table] \
+                WHERE $sql"
+        }
+        method distinct {columns {sql "1"}} {
+            return "SELECT DISTINCT \
+                    [my qcols $columns] \
+                FROM [my qname $table] \
+                WHERE $sql"
+        }
+        method cdistinct {columns table {sql "1"}} {
+            # should be select * ?
+            return "SELECT \
+                    count(1) [my qname #],
+                    [my qcols $columns] \
+                FROM [my qname $table] \
+                GROUP BY [my qcols $columns \
+                HAVING $having"
+        }
+
+        forward set   my qdict -join ", "
+        #forward where my qdict -join "\n  AND "
+        method where args {
+            if {[llength $args] == 1} {
+                tailcall my qdict -join "\n  AND " {*}$args
+            }
+            join [lmap arg $args {
+                string cat ([my qdict -join " AND " $arg])
+            }] "\n   OR "
+        }
+
+        method update {table {set {}} {where {}}} {
+            append res "UPDATE [my qname $table]"
+            if {$set ne ""} {
+                append res "\nSET [my set $set]"
+            }
+            if {$where ne ""} {
+                append res "\nWHERE [my where $where]"
+            }
+            return $res
+        }
+
+        method delete {table {args {}}} {
+            append res "DELETE FROM [my qname $table]\n"
+            if {$args ne ""} {
+                append res "WHERE "
+                append res [join [lmap where $args {
+                    string cat ([my where $where])
+                }] "\n  OR "]
+            }
+            return $res
+        }
+
+        # this could take options to make it more generic:
+        #   -notnull "*"
+        #   -types $dict
+        method create_table {tableName colNames} { ;# sqlite specific!
+            #set colspec [join [lmap col $colNames {K "[my qname $colName] NOT NULL"}] ", "]
+            return "CREATE TABLE [my qname $tableName] ([my qcols $colNames])"
+        }
+                    
+        method insertdicts {tableName dict args} {
+            set cols [dict keys $dict]
+            append res "INSERT INTO [my qname $tableName] ([my qcols $cols])\n"
+            append res " VALUES ([my qlist [dict values $dict]])"
+            while {$args ne "" && [dict keys [lindex $args 0]] eq $cols} {
+                set args [lassign $args dict]
+                append res ",\n ([my qlist [dict values $dict]])"
+            }
+            append res "\n;"
+            if {$args ne ""} {
+                append res [insertdicts $tableName {*}$args]
+            }
+            return $res
+        }
+
+        # values are not quoted, so they can be "$var"
+        method insert {tableName colNames args} {
+            return "INSERT INTO [my qname $tableName] ([my qcols $colNames])\n\
+                VALUES [join [lmap vals $args {
+                    string cat ( [join $vals ,] )
+                }] ,]"
+        }
+
+    # quotation:
+        method qname {args} {
+            foreach a $args {
+                set a [string map {` ``} $a]
+                lappend res `$a`
+            }
+            return [join $res .]
+        }
+
+        # doesn't add brackets
+        method qlist {list} {
+            join [map {my qstr} $list] ,
+        }
+        # quote a (string) value:
+        method qstr {value} {
+            set value [string map {' ''} $value]
+            return '$value'
+        }
+
+        ## quote a list of column names:
+        # this seems to be a bit overloaded
+        method qcols {columns {attr {}} {prepend {}}} {
+            set res [join [lmap c $columns {subst {[my qname $c] $attr}}] ,]
+            if {($prepend ne {}) && ($res ne {})} {
+                set res $prepend$res
+            }
+            return $res
+        }
+
+        method qdict args {
+            options {-table {}} {-join " AND "}
+            arguments {dict}
+            if {$table ne ""} {set table [list $table]}
+            join [lmap {col val} $dict {
+                string cat [
+                    my qname {*}$table $col
+                ] " = " [
+                    my qstr $val    ;# ?? numbers?
+                ]
+            }] $join
+        }
+
+        method unknown {method args} {
+            set match [lsearch -all -inline -glob [info object methods [self] -all] $method*]
+            if {[llength $match] eq 1} {
+                tailcall my $match {*}$args
+            }
+            throw {TCL METHOD_UNKNOWN} "Method unknown"
+        }
+    }
+    SqlClass create Sql
+}

Index: modules/tdbcplus-0.1.tm
==================================================================
--- modules/tdbcplus-0.1.tm
+++ modules/tdbcplus-0.1.tm
@@ -1,7 +1,7 @@
 package require pkg
-package require debug
+package require adebug
 
 pkg tdbcplus {
     oo::class create tdbcplus {
 
         # these work around http://core.tcl.tk/tdbc/tktview?name=fbcd8d40f1

ADDED   modules/tkImprover-0.tm
Index: modules/tkImprover-0.tm
==================================================================
--- /dev/null
+++ modules/tkImprover-0.tm
@@ -0,0 +1,283 @@
+# most of this is from marsgui by WHD @ JPL:  http://wiki.tcl.tk/41820
+#   git://github.com/AthenaModel/mars
+#   lib/marsgui/global.tcl
+#
+# See also:
+#   * user interface guidelines from http://wiki.tcl.tk/41773
+#   * further text improvements from http://wiki.tcl.tk/14918
+#   * treeview RowSelect events from http://wiki.tcl.tk/24636
+#   * treeview search by typing from http://wiki.tcl.tk/20065
+#
+# TODO:
+#   * MouseWheel (win) vs Button-[45] (unix) (see http://wiki.tcl.tk/3893)
+#
+# from nemethi @ comp.lang.tcl:  panedwindow performance improver
+#
+# proc ttk::panedwindow::Drag {w x y} {
+#     variable State
+#     if {!$State(pressed)} { return }
+#
+#     switch -- [$w cget -orient] {
+#         horizontal { set State(delta) [expr {$x - $State(pressX)}] }
+#         vertical   { set State(delta) [expr {$y - $State(pressY)}] }
+#     }
+#
+#     if {![info exists State(afterId)]} {
+#         set State(afterId) [after 10 [list ttk::panedwindow::UpdateSashPos $w]]
+#     }
+# }
+#
+# proc ttk::panedwindow::UpdateSashPos {w} {
+#     variable State
+#     unset State(afterId)
+#
+#     $w sashpos $State(sash) [expr {$State(sashPos) + $State(delta)}]
+# }
+
+package require Tk
+
+# widgets should take focus when clicked on
+
+bind all <1> {+catch {if {[%W cget -takefocus] ne 0} {puts "Focusing %W"; focus %W}}}
+
+# workaround for https://core.tcl.tk/tk/tktview/3009450fffffffffffffffffffffffffffffffff
+# FIXME: this assumes the parent is normally -disabled 0.
+rename grab _grab
+proc grab {args} {
+    switch -glob -- [lindex $args 0] {
+        set - .* - -* {
+            set win [lindex $args end]
+            set parent [wm transient $win]
+            if {$parent ne ""} {
+                wm attributes $parent -disabled 1
+                # HaO 2016-02-22: if grabbed window is destroyed before grab is released
+                # (which is ok for standard grab), the parent window must be re-enabled
+                bind $win <Destroy> +[list wm attributes $parent -disabled 0]
+            }
+        }
+        release {
+            set win [lindex $args end]
+            set parent [wm transient $win]
+            if {$parent ne ""} {
+                wm attributes $parent -disabled 0
+            }
+        }
+    }
+    tailcall _grab {*}$args
+}
+
+
+# helper for re-binding events
+namespace eval Events {
+
+    #variable Events ;# this isn't really needed
+    variable Keys    ;# tracking what keys are already bound is importand for rebinding!
+    variable Log on
+
+    proc Init {} {
+        #variable Events
+        variable Keys
+        foreach event [event info] {
+            set keys [event info $event]
+            #dict set Events $event $keys
+            foreach key $keys {
+                dict set Keys $key $event
+            }
+        }
+    }
+
+    # this isn't very clever, only close enough for the immediate need here.
+    # A fully-accurate version might use <http://wiki.tcl.tk/1401#pagetoc4d1849c3>
+    # (or at least be tested against it)
+    proc normalize {event} {
+        set event [string range $event 1 end-1]
+        set parts [split $event -]
+        foreach type {Button ButtonPress ButtonRelease Key KeyPress KeyRelease} {
+            if {$type in $parts} {
+                return $event
+            }
+        }
+        set bit [lindex $parts end]
+        if {[string is digit -strict $bit]} {
+            set parts [linsert $parts end-1 "Button"]
+        } else {
+            set parts [linsert $parts end-1 "Key"]
+        }
+        return <[join $parts -]>
+    }
+
+    proc Lock {event} {
+        set event [string range $event 1 end-1]
+        set parts [split $event -]
+        if {"Lock" in $parts} {
+            return ""   ;# nothing to add
+        }
+        if {[string match Key* [lindex $parts end-1]]} {
+            set key [lindex $parts end]
+            if {[string is upper $key]} {
+                set key [string tolower $key]
+            } elseif {[string is lower $key]} {
+                set key [string toupper $key]
+            } else {
+                return ""   ;# nothing to add
+            }
+            lset parts end $key
+            set parts [linsert $parts end-2 "Lock"]
+        }
+        return <[join $parts -]>
+    }
+
+    proc rebind {event key args} {
+        variable Log
+        #variable Events
+        variable Keys
+        set args [list $key {*}$args]
+        set args [lmap a $args {normalize $a}]
+        foreach arg $args {
+            set lock [Lock $arg]
+            if {$lock ne ""} {
+                if {$Log} {
+                    puts stderr "Warning: implicitly binding $lock as well as $key"
+                }
+                lappend args $lock
+            }
+        }
+        foreach key $args {
+            try {
+                set old [dict get $Keys $key]
+                if {$Log} {
+                    puts stderr "Warning: rebinding $key to $event (from $old)"
+                }
+                event del $old $key
+                dict set Keys $key $event
+            } trap {TCL LOOKUP DICT} {} {
+                # ok
+            }
+        }
+        event add $event {*}$args
+        #dict lappend Events $event {*}$args
+    }
+    Init
+}
+
+
+apply {{} {
+
+    global tcl_platform
+
+    # identify the platform in a useful way:
+
+    if {$tcl_platform(platform) eq "windows"} {
+        set platform "win"
+    } elseif {$tcl_platform(os) eq "Darwin"} {
+        set platform "mac"
+    } else {
+        set platform "unix"
+    }
+
+    # the default theme is a bit crap, particularly on Linux
+    switch $platform {
+        "windows" {
+            ::ttk::style theme use vista
+        }
+        "unix" {
+            ::ttk::style theme use alt
+        }
+    }
+
+    # Relate the virtual events to these keystrokes.  Widgets will get
+    # the virtual event on the keystroke, unless there's some other
+    # keybinding.
+
+    Events::rebind <<Cut>>       <Control-x>
+    Events::rebind <<Copy>>      <Control-c>
+    Events::rebind <<Paste>>     <Control-v>
+    Events::rebind <<Undo>>      <Control-z>
+
+    if {$tcl_platform(os) eq "SunOS"} {
+        Events::rebind <<Redo>>      <Control-Shift-z>  ;# Control-Shift-Z - <Control-y> is <<Paste>>
+    } else {
+        Events::rebind <<Redo>>      <Control-y>
+    }
+
+    if {$platform eq "unix"} {
+        Events::rebind <<SelectAll>> <Control-A>  ;# Control-Shift-A - <Control-a> is <<Home>>
+    } else {
+        Events::rebind <<SelectAll>> <Control-a>
+    }
+
+    # Entry and Text Widget Paste Behavior
+    #
+    # For some odd reason, if you paste via <<Paste>> into an entry widget
+    # when text is selected, the pasted text doesn't replace the selected
+    # text.  I don't know why this is, but it's counter-intuitive.  The
+    # default binding says explicitly that if we're on x11 *don't* delete
+    # the previously selected text.  So we override that check in the default
+    # bindings.
+
+    set map {{[tk windowingsystem] ne "x11"}
+             {1 || [tk windowingsystem] ne "x11"}}
+
+    bind Entry <<Paste>> [
+        string map $map [bind Entry <<Paste>>]
+    ]
+
+    proc ::tk_textPaste {w} [
+        string map $map [info body ::tk_textPaste]
+    ]
+
+# Virtual events for forms:  <<Submit>> and <<Cancel>>
+
+    # .. these make a mess when widgets already handle said keystroke
+    #event add <<Submit>> <Return>
+    #event add <<Cancel>> <Escape>
+ 
+    # .. so some extra smarts are needed:
+    bind all <Return> {
+        if {%M==0} {
+            event generate %W <<Submit>>
+        }
+    }
+    bind all <Escape> {
+        if {%M==0} {
+            event generate %W <<Cancel>>
+        }
+    }
+# rebind do-nothing keys to generate these events
+    foreach tag {Entry TEntry Text} {   ;# CText?
+        foreach {event key} {
+            <<Submit>> <Return>
+            <<Cancel>> <Escape>
+        } {
+            set script [bind $tag $key]
+            if {$script eq "# nothing"} {
+                bind $tag $key "[list event generate %W $event]; break"
+            }
+        }
+    }
+    #bind all <<Submit>> {puts Sbmit!%W}
+    #bind all <<Cancel>> {puts Cancl!%W}
+
+
+# set up some better default options
+    set defaultBackground [ttk::style configure . -background]
+    set defaultBackground [ttk::style lookup . -background active]
+    set stripeBackground  #EEF9FF
+
+    # Give a combobox with focus the same kind of halo as a ttk::entry.
+    ttk::style map TCombobox \
+        -lightcolor      [list  focus "#6f9dc6"] \
+        -darkcolor       [list  focus "#6f9dc6"] \
+        -fieldbackground [list disabled $defaultBackground]
+
+    # TEntry: Set background for readonly and disabled ttk::entry widgets
+    ttk::style map TEntry \
+        -fieldbackground [list readonly $defaultBackground \
+                               disabled $defaultBackground]
+
+    # the default TButton minwidth of 11 is too big:
+    ttk::style configure TButton -width -8
+
+    # tearoff menus suck:
+    option add *Menu.tearOff                    no
+}}

ADDED   modules/tksh-0.1.tm
Index: modules/tksh-0.1.tm
==================================================================
--- /dev/null
+++ modules/tksh-0.1.tm
@@ -0,0 +1,1253 @@
+# SYNOPSIS:
+#
+#   console *windowPath* ?options?
+#
+
+# OPTIONS:
+#
+#     -interp %         - create a new interp.  Can be queried by [$win cget -interp]
+#     -interp $int      - use an existing interp.
+#
+#     -thread %         - create a new thread.  Can be queried by [$win cget -thread]
+#     -thread $tid      - use an existing thread.
+#
+#     -stdout /mode/    - mode is either "tee" or "copy" to copy stdout/err into the console
+#                         or "redir" or "move" to redirect stdout/err into the console.
+#                         Default is empty:  no touching of stdout/err.
+#                         This will do the right thing if -interp or -thread is used.
+#
+#     -block 0|1|2      - makes sense for -thread:
+#                         0 - no blocking;
+#                         1 - highlight when blocked (but accept input)
+#                         2 - block when blocked
+#
+#     -eval             - custom evaluator.  Takes a script and returns [list $rc $result $opts]
+#
+#     -evalprefix       - all commands will be prefixed with this.  Note [cmd subs] are unaffected.
+#
+#     -prompt           - custom prompt method body.
+#
+#     -iscomplete       - command to determine whether input is a complete command.
+#
+
+# WIDGET COMMANDS:
+#
+#    cget /option/      - useful for -thread, -interp
+#
+#    eval /script/      - evaluate a script and return its result
+#                         uses a trampoline to return errors and options
+#
+#    input /text/       - append $text to input, as though it had been typed/pasted by the user
+#
+#    stdout /text/      - emit $text to the emulated stdout
+#
+#    stderr /text/      - emit $text to the emulated stderr
+#
+#    history /subcmd/   - access to input history
+
+# TODO:
+#   * tab-completion
+#   * history search
+#   * share window with statusbar, menu and docked buttonbox (how?)
+#   * persistent history
+#   * host commands via a sigil
+
+# Wraptext serves as a reference for wrapping Tk widgets in TclOO objects, and
+# provides a widget which extends on text:
+#
+#   option -readonly false boolean
+#
+#       makes the widget readonly but still cursor-interactive
+#       FIXME: use [ins] and [del] and [rep] to move text on it.
+#
+#   option -maxheight "" integer
+#
+#       if this is set, the text widget will automatically resize
+#       its height to just contain its contents
+#
+#   option -minheight 1 integer
+#
+#       interacts with the above - an empty widget will be this high
+#
+
+package require Tk          ;# needs to be present at load time for copyBindtags
+#package require autoscroll      ;# tklib
+
+
+namespace eval tksh {
+
+    # the constructor needs some help:
+    proc wraptext {win args} {
+        set obj [WrapText new $win {*}$args]
+        rename $obj ::${win}
+        return $win
+    }
+
+    oo::class create WrapText {
+
+        # the widget bit:
+        variable hull
+        constructor {w args} {
+            namespace path [list [namespace qualifiers [self class]] {*}[namespace path]]   ;# having to do this kinda sucks
+
+            set hull $w
+            proc hull args "$hull {*}\$args"
+
+            lassign [my SplitOpts $args] myargs hullargs
+
+            set obj [text $hull {*}$hullargs]
+            rename ::${obj} [namespace current]::${obj}
+            trace add command [namespace current]::${obj} delete [thunk my destroy]
+
+            set defaults [dict map {opt spec} [my OptSpec] {lindex $spec 3}]    ;# yuck
+            set myargs   [dict merge $defaults $myargs]
+            #my SetupOptTrace
+            my Configure $myargs
+        }
+
+        destructor {
+            #after 0 [list after idle [list puts "Destroyed: [self]"]]
+        }
+
+        method unknown args {
+            tailcall $hull {*}$args
+        }
+
+        # options:
+        variable Options
+
+        # public interface:
+        method cget {option} {
+            if {[info exists Options($option)]} {
+                my Cget $option
+            } else {
+                $hull cget $option
+            }
+        }
+        method configure {args} {
+            if {[llength $args] < 2} {
+                tailcall my CgetSpec {*}$args
+            }
+            lassign [my SplitOpts $args] myargs hullargs
+            $hull configure {*}$hullargs
+            if {$myargs ne ""} {
+                my Configure $myargs
+            }
+        }
+
+        # private interface:
+        # this could be a variable, shared with
+        #   namespace upvar [info object namespace [self class]] OptSpec OptSpec
+        # but a method is syntactically convenient, and the tclobj will be cached
+        method OptSpec {} {
+            #  {-commandlineswitch resourceName ResourceClass defaultValue verifier}
+            # snit provides -default -verifier -configuremethod -cgetmethod, [delegate]
+            return {
+                -readonly   {-readonly      readOnly    ReadOnly    false   {string is boolean}}
+                -maxheight  {-maxheight     maxHeight   MaxHeight   {}      {string is integer}}
+                -minheight  {-minheight     minHeight   MinHeight   1       {string is integer}}
+            }
+            # FIXME: add delegates
+            #
+            #
+            # Each option is identified by name (-switch)
+            # and must have:
+            #   -resource StudlyCaps
+            # and may have:
+            #   -delegate           <component name>
+            #   -configuremethod    <mymethod ?arg ..?>
+            #   -cgetmethod         <mymethod ?arg ..?>
+            #   -verifier           <cmdprefix returning bool>
+            #   -default            <value>
+            #   -readonly           <bool>
+            #     option can only be set at construction time
+            #
+            # Wildcard delegation:
+            #   option * -delegate hull
+            #     * any unrecognised option (cget/configure)
+            #       will be given to the hull
+            #     * getting all configuration will splice
+            #       in (non-colliding) * from the hull
+            #   Otherwise this option is ignored.
+        }
+
+        # utility for configuration: separate options into hull (passthrough) and local
+        method SplitOpts {optargs} {    ;# lassign [my SplitOpts] hullopts myopts
+            # delegated options are local for this purpose
+            set myargs {}
+            set spec [my OptSpec]
+            set hullargs [dict map {option value} $optargs {
+                if {[dict exists $spec $option]} {
+                    dict set myargs $option $value
+                    continue
+                } else {
+                    set value
+                }
+            }]
+            list $myargs $hullargs
+        }
+
+        # configuration private interface:
+        method Configure {optargs} {
+            # needs to handle:
+            #   * readonly options (constructor time only)
+            #   * delegation
+            #   * hull options
+            #   * verify
+            #   * configuremethod
+            #   * maintaining array
+            dict for {option value} $optargs {
+                my Verify $option $value
+            }
+            dict for {option value} $optargs {
+                set Options($option) $value
+            }
+        }
+        method Verify {option value} {
+            set cmd [lindex [dict get [my OptSpec] $option] 4]  ;# yuck
+            if {![uplevel #0 $cmd [list $value]]} {
+                throw {TK BAD OPTION} "Bad value for \"$option\", should be \[$cmd\], not \"$value\""
+            }
+        }
+        method Cget {option} {
+            # return the options's value: must handle:
+            #   * delegation
+            #   * hull options
+            #   * cgetmethod
+            #   * maintaining array
+            return $Options($option)
+        }
+        method CgetSpec {args} {
+            # returns Tk optspec list:
+            #  {-switch resName ResClass defValue value}
+            # must handle:
+            #   * delegation
+            #   * hull options
+            #   * cgetmethod
+            if {$args eq ""} {
+                set speclist [$hull configure]
+                foreach {option spec} [my OptSpec] {
+                    set spec [lreplace $spec 4 end $Options($option)]   ;# yuck
+                    lappend speclist $spec
+                }
+                return $speclist
+            }
+            set spec [my OptSpec]
+            return [lmap option $args {
+                if {[dict exists $spec $option]} {
+                    lreplace [dict get $spec $option] 4 end $Options($option)   ;# yuck
+                } else {
+                    $hull configure $option
+                }
+            }]
+        }
+
+        # declaring an option adds an entry to the class's OptInfo dict
+        #    {-option} {default verifier configuremethod cgetmethod delegate}
+        # delegate links a default configure/cgetmethod
+        method SetupOptTrace {} {
+            #namespace upvar .. [myclass OptInfo]?
+            foreach {option info} {} {
+                if {[dict exists $info configuremethod]} {
+                    trace add variable Options($option) write [callback my [dict get $info configuremethod]]
+                }
+                if {[dict exists $info cgetmethod]} {
+                    trace add variable Options($option) read  [callback my [dict get $info cgetmethod     ]]
+                }
+                if {[dict exists $info delegate]} {
+                    # TODO: handle *
+                    trace add variable Options($option) write [callback my DelegateOption $option [dict get $info delegate]]
+                    trace add variable Options($option) read  [callback my DelegateOption $option [dict get $info delegate]]
+                }
+            }
+        }
+        method DelegateOption {option cmdprefix _ _ op} {
+            # FIXME: avoid reentry?
+            switch $op {
+                "write" {
+                    {*}$cmdprefix configure $option $Options($option)
+                }
+                "read" {
+                    set Options($option) [{*}$cmdprefix cget $option]
+                }
+            }
+        }
+
+        # basic text wrappers .. looks like it wants AOP:
+        forward ins hull insert
+        forward del hull delete
+        forward rep hull replace
+        method insert args {
+            if {$Options(-readonly)} {
+                event generate $hull <<ReadOnly>> -data [list insert {*}$args]
+                return
+            }
+            try {
+                $hull insert {*}$args
+            } finally {
+                my <<TextChanged>>  ;# not really an event
+            }
+        }
+        method replace args {
+            if {$Options(-readonly)} {
+                event generate $hull <<ReadOnly>> -data [list replace {*}$args]
+                return
+            }
+            try {
+                $hull replace {*}$args
+            } finally {
+                my <<TextChanged>>  ;# not really an event
+            }
+        }
+        method delete args {
+            if {$Options(-readonly)} {
+                event generate $hull <<ReadOnly>> -data [list delete {*}$args]
+                return
+            }
+            try {
+                $hull delete {*}$args
+            } finally {
+                my <<TextChanged>>  ;# not really an event
+            }
+        }
+
+        method <<TextChanged>> {} {
+            if {$Options(-maxheight) ne ""} {
+                variable DLines
+                incr DLines 0
+                set dlines [$hull count -displaylines 1.0 end]
+                set dlines [expr {max( $Options(-minheight) , $dlines )}]
+                set dlines [expr {min( $dlines , $Options(-maxheight) )}]
+                if {$dlines != $DLines} {
+                    set DLines $dlines
+                    my configure -height $dlines
+                }
+            }
+        }
+    }
+
+
+    # 
+    # A simple vertically-oriented button box with convenient methods for adding buttons
+    proc buttonbox {win args} {
+        set obj [ButtonBox new $win {*}$args]
+        rename $obj ::${win}
+        return $win
+    }
+    oo::class create ButtonBox {
+        variable hull
+        variable Options
+        variable Buttons
+        variable ID
+
+        constructor {w args} {
+            namespace path [list [namespace qualifiers [self class]] {*}[namespace path]]   ;# having to do this kinda sucks
+
+            set hull $w
+            proc hull args "$hull {*}\$args"
+
+            set obj [ttk::frame $hull]     ;# FIXME: hullargs?
+
+            rename ::${obj} [namespace current]::${obj}
+            trace add command [namespace current]::${obj} delete [thunk my destroy]
+        }
+
+        method unknown args {
+            tailcall $hull {*}$args
+        }
+
+
+        method add {text cmd args} {
+            set id $text
+            set btn $hull.b[incr ID]
+            lassign [::tk::UnderlineAmpersand $text] label ul
+            set accel [string index $label $ul]
+
+            ttk::button $btn -text $label -underline $ul -command $cmd  {*}$args
+            pack $btn -side top -fill x
+
+            set top [winfo toplevel $hull]  ;# configureable option?
+
+            set key <Alt-[string tolower $accel]>
+
+            set invoke "
+                after 0 {after idle {
+                    event generate [list $btn] <<Invoke>>
+                }}
+            "
+
+            if {[bind $top $key] ne ""} {
+                puts "WARNING: $key is already bound!"
+            } else {
+                bind $top $key $invoke
+                trace add command $btn delete [thunk bind $top $key {}]
+            }
+
+            return $btn
+        }
+        method remove args {
+            foreach id $args {
+                if {[winfo exists $id]} {
+                    set btn $id
+                    set label [dict get $Buttons widget $btn]
+                } elseif {![catch {set btn [dict get $Buttons label $id]}]} {
+                    set widget $id
+                } else {
+                    continue
+                }
+                destroy $widget
+                dict unset Buttons label  $id
+                dict unset Buttons widget $btn
+            }
+        }
+    }
+
+    # 
+    # This provides a very simple console, suitable for embedding an interactive interpreter (like Tcl!)
+    # Its backend configuration is through methods Prompt, IsComplete and Evaluate
+    #
+    # Illustration here is of a megawidget which does *not* delegate most commands to its hull.  Instead,
+    # it has a richer [configure]tion and type-specific methods.  Bindings are more imporant.
+    #
+    proc console {win args} {
+        set obj [Console new $win {*}$args]
+        rename $obj ::${win}
+        return $win
+    }
+    oo::class create Console {
+        variable hull
+
+        variable Options
+
+        constructor {w args} {
+            namespace path [list [namespace qualifiers [self class]] {*}[namespace path]]   ;# having to do this kinda sucks
+
+            set hull $w
+            set obj [toplevel $hull -padx 5 -pady 5 -bg darkgrey]     ;# FIXME: hullargs?
+            rename ::${obj} [namespace current]::${obj}
+            trace add command [namespace current]::${obj} delete [thunk my destroy]
+
+            ttk::frame $hull.top -style Tksh.TFrame
+            ttk::frame $hull.bottom -style Tksh.TFrame
+
+            #scrollbar $hull.output_scrolly -orient v -command [list $hull.output yview]
+            #scrollbar $hull.input_scrolly  -orient v -command [list $hull.input yview]
+
+            wraptext $hull.output  -height 24 -width 80 -wrap char  -readonly 1 \
+                ;#-yscrollcommand [list $hull.output_scrolly set]
+            wraptext $hull.input   -height 1  -width 80 -wrap char  -maxheight 5 -undo 1 \
+                ;#-yscrollcommand [list $hull.input_scrolly set]
+
+            buttonbox $hull.buttons
+            oo::objdefine [self] forward buttons $hull.buttons
+
+            #my buttons add "&Packages" [callback my input "after 2000; package names\n"]
+
+            bindtags $hull.output [string map {Text ConsoleOutput.Text} [bindtags $hull.output]]
+
+            History create history {
+                {parray ::tcl_platform}
+                {coroeval {after 500 [info coroutine]; puts "yielding [info coroutine]"; yield; puts "done"; expr 501}}
+            }
+
+            #pack $hull.top -side top -expand yes -fill both
+            #pack $hull.bottom -side top -expand yes -fill both
+            grid $hull.top -sticky nsew
+            grid $hull.bottom -sticky nsew
+            grid columnconfigure $hull $hull.top -weight 1
+            grid rowconfigure $hull $hull.top -weight 1
+            grid propagate $hull 1
+
+            #pack $hull.output_scrolly -in $hull.top    -side right -fill y
+            #pack $hull.input_scrolly  -in $hull.bottom -side right -fill y
+
+            pack $hull.buttons -in $hull.top      -side right -anchor n ;#-fill y
+            pack $hull.output -in $hull.top    -expand yes -fill both
+            pack $hull.input  -in $hull.bottom -expand yes -fill both
+
+
+            # FIXME: autoscroll isn't doing what I want, particularly on .output
+            #autoscroll::autoscroll $hull.output_scrolly
+            #autoscroll::autoscroll $hull.input_scrolly
+
+            my SetupTags
+            my SetupBinds
+            # -block:  0: don't block input;  1: block input;  2: only highlight
+            # -interp: % to create a new one, or the handle of an existing interp
+            # -thread: % to create a new one, or the id of an existing thread
+            # -stdout:  tee/copy or redir/move to appropriately plumb stdout/err in the target
+            array set Options {
+                -block  1
+                -interp ""
+                -thread ""
+                -stdout ""
+                -evalprefix ""
+                -resultvar :::
+            }
+            my Configure $args
+            if {$Options(-stdout) ne ""} {
+                if {$Options(-thread) ne ""} {
+                    my PlumbThread $Options(-thread) $Options(-stdout)
+                } elseif {$Options(-interp) ne ""} {
+                    my PlumbInterp $Options(-interp) $Options(-stdout)
+                } else {
+                    my Plumb $Options(-stdout)
+                }
+            }
+            focus $hull.input    ;# FIXME: ???
+            return $hull
+        }
+
+        method OnDestroy {script} {
+            variable DestroyList
+            lappend DestroyList $script
+        }
+
+        destructor {
+            #after 0 [list after idle [list puts "Destroyed: [self]"]]
+            variable DestroyList
+            if {[info exists DestroyList]} {
+                foreach script [lreverse $DestroyList] {
+                    try {
+                        uplevel #0 $script
+                    } on error {e o} {
+                        set e "during [self] destructor: \"$e\" in {$script}"
+                        after idle [list return -code error -options $o $e]
+                    }
+                }
+            }
+        }
+
+        forward history history
+
+        # public interfaces to io:
+        method puts {str} {
+            my stdout $str\n
+        }
+        method input {s} {
+            if {[regexp {^(.*)\n$} $s -> t]} {
+                my Input $t
+                focus $hull.input
+                event generate $hull.input <Return>
+            } else {
+                my Input $s
+            }
+        }
+        method clearInput {} {
+            my SetInput ""
+        }
+        method stdout {str} {
+            set move [expr {1.0 == [lindex [$hull.output yview] 1]}]
+            $hull.output ins end $str stdout
+            if {$move} {$hull.output see end} ;#else {my Flash $hull.output darkgrey}
+        }
+        method stderr {str} {
+            set move [expr {1.0 == [lindex [$hull.output yview] 1]}]
+            $hull.output ins end $str stderr
+            if {$move} {$hull.output see end} ;#else {my Flash $hull.output darkgrey}
+        }
+        method eof {{chan stdout}} {
+            $hull.output ins end \u03 $chan
+            if {$Options(-thread) ne ""} {
+                if {[thread::exists $Options(-thread)]} {
+                    return
+                }
+            } elseif {$Options(-interp) ne ""} {
+                if {[interp exists $Options(-interp)]} {
+                    return
+                }
+            }
+            set Options(-block) 2   ;# kinda a hack
+            my BlockInput
+        }
+
+        # silent eval:
+        method eval {script} {
+            lassign [my Evaluate $script] rc res opts
+            # XXX: bypasses -evalprefix.  Is that a good idea?
+            #set result [my Evaluate [concat $Options(-evalprefix) $script]]
+            return -code $rc -options $opts $res
+        }
+
+        # useful for pulling the interp/thread out of a console:
+        method cget {option} {
+            try {
+                return $Options($option)
+            } on error {} {
+                $hull cget $option
+            }
+        }
+
+        # runtime configuration is NOT PROPERLY SUPPORTED
+        # - this needs OptSpec support for readonly items
+        method configure args {
+            foreach {option value} $args {
+                if {![info exists Options($option)]} {
+                    $hull configure $option $value
+                } elseif {$option ni {-block -evalprefix -resultvar}} {
+                    throw {TK READONLY OPTION} "Option \"$readonly\" is read-only!"
+                } else {
+                    my Configure [list $option $value]
+                }
+            }
+        }
+
+        method Configure {optargs} {
+            variable Options
+            dict for {option value} $optargs {
+                incr ite [expr {$option in "-interp -thread -eval"}]
+                if {$ite > 1} {
+                    throw {TCL BADARGS} "Can only provide one of -interp, -thread or -eval"
+                }
+                switch $option {
+                    "-block" {
+                        set Options(-block) $value
+                    }
+                    "-interp" {
+                        if {$value eq "%"} {
+                            set value [interp create]
+                            my OnDestroy [list interp delete $value]
+                        }
+                        oo::objdefine [self] method Evaluate {script} "my EvalInterp [list $value] \$script"
+                    }
+                    "-thread" {
+                        if {$value eq "%"} {
+                            set value [thread::create]
+                            my OnDestroy [list thread::release $value]
+                        }
+                        oo::objdefine [self] method Evaluate {script} "my EvalThread [list $value] \$script"
+                    }
+                    "-stdout" {
+                        if {$value in {"tee" "copy"}} {
+                            set value tee
+                        } elseif {$value in {"redir" "move"}} {
+                            set value redir
+                        } else {
+                            throw {TCL BADARGS} "Unknown value for option -stdout \"$value\", should be one of \"tee\", \"redir\""
+                        }
+                    }
+                    "-eval" {
+                        oo::objdefine [self] method Evaluate {script} "[list {*}$value] \$script"
+                    }
+                    "-evalprefix"  - "-resultvar" {
+                        # just store it
+                    }
+                    "-prompt" {
+                        oo::objdefine [self] method Prompt {} $value
+                    }
+                    "-iscomplete" {
+                        # note the appended \n !
+                        oo::objdefine [self] method IsComplete {script} "[list {*}$value] \$script\\n"
+                    }
+                    default {
+                        throw {TCL BADARGS} "Unknown option \"$option\", expected one of -eval, -prompt or -iscomplete"
+                    }
+                }
+                set Options($option) $value
+            }
+        }
+
+        method SetupTags {} {
+            set textopts {-background black -foreground white
+                        -insertbackground blue
+                        -border 0
+                        -highlightbackground darkgray -highlightcolor lightgray}
+            array set tagconfig {
+                prompt  {-foreground green}
+                input   {-foreground darkgray}
+                stdout  {-foreground lightgray}
+                stderr  {-foreground red}
+                sel     {-background darkgreen}
+                result  {}
+                error   {-foreground red -underline yes}
+                error-detail   {-foreground red -underline no -elide 1}
+            }
+
+            $hull.output configure {*}$textopts
+            $hull.input configure  {*}$textopts
+
+            dict for {tag opts} [array get tagconfig] {
+                $hull.output tag configure $tag {*}$opts ;#[dict merge $defaults $opts]
+            }
+            $hull.output tag bind error         <Double-1>  +[callback my HotError] ;#\;break
+            $hull.output tag bind error-detail  <Double-1>  +[callback my HotError] ;#\;break
+            # FIXME: it would be nice if the above binds could [break] to prevent selection 
+            # but that looks like it's going to need plumbing the main Text bindtags ..
+        }
+
+        method SetupBinds {} {
+            bind $hull.input <Control-Return> [callback my <Control-Return>]
+            bind $hull.input <Return>         [callback my <Return>]
+            bind $hull.input <Up>             [callback my <Up>]
+            bind $hull.input <Down>           [callback my <Down>]
+            bind $hull.input <Next>           [callback my <Next>]
+            bind $hull.input <Prior>          [callback my <Prior>]
+            bind $hull.input <Control-Up>     [callback my <Control-Up>]
+            bind $hull.input <Control-Down>   [callback my <Control-Down>]
+            bind $hull.input <Control-y>      {event generate %W <<Redo>>; break}    ;# FIXME: tkImprover does this better
+
+            bind $hull.output <Tab>           "[list ::focus $hull.input]\nbreak"
+            bind $hull.output <<ReadOnly>>    [callback my Flash $hull.output]        ;# delegate to <<Alert>> event?
+        }
+
+        method Flash {w {colour red}} {
+            set oldbg [$w cget -background]     ;# FIXME: use a tag to mimic a ttk style
+            $w configure -background $colour
+            after 50 [list $w configure -background $oldbg]
+        }
+
+        method <Return> {} {
+            set script [my GetInput]
+            # FIXME: check for meta-commands
+            if {$script eq ""} {
+                after idle [callback my Flash $hull.input]
+                return -code break
+            } elseif {![my IsComplete $script]} {
+                return -code ok
+            } elseif {[my BossKey $script]} {
+                after idle [callback my BossExec $script]
+                my SetInput ""
+                return -code break
+            } else {
+                after idle [callback my Execute $script]
+                my SetInput ""
+                return -code break
+            }
+        }
+        method <Control-Return> {} {
+            my Input \n
+            return -code break
+        }
+        method <Up> {} {
+            set n [$hull.input count -displaylines 1.0 insert]
+            if {$n > 0} {return -code ok}
+            my SetInput [history prev [my GetInput]]
+            return -code break
+        }
+        method <Down> {} {
+            set n [$hull.input count -displaylines insert end]
+            if {$n > 1} {return -code ok}
+            my SetInput [history next [my GetInput]]
+            return -code break
+        }
+        method <Control-Down> {} {
+            focus $hull.output
+            event generate $hull.output <Down>
+        }
+        method <Control-Up> {} {
+            focus $hull.output
+            event generate $hull.output <Up>
+        }
+        method <Next> {} {
+            focus $hull.output
+            event generate $hull.output <Next>
+        }
+        method <Prior> {} {
+            focus $hull.output
+            event generate $hull.output <Prior>
+        }
+
+        # input simplified accessors
+        method Input {s} {
+            # FIXME: check if blocked?
+            $hull.input insert insert $s
+        }
+        method SetInput {text} {
+            $hull.input replace 1.0 end $text
+        }
+        method GetInput {} {
+            string range [$hull.input get 1.0 end] 0 end-1   ;# strip newline!
+        }
+        method InputPos {} {
+            $hull.input count -displaychars 1.0 insert
+        }
+
+        # execute in "boss mode" - local escape
+        # FIXME: control this with an option, name it better and disable by default
+        method BossKey {script}     {
+            string match !* $script
+        }
+        method BossExec {script} {
+            $hull.output ins end [my Prompt] prompt
+            $hull.output ins end $script\n input
+            history add $script
+            set script [string range $script 1 end]
+            set result [list [catch {uplevel #0 $script} e o] $e $o]
+            after idle [list after 0 [callback my ShowResult {*}$result]]
+        }
+
+        # evaluate current input, also make a history entry
+        method Execute {script} {
+            $hull.output ins end [my Prompt] prompt
+            $hull.output ins end $script\n input
+            history add $script
+
+            if {$Options(-resultvar) ne ":::"} {
+                set script "set [list $Options(-resultvar)] \[$script\]"
+            }
+            if {$Options(-evalprefix) ne ""} {
+                set script [list {*}$Options(-evalprefix) $script]
+            }
+            set result [my Evaluate $script]
+
+            # let the event loop catch up before showing the result (think IO)
+            after idle [list after 0 [callback my ShowResult {*}$result]]
+        }
+
+        method ShowResult {rc res opts} {
+            # this might want to be more clever about:
+            #   - insert a leading newline if not at bol
+            #   - add a newline at the end
+            #   - trimming extremely long output
+            if {$rc == 0} {
+                if {$res ne ""} {
+                    $hull.output ins end $res result
+                }
+            } else {
+                set tag "Err [info cmdcount]"
+                $hull.output ins end "\[$rc\]: $res\n" [list error $tag]
+                $hull.output ins end [my FormatError $opts] [list error-detail "$tag Detail"]
+            }
+            $hull.output see end
+        }
+
+        method FormatError {d} {
+            if {[dict size $d] eq 0} return
+            set d [lsort -stride 2 $d]  ;# canonical order is nice for errors
+            set maxl [::tcl::mathfunc::max {*}[lmap k [dict keys $d] {string length $k}]]
+            set map [list \n [format "\n%-*s   " $maxl ""]]
+            ;# [dict for] doesn't see duplicate elements, but I want to:
+            foreach {key value} $d {
+                set value [string map $map $value]
+                append result [format "%-*s = %s\n" $maxl $key $value]
+            }
+            return $result
+        }
+
+        method HotError {} {
+            set tags [$hull.output tag names current]
+            set tag [lsearch -inline $tags "Err *"]
+            if {![string match "* Detail" $tag]} {set tag "$tag Detail"}
+            $hull.output tag configure $tag -elide [expr {0 eq [
+                $hull.output tag cget $tag -elide
+            ]}]
+        }
+
+        # configurable items - see [method Configure]:
+        method Prompt {}            {return "\n% "}
+        method IsComplete {script}  {info complete $script\n}
+        method Evaluate {script}    {list [catch {uplevel #0 $script} e o] $e $o}
+
+        # evaluator for -interp:
+        method EvalInterp {interp script} {
+            set Try {apply {{script} {
+                list [catch {uplevel #0 $script} e o] $e $o
+            }}}
+            set script [list {*}$Try $script]
+            $interp eval $script
+        }
+
+        # evaluator for -thread (async! using vwait):
+        method EvalThread {thread script} {
+            set Try {apply {{script} {
+                list [catch {uplevel #0 $script} e o] $e $o
+            }}}
+
+            if {$Options(-block)} {
+                my BlockInput
+                finally [callback my UnblockInput]
+            }
+
+            variable EvalID
+            incr EvalID
+            set resultvar [namespace current]::evalresult($EvalID)
+
+            set script [list {*}$Try $script]
+
+            thread::send -async $thread $script $resultvar
+
+            if {[info coroutine] ne ""} {   ;# FIXME: not really a good idea.  See [yieldfor]
+                trace add variable $resultvar write [info coroutine]
+                yieldto string cat
+            } else {
+                vwait $resultvar
+            }
+
+            return [set $resultvar][unset $resultvar]
+        }
+
+        method BlockInput {} {
+            variable BlockDepth
+            incr BlockDepth
+            if {$Options(-block) == 2} {
+                ;# FIXME: use a tag to mimic a ttk style
+                $hull.input configure -background gray -state disabled
+            } else {
+                $hull.input configure -background gray
+            }
+        }
+        method UnblockInput {} {
+            variable BlockDepth
+            incr BlockDepth -1
+            if {$BlockDepth == 0} {
+                ;# FIXME: use a tag to mimic a ttk style
+                $hull.input configure -background black -state normal
+            }
+        }
+
+        # setup for stdout/stderr in slave
+        method Plumb {{kind tee}} {
+            if {$kind eq "tee"} {
+                chan push stdout [callback transchans::TeeCmd stdout [callback my stdout]]
+                chan push stderr [callback transchans::TeeCmd stderr [callback my stderr]]
+            } else {
+                chan push stdout [callback transchans::RedirCmd stdout [callback my stdout]]
+                chan push stderr [callback transchans::RedirCmd stderr [callback my stderr]]
+            }
+
+            my OnDestroy {chan pop stderr; chan pop stdout}
+        }
+        method PlumbInterp {int {kind tee}} {
+            # set up aliases in the interp:
+            #   :Stdout :Stderr - commands which take a string to write
+            interp alias $int :Stdout {} [self] stdout
+            interp alias $int :Stderr {} [self] stderr
+            if {$kind eq "tee"} {
+                set script [transchans::script TeeCmd]
+            } elseif {$kind eq "redir"} {
+                set script [transchans::script RedirCmd]
+            }
+            $int eval [list namespace eval StdRedir $script]
+            $int eval {
+                chan push stdout {StdRedir stdout :Stdout}
+                chan push stderr {StdRedir stderr :Stderr}
+            }
+
+            my OnDestroy [list $int eval {chan pop stderr; chan pop stdout}]
+        }
+        method PlumbThread {tid {kind tee}} {
+            if {$kind eq "tee"} {
+                set script [transchans::script TeeChan]
+            } elseif {$kind eq "redir"} {
+                set script [transchans::script RedirChan]
+            }
+            thread::send $tid [list namespace eval StdRedir $script]
+            foreach basechan {stdout stderr} {
+                lassign [chan pipe] r w
+                chan configure $w -buffering none -translation binary -eofchar {}
+                chan configure $r -blocking 0 -eofchar {}
+                chan configure $r -encoding    [chan configure $basechan -encoding]
+                chan configure $r -translation [chan configure $basechan -translation]
+                thread::transfer $tid $w
+                thread::send $tid [list apply {{chan redir} {
+                    chan configure $chan -eofchar {} -buffering none    ;# unbuffer
+                    chan push $chan [list StdRedir $redir]
+                }} $basechan $w]
+                chan event $r readable [list apply {{win r basechan} {
+                    set data [read $r]
+                    if {$data ne ""} {
+                        $win $basechan $data
+                    } elseif {[eof $r]} {
+                        close $r
+                        $win eof $basechan
+                    }
+                }} $hull $r $basechan]
+
+                my OnDestroy [list chan close $r]   ;# NOTE reverse order
+                my OnDestroy [list chan event $r readable ""]
+            }
+        }
+
+    }
+
+
+    proc copyBindtags {from to} {
+        foreach {event} [bind $from] {
+            set script [bind $from $event]
+            bind $to $event $script
+        }
+    }
+
+    copyBindtags Text ConsoleOutput.Text
+
+    bind ConsoleOutput.Text <Key> [namespace code {Console.Output.Key %W %K}]
+
+    # need to make specific binds too to get priority
+    bind ConsoleOutput.Text <Return> [namespace code {Console.Output.Key %W %K}]
+
+    proc Console.Output.Key {W K args} {
+        set input [winfo parent $W].input
+        if {[string match *_* $K]} {return -code ok}  ;# FIXME: imprecise HACK to avoid modifiers
+        focus $input
+        event generate $input <Key-$K>
+        return -code break
+    }
+
+    # A simple interactive history gadget.
+    #   - [prev] and [next] take the current input as an argument, to stash it
+    #     for later retrieval
+    #   - adjacent duplicate entries are elided
+    oo::class create History {
+        variable history
+        variable left
+        variable right
+        constructor {past} {
+            namespace path [list [namespace qualifiers [self class]] {*}[namespace path]]   ;# having to do this kinda sucks
+
+            set history $past
+        }
+        method get {} {
+            return $history
+        }
+        method add {entry} {
+            unset -nocomplain left right
+            if {$entry ne "" && $entry ne [lindex $history end]} {
+                lappend history $entry
+            }
+            return ""   ;# no result
+        }
+        method prev {curr} {
+            if {![info exists left]} {
+                set pat $curr*
+                set left [lsearch -inline -all -glob $history $pat]
+                set right {}
+            }
+            if {$left eq ""} {
+                # complain?
+                return $curr
+            }
+            lpush right $curr
+            lpop left
+        }
+        method next {curr} {
+            if {![info exists left]} {
+                return $curr
+            }
+            if {$right eq ""} {
+                # complain?
+                return $curr
+            }
+            lpush left $curr
+            lpop right
+        }
+        method size {} {llength $history}
+    }
+
+    # essential utilities
+    proc callback {args} { tailcall namespace code $args }
+    proc thunk {args} { list ::apply [list args $args [uplevel 1 {namespace current}]] }
+    proc finally {script} { tailcall trace add variable :#finally_var#: unset "$script\n;#" }
+
+    interp alias {} lpush {} lappend
+    proc lpop {_list args} {
+        upvar 1 $_list list
+        try {
+            lindex $list end
+        } finally {
+            set list [lrange $list 0 end-1]
+        }
+    }
+
+
+    # Channel redirection:
+    #
+    # it's desirable to capture stdout/stderr of embedded interpreters(/threads)
+    # for redirection to the console.  We can do this quite nicely with channel
+    # transformers (aka transchans - see [chan push]), but there are some details
+    # to get right:
+    #
+    #   * for same-thread (even inter-interp) comms, redirecting to a command
+    #     is fine.
+    #   * for inter-thread comms, it works better to have a [chan pipe] for
+    #     copying data to the main thread.
+    #   * in each case, we may want to either retain or suppress output on
+    #     the original stdchan.
+    #
+    # Rather than loading up a single transformer with options, we simply
+    # define four:  {Tee,Redir}{Chan,Cmd}
+    #
+    #   * Tee *copies* its output, leaving a copy on the tty
+    #   * Redir *redirects* its output, not letting it reach the tty
+    #
+    #   * Chan's destination is a channel, which must be in binary mode (and should be unbuffered)
+    #   * Cmd's destination is a cmdPrefix, which will receive decoded unicode
+    #
+    # Only Cmd variants need to receive the underlying chan as an argument.
+    #
+    # Their [namespace eval] scripts are all stored in variables for conveniently sending
+    # to another interp (or thread)
+    #
+    namespace eval transchans {
+        proc script {varname} {
+            variable $varname
+            return [set $varname]
+        }
+
+        # Usage:
+        #   chan push $chan [list TeeCmd $chan $cmdPrefix]
+        variable TeeCmd {
+            proc initialize {chan cmd x mode}  {
+                info procs
+            }
+            proc finalize   {chan cmd x}       { }
+            proc write      {chan cmd x data}  {
+                set enc [chan configure $chan -encoding]
+                if {$enc ne "binary"} {
+                    lappend cmd [encoding convertfrom $enc $data]
+                } else {
+                    lappend cmd $data
+                }
+                uplevel #0 $cmd
+                return $data
+            }
+            proc flush      {chan cmd x}       { }
+            namespace export *
+            namespace ensemble create -parameters {chan cmdprefix}
+        }
+        namespace eval TeeCmd $TeeCmd
+
+        #   chan push $chan [list RedirCmd $chan $cmdPrefix]
+        variable RedirCmd {
+            proc initialize {chan cmd x mode}  {
+                info procs
+            }
+            proc finalize   {chan cmd x}       { }
+            proc write      {chan cmd x data}  {
+                set enc [chan configure $chan -encoding]
+                lappend cmd [encoding convertfrom $enc $data]
+                uplevel #0 $cmd
+                return $data
+            }
+            proc flush      {chan cmd x}       { }
+            namespace export *
+            namespace ensemble create -parameters {chan cmdprefix}
+        }
+        namespace eval RedirCmd $RedirCmd
+
+
+        # if dest is a pipe, be sure to set the read side's encoding
+        # to the same as the underlying channel
+        #
+        # Usage:
+        #   chan push $chan [list TeeChan $redir]
+        variable TeeChan {
+            proc initialize {rechan x mode}  {
+                info procs
+            }
+            proc finalize {rechan x}         { }
+            proc write {rechan x data}       {
+                puts -nonewline $rechan $data
+                return $data
+            }
+            proc flush {rechan x}            { }
+            namespace export *
+            namespace ensemble create -parameters {rechan}
+        }
+        namespace eval TeeChan $TeeChan
+
+        #   chan push $chan [list RedirChan $redir]
+        variable RedirChan {
+            proc initialize {rechan x mode}  {
+                info procs
+            }
+            proc finalize {rechan x}         { }
+            proc write {rechan x data}       {
+                puts -nonewline $rechan $data
+                return ""
+            }
+            proc flush {rechan x}            { }
+            namespace export *
+            namespace ensemble create -parameters {rechan}
+        }
+        namespace eval RedirChan $RedirChan
+    }
+
+
+
+    # hacky autoscroll which packs itself *inside* the scrolled widget
+    # this would work better if the scrollbar were styled to avoid obscuring text ..
+    proc autoscroll {w} {
+        pack propagate $w off
+        $w configure -yscrollcommand [callback autoscrollCmd $w]
+    }
+
+    proc autoscrollCmd {w min max} {
+        if {$min > 0.0 || $max < 1.0} {
+            set sy [ttk::scrollbar $w.sy -orient vert -command [callback $w yview]]
+            pack $sy -in $w -side right -fill y
+            $w configure -yscrollcommand [callback autoscrollCmd2 $w $sy]
+        }
+    }
+    proc autoscrollCmd2 {w sy min max} {
+        if {$min <= 0.0 && $max >= 1.0} {
+            destroy $sy
+            $w configure -yscrollcommand [callback autoscrollCmd $w]
+        } else {
+            tailcall $sy set $min $max
+        }
+    }
+
+    namespace export console wraptext autoscroll
+}
+
+namespace import tksh::console
+
+if {[info exists ::argv0] && $::argv0 eq [info script]} {
+
+    # main script:
+    #
+    package require Thread
+    wm withdraw .
+
+    #console .console -stdout tee
+    #set i .console
+
+    #console .console -interp % -stdout tee
+    #set i [.console cget -interp]
+
+    console .console -thread % -stdout tee -resultvar ::_
+    set i [.console cget -thread]
+
+    #.console buttons add "&Packages" [::tksh::callback .console input "package names\n"]
+
+    .console eval { ;# {} - fix syntax
+        lappend ::argv              ;# these make threads much happier
+        append ::argv0 {}
+        set ::tcl_interactive 1     ;# we like this in scripts
+    }
+
+    # issue scripts from the console that can [yield] to the event loop!
+    .console eval {
+        proc coroeval {script} {
+            variable CoroEval
+            variable CoroEvalID
+            incr CoroEvalID
+            set ID $CoroEvalID
+            coroutine coroeval#$CoroEvalID CoroEval $ID $script
+            if {![info exists CoroEval($ID)]} {
+                vwait CoroEval($ID)
+            }
+            lassign $CoroEval($ID)[unset CoroEval($ID)] R E O
+            return -code $R -options $O $E
+        }
+        proc CoroEval {ID script} {
+            variable CoroEval
+            lappend CoroEval($ID) [catch $script E O] $E $O
+        }
+    }
+    #.console configure -evalprefix coroeval
+
+    update
+    tksh::autoscroll .console.output
+
+    #puts "Interpreter is $i"
+    #puts "Console says [.console eval {package require Tcl}]"
+
+    .console puts "Tcl [package require Tcl]"
+    .console puts "Tk [package require Tk]"
+    .console puts "Executable [info nameofexecutable]"
+    .console puts "Library [info library]"
+    .console puts "Architecture $tcl_platform(os) $tcl_platform(machine)"
+    catch {boot .console eval}
+    wm protocol .console WM_DELETE_WINDOW exit
+}

Index: modules/tsv-0.1.tm
==================================================================
--- modules/tsv-0.1.tm
+++ modules/tsv-0.1.tm
@@ -6,12 +6,12 @@
 # and about an order of magnitude slower for exotic cases that csv might not be able to handle anyway
 #
 #tcl::tm::path add [pwd]
 package require options
 package require tests
-package require escape
-package require debug   ;# for assert
+package require fun     ;# for quote_regex
+package require adebug  ;# for assert
 
 catch {namespace delete tsv}
 namespace eval tsv {
     oo::class create TextSplitter {
 

ADDED   modules/vartrace-0.1.tm
Index: modules/vartrace-0.1.tm
==================================================================
--- /dev/null
+++ modules/vartrace-0.1.tm
@@ -0,0 +1,91 @@
+# SYNOPSIS:
+#
+#   A persistent trace for namespace variables.
+#     [vartrace add varName ops cmdPrefix]
+#     [vartrace info varName]
+#     [vartrace remove varName ops cmdprefix]
+#     [vartrace suspend varName script]
+#
+#   vartrace implicitly adds an [unset] trace which will restore the vartraces.
+#
+#   Differences from trace:
+#     * [trace info] returns a list of pairs.  [vartrace info] flattens it.
+#     * this doesn't work with locals, so it attempts to qualify the passed varName.  It should error if you attempt to pass a local.
+#     * [vartrace remove varName] will remove all traces
+#
+# See `binder.tcl` for some fairly thorough tests.
+#
+catch {namespace delete ::vartrace}
+package require adebug
+namespace eval ::vartrace {
+    #debug off
+
+    proc _qualify {varName} {
+        debug assert {[string match ::* $varName]}
+        return $varName ;# qualifying is a bad idea
+        #uplevel 2 namespace which -variable [list $varName]
+    }
+
+    proc add {varName ops cmdPrefix} {
+        set varName [_qualify $varName]
+        trace add variable $varName $ops $cmdPrefix
+        trace add variable $varName unset [list ::vartrace::_handler $varName $ops $cmdPrefix]
+    }
+
+    proc _handler {varName ops cmdPrefix name1 name2 unset} {
+debug what
+        # varName is already qualified here
+        set ns [namespace qualifiers $varName]
+        if {$ns eq "" || [namespace exists $ns]} {
+            debug log {restoring vartraces on $varName}
+            tailcall add $varName $ops $cmdPrefix
+        } else {
+            debug log {not restoring vartraces on $varName - namespace has gone away}
+        }
+    }
+
+    proc info {varName} {
+        set varName [_qualify $varName]
+        set traces [concat {*}[trace info variable $varName]]
+
+        lconcat {ops cmdPrefix} $traces {
+            if {[lindex $cmdPrefix 0] ne "::vartrace::_handler"} {
+                continue
+            }
+            lassign $cmdPrefix _ _ ops cmdPrefix
+            list $ops $cmdPrefix
+        }
+    }
+
+    # remove varName ?ops cmdPrefix? ...
+    # .. if no args are provided, it returns *all* vartraces
+    proc remove {varName args} {
+        debug assert {[llength $args] % 2 == 0}
+        set varName [_qualify $varName]
+        if {[llength $args] eq 0} {
+            set args [::vartrace info [list $varName]]
+        }
+        foreach {ops cmdPrefix} $args {
+            debug log {removing vartrace: [list $varName $ops $cmdPrefix]}
+            trace remove variable $varName $ops $cmdPrefix
+            trace remove variable $varName unset [list ::vartrace::_handler $varName $ops $cmdPrefix]
+        }
+        return $args
+    }
+
+    proc suspend {varName script} {
+        ;# !! FIXME: this should take optional middle args
+        set traces [::vartrace remove $varName]
+        try {
+            uplevel 1 $script
+        } finally {
+            foreach {ops cmdPrefix} $traces {
+                ::vartrace add $varName $ops $cmdPrefix
+            }
+        }
+    }
+
+    namespace export {[a-z]*}
+    namespace ensemble create
+}
+

Index: procmap/procmap.tcl
==================================================================
--- procmap/procmap.tcl
+++ procmap/procmap.tcl
@@ -61,10 +61,12 @@
     proc is_object cmd {
         expr {![catch {info object $cmd}]}
     }
     proc ens_map ens {  ;# see also fun::subcommands
         # FIXME:? parameters?
+        # FIXME: if both -map and -subcommands are populated, -map is "slave" to -subcommands (thanks pyk 2015-11-23)
+        # FIXME: the values of $map can include arguments.  Handling that will make things quite a bit more complicated (thanks pyk 2015-22-23)
         if {[set map [namespace ensemble configure $ens -map]] ne ""} {
             return $map
         }
         set ns [namespace ensemble configure $ens -namespace]
         if {[set map [namespace ensemble configure $ens -subcommands]] ne ""} {
@@ -337,10 +339,13 @@
             zlib
         }   ;# some of these are recognisable by "subcommand ?...?"
         set maxfirst [map {string cat ::} $maxfirst]
         set avoid [map {string cat ::} $avoid]
         set doms [map {string cat ::} $doms]
+        ;# FIXME: need to examine namespaces other than root to catch
+        ;#  ::oo::define, ::tcl::mathfunc::* etc.  But I should take some care
+        ;#  to not double-count (or worse: double-examine) ensemble subcommands
         set procs [lsort [dict keys [procmap::procmap]]]
         set Procs $procs
 
         while {$procs ne ""} {
             set procs [lassign $procs cmd]

ADDED   proxy/proxy.pac
Index: proxy/proxy.pac
==================================================================
--- /dev/null
+++ proxy/proxy.pac
@@ -0,0 +1,8 @@
+/*
+ * http://findproxyforurl.com/
+ * https://www.chromium.org/developers/design-documents/secure-web-proxy
+ * http://wiki.squid-cache.org/Features/HTTPS#Encrypted_browser-Squid_connection
+ */
+function FindProxyForURL(url, host) {
+    return "HTTPS localhost:1443";
+}

ADDED   proxy/proxy.tcl
Index: proxy/proxy.tcl
==================================================================
--- /dev/null
+++ proxy/proxy.tcl
@@ -0,0 +1,277 @@
+#!/usr/bin/env tclsh8.6
+#
+
+proc main {{port 8080}} {
+    # FIXME: support a bind address/port registry
+    variable MYPORTS
+    lappend MYPORTS $port
+    socket -server {accept proxy} $port
+    log "listening on $port"
+    # FIXME: stunnel https
+    if {[file exists stunnel.sh]} {
+        variable SSL
+        set sslport [expr {$port + 443 - 80}]
+        lappend MYPORTS $sslport
+        set SSL [open "|./stunnel.sh $sslport $port" w]
+        finally [list close $SSL]   ;# harhar
+        log "listening (TLS) on $sslport"
+        vwait forever
+    }
+}
+
+namespace eval util {
+    proc yieldm args {yieldto string cat {*}$args}
+
+    proc finally {script} {
+        tailcall trace add variable :#finally#: unset [list apply [list args $script]]
+    }
+
+    proc timestamp {} {
+        clock format [clock seconds] -format "%H:%M:%S"
+    }
+
+    proc log {args} {
+        puts stderr "[timestamp] [list [info coroutine]] $args"
+    }
+
+    proc dedent {text} {
+        set text [string trimleft $text \n]
+        set text [string trimright $text \ ]
+        regexp -line {^ +} $text space
+        regsub -line -all ^$space $text ""
+    }
+
+    namespace export *
+}
+namespace import util::*
+
+proc serve_http {chan scheme host port path} {
+    log "Serving HTTP" $path
+    if {$path eq "/proxy.pac"} {
+        puts $chan "HTTP/1.1 200 OK"
+        puts $chan "Connection: close"  ;# not _strictly_ required, but be sure
+        puts $chan "Content-Type: text/javascript"
+        puts $chan ""
+        # FIXME: this can be generated more cleverly, but have to be stunnel-aware
+        variable MYPORTS
+        variable SSL
+        if {[info exists SSL] && $SSL ne ""} {
+            set port [lindex $MYPORTS 1]
+            puts $chan "function FindProxyForURL(u,h){return \"HTTPS $host:$port\";}"
+        } else {
+            set port [lindex $MYPORTS 0]
+            puts $chan "function FindProxyForURL(u,h){return \"PROXY $host:$port\";}"
+        }
+    } else {
+        puts $chan "HTTP/1.1 404 Not Found"
+        puts $chan "Connection: close"
+        puts $chan "Content-Type: text/plain"
+        puts $chan ""
+        puts $chan "No such thing here.  Try /proxy.pac"
+    }
+}
+
+namespace eval filter {
+    # TODO: a bit of sugar
+    proc deproxify {_request _headers} {    ;# turn request into path-only and create Host: header
+                                            ;# most servers don't actually care, but rfc2616 5.1.2 MUST
+                                            ;# and paste.tclers.tk cares
+        upvar 1 $_request request
+        upvar 1 $_headers headers
+
+        # FIXME: code duplication
+        if {![regexp {^([A-Z]+) (.*) (HTTP/.*)$} $request -> verb dest httpver]} {
+            return
+        }
+        if {[regexp {^(\w+)://\[([^\]/ ]+)\](?::(\d+))?(.*)$} $dest -> scheme host port path]} {
+            # IPv6 URL
+        } elseif {[regexp {^(\w+)://([^:/ ]+)(?::(\d+))?(.*)$} $dest -> scheme host port path]} {
+            # normal URL
+        } else {
+            return  ;# nothing I can handle here!
+        }
+        if {$scheme ne "http"} return   ;# nothing I can handle here!
+        if {$port eq 80} {set port ""}
+        if {[regexp -line {^Host: (.*)(?::(.*))$} $headers -> h_host h_port]} {
+            if {$h_port eq 80} {set h_port ""}
+            if {$h_host ne $host || $h_port ne $port} {
+                throw {PROXY ILLEGAL HEADER} "Illegal host header! $h_host:$h_port"
+            }
+            regsub -line {^Host: (.*)\n} $headers "" headers
+        }
+        set request "$verb $path $httpver"
+        set headers "Host: $host:$port\n$headers"
+    }
+
+    proc nokeepalive {_request _headers} {
+        upvar 1 $_request request
+        upvar 1 $_headers headers
+        regsub -line {^Connection: (.*)\n} $headers "" headers
+        append headers "Connection: close\n"
+    }
+
+    proc basicauth {_request _headers} {
+        upvar 1 $_request request
+        upvar 1 $_headers headers
+        if {![regexp -line {^Proxy-Authorization: Basic (.*)$} $headers -> creds]} {
+            return -code return [dedent {
+                HTTP/1.1 407 Proxy Authentication Required
+                Proxy-Authenticate: Basic realm="Tiny Proxy"
+                Connection: close
+                
+            }]
+        }
+        set creds [binary decode base64 $creds]
+        if {![regexp {^(.*?):(.*)$} $creds -> user pass]} {
+            throw {PROXY AUTH BAD}
+        }
+        log "Authenticated: $user $pass"
+        regsub -line {^Proxy-Authorization: Basic (.*)\n} $headers "" headers
+    }
+}
+
+namespace eval Clients {}
+
+proc accept {handler chan host port} {
+    set coname [string map {: _} $host]:$port
+    coroutine Clients::$coname $handler $chan $host $port
+}
+
+proc proxy {chan chost cport} {
+    variable MYPORTS
+    finally [list catch [list close $chan]]
+
+    log "New connection: $chan"
+    chan configure $chan -blocking 0 -buffering line -translation crlf -encoding iso8859-1
+
+    chan event $chan readable [info coroutine]
+
+    yield; gets $chan request
+
+    if {$request eq "" && [chan eof $chan]} {
+        log "Client closed before sending request"
+        return
+    }
+
+    set preamble ""
+    while {[yield; gets $chan line] > 0} {
+        append preamble $line\n
+    }
+
+    chan even $chan readable ""
+
+    if {![regexp {^([A-Z]+) (.*) (HTTP/.*)$} $request -> verb dest httpver]} {
+        throw {PROXY BAD_REQUEST} "Bad request: [list $request]"
+    }
+
+    set is_http [regexp {^/.*$} $dest]  ;# for transparent proxying, or acting as an HTTP server
+    if {$is_http} {
+        set scheme "http"   ;# because stunnel is invisible
+        set path $dest
+        if {![regexp -line {^Host: (.*?)(?::(\d+))?$} $preamble -> host port]} {
+            throw {PROXY HTTP BAD_HOST} "Bad Host header!"
+        }
+    } elseif {[regexp {^(\w+)://\[([^\]/ ]+)\](?::(\d+))?(.*)$} $dest -> scheme host port path]} {
+        # IPv6 URL
+    } elseif {[regexp {^(\w+)://([^:/ ]+)(?::(\d+))?(.*)$} $dest -> scheme host port path]} {
+        # normal URL
+    } elseif {[regexp {^([^:/ ]+)(?::(\d+))?$} $dest -> host port]} {
+        set scheme ""
+        # CONNECT-style host:port
+    } elseif {[regexp {^\[([^\]/ ]+)\](?::(\d+))?$} $dest -> host port]} {
+        set scheme ""
+        # CONNECT-style host:port IPv6
+    } else {
+        throw [list PROXY BAD_URL $dest] "Invalid URL format: [list $dest]"
+    }
+
+    if {$scheme ni {"" "http"}} {
+        throw [list PROXY BAD_SCHEME $scheme] "Unknown URL scheme [list $scheme]; only HTTP supported!"
+    }
+
+    # divine the port, if blank
+    if {$port eq ""} {
+        set port 80
+    }
+
+    # FIXME: don't simply check $is_http because we might want to be a transparent proxy
+    # FIXME: make this a filter
+    if {$is_http || ($host in {127.0.0.1 localhost ::1} && $port in $MYPORTS)} {
+        serve_http $chan $scheme $host $port $path
+        return ;# NOTE: cannot tailcall here, because that will trigger [finally] and close the channel!
+    }
+
+    # Filters must be able to:
+    #  [x] alter the request        (pass by reference)
+    #  [x] provide a full response  (-code return)
+    #  [ ] filter request body
+    #  [ ] filter response
+    try {
+        filter::deproxify request preamble
+        filter::basicauth request preamble
+        filter::nokeepalive request preamble
+    } on return {response opts} {
+        puts -nonewline $chan $response
+        return
+    }
+
+    log "Trying $verb $host:$port"
+    set upchan [socket -async $host $port]  ;# FIXME: synchronous DNS blocks :(
+    yieldto chan event $upchan writable [info coroutine]
+    chan event $upchan writable ""
+    set err [chan configure $upchan -error]
+    if {$err ne ""} {
+        log "Connect error: $err"
+        # FIXME: smarter responses
+        puts -nonewline $chan [dedent "
+                    $httpver 502 Bad Gateway
+                    Content-type: text/plain
+                    Connection: close
+                    
+                    Error connecting to $host port $port:
+                      $err
+        "]
+        return
+    }
+    finally [list catch [list close $upchan]]
+
+    chan configure $upchan -blocking 0 -buffering line -translation crlf -encoding iso8859-1
+
+    if {$verb eq "CONNECT"} {
+        # for CONNECT, we need to synthesise a response:
+        puts $chan "$httpver 200 OK"
+        puts $chan ""
+    } else {
+        # else, forward the request headers:
+        puts $upchan $request
+        puts $upchan $preamble  ;# extra newline is wanted here!
+    }
+
+    # FIXME: handle persistent connections
+    #   - need to intervene in the beginning of EVERY http request
+    #   - which is kind of awful.  filter::nokeepalive will do?
+    chan configure $chan   -buffering none -translation binary
+    chan configure $upchan -buffering none -translation binary
+    chan copy $chan $upchan -command [info coroutine]
+    chan copy $upchan $chan -command [info coroutine]
+
+    # wait for one chan to close:
+    lassign [yieldm] nbytes err
+    if {$err ne ""} {
+        log "Error during transfer: $err"
+        # which channel?  No eyed-deer
+    }
+    if {[chan eof $chan]} {     ;# this would be the wrong test if TCP supported tip#332 !
+        log "Client abandoned keepalive"
+        #close $upchan  ;# [finally] will do this for us
+    } else {
+        # wait until we're done sending to the client
+        lassign [yieldm] nbytes err
+        if {$err ne ""} {
+            log "Error during transfer: $err"
+        }
+    }
+    log "Done"
+}
+
+main {*}$argv

ADDED   proxy/stunnel.sh
Index: proxy/stunnel.sh
==================================================================
--- /dev/null
+++ proxy/stunnel.sh
@@ -0,0 +1,30 @@
+#!/bin/sh
+LISTEN=${1:-8443}
+DEST=${2:-8080}
+SVC=${3:-stunnel}
+
+echo > ${SVC}.conf "
+foreground = yes
+syslog = no
+
+[https]
+accept = $LISTEN
+connect = $DEST
+cert = ${SVC}.pem
+"
+
+if [ ! -f ${SVC}.pem ]; then
+	touch ${SVC}.key ${SVC}.crt ${SVC}.pem
+	chmod 600 ${SVC}.key ${SVC}.crt ${SVC}.pem
+
+	# openssl genrsa -out isn't playing nice ... wth?
+	# FIXME: use genpkey
+	openssl genrsa 4096 > ${SVC}.key
+	# params on cmdline?
+	yes '' | openssl req -new -key ${SVC}.key -x509 -days 90 -out ${SVC}.crt
+	cat ${SVC}.key ${SVC}.crt > ${SVC}.pem
+	rm ${SVC}.key ${SVC}.crt
+	trap "rm ${SVC}.pem" EXIT
+fi
+
+stunnel ${SVC}.conf

ADDED   requirements.txt
Index: requirements.txt
==================================================================
--- /dev/null
+++ requirements.txt
@@ -0,0 +1,5 @@
+ctext
+tablelist
+widget::dialog
+tooltip
+snit