Tcl Extension Architecture (TEA) Sample Extension

Check-in [a2f82d04ff]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Adding local resident copy of practcl
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | practcl
Files: files | file ages | folders
SHA3-256: a2f82d04ffb8dd45e275ff5fb481e28cf2e35e8e4b7183f0f2e12253eeebc7e0
User & Date: seandeelywoods 2018-10-28 07:02:31
Context
2018-10-28
07:10
Branch which utilizes practcl as the make system and autosetup to replace autoconf. Leaf check-in: 4e4e6b55d3 user: seandeelywoods tags: autosetup
07:02
Adding local resident copy of practcl Leaf check-in: a2f82d04ff user: seandeelywoods tags: practcl
06:55
Merge with trunk check-in: 9011a8649b user: seandeelywoods tags: practcl
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to make.tcl.

     1      1   set CWD [pwd]
     2      2   set ::project(builddir) $::CWD
     3      3   set ::SRCDIR   [file dirname [file normalize [info script]]]
     4      4   set ::SANDBOX  [file dirname $::SRCDIR]
     5      5   
     6         -if {[file exists [file join $::SANDBOX tclconfig practcl.tcl]]} {
     7         -  source [file join $::SANDBOX tclconfig practcl.tcl]
     8         -} else {
     9         -  source [file join $SRCDIR tclconfig practcl.tcl]
    10         -}
            6  +source [file join $SRCDIR tools practcl.tcl]
    11      7   
    12      8   array set ::project [::practcl::config.tcl $CWD]
    13      9   ::practcl::library create LIBRARY [array get ::project]
    14     10   LIBRARY define set builddir $CWD
    15     11   LIBRARY define set srcdir $SRCDIR
    16     12   LIBRARY clay set meta license BSD
    17     13   LIBRARY clay set meta description {The Reference TEA Extension for Developers}

Added tools/practcl.tcl.

            1  +###
            2  +# Amalgamated package for practcl
            3  +# Do not edit directly, tweak the source in src/ and rerun
            4  +# build.tcl
            5  +###
            6  +package require Tcl 8.6
            7  +package provide practcl 0.15
            8  +namespace eval ::practcl {}
            9  +
           10  +###
           11  +# START: httpwget/wget.tcl
           12  +###
           13  +package provide http::wget 0.1
           14  +package require http
           15  +::namespace eval ::http {
           16  +}
           17  +proc ::http::_followRedirects {url args} {
           18  +    while 1 {
           19  +        set token [geturl $url -validate 1]
           20  +        set ncode [ncode $token]
           21  +        if { $ncode eq "404" } {
           22  +          error "URL Not found"
           23  +        }
           24  +        switch -glob $ncode {
           25  +            30[1237] {### redirect - see below ###}
           26  +            default  {cleanup $token ; return $url}
           27  +        }
           28  +        upvar #0 $token state
           29  +        array set meta [set ${token}(meta)]
           30  +        cleanup $token
           31  +        if {![info exists meta(Location)]} {
           32  +           return $url
           33  +        }
           34  +        set url $meta(Location)
           35  +        unset meta
           36  +    }
           37  +    return $url
           38  +}
           39  +proc ::http::wget {url destfile {verbose 1}} {
           40  +    set tmpchan [open $destfile w]
           41  +    fconfigure $tmpchan -translation binary
           42  +    if { $verbose } {
           43  +        puts [list  GETTING [file tail $destfile] from $url]
           44  +    }
           45  +    set real_url [_followRedirects $url]
           46  +    set token [geturl $real_url -channel $tmpchan -binary yes]
           47  +    if {[ncode $token] != "200"} {
           48  +      error "DOWNLOAD FAILED"
           49  +    }
           50  +    cleanup $token
           51  +    close $tmpchan
           52  +}
           53  +
           54  +###
           55  +# END: httpwget/wget.tcl
           56  +###
           57  +###
           58  +# START: clay/clay.tcl
           59  +###
           60  +package provide clay 0.6
           61  +namespace eval ::clay {
           62  +}
           63  +package require Tcl 8.5
           64  +namespace eval uuid {
           65  +    variable accel
           66  +    array set accel {critcl 0}
           67  +    namespace export uuid
           68  +    variable uid
           69  +    if {![info exists uid]} {
           70  +        set uid 1
           71  +    }
           72  +    proc K {a b} {set a}
           73  +}
           74  +proc ::uuid::generate_tcl_machinfo {} {
           75  +  variable machinfo
           76  +  if {[info exists machinfo]} {
           77  +    return $machinfo
           78  +  }
           79  +  lappend machinfo [clock seconds]; # timestamp
           80  +  lappend machinfo [clock clicks];  # system incrementing counter
           81  +  lappend machinfo [info hostname]; # spatial unique id (poor)
           82  +  lappend machinfo [pid];           # additional entropy
           83  +  lappend machinfo [array get ::tcl_platform]
           84  +
           85  +  ###
           86  +  # If we have /dev/urandom just stream 128 bits from that
           87  +  ###
           88  +  if {[file exists /dev/urandom]} {
           89  +    set fin [open /dev/urandom r]
           90  +    binary scan [read $fin 128] H* machinfo
           91  +    close $fin
           92  +  } elseif {[catch {package require nettool}]} {
           93  +    # More spatial information -- better than hostname.
           94  +    # bug 1150714: opening a server socket may raise a warning messagebox
           95  +    #   with WinXP firewall, using ipconfig will return all IP addresses
           96  +    #   including ipv6 ones if available. ipconfig is OK on win98+
           97  +    if {[string equal $::tcl_platform(platform) "windows"]} {
           98  +      catch {exec ipconfig} config
           99  +      lappend machinfo $config
          100  +    } else {
          101  +      catch {
          102  +          set s [socket -server void -myaddr [info hostname] 0]
          103  +          K [fconfigure $s -sockname] [close $s]
          104  +      } r
          105  +      lappend machinfo $r
          106  +    }
          107  +
          108  +    if {[package provide Tk] != {}} {
          109  +      lappend machinfo [winfo pointerxy .]
          110  +      lappend machinfo [winfo id .]
          111  +    }
          112  +  } else {
          113  +    ###
          114  +    # If the nettool package works on this platform
          115  +    # use the stream of hardware ids from it
          116  +    ###
          117  +    lappend machinfo {*}[::nettool::hwid_list]
          118  +  }
          119  +  return $machinfo
          120  +}
          121  +proc ::uuid::generate_tcl {} {
          122  +    package require md5 2
          123  +    variable uid
          124  +
          125  +    set tok [md5::MD5Init]
          126  +    md5::MD5Update $tok [incr uid];      # package incrementing counter
          127  +    foreach string [generate_tcl_machinfo] {
          128  +      md5::MD5Update $tok $string
          129  +    }
          130  +    set r [md5::MD5Final $tok]
          131  +    binary scan $r c* r
          132  +
          133  +    # 3.4: set uuid versioning fields
          134  +    lset r 8 [expr {([lindex $r 8] & 0x3F) | 0x80}]
          135  +    lset r 6 [expr {([lindex $r 6] & 0x0F) | 0x40}]
          136  +
          137  +    return [binary format c* $r]
          138  +}
          139  +if {[string equal $tcl_platform(platform) "windows"]
          140  +        && [package provide critcl] != {}} {
          141  +    namespace eval uuid {
          142  +        critcl::ccode {
          143  +            #define WIN32_LEAN_AND_MEAN
          144  +            #define STRICT
          145  +            #include <windows.h>
          146  +            #include <ole2.h>
          147  +            typedef long (__stdcall *LPFNUUIDCREATE)(UUID *);
          148  +            typedef const unsigned char cu_char;
          149  +        }
          150  +        critcl::cproc generate_c {Tcl_Interp* interp} ok {
          151  +            HRESULT hr = S_OK;
          152  +            int r = TCL_OK;
          153  +            UUID uuid = {0};
          154  +            HMODULE hLib;
          155  +            LPFNUUIDCREATE lpfnUuidCreate = NULL;
          156  +            hLib = LoadLibraryA(("rpcrt4.dll"));
          157  +            if (hLib)
          158  +                lpfnUuidCreate = (LPFNUUIDCREATE)
          159  +                    GetProcAddress(hLib, "UuidCreate");
          160  +            if (lpfnUuidCreate) {
          161  +                Tcl_Obj *obj;
          162  +                lpfnUuidCreate(&uuid);
          163  +                obj = Tcl_NewByteArrayObj((cu_char *)&uuid, sizeof(uuid));
          164  +                Tcl_SetObjResult(interp, obj);
          165  +            } else {
          166  +                Tcl_SetResult(interp, "error: failed to create a guid",
          167  +                              TCL_STATIC);
          168  +                r = TCL_ERROR;
          169  +            }
          170  +            return r;
          171  +        }
          172  +    }
          173  +}
          174  +proc ::uuid::tostring {uuid} {
          175  +    binary scan $uuid H* s
          176  +    foreach {a b} {0 7 8 11 12 15 16 19 20 end} {
          177  +        append r [string range $s $a $b] -
          178  +    }
          179  +    return [string tolower [string trimright $r -]]
          180  +}
          181  +proc ::uuid::fromstring {uuid} {
          182  +    return [binary format H* [string map {- {}} $uuid]]
          183  +}
          184  +proc ::uuid::equal {left right} {
          185  +    set l [fromstring $left]
          186  +    set r [fromstring $right]
          187  +    return [string equal $l $r]
          188  +}
          189  +proc ::uuid::generate {} {
          190  +    variable accel
          191  +    if {$accel(critcl)} {
          192  +        return [generate_c]
          193  +    } else {
          194  +        return [generate_tcl]
          195  +    }
          196  +}
          197  +proc uuid::uuid {cmd args} {
          198  +    switch -exact -- $cmd {
          199  +        generate {
          200  +            if {[llength $args] != 0} {
          201  +                return -code error "wrong # args:\
          202  +                    should be \"uuid generate\""
          203  +            }
          204  +            return [tostring [generate]]
          205  +        }
          206  +        equal {
          207  +            if {[llength $args] != 2} {
          208  +                return -code error "wrong \# args:\
          209  +                    should be \"uuid equal uuid1 uuid2\""
          210  +            }
          211  +            return [eval [linsert $args 0 equal]]
          212  +        }
          213  +        default {
          214  +            return -code error "bad option \"$cmd\":\
          215  +                must be generate or equal"
          216  +        }
          217  +    }
          218  +}
          219  +proc ::uuid::LoadAccelerator {name} {
          220  +    variable accel
          221  +    set r 0
          222  +    switch -exact -- $name {
          223  +        critcl {
          224  +            if {![catch {package require tcllibc}]} {
          225  +                set r [expr {[info commands ::uuid::generate_c] != {}}]
          226  +            }
          227  +        }
          228  +        default {
          229  +            return -code error "invalid accelerator package:\
          230  +                must be one of [join [array names accel] {, }]"
          231  +        }
          232  +    }
          233  +    set accel($name) $r
          234  +}
          235  +namespace eval ::uuid {
          236  +    variable e {}
          237  +    foreach e {critcl} {
          238  +        if {[LoadAccelerator $e]} break
          239  +    }
          240  +    unset e
          241  +}
          242  +package provide uuid 1.0.7
          243  +namespace eval ::oo::dialect {
          244  +  namespace export create
          245  +}
          246  +foreach {flag test} {
          247  +  tip470 {package vsatisfies [package provide Tcl] 8.7}
          248  +} {
          249  +  if {![info exists ::oo::dialect::has($flag)]} {
          250  +    set ::oo::dialect::has($flag) [eval $test]
          251  +  }
          252  +}
          253  +proc ::oo::dialect::Push {class} {
          254  +  ::variable class_stack
          255  +  lappend class_stack $class
          256  +}
          257  +proc ::oo::dialect::Peek {} {
          258  +  ::variable class_stack
          259  +  return [lindex $class_stack end]
          260  +}
          261  +proc ::oo::dialect::Pop {} {
          262  +  ::variable class_stack
          263  +  set class_stack [lrange $class_stack 0 end-1]
          264  +}
          265  +if {$::oo::dialect::has(tip470)} {
          266  +proc ::oo::dialect::current_class {} {
          267  +  return [uplevel 1 self]
          268  +}
          269  +} else {
          270  +proc ::oo::dialect::current_class {} {
          271  +  tailcall Peek
          272  +}
          273  +}
          274  +proc ::oo::dialect::create {name {parent ""}} {
          275  +  variable has
          276  +  set NSPACE [NSNormalize [uplevel 1 {namespace current}] $name]
          277  +  ::namespace eval $NSPACE {::namespace eval define {}}
          278  +  ###
          279  +  # Build the "define" namespace
          280  +  ###
          281  +
          282  +  if {$parent eq ""} {
          283  +    ###
          284  +    # With no "parent" language, begin with all of the keywords in
          285  +    # oo::define
          286  +    ###
          287  +    foreach command [info commands ::oo::define::*] {
          288  +      set procname [namespace tail $command]
          289  +      interp alias {} ${NSPACE}::define::$procname {} \
          290  +        ::oo::dialect::DefineThunk $procname
          291  +    }
          292  +    # Create an empty dynamic_methods proc
          293  +    proc ${NSPACE}::dynamic_methods {class} {}
          294  +    namespace eval $NSPACE {
          295  +      ::namespace export dynamic_methods
          296  +      ::namespace eval define {::namespace export *}
          297  +    }
          298  +    set ANCESTORS {}
          299  +  } else {
          300  +    ###
          301  +    # If we have a parent language, that language already has the
          302  +    # [oo::define] keywords as well as additional keywords and behaviors.
          303  +    # We should begin with that
          304  +    ###
          305  +    set pnspace [NSNormalize [uplevel 1 {namespace current}] $parent]
          306  +    apply [list parent {
          307  +      ::namespace export dynamic_methods
          308  +      ::namespace import -force ${parent}::dynamic_methods
          309  +    } $NSPACE] $pnspace
          310  +
          311  +    apply [list parent {
          312  +      ::namespace import -force ${parent}::define::*
          313  +      ::namespace export *
          314  +    } ${NSPACE}::define] $pnspace
          315  +      set ANCESTORS [list ${pnspace}::object]
          316  +  }
          317  +  ###
          318  +  # Build our dialect template functions
          319  +  ###
          320  +  proc ${NSPACE}::define {oclass args} [string map [list %NSPACE% $NSPACE] {
          321  +  ###
          322  +  # To facilitate library reloading, allow
          323  +  # a dialect to create a class from DEFINE
          324  +  ###
          325  +  set class [::oo::dialect::NSNormalize [uplevel 1 {namespace current}] $oclass]
          326  +    if {[info commands $class] eq {}} {
          327  +      %NSPACE%::class create $class {*}${args}
          328  +    } else {
          329  +      ::oo::dialect::Define %NSPACE% $class {*}${args}
          330  +    }
          331  +}]
          332  +  interp alias {} ${NSPACE}::define::current_class {} \
          333  +    ::oo::dialect::current_class
          334  +  interp alias {} ${NSPACE}::define::aliases {} \
          335  +    ::oo::dialect::Aliases $NSPACE
          336  +  interp alias {} ${NSPACE}::define::superclass {} \
          337  +    ::oo::dialect::SuperClass $NSPACE
          338  +
          339  +  if {[info command ${NSPACE}::class] ne {}} {
          340  +    ::rename ${NSPACE}::class {}
          341  +  }
          342  +  ###
          343  +  # Build the metaclass for our language
          344  +  ###
          345  +  ::oo::class create ${NSPACE}::class {
          346  +    superclass ::oo::dialect::MotherOfAllMetaClasses
          347  +  }
          348  +  # Wire up the create method to add in the extra argument we need; the
          349  +  # MotherOfAllMetaClasses will know what to do with it.
          350  +  ::oo::objdefine ${NSPACE}::class \
          351  +    method create {name {definitionScript ""}} \
          352  +      "next \$name [list ${NSPACE}::define] \$definitionScript"
          353  +
          354  +  ###
          355  +  # Build the mother of all classes. Note that $ANCESTORS is already
          356  +  # guaranteed to be a list in canonical form.
          357  +  ###
          358  +  uplevel #0 [string map [list %NSPACE% [list $NSPACE] %name% [list $name] %ANCESTORS% $ANCESTORS] {
          359  +    %NSPACE%::class create %NSPACE%::object {
          360  +     superclass %ANCESTORS%
          361  +      # Put MOACish stuff in here
          362  +    }
          363  +  }]
          364  +  if { "${NSPACE}::class" ni $::oo::dialect::core_classes } {
          365  +    lappend ::oo::dialect::core_classes "${NSPACE}::class"
          366  +  }
          367  +  if { "${NSPACE}::object" ni $::oo::dialect::core_classes } {
          368  +    lappend ::oo::dialect::core_classes "${NSPACE}::object"
          369  +  }
          370  +}
          371  +proc ::oo::dialect::NSNormalize {namespace qualname} {
          372  +  if {![string match ::* $qualname]} {
          373  +    set qualname ${namespace}::$qualname
          374  +  }
          375  +  regsub -all {::+} $qualname "::"
          376  +}
          377  +proc ::oo::dialect::DefineThunk {target args} {
          378  +  tailcall ::oo::define [Peek] $target {*}$args
          379  +}
          380  +proc ::oo::dialect::Canonical {namespace NSpace class} {
          381  +  namespace upvar $namespace cname cname
          382  +  #if {[string match ::* $class]} {
          383  +  #  return $class
          384  +  #}
          385  +  if {[info exists cname($class)]} {
          386  +    return $cname($class)
          387  +  }
          388  +  if {[info exists ::oo::dialect::cname($class)]} {
          389  +    return $::oo::dialect::cname($class)
          390  +  }
          391  +  if {[info exists ::oo::dialect::cname(${NSpace}::${class})]} {
          392  +    return $::oo::dialect::cname(${NSpace}::${class})
          393  +  }
          394  +  foreach item [list "${NSpace}::$class" "::$class"] {
          395  +    if {[info commands $item] ne {}} {
          396  +      return $item
          397  +    }
          398  +  }
          399  +  return ${NSpace}::$class
          400  +}
          401  +proc ::oo::dialect::Define {namespace class args} {
          402  +  Push $class
          403  +  try {
          404  +  	if {[llength $args]==1} {
          405  +      namespace eval ${namespace}::define [lindex $args 0]
          406  +    } else {
          407  +      ${namespace}::define::[lindex $args 0] {*}[lrange $args 1 end]
          408  +    }
          409  +  	${namespace}::dynamic_methods $class
          410  +  } finally {
          411  +    Pop
          412  +  }
          413  +}
          414  +proc ::oo::dialect::Aliases {namespace args} {
          415  +  set class [Peek]
          416  +  namespace upvar $namespace cname cname
          417  +  set NSpace [join [lrange [split $class ::] 1 end-2] ::]
          418  +  set cname($class) $class
          419  +  foreach name $args {
          420  +    set cname($name) $class
          421  +    #set alias $name
          422  +    set alias [NSNormalize $NSpace $name]
          423  +    # Add a local metaclass reference
          424  +    if {![info exists ::oo::dialect::cname($alias)]} {
          425  +      lappend ::oo::dialect::aliases($class) $alias
          426  +      ##
          427  +      # Add a global reference, first come, first served
          428  +      ##
          429  +      set ::oo::dialect::cname($alias) $class
          430  +    }
          431  +  }
          432  +}
          433  +proc ::oo::dialect::SuperClass {namespace args} {
          434  +  set class [Peek]
          435  +  namespace upvar $namespace class_info class_info
          436  +  dict set class_info($class) superclass 1
          437  +  set ::oo::dialect::cname($class) $class
          438  +  set NSpace [join [lrange [split $class ::] 1 end-2] ::]
          439  +  set unique {}
          440  +  foreach item $args {
          441  +    set Item [Canonical $namespace $NSpace $item]
          442  +    dict set unique $Item $item
          443  +  }
          444  +  set root ${namespace}::object
          445  +  if {$class ne $root} {
          446  +    dict set unique $root $root
          447  +  }
          448  +  tailcall ::oo::define $class superclass {*}[dict keys $unique]
          449  +}
          450  +if {[info command ::oo::dialect::MotherOfAllMetaClasses] eq {}} {
          451  +::oo::class create ::oo::dialect::MotherOfAllMetaClasses {
          452  +  superclass ::oo::class
          453  +  constructor {define definitionScript} {
          454  +    $define [self] {
          455  +      superclass
          456  +    }
          457  +    $define [self] $definitionScript
          458  +  }
          459  +  method aliases {} {
          460  +    if {[info exists ::oo::dialect::aliases([self])]} {
          461  +      return $::oo::dialect::aliases([self])
          462  +    }
          463  +  }
          464  +}
          465  +}
          466  +namespace eval ::oo::dialect {
          467  +  variable core_classes {::oo::class ::oo::object}
          468  +}
          469  +package provide oo::dialect 0.4
          470  +package provide dicttool 1.2
          471  +namespace eval ::dicttool {
          472  +}
          473  +namespace eval ::dicttool {
          474  +}
          475  +namespace eval ::tcllib {
          476  +}
          477  +proc ::tcllib::PROC {name arglist body {ninja {}}} {
          478  +  if {[info commands $name] ne {}} return
          479  +  proc $name $arglist $body
          480  +  eval $ninja
          481  +}
          482  +if {[info commands ::PROC] eq {}} {
          483  +  namespace eval ::tcllib { namespace export PROC }
          484  +  namespace eval :: { namespace import ::tcllib::PROC }
          485  +}
          486  +proc ::tcllib::noop args {}
          487  +if {[info commands ::noop] eq {}} {
          488  +  namespace eval ::tcllib { namespace export noop }
          489  +  namespace eval :: { namespace import ::tcllib::noop }
          490  +}
          491  +proc ::tcllib::putb {buffername args} {
          492  +  upvar 1 $buffername buffer
          493  +  switch [llength $args] {
          494  +    1 {
          495  +      append buffer [lindex $args 0] \n
          496  +    }
          497  +    2 {
          498  +      append buffer [string map {*}$args] \n
          499  +    }
          500  +    default {
          501  +      error "usage: putb buffername ?map? string"
          502  +    }
          503  +  }
          504  +}
          505  +if {[info command ::putb] eq {}} {
          506  +  namespace eval ::tcllib { namespace export putb }
          507  +  namespace eval :: { namespace import ::tcllib::putb }
          508  +}
          509  +::tcllib::PROC ::tcl::dict::getnull {dictionary args} {
          510  +  if {[exists $dictionary {*}$args]} {
          511  +    get $dictionary {*}$args
          512  +  }
          513  +} {
          514  +  namespace ensemble configure dict -map [dict replace\
          515  +      [namespace ensemble configure dict -map] getnull ::tcl::dict::getnull]
          516  +}
          517  +::tcllib::PROC ::tcl::dict::is_dict { d } {
          518  +  # is it a dict, or can it be treated like one?
          519  +  if {[catch {dict size $d} err]} {
          520  +    #::set ::errorInfo {}
          521  +    return 0
          522  +  }
          523  +  return 1
          524  +} {
          525  +  namespace ensemble configure dict -map [dict replace\
          526  +      [namespace ensemble configure dict -map] is_dict ::tcl::dict::is_dict]
          527  +}
          528  +::tcllib::PROC ::tcl::dict::rmerge {args} {
          529  +  ::set result [dict create . {}]
          530  +  # Merge b into a, and handle nested dicts appropriately
          531  +  ::foreach b $args {
          532  +    for { k v } $b {
          533  +      ::set field [string trim $k :/]
          534  +      if {![::dicttool::is_branch $b $k]} {
          535  +        # Element names that end in ":" are assumed to be literals
          536  +        set result $k $v
          537  +      } elseif { [exists $result $k] } {
          538  +        # key exists in a and b?  let's see if both values are dicts
          539  +        # both are dicts, so merge the dicts
          540  +        if { [is_dict [get $result $k]] && [is_dict $v] } {
          541  +          set result $k [rmerge [get $result $k] $v]
          542  +        } else {
          543  +          set result $k $v
          544  +        }
          545  +      } else {
          546  +        set result $k $v
          547  +      }
          548  +    }
          549  +  }
          550  +  return $result
          551  +} {
          552  +  namespace ensemble configure dict -map [dict replace\
          553  +      [namespace ensemble configure dict -map] rmerge ::tcl::dict::rmerge]
          554  +}
          555  +::tcllib::PROC ::dicttool::is_branch { dict path } {
          556  +  set field [lindex $path end]
          557  +  if {[string index $field end] eq ":"} {
          558  +    return 0
          559  +  }
          560  +  if {[string index $field 0] eq "."} {
          561  +    return 0
          562  +  }
          563  +  if {[string index $field end] eq "/"} {
          564  +    return 1
          565  +  }
          566  +  return [dict exists $dict {*}$path .]
          567  +}
          568  +::tcllib::PROC ::dicttool::print {dict} {
          569  +  ::set result {}
          570  +  ::set level -1
          571  +  ::dicttool::_dictputb $level result $dict
          572  +  return $result
          573  +}
          574  +::tcllib::PROC ::dicttool::_dictputb {level varname dict} {
          575  +  upvar 1 $varname result
          576  +  incr level
          577  +  dict for {field value} $dict {
          578  +    if {$field eq "."} continue
          579  +    if {[dicttool::is_branch $dict $field]} {
          580  +      putb result "[string repeat "  " $level]$field \{"
          581  +      _dictputb $level result $value
          582  +      putb result "[string repeat "  " $level]\}"
          583  +    } else {
          584  +      putb result "[string repeat "  " $level][list $field $value]"
          585  +    }
          586  +  }
          587  +}
          588  +proc ::dicttool::sanitize {dict} {
          589  +  ::set result {}
          590  +  ::set level -1
          591  +  ::dicttool::_sanitizeb {} result $dict
          592  +  return $result
          593  +}
          594  +proc ::dicttool::_sanitizeb {path varname dict} {
          595  +  upvar 1 $varname result
          596  +  dict for {field value} $dict {
          597  +    if {$field eq "."} continue
          598  +    if {[dicttool::is_branch $dict $field]} {
          599  +      _sanitizeb [list {*}$path $field] result $value
          600  +    } else {
          601  +      dict set result {*}$path $field $value
          602  +    }
          603  +  }
          604  +}
          605  +proc ::dicttool::storage {rawpath} {
          606  +  set isleafvar 0
          607  +  set path {}
          608  +  set tail [string index $rawpath end]
          609  +  foreach element $rawpath {
          610  +    set items [split [string trim $element /] /]
          611  +    foreach item $items {
          612  +      if {$item eq {}} continue
          613  +      lappend path $item
          614  +    }
          615  +  }
          616  +  return $path
          617  +}
          618  +proc ::dicttool::dictset {varname args} {
          619  +  upvar 1 $varname result
          620  +  if {[llength $args] < 2} {
          621  +    error "Usage: ?path...? path value"
          622  +  } elseif {[llength $args]==2} {
          623  +    set rawpath [lindex $args 0]
          624  +  } else {
          625  +    set rawpath  [lrange $args 0 end-1]
          626  +  }
          627  +  set value [lindex $args end]
          628  +  set path [storage $rawpath]
          629  +  set dot .
          630  +  set one {}
          631  +  dict set result $dot $one
          632  +  set dpath {}
          633  +  foreach item [lrange $path 0 end-1] {
          634  +    set field $item
          635  +    lappend dpath [string trim $item /]
          636  +    dict set result {*}$dpath $dot $one
          637  +  }
          638  +  set field [lindex $rawpath end]
          639  +  set ext   [string index $field end]
          640  +  if {$ext eq {:} || ![dict is_dict $value]} {
          641  +    dict set result {*}$path $value
          642  +    return
          643  +  }
          644  +  if {$ext eq {/} && ![dict exists $result {*}$path $dot]} {
          645  +    dict set result {*}$path $dot $one
          646  +  }
          647  +  if {[dict exists $result {*}$path $dot]} {
          648  +    dict set result {*}$path [::dicttool::merge [dict get $result {*}$path] $value]
          649  +    return
          650  +  }
          651  +  dict set result {*}$path $value
          652  +}
          653  +proc ::dicttool::dictmerge {varname args} {
          654  +  upvar 1 $varname result
          655  +  set dot .
          656  +  set one {}
          657  +  dict set result $dot $one
          658  +  foreach dict $args {
          659  +    dict for {f v} $dict {
          660  +      set field [string trim $f /]
          661  +      set bbranch [dicttool::is_branch $dict $f]
          662  +      if {![dict exists $result $field]} {
          663  +        dict set result $field $v
          664  +        if {$bbranch} {
          665  +          dict set result $field [dicttool::merge $v]
          666  +        } else {
          667  +          dict set result $field $v
          668  +        }
          669  +      } elseif {[dict exists $result $field $dot]} {
          670  +        if {$bbranch} {
          671  +          dict set result $field [dicttool::merge [dict get $result $field] $v]
          672  +        } else {
          673  +          dict set result $field $v
          674  +        }
          675  +      }
          676  +    }
          677  +  }
          678  +  return $result
          679  +}
          680  +proc ::dicttool::merge {args} {
          681  +  ###
          682  +  # The result of a merge is always a dict with branches
          683  +  ###
          684  +  set dot .
          685  +  set one {}
          686  +  dict set result $dot $one
          687  +  set argument 0
          688  +  foreach b $args {
          689  +    # Merge b into a, and handle nested dicts appropriately
          690  +    if {![dict is_dict $b]} {
          691  +      error "Element $b is not a dictionary"
          692  +    }
          693  +    dict for { k v } $b {
          694  +      if {$k eq $dot} {
          695  +        dict set result $dot $one
          696  +        continue
          697  +      }
          698  +      set bbranch [is_branch $b $k]
          699  +      set field [string trim $k /]
          700  +      if { ![dict exists $result $field] } {
          701  +        if {$bbranch} {
          702  +          dict set result $field [merge $v]
          703  +        } else {
          704  +          dict set result $field $v
          705  +        }
          706  +      } else {
          707  +        set abranch [dict exists $result $field $dot]
          708  +        if {$abranch && $bbranch} {
          709  +          dict set result $field [merge [dict get $result $field] $v]
          710  +        } else {
          711  +          dict set result $field $v
          712  +          if {$bbranch} {
          713  +            dict set result $field $dot $one
          714  +          }
          715  +        }
          716  +      }
          717  +    }
          718  +  }
          719  +  return $result
          720  +}
          721  +::tcllib::PROC ::tcl::dict::isnull {dictionary args} {
          722  +  if {![exists $dictionary {*}$args]} {return 1}
          723  +  return [expr {[get $dictionary {*}$args] in {{} NULL null}}]
          724  +} {
          725  +  namespace ensemble configure dict -map [dict replace\
          726  +      [namespace ensemble configure dict -map] isnull ::tcl::dict::isnull]
          727  +}
          728  +namespace eval ::dictargs {
          729  +}
          730  +if {[info commands ::dictargs::parse] eq {}} {
          731  +  proc ::dictargs::parse {argdef argdict} {
          732  +    set result {}
          733  +    dict for {field info} $argdef {
          734  +      if {![string is alnum [string index $field 0]]} {
          735  +        error "$field is not a simple variable name"
          736  +      }
          737  +      upvar 1 $field _var
          738  +      set aliases {}
          739  +      if {[dict exists $argdict $field]} {
          740  +        set _var [dict get $argdict $field]
          741  +        continue
          742  +      }
          743  +      if {[dict exists $info aliases:]} {
          744  +        set found 0
          745  +        foreach {name} [dict get $info aliases:] {
          746  +          if {[dict exists $argdict $name]} {
          747  +            set _var [dict get $argdict $name]
          748  +            set found 1
          749  +            break
          750  +          }
          751  +        }
          752  +        if {$found} continue
          753  +      }
          754  +      if {[dict exists $info default:]} {
          755  +        set _var [dict get $info default:] \n
          756  +        continue
          757  +      }
          758  +      set mandatory 1
          759  +      if {[dict exists $info mandatory:]} {
          760  +        set mandatory [dict get $info mandatory:]
          761  +      }
          762  +      if {$mandatory} {
          763  +        error "$field is required"
          764  +      }
          765  +    }
          766  +  }
          767  +}
          768  +proc ::dictargs::proc {name argspec body} {
          769  +  set result {}
          770  +  append result "::dictargs::parse \{$argspec\} \$args" \;
          771  +  append result $body
          772  +  uplevel 1 [list ::proc $name [list [list args [list dictargs $argspec]]] $result]
          773  +}
          774  +proc ::dictargs::method {name argspec body} {
          775  +  set class [lindex [::info level -1] 1]
          776  +  set result {}
          777  +  append result "::dictargs::parse \{$argspec\} \$args" \;
          778  +  append result $body
          779  +  oo::define $class method $name [list [list args [list dictargs $argspec]]] $result
          780  +}
          781  +::tcllib::PROC ::dicttool::ladd {varname args} {
          782  +  upvar 1 $varname var
          783  +  if ![info exists var] {
          784  +      set var {}
          785  +  }
          786  +  foreach item $args {
          787  +    if {$item in $var} continue
          788  +    lappend var $item
          789  +  }
          790  +  return $var
          791  +}
          792  +::tcllib::PROC ::dicttool::ldelete {varname args} {
          793  +  upvar 1 $varname var
          794  +  if ![info exists var] {
          795  +      return
          796  +  }
          797  +  foreach item [lsort -unique $args] {
          798  +    while {[set i [lsearch $var $item]]>=0} {
          799  +      set var [lreplace $var $i $i]
          800  +    }
          801  +  }
          802  +  return $var
          803  +}
          804  +::tcllib::PROC ::dicttool::lrandom list {
          805  +  set len [llength $list]
          806  +  set idx [expr int(rand()*$len)]
          807  +  return [lindex $list $idx]
          808  +}
          809  +namespace eval ::dicttool {
          810  +  namespace export *
          811  +}
          812  +package require Tcl 8.6 ;# try in pipeline.tcl. Possibly other things.
          813  +package require TclOO
          814  +::oo::dialect::create ::clay
          815  +::namespace eval ::clay {
          816  +}
          817  +::namespace eval ::clay::classes {
          818  +}
          819  +::namespace eval ::clay::define {
          820  +}
          821  +namespace eval ::clay {
          822  +}
          823  +set ::clay::trace 0
          824  +proc ::clay::ancestors args {
          825  +  set result {}
          826  +  set queue  [lreverse $args]
          827  +  set result $queue
          828  +  set metaclasses {}
          829  +  while {[llength $queue]} {
          830  +    set tqueue $queue
          831  +    set queue {}
          832  +    foreach qclass $tqueue {
          833  +      foreach aclass [::info class superclasses $qclass] {
          834  +        if { $aclass in $result } continue
          835  +        if { $aclass in $queue } continue
          836  +        lappend queue $aclass
          837  +      }
          838  +    }
          839  +    foreach item $tqueue {
          840  +      if { $item ni $result } {
          841  +        lappend result $item
          842  +      }
          843  +    }
          844  +  }
          845  +  lappend result {*}$metaclasses
          846  +  ###
          847  +  # Screen out classes that do not participate in clay
          848  +  # interactions
          849  +  ###
          850  +  set output {}
          851  +  foreach {item} $result {
          852  +    if {[catch {$item clay noop} err]} {
          853  +      continue
          854  +    }
          855  +    lappend output $item
          856  +  }
          857  +  return $output
          858  +}
          859  +proc ::clay::args_to_dict args {
          860  +  if {[llength $args]==1} {
          861  +    return [lindex $args 0]
          862  +  }
          863  +  return $args
          864  +}
          865  +proc ::clay::args_to_options args {
          866  +  set result {}
          867  +  foreach {var val} [args_to_dict {*}$args] {
          868  +    lappend result [string trim $var -:] $val
          869  +  }
          870  +  return $result
          871  +}
          872  +proc ::clay::dynamic_arguments {ensemble method arglist args} {
          873  +  set idx 0
          874  +  set len [llength $args]
          875  +  if {$len > [llength $arglist]} {
          876  +    ###
          877  +    # Catch if the user supplies too many arguments
          878  +    ###
          879  +    set dargs 0
          880  +    if {[lindex $arglist end] ni {args dictargs}} {
          881  +      return -code error -level 2 "Usage: $ensemble $method [string trim [dynamic_wrongargs_message $arglist]]"
          882  +    }
          883  +  }
          884  +  foreach argdef $arglist {
          885  +    if {$argdef eq "args"} {
          886  +      ###
          887  +      # Perform args processing in the style of tcl
          888  +      ###
          889  +      uplevel 1 [list set args [lrange $args $idx end]]
          890  +      break
          891  +    }
          892  +    if {$argdef eq "dictargs"} {
          893  +      ###
          894  +      # Perform args processing in the style of tcl
          895  +      ###
          896  +      uplevel 1 [list set args [lrange $args $idx end]]
          897  +      ###
          898  +      # Perform args processing in the style of clay
          899  +      ###
          900  +      set dictargs [::clay::args_to_options {*}[lrange $args $idx end]]
          901  +      uplevel 1 [list set dictargs $dictargs]
          902  +      break
          903  +    }
          904  +    if {$idx > $len} {
          905  +      ###
          906  +      # Catch if the user supplies too few arguments
          907  +      ###
          908  +      if {[llength $argdef]==1} {
          909  +        return -code error -level 2 "Usage: $ensemble $method [string trim [dynamic_wrongargs_message $arglist]]"
          910  +      } else {
          911  +        uplevel 1 [list set [lindex $argdef 0] [lindex $argdef 1]]
          912  +      }
          913  +    } else {
          914  +      uplevel 1 [list set [lindex $argdef 0] [lindex $args $idx]]
          915  +    }
          916  +    incr idx
          917  +  }
          918  +}
          919  +proc ::clay::dynamic_wrongargs_message {arglist} {
          920  +  set result ""
          921  +  set dargs 0
          922  +  foreach argdef $arglist {
          923  +    if {$argdef in {args dictargs}} {
          924  +      set dargs 1
          925  +      break
          926  +    }
          927  +    if {[llength $argdef]==1} {
          928  +      append result " $argdef"
          929  +    } else {
          930  +      append result " ?[lindex $argdef 0]?"
          931  +    }
          932  +  }
          933  +  if { $dargs } {
          934  +    append result " ?option value?..."
          935  +  }
          936  +  return $result
          937  +}
          938  +proc ::clay::is_dict { d } {
          939  +  # is it a dict, or can it be treated like one?
          940  +  if {[catch {::dict size $d} err]} {
          941  +    #::set ::errorInfo {}
          942  +    return 0
          943  +  }
          944  +  return 1
          945  +}
          946  +proc ::clay::is_null value {
          947  +  return [expr {$value in {{} NULL}}]
          948  +}
          949  +proc ::clay::leaf args {
          950  +  set marker [string index [lindex $args end] end]
          951  +  set result [path {*}${args}]
          952  +  if {$marker eq "/"} {
          953  +    return $result
          954  +  }
          955  +  return [list {*}[lrange $result 0 end-1] [string trim [string trim [lindex $result end]] /]]
          956  +}
          957  +proc ::clay::path args {
          958  +  set result {}
          959  +  foreach item $args {
          960  +    set item [string trim $item :./]
          961  +    foreach subitem [split $item /] {
          962  +      lappend result [string trim ${subitem}]/
          963  +    }
          964  +  }
          965  +  return $result
          966  +}
          967  +proc ::clay::script_path {} {
          968  +  set path [file dirname [file join [pwd] [info script]]]
          969  +  return $path
          970  +}
          971  +proc ::clay::NSNormalize qualname {
          972  +  if {![string match ::* $qualname]} {
          973  +    set qualname ::clay::classes::$qualname
          974  +  }
          975  +  regsub -all {::+} $qualname "::"
          976  +}
          977  +proc ::clay::uuid_generate args {
          978  +  return [uuid::uuid generate]
          979  +}
          980  +namespace eval ::clay {
          981  +  variable option_class {}
          982  +  variable core_classes {::oo::class ::oo::object}
          983  +}
          984  +proc ::clay::dynamic_methods class {
          985  +  foreach command [info commands [namespace current]::dynamic_methods_*] {
          986  +    $command $class
          987  +  }
          988  +}
          989  +proc ::clay::dynamic_methods_class {thisclass} {
          990  +  set methods {}
          991  +  set mdata [$thisclass clay find class_typemethod]
          992  +  foreach {method info} $mdata {
          993  +    if {$method eq {.}} continue
          994  +    set method [string trimright $method :/-]
          995  +    if {$method in $methods} continue
          996  +    lappend methods $method
          997  +    set arglist [dict getnull $info arglist]
          998  +    set body    [dict getnull $info body]
          999  +    ::oo::objdefine $thisclass method $method $arglist $body
         1000  +  }
         1001  +}
         1002  +proc ::clay::define::Array {name {values {}}} {
         1003  +  set class [current_class]
         1004  +  set name [string trim $name :/]
         1005  +  $class clay branch array $name
         1006  +  dict for {var val} $values {
         1007  +    $class clay set array/ $name $var $val
         1008  +  }
         1009  +}
         1010  +proc ::clay::define::Delegate {name info} {
         1011  +  set class [current_class]
         1012  +  foreach {field value} $info {
         1013  +    $class clay set component/ [string trim $name :/]/ $field $value
         1014  +  }
         1015  +}
         1016  +proc ::clay::define::constructor {arglist rawbody} {
         1017  +  set body {
         1018  +my variable DestroyEvent
         1019  +set DestroyEvent 0
         1020  +::clay::object_create [self] [info object class [self]]
         1021  +# Initialize public variables and options
         1022  +my InitializePublic
         1023  +  }
         1024  +  append body $rawbody
         1025  +  set class [current_class]
         1026  +  ::oo::define $class constructor $arglist $body
         1027  +}
         1028  +proc ::clay::define::class_method {name arglist body} {
         1029  +  set class [current_class]
         1030  +  $class clay set class_typemethod/ [string trim $name :/] [dict create arglist $arglist body $body]
         1031  +}
         1032  +proc ::clay::define::clay {args} {
         1033  +  set class [current_class]
         1034  +  if {[lindex $args 0] in "cget set branch"} {
         1035  +    $class clay {*}$args
         1036  +  } else {
         1037  +    $class clay set {*}$args
         1038  +  }
         1039  +}
         1040  +proc ::clay::define::destructor rawbody {
         1041  +  set body {
         1042  +# Run the destructor once and only once
         1043  +set self [self]
         1044  +my variable DestroyEvent
         1045  +if {$DestroyEvent} return
         1046  +set DestroyEvent 1
         1047  +::clay::object_destroy $self
         1048  +}
         1049  +  append body $rawbody
         1050  +  ::oo::define [current_class] destructor $body
         1051  +}
         1052  +proc ::clay::define::Dict {name {values {}}} {
         1053  +  set class [current_class]
         1054  +  set name [string trim $name :/]
         1055  +  $class clay branch dict $name
         1056  +  foreach {var val} $values {
         1057  +    $class clay set dict/ $name/ $var $val
         1058  +  }
         1059  +}
         1060  +proc ::clay::define::Option {name args} {
         1061  +  set class [current_class]
         1062  +  set dictargs {default {}}
         1063  +  foreach {var val} [::clay::args_to_dict {*}$args] {
         1064  +    dict set dictargs [string trim $var -:/] $val
         1065  +  }
         1066  +  set name [string trimleft $name -]
         1067  +
         1068  +  ###
         1069  +  # Option Class handling
         1070  +  ###
         1071  +  set optclass [dict getnull $dictargs class]
         1072  +  if {$optclass ne {}} {
         1073  +    foreach {f v} [$class clay find option_class $optclass] {
         1074  +      if {![dict exists $dictargs $f]} {
         1075  +        dict set dictargs $f $v
         1076  +      }
         1077  +    }
         1078  +    if {$optclass eq "variable"} {
         1079  +      variable $name [dict getnull $dictargs default]
         1080  +    }
         1081  +  }
         1082  +  foreach {f v} $dictargs {
         1083  +    $class clay set option $name $f $v
         1084  +  }
         1085  +}
         1086  +proc ::clay::define::Option_Class {name args} {
         1087  +  set class [current_class]
         1088  +  set dictargs {default {}}
         1089  +  set name [string trimleft $name -:]
         1090  +  foreach {f v} [::clay::args_to_dict {*}$args] {
         1091  +    $class clay set option_class $name [string trim $f -/:] $v
         1092  +  }
         1093  +}
         1094  +proc ::clay::define::Variable {name {default {}}} {
         1095  +  set class [current_class]
         1096  +  set name [string trimright $name :/]
         1097  +  $class clay set variable/ $name $default
         1098  +}
         1099  +proc ::clay::object_create {objname {class {}}} {
         1100  +  #if {$::clay::trace>0} {
         1101  +  #  puts [list $objname CREATE]
         1102  +  #}
         1103  +}
         1104  +proc ::clay::object_rename {object newname} {
         1105  +  if {$::clay::trace>0} {
         1106  +    puts [list $object RENAME -> $newname]
         1107  +  }
         1108  +}
         1109  +proc ::clay::object_destroy objname {
         1110  +  if {$::clay::trace>0} {
         1111  +    puts [list $objname DESTROY]
         1112  +  }
         1113  +  ::cron::object_destroy $objname
         1114  +}
         1115  +::namespace eval ::clay::define {
         1116  +}
         1117  +proc ::clay::ensemble_methodbody {ensemble einfo} {
         1118  +  set default standard
         1119  +  set preamble {}
         1120  +  set eswitch {}
         1121  +  if {[dict exists $einfo default]} {
         1122  +    set emethodinfo [dict get $einfo default]
         1123  +    set arglist     [dict getnull $emethodinfo arglist]
         1124  +    set realbody    [dict get $emethodinfo body]
         1125  +    if {[llength $arglist]==1 && [lindex $arglist 0] in {{} args arglist}} {
         1126  +      set body {}
         1127  +    } else {
         1128  +      set body "\n      ::clay::dynamic_arguments $ensemble \$method [list $arglist] {*}\$args"
         1129  +    }
         1130  +    append body "\n      " [string trim $realbody] "      \n"
         1131  +    set default $body
         1132  +    dict unset einfo default
         1133  +  }
         1134  +  foreach {msubmethod esubmethodinfo} [lsort -dictionary -stride 2 $einfo] {
         1135  +    set submethod [string trim $msubmethod :/-]
         1136  +    if {$submethod eq "_body"} continue
         1137  +    if {$submethod eq "_preamble"} {
         1138  +      set preamble [dict getnull $esubmethodinfo body]
         1139  +      continue
         1140  +    }
         1141  +    set arglist     [dict getnull $esubmethodinfo arglist]
         1142  +    set realbody    [dict getnull $esubmethodinfo body]
         1143  +    if {[string length [string trim $realbody]] eq {}} {
         1144  +      dict set eswitch $submethod {}
         1145  +    } else {
         1146  +      if {[llength $arglist]==1 && [lindex $arglist 0] in {{} args arglist}} {
         1147  +        set body {}
         1148  +      } else {
         1149  +        set body "\n      ::clay::dynamic_arguments $ensemble \$method [list $arglist] {*}\$args"
         1150  +      }
         1151  +      append body "\n      " [string trim $realbody] "      \n"
         1152  +      if {$submethod eq "default"} {
         1153  +        set default $body
         1154  +      } else {
         1155  +        foreach alias [dict getnull $esubmethodinfo aliases] {
         1156  +          dict set eswitch $alias -
         1157  +        }
         1158  +        dict set eswitch $submethod $body
         1159  +      }
         1160  +    }
         1161  +  }
         1162  +  set methodlist [lsort -dictionary [dict keys $eswitch]]
         1163  +  if {![dict exists $eswitch <list>]} {
         1164  +    dict set eswitch <list> {return $methodlist}
         1165  +  }
         1166  +  if {$default eq "standard"} {
         1167  +    set default "error \"unknown method $ensemble \$method. Valid: \$methodlist\""
         1168  +  }
         1169  +  dict set eswitch default $default
         1170  +  set mbody {}
         1171  +
         1172  +  append mbody $preamble \n
         1173  +
         1174  +  append mbody \n [list set methodlist $methodlist]
         1175  +  append mbody \n "set code \[catch {switch -- \$method [list $eswitch]} result opts\]"
         1176  +  append mbody \n {return -options $opts $result}
         1177  +  return $mbody
         1178  +}
         1179  +::proc ::clay::define::Ensemble {rawmethod arglist body} {
         1180  +  set class [current_class]
         1181  +  #if {$::clay::trace>2} {
         1182  +  #  puts [list $class Ensemble $rawmethod $arglist $body]
         1183  +  #}
         1184  +  set mlist [split $rawmethod "::"]
         1185  +  set ensemble [string trim [lindex $mlist 0] :/]
         1186  +  set mensemble ${ensemble}/
         1187  +  if {[llength $mlist]==1 || [lindex $mlist 1] in "_body"} {
         1188  +    set method _body
         1189  +    ###
         1190  +    # Simple method, needs no parsing, but we do need to record we have one
         1191  +    ###
         1192  +    $class clay set method_ensemble/ $mensemble _body [dict create arglist $arglist body $body]
         1193  +    if {$::clay::trace>2} {
         1194  +      puts [list $class clay set method_ensemble/ $mensemble _body ...]
         1195  +    }
         1196  +    set method $rawmethod
         1197  +    if {$::clay::trace>2} {
         1198  +      puts [list $class Ensemble $rawmethod $arglist $body]
         1199  +      set rawbody $body
         1200  +      set body {puts [list [self] $class [self method]]}
         1201  +      append body \n $rawbody
         1202  +    }
         1203  +    ::oo::define $class method $rawmethod $arglist $body
         1204  +    return
         1205  +  }
         1206  +  set method [join [lrange $mlist 2 end] "::"]
         1207  +  $class clay set method_ensemble/ $mensemble [string trim [lindex $method 0] :/] [dict create arglist $arglist body $body]
         1208  +  if {$::clay::trace>2} {
         1209  +    puts [list $class clay set method_ensemble/ $mensemble [string trim $method :/]  ...]
         1210  +  }
         1211  +}
         1212  +::oo::define ::clay::class {
         1213  +  method clay {submethod args} {
         1214  +    my variable clay
         1215  +    if {![info exists clay]} {
         1216  +      set clay {}
         1217  +    }
         1218  +    switch $submethod {
         1219  +      ancestors {
         1220  +        tailcall ::clay::ancestors [self]
         1221  +      }
         1222  +      branch {
         1223  +        set path [::dicttool::storage $args]
         1224  +        if {![dict exists $clay {*}$path .]} {
         1225  +          dict set clay {*}$path . {}
         1226  +        }
         1227  +      }
         1228  +      exists {
         1229  +        if {![info exists clay]} {
         1230  +          return 0
         1231  +        }
         1232  +        set path [::dicttool::storage $args]
         1233  +        if {[dict exists $clay {*}$path]} {
         1234  +          return 1
         1235  +        }
         1236  +        if {[dict exists $clay {*}[lrange $path 0 end-1] [lindex $path end]:]} {
         1237  +          return 1
         1238  +        }
         1239  +        return 0
         1240  +      }
         1241  +      dump {
         1242  +        return $clay
         1243  +      }
         1244  +      dget {
         1245  +         if {![info exists clay]} {
         1246  +          return {}
         1247  +        }
         1248  +        set path [::dicttool::storage $args]
         1249  +        if {[dict exists $clay {*}$path]} {
         1250  +          return [dict get $clay {*}$path]
         1251  +        }
         1252  +        if {[dict exists $clay {*}[lrange $path 0 end-1] [lindex $path end]:]} {
         1253  +          return [dict get $clay {*}[lrange $path 0 end-1] [lindex $path end]:]
         1254  +        }
         1255  +        return {}
         1256  +      }
         1257  +      is_branch {
         1258  +        set path [::dicttool::storage $args]
         1259  +        return [dict exists $clay {*}$path .]
         1260  +      }
         1261  +      getnull -
         1262  +      get {
         1263  +        if {![info exists clay]} {
         1264  +          return {}
         1265  +        }
         1266  +        set path [::dicttool::storage $args]
         1267  +        if {[llength $path]==0} {
         1268  +          return $clay
         1269  +        }
         1270  +        if {[dict exists $clay {*}$path .]} {
         1271  +          return [::dicttool::sanitize [dict get $clay {*}$path]]
         1272  +        }
         1273  +        if {[dict exists $clay {*}$path]} {
         1274  +          return [dict get $clay {*}$path]
         1275  +        }
         1276  +        if {[dict exists $clay {*}[lrange $path 0 end-1] [lindex $path end]:]} {
         1277  +          return [dict get $clay {*}[lrange $path 0 end-1] [lindex $path end]:]
         1278  +        }
         1279  +        return {}
         1280  +      }
         1281  +      find {
         1282  +        set path [::dicttool::storage $args]
         1283  +        if {![info exists clay]} {
         1284  +          set clay {}
         1285  +        }
         1286  +        set clayorder [::clay::ancestors [self]]
         1287  +        set found 0
         1288  +        if {[llength $path]==0} {
         1289  +          set result [dict create . {}]
         1290  +          foreach class $clayorder {
         1291  +            ::dicttool::dictmerge result [$class clay dump]
         1292  +          }
         1293  +          return [::dicttool::sanitize $result]
         1294  +        }
         1295  +        foreach class $clayorder {
         1296  +          if {[$class clay exists {*}$path .]} {
         1297  +            # Found a branch break
         1298  +            set found 1
         1299  +            break
         1300  +          }
         1301  +          if {[$class clay exists {*}$path]} {
         1302  +            # Found a leaf. Return that value immediately
         1303  +            return [$class clay get {*}$path]
         1304  +          }
         1305  +          if {[dict exists $clay {*}[lrange $path 0 end-1] [lindex $path end]:]} {
         1306  +            return [dict get $clay {*}[lrange $path 0 end-1] [lindex $path end]:]
         1307  +          }
         1308  +        }
         1309  +        if {!$found} {
         1310  +          return {}
         1311  +        }
         1312  +        set result {}
         1313  +        # Leaf searches return one data field at a time
         1314  +        # Search in our local dict
         1315  +        # Search in the in our list of classes for an answer
         1316  +        foreach class [lreverse $clayorder] {
         1317  +          ::dicttool::dictmerge result [$class clay dget {*}$path]
         1318  +        }
         1319  +        return [::dicttool::sanitize $result]
         1320  +      }
         1321  +      merge {
         1322  +        foreach arg $args {
         1323  +          ::dicttool::dictmerge clay {*}$arg
         1324  +        }
         1325  +      }
         1326  +      noop {
         1327  +        # Do nothing. Used as a sign of clay savviness
         1328  +      }
         1329  +      search {
         1330  +        foreach aclass [::clay::ancestors [self]] {
         1331  +          if {[$aclass clay exists {*}$args]} {
         1332  +            return [$aclass clay get {*}$args]
         1333  +          }
         1334  +        }
         1335  +      }
         1336  +      set {
         1337  +        ::dicttool::dictset clay {*}$args
         1338  +      }
         1339  +      unset {
         1340  +        dict unset clay {*}$args
         1341  +      }
         1342  +      default {
         1343  +        dict $submethod clay {*}$args
         1344  +      }
         1345  +    }
         1346  +  }
         1347  +}
         1348  +::oo::define ::clay::object {
         1349  +  method clay {submethod args} {
         1350  +    my variable clay claycache clayorder config option_canonical
         1351  +    if {![info exists clay]} {set clay {}}
         1352  +    if {![info exists claycache]} {set claycache {}}
         1353  +    if {![info exists config]} {set config {}}
         1354  +    if {![info exists clayorder] || [llength $clayorder]==0} {
         1355  +      set clayorder [::clay::ancestors [info object class [self]] {*}[info object mixins [self]]]
         1356  +    }
         1357  +    switch $submethod {
         1358  +      ancestors {
         1359  +        return $clayorder
         1360  +      }
         1361  +      branch {
         1362  +        set path [::dicttool::storage $args]
         1363  +        if {![dict exists $clay {*}$path .]} {
         1364  +          dict set clay {*}$path . {}
         1365  +        }
         1366  +      }
         1367  +      cget {
         1368  +        # Leaf searches return one data field at a time
         1369  +        # Search in our local dict
         1370  +        if {[llength $args]==1} {
         1371  +          set field [string trim [lindex $args 0] -:/]
         1372  +          if {[info exists option_canonical($field)]} {
         1373  +            set field $option_canonical($field)
         1374  +          }
         1375  +          if {[dict exists $config $field]} {
         1376  +            return [dict get $config $field]
         1377  +          }
         1378  +        }
         1379  +        set path [::dicttool::storage $args]
         1380  +        if {[dict exists $clay {*}$path]} {
         1381  +          return [dict get $clay {*}$path]
         1382  +        }
         1383  +        # Search in our local cache
         1384  +        if {[dict exists $claycache {*}$path]} {
         1385  +          if {[dict exists $claycache {*}$path .]} {
         1386  +            return [dict remove [dict get $claycache {*}$path] .]
         1387  +          } else {
         1388  +            return [dict get $claycache {*}$path]
         1389  +          }
         1390  +        }
         1391  +        # Search in the in our list of classes for an answer
         1392  +        foreach class $clayorder {
         1393  +          if {[$class clay exists {*}$path]} {
         1394  +            set value [$class clay get {*}$path]
         1395  +            dict set claycache {*}$path $value
         1396  +            return $value
         1397  +          }
         1398  +          if {[$class clay exists const {*}$path]} {
         1399  +            set value [$class clay get const {*}$path]
         1400  +            dict set claycache {*}$path $value
         1401  +            return $value
         1402  +          }
         1403  +          if {[$class clay exists option {*}$path default]} {
         1404  +            set value [$class clay get option {*}$path default]
         1405  +            dict set claycache {*}$path $value
         1406  +            return $value
         1407  +          }
         1408  +        }
         1409  +        return {}
         1410  +      }
         1411  +      delegate {
         1412  +        if {![dict exists $clay .delegate <class>]} {
         1413  +          dict set clay .delegate <class> [info object class [self]]
         1414  +        }
         1415  +        if {[llength $args]==0} {
         1416  +          return [dict get $clay .delegate]
         1417  +        }
         1418  +        if {[llength $args]==1} {
         1419  +          set stub <[string trim [lindex $args 0] <>]>
         1420  +          if {![dict exists $clay .delegate $stub]} {
         1421  +            return {}
         1422  +          }
         1423  +          return [dict get $clay .delegate $stub]
         1424  +        }
         1425  +        if {([llength $args] % 2)} {
         1426  +          error "Usage: delegate
         1427  +    OR
         1428  +    delegate stub
         1429  +    OR
         1430  +    delegate stub OBJECT ?stub OBJECT? ..."
         1431  +        }
         1432  +        foreach {stub object} $args {
         1433  +          set stub <[string trim $stub <>]>
         1434  +          dict set clay .delegate $stub $object
         1435  +          oo::objdefine [self] forward ${stub} $object
         1436  +          oo::objdefine [self] export ${stub}
         1437  +        }
         1438  +      }
         1439  +      dump {
         1440  +        # Do a full dump of clay data
         1441  +        set result {}
         1442  +        # Search in the in our list of classes for an answer
         1443  +        foreach class $clayorder {
         1444  +          ::dicttool::dictmerge result [$class clay dump]
         1445  +        }
         1446  +        ::dicttool::dictmerge result $clay
         1447  +        return $result
         1448  +      }
         1449  +      ensemble_map {
         1450  +        set ensemble [lindex $args 0]
         1451  +        my variable claycache
         1452  +        set mensemble [string trim $ensemble :/]
         1453  +        if {[dict exists $claycache method_ensemble $mensemble]} {
         1454  +          return [dicttool::sanitize [dict get $claycache method_ensemble $mensemble]]
         1455  +        }
         1456  +        set emap [my clay dget method_ensemble $mensemble]
         1457  +        dict set claycache method_ensemble $mensemble $emap
         1458  +        return [dicttool::sanitize $emap]
         1459  +      }
         1460  +      eval {
         1461  +        set script [lindex $args 0]
         1462  +        set buffer {}
         1463  +        set thisline {}
         1464  +        foreach line [split $script \n] {
         1465  +          append thisline $line
         1466  +          if {![info complete $thisline]} {
         1467  +            append thisline \n
         1468  +            continue
         1469  +          }
         1470  +          set thisline [string trim $thisline]
         1471  +          if {[string index $thisline 0] eq "#"} continue
         1472  +          if {[string length $thisline]==0} continue
         1473  +          if {[lindex $thisline 0] eq "my"} {
         1474  +            # Line already calls out "my", accept verbatim
         1475  +            append buffer $thisline \n
         1476  +          } elseif {[string range $thisline 0 2] eq "::"} {
         1477  +            # Fully qualified commands accepted verbatim
         1478  +            append buffer $thisline \n
         1479  +          } elseif {
         1480  +            append buffer "my $thisline" \n
         1481  +          }
         1482  +          set thisline {}
         1483  +        }
         1484  +        eval $buffer
         1485  +      }
         1486  +      evolve -
         1487  +      initialize {
         1488  +        my InitializePublic
         1489  +      }
         1490  +      exists {
         1491  +        # Leaf searches return one data field at a time
         1492  +        # Search in our local dict
         1493  +        set path [::dicttool::storage $args]
         1494  +        if {[dict exists $clay {*}$path]} {
         1495  +          return 1
         1496  +        }
         1497  +        # Search in our local cache
         1498  +        if {[dict exists $claycache {*}$path]} {
         1499  +          return 2
         1500  +        }
         1501  +        set count 2
         1502  +        # Search in the in our list of classes for an answer
         1503  +        foreach class $clayorder {
         1504  +          incr count
         1505  +          if {[$class clay exists {*}$path]} {
         1506  +            return $count
         1507  +          }
         1508  +        }
         1509  +        return 0
         1510  +      }
         1511  +      flush {
         1512  +        set claycache {}
         1513  +        set clayorder [::clay::ancestors [info object class [self]] {*}[info object mixins [self]]]
         1514  +      }
         1515  +      forward {
         1516  +        oo::objdefine [self] forward {*}$args
         1517  +      }
         1518  +      dget {
         1519  +        # Search in our local cache
         1520  +        set path [::dicttool::storage $args]
         1521  +        if {[llength $path]==0} {
         1522  +          # Do a full dump of clay data
         1523  +          set result {}
         1524  +          # Search in the in our list of classes for an answer
         1525  +          foreach class $clayorder {
         1526  +            ::dicttool::dictmerge result [$class clay dump]
         1527  +          }
         1528  +          ::dicttool::dictmerge result $clay
         1529  +          return $result
         1530  +        }
         1531  +        #if {[dict exists $claycache {*}$path]} {
         1532  +        #  return [dict get $claycache {*}$path]
         1533  +        #}
         1534  +        if {[dict exists $clay {*}$path .]} {
         1535  +          # Path is a branch
         1536  +          set result {}
         1537  +          foreach class [lreverse $clayorder] {
         1538  +            if {[$class clay exists {*}$path .]} {
         1539  +              set value [$class clay dget {*}$path]
         1540  +              ::dicttool::dictmerge result $value
         1541  +            }
         1542  +          }
         1543  +          ::dicttool::dictmerge result [dict get $clay {*}$path]
         1544  +          dict set claycache {*}$path $result
         1545  +          return $result
         1546  +        } elseif {[dict exists $clay {*}$path]} {
         1547  +          # Path is a leaf
         1548  +          return [dict get $clay {*}$path]
         1549  +        }
         1550  +        # Search in the in our list of classes for an answer
         1551  +        set found 0
         1552  +        foreach class $clayorder {
         1553  +          if {[$class clay exists {*}$path .]} {
         1554  +            set found 1
         1555  +            break
         1556  +          }
         1557  +          if {[$class clay exists {*}$path]} {
         1558  +            # Found a leaf.
         1559  +            set result [$class clay get {*}$path]
         1560  +            dict set claycache {*}$path $result
         1561  +            return $result
         1562  +          }
         1563  +        }
         1564  +        set result {}
         1565  +        if {$found} {
         1566  +          # One of our ancestors has this as a branch
         1567  +          # Do a recursive merge across all classes
         1568  +          foreach class [lreverse $clayorder] {
         1569  +            if {[$class clay exists {*}$path .]} {
         1570  +              set value [$class clay dget {*}$path]
         1571  +              ::dicttool::dictmerge result $value
         1572  +            }
         1573  +          }
         1574  +        }
         1575  +        dict set claycache {*}$path $result
         1576  +        return $result
         1577  +      }
         1578  +      getnull -
         1579  +      get {
         1580  +        set path [::dicttool::storage $args]
         1581  +        if {[llength $path]==0} {
         1582  +          # Do a full dump of clay data
         1583  +          set result {}
         1584  +          # Search in the in our list of classes for an answer
         1585  +          foreach class $clayorder {
         1586  +            ::dicttool::dictmerge result [$class clay dump]
         1587  +          }
         1588  +          ::dicttool::dictmerge result $clay
         1589  +          return [::dicttool::sanitize $result]
         1590  +        }
         1591  +        if {[dict exists $claycache {*}$path .]} {
         1592  +          return [::dicttool::sanitize [dict get $claycache {*}$path]]
         1593  +        }
         1594  +        if {[dict exists $claycache {*}$path]} {
         1595  +          return [dict get $claycache {*}$path]
         1596  +        }
         1597  +        if {[dict exists $clay {*}$path] && ![dict exists $clay {*}$path .]} {
         1598  +          # Path is a leaf
         1599  +          return [dict get $clay {*}$path]
         1600  +        }
         1601  +        set found 0
         1602  +        set branch [dict exists $clay {*}$path .]
         1603  +        foreach class $clayorder {
         1604  +          if {[$class clay exists {*}$path .]} {
         1605  +            set found 1
         1606  +            break
         1607  +          }
         1608  +          if {!$branch && [$class clay exists {*}$path]} {
         1609  +            set result [$class clay dget {*}$path]
         1610  +            dict set claycache {*}$path $result
         1611  +            return $result
         1612  +          }
         1613  +        }
         1614  +        # Path is a branch
         1615  +        set result {}
         1616  +        foreach class [lreverse $clayorder] {
         1617  +          if {[$class clay exists {*}$path .]} {
         1618  +            set value [$class clay dget {*}$path]
         1619  +            ::dicttool::dictmerge result $value
         1620  +          }
         1621  +        }
         1622  +        if {[dict exists $clay {*}$path .]} {
         1623  +          ::dicttool::dictmerge result [dict get $clay {*}$path]
         1624  +        }
         1625  +        dict set claycache {*}$path $result
         1626  +        return [dicttool::sanitize $result]
         1627  +      }
         1628  +      leaf {
         1629  +        # Leaf searches return one data field at a time
         1630  +        # Search in our local dict
         1631  +        set path [::dicttool::storage $args]
         1632  +        if {[dict exists $clay {*}$path .]} {
         1633  +          return [dicttool::sanitize [dict get $clay {*}$path]]
         1634  +        }
         1635  +        if {[dict exists $clay {*}$path]} {
         1636  +          return [dict get $clay {*}$path]
         1637  +        }
         1638  +        # Search in our local cache
         1639  +        if {[dict exists $claycache {*}$path .]} {
         1640  +          return [dicttool::sanitize [dict get $claycache {*}$path]]
         1641  +        }
         1642  +        if {[dict exists $claycache {*}$path]} {
         1643  +          return [dict get $claycache {*}$path]
         1644  +        }
         1645  +        # Search in the in our list of classes for an answer
         1646  +        foreach class $clayorder {
         1647  +          if {[$class clay exists {*}$path]} {
         1648  +            set value [$class clay get {*}$path]
         1649  +            dict set claycache {*}$path $value
         1650  +            return $value
         1651  +          }
         1652  +        }
         1653  +      }
         1654  +      merge {
         1655  +        foreach arg $args {
         1656  +          ::dicttool::dictmerge clay {*}$arg
         1657  +        }
         1658  +      }
         1659  +      mixin {
         1660  +        ###
         1661  +        # Mix in the class
         1662  +        ###
         1663  +        set prior  [info object mixins [self]]
         1664  +        set newmixin {}
         1665  +        foreach item $args {
         1666  +          lappend newmixin ::[string trimleft $item :]
         1667  +        }
         1668  +        set newmap $args
         1669  +        foreach class $prior {
         1670  +          if {$class ni $newmixin} {
         1671  +            set script [$class clay search mixin/ unmap-script]
         1672  +            if {[string length $script]} {
         1673  +              if {[catch $script err errdat]} {
         1674  +                puts stderr "[self] MIXIN ERROR POPPING $class:\n[dict get $errdat -errorinfo]"
         1675  +              }
         1676  +            }
         1677  +          }
         1678  +        }
         1679  +        ::oo::objdefine [self] mixin {*}$args
         1680  +        ###
         1681  +        # Build a compsite map of all ensembles defined by the object's current
         1682  +        # class as well as all of the classes being mixed in
         1683  +        ###
         1684  +        my InitializePublic
         1685  +        foreach class $newmixin {
         1686  +          if {$class ni $prior} {
         1687  +            set script [$class clay search mixin/ map-script]
         1688  +            if {[string length $script]} {
         1689  +              if {[catch $script err errdat]} {
         1690  +                puts stderr "[self] MIXIN ERROR PUSHING $class:\n[dict get $errdat -errorinfo]"
         1691  +              }
         1692  +            }
         1693  +          }
         1694  +        }
         1695  +        foreach class $newmixin {
         1696  +          set script [$class clay search mixin/ react-script]
         1697  +          if {[string length $script]} {
         1698  +            if {[catch $script err errdat]} {
         1699  +              puts stderr "[self] MIXIN ERROR PEEKING $class:\n[dict get $errdat -errorinfo]"
         1700  +            }
         1701  +            break
         1702  +          }
         1703  +        }
         1704  +      }
         1705  +      mixinmap {
         1706  +        my variable clay
         1707  +        if {![dict exists $clay .mixin]} {
         1708  +          dict set clay .mixin {}
         1709  +        }
         1710  +        if {[llength $args]==0} {
         1711  +          return [dict get $clay .mixin]
         1712  +        } elseif {[llength $args]==1} {
         1713  +          return [dict getnull $clay .mixin [lindex $args 0]]
         1714  +        } else {
         1715  +          foreach {slot classes} $args {
         1716  +            dict set clay .mixin $slot $classes
         1717  +          }
         1718  +          set claycache {}
         1719  +          set classlist {}
         1720  +          foreach {item class} [dict get $clay .mixin] {
         1721  +            if {$class ne {}} {
         1722  +              lappend classlist $class
         1723  +            }
         1724  +          }
         1725  +          my clay mixin {*}[lreverse $classlist]
         1726  +        }
         1727  +      }
         1728  +      provenance {
         1729  +        if {[dict exists $clay {*}$args]} {
         1730  +          return self
         1731  +        }
         1732  +        foreach class $clayorder {
         1733  +          if {[$class clay exists {*}$args]} {
         1734  +            return $class
         1735  +          }
         1736  +        }
         1737  +        return {}
         1738  +      }
         1739  +      replace {
         1740  +        set clay [lindex $args 0]
         1741  +      }
         1742  +      source {
         1743  +        source [lindex $args 0]
         1744  +      }
         1745  +      set {
         1746  +        #puts [list [self] clay SET {*}$args]
         1747  +        set claycache {}
         1748  +        ::dicttool::dictset clay {*}$args
         1749  +      }
         1750  +      default {
         1751  +        dict $submethod clay {*}$args
         1752  +      }
         1753  +    }
         1754  +  }
         1755  +  method InitializePublic {} {
         1756  +    my variable clayorder clay claycache config option_canonical
         1757  +    set claycache {}
         1758  +    set clayorder [::clay::ancestors [info object class [self]] {*}[info object mixins [self]]]
         1759  +    if {![info exists clay]} {
         1760  +      set clay {}
         1761  +    }
         1762  +    if {![info exists config]} {
         1763  +      set config {}
         1764  +    }
         1765  +    dict for {var value} [my clay get variable] {
         1766  +      if { $var in {. clay} } continue
         1767  +      set var [string trim $var :/]
         1768  +      my variable $var
         1769  +      if {![info exists $var]} {
         1770  +        if {$::clay::trace>2} {puts [list initialize variable $var $value]}
         1771  +        set $var $value
         1772  +      }
         1773  +    }
         1774  +    dict for {var value} [my clay get dict/] {
         1775  +      if { $var in {. clay} } continue
         1776  +      set var [string trim $var :/]
         1777  +      my variable $var
         1778  +      if {![info exists $var]} {
         1779  +        set $var {}
         1780  +      }
         1781  +      foreach {f v} $value {
         1782  +        if {$f eq "."} continue
         1783  +        if {![dict exists ${var} $f]} {
         1784  +          if {$::clay::trace>2} {puts [list initialize dict $var $f $v]}
         1785  +          dict set ${var} $f $v
         1786  +        }
         1787  +      }
         1788  +    }
         1789  +    foreach {var value} [my clay get array/] {
         1790  +      if { $var in {. clay} } continue
         1791  +      set var [string trim $var :/]
         1792  +      if { $var eq {clay} } continue
         1793  +      my variable $var
         1794  +      if {![info exists $var]} { array set $var {} }
         1795  +      foreach {f v} $value {
         1796  +        if {![array exists ${var}($f)]} {
         1797  +          if {$f eq "."} continue
         1798  +          if {$::clay::trace>2} {puts [list initialize array $var\($f\) $v]}
         1799  +          set ${var}($f) $v
         1800  +        }
         1801  +      }
         1802  +    }
         1803  +    foreach {field info} [my clay get option/] {
         1804  +      if { $field in {. clay} } continue
         1805  +      set field [string trim $field -/:]
         1806  +      foreach alias [dict getnull $info aliases] {
         1807  +        set option_canonical($alias) $field
         1808  +      }
         1809  +      if {[dict exists $config $field]} continue
         1810  +      set getcmd [dict getnull $info default-command]
         1811  +      if {$getcmd ne {}} {
         1812  +        set value [{*}[string map [list %field% $field %self% [namespace which my]] $getcmd]]
         1813  +      } else {
         1814  +        set value [dict getnull $info default]
         1815  +      }
         1816  +      dict set config $field $value
         1817  +      set setcmd [dict getnull $info set-command]
         1818  +      if {$setcmd ne {}} {
         1819  +        {*}[string map [list %field% [list $field] %value% [list $value] %self% [namespace which my]] $setcmd]
         1820  +      }
         1821  +    }
         1822  +    my variable clayorder clay claycache
         1823  +    if {[info exists clay]} {
         1824  +      set emap [dict getnull $clay method_ensemble]
         1825  +    } else {
         1826  +      set emap {}
         1827  +    }
         1828  +    foreach class [lreverse $clayorder] {
         1829  +      ###
         1830  +      # Build a compsite map of all ensembles defined by the object's current
         1831  +      # class as well as all of the classes being mixed in
         1832  +      ###
         1833  +      dict for {mensemble einfo} [$class clay get method_ensemble] {
         1834  +        if {$mensemble eq {.}} continue
         1835  +        set ensemble [string trim $mensemble :/]
         1836  +        if {$::clay::trace>2} {puts [list Defining $ensemble from $class]}
         1837  +
         1838  +        dict for {method info} $einfo {
         1839  +          if {$method eq {.}} continue
         1840  +          if {![dict is_dict $info]} {
         1841  +            puts [list WARNING: class: $class method: $method not dict: $info]
         1842  +            continue
         1843  +          }
         1844  +          dict set info source $class
         1845  +          if {$::clay::trace>2} {puts [list Defining $ensemble -> $method from $class - $info]}
         1846  +          dict set emap $ensemble $method $info
         1847  +        }
         1848  +      }
         1849  +    }
         1850  +    foreach {ensemble einfo} $emap {
         1851  +      #if {[dict exists $einfo _body]} continue
         1852  +      set body [::clay::ensemble_methodbody $ensemble $einfo]
         1853  +      if {$::clay::trace>2} {
         1854  +        set rawbody $body
         1855  +        set body {puts [list [self] <object> [self method]]}
         1856  +        append body \n $rawbody
         1857  +      }
         1858  +      oo::objdefine [self] method $ensemble {{method default} args} $body
         1859  +    }
         1860  +  }
         1861  +}
         1862  +::clay::object clay branch array
         1863  +::clay::object clay branch mixin
         1864  +::clay::object clay branch option
         1865  +::clay::object clay branch dict clay
         1866  +::clay::object clay set variable DestroyEvent 0
         1867  +namespace eval ::clay {
         1868  +  namespace export *
         1869  +}
         1870  +
         1871  +###
         1872  +# END: clay/clay.tcl
         1873  +###
         1874  +###
         1875  +# START: setup.tcl
         1876  +###
         1877  +package require TclOO
         1878  +set tcllib_path {}
         1879  +foreach path {.. ../.. ../../..} {
         1880  +  foreach path [glob -nocomplain [file join [file normalize $path] tcllib* modules]] {
         1881  +    set tclib_path $path
         1882  +    lappend ::auto_path $path
         1883  +    break
         1884  +  }
         1885  +  if {$tcllib_path ne {}} break
         1886  +}
         1887  +namespace eval ::practcl {
         1888  +}
         1889  +namespace eval ::practcl::OBJECT {
         1890  +}
         1891  +
         1892  +###
         1893  +# END: setup.tcl
         1894  +###
         1895  +###
         1896  +# START: doctool.tcl
         1897  +###
         1898  +namespace eval ::practcl {
         1899  +}
         1900  +proc ::practcl::cat fname {
         1901  +    if {![file exists $fname]} {
         1902  +       return
         1903  +    }
         1904  +    set fin [open $fname r]
         1905  +    set data [read $fin]
         1906  +    close $fin
         1907  +    return $data
         1908  +}
         1909  +proc ::practcl::docstrip text {
         1910  +  set result {}
         1911  +  foreach line [split $text \n] {
         1912  +    append thisline $line \n
         1913  +    if {![info complete $thisline]} continue
         1914  +    set outline $thisline
         1915  +    set thisline {}
         1916  +    if {[string trim $outline] eq {}} {
         1917  +      continue
         1918  +    }
         1919  +    if {[string index [string trim $outline] 0] eq "#"} continue
         1920  +    set cmd [string trim [lindex $outline 0] :]
         1921  +    if {$cmd eq "namespace" && [lindex $outline 1] eq "eval"} {
         1922  +      append result [list {*}[lrange $outline 0 end-1]] " " \{ \n [docstrip [lindex $outline end]]\} \n
         1923  +      continue
         1924  +    }
         1925  +    if {[string match "*::define" $cmd] && [llength $outline]==3} {
         1926  +      append result [list {*}[lrange $outline 0 end-1]] " " \{ \n [docstrip [lindex $outline end]]\} \n
         1927  +      continue
         1928  +    }
         1929  +    if {$cmd eq "oo::class" && [lindex $outline 1] eq "create"} {
         1930  +      append result [list {*}[lrange $outline 0 end-1]] " " \{ \n [docstrip [lindex $outline end]]\} \n
         1931  +      continue
         1932  +    }
         1933  +    append result $outline
         1934  +  }
         1935  +  return $result
         1936  +}
         1937  +proc ::putb {buffername args} {
         1938  +  upvar 1 $buffername buffer
         1939  +  switch [llength $args] {
         1940  +    1 {
         1941  +      append buffer [lindex $args 0] \n
         1942  +    }
         1943  +    2 {
         1944  +      append buffer [string map {*}$args] \n
         1945  +    }
         1946  +    default {
         1947  +      error "usage: putb buffername ?map? string"
         1948  +    }
         1949  +  }
         1950  +}
         1951  +::oo::class create ::practcl::doctool {
         1952  +  constructor {} {
         1953  +    my reset
         1954  +  }
         1955  +  method arglist {arglist} {
         1956  +    set result [dict create]
         1957  +    foreach arg $arglist {
         1958  +      set name [lindex $arg 0]
         1959  +      dict set result $name positional 1
         1960  +      dict set result $name mandatory  1
         1961  +      if {$name in {args dictargs}} {
         1962  +        switch [llength $arg] {
         1963  +          1 {
         1964  +            dict set result $name mandatory 0
         1965  +          }
         1966  +          2 {
         1967  +            dict for {optname optinfo} [lindex $arg 1] {
         1968  +              set optname [string trim $optname -:]
         1969  +              dict set result $optname {positional 1 mandatory 0}
         1970  +              dict for {f v} $optinfo {
         1971  +                dict set result $optname [string trim $f -:] $v
         1972  +              }
         1973  +            }
         1974  +          }
         1975  +          default {
         1976  +            error "Bad argument"
         1977  +          }
         1978  +        }
         1979  +      } else {
         1980  +        switch [llength $arg] {
         1981  +          1 {
         1982  +            dict set result $name mandatory 1
         1983  +          }
         1984  +          2 {
         1985  +            dict set result $name mandatory 0
         1986  +            dict set result $name default   [lindex $arg 1]
         1987  +          }
         1988  +          default {
         1989  +            error "Bad argument"
         1990  +          }
         1991  +        }
         1992  +      }
         1993  +    }
         1994  +    return $result
         1995  +  }
         1996  +  method comment block {
         1997  +    set count 0
         1998  +    set field description
         1999  +    set result [dict create description {}]
         2000  +    foreach line [split $block \n] {
         2001  +      set sline [string trim $line]
         2002  +      set fwidx [string first " " $sline]
         2003  +      if {$fwidx < 0} {
         2004  +        set firstword [string range $sline 0 end]
         2005  +        set restline {}
         2006  +      } else {
         2007  +        set firstword [string range $sline 0 [expr {$fwidx-1}]]
         2008  +        set restline [string range $sline [expr {$fwidx+1}] end]
         2009  +      }
         2010  +      if {[string index $firstword end] eq ":"} {
         2011  +        set field [string tolower [string trim $firstword -:]]
         2012  +        switch $field {
         2013  +          desc {
         2014  +            set field description
         2015  +          }
         2016  +        }
         2017  +        if {[string length $restline]} {
         2018  +          dict append result $field "$restline\n"
         2019  +        }
         2020  +      } else {
         2021  +        dict append result $field "$line\n"
         2022  +      }
         2023  +    }
         2024  +    return $result
         2025  +  }
         2026  +  method keyword.Annotation {resultvar commentblock type name body} {
         2027  +    upvar 1 $resultvar result
         2028  +    set name [string trim $name :]
         2029  +    if {[dict exists $result $type $name]} {
         2030  +      set info [dict get $result $type $name]
         2031  +    } else {
         2032  +      set info [my comment $commentblock]
         2033  +    }
         2034  +    foreach {f v} $body {
         2035  +      dict set info $f $v
         2036  +    }
         2037  +    dict set result $type $name $info
         2038  +  }
         2039  +  method keyword.Class {resultvar commentblock name body} {
         2040  +    upvar 1 $resultvar result
         2041  +    set name [string trim $name :]
         2042  +    if {[dict exists $result class $name]} {
         2043  +      set info [dict get $result class $name]
         2044  +    } else {
         2045  +      set info [my comment $commentblock]
         2046  +    }
         2047  +    set commentblock {}
         2048  +    foreach line [split $body \n] {
         2049  +      append thisline $line \n
         2050  +      if {![info complete $thisline]} continue
         2051  +      set thisline [string trim $thisline]
         2052  +      if {[string index $thisline 0] eq "#"} {
         2053  +        append commentblock [string trimleft $thisline #] \n
         2054  +        set thisline {}
         2055  +        continue
         2056  +      }
         2057  +      set cmd [string trim [lindex $thisline 0] ":"]
         2058  +      switch $cmd {
         2059  +        Option -
         2060  +        option {
         2061  +          my keyword.Annotation info $commentblock option [lindex $thisline 1] [lindex $thisline 2]
         2062  +          set commentblock {}
         2063  +        }
         2064  +        variable -
         2065  +        Variable {
         2066  +          my keyword.Annotation info $commentblock variable [lindex $thisline 1] [list type scaler default [lindex $thisline 2]]
         2067  +          set commentblock {}
         2068  +        }
         2069  +        Dict -
         2070  +        Array {
         2071  +          set iinfo [lindex $thisline 2]
         2072  +          dict set iinfo type [string tolower $cmd]
         2073  +          my keyword.Annotation info $commentblock variable [lindex $thisline 1] $iinfo
         2074  +          set commentblock {}
         2075  +        }
         2076  +        Componant -
         2077  +        Delegate {
         2078  +          my keyword.Annotation info $commentblock delegate [lindex $thisline 1] [lindex $thisline 2]
         2079  +          set commentblock {}
         2080  +        }
         2081  +        method -
         2082  +        Ensemble {
         2083  +          my keyword.class_method info $commentblock  {*}[lrange $thisline 1 end-1]
         2084  +          set commentblock {}
         2085  +        }
         2086  +      }
         2087  +      set thisline {}
         2088  +    }
         2089  +    dict set result class $name $info
         2090  +  }
         2091  +  method keyword.class {resultvar commentblock name body} {
         2092  +    upvar 1 $resultvar result
         2093  +    set name [string trim $name :]
         2094  +    if {[dict exists $result class $name]} {
         2095  +      set info [dict get $result class $name]
         2096  +    } else {
         2097  +      set info [my comment $commentblock]
         2098  +    }
         2099  +    set commentblock {}
         2100  +    foreach line [split $body \n] {
         2101  +      append thisline $line \n
         2102  +      if {![info complete $thisline]} continue
         2103  +      set thisline [string trim $thisline]
         2104  +      if {[string index $thisline 0] eq "#"} {
         2105  +        append commentblock [string trimleft $thisline #] \n
         2106  +        set thisline {}
         2107  +        continue
         2108  +      }
         2109  +      set cmd [string trim [lindex $thisline 0] ":"]
         2110  +      switch $cmd {
         2111  +        Option -
         2112  +        option {
         2113  +          puts [list keyword.Annotation $cmd $thisline]
         2114  +          my keyword.Annotation info $commentblock option [lindex $thisline 1] [lindex $thisline 2]
         2115  +          set commentblock {}
         2116  +        }
         2117  +        variable -
         2118  +        Variable {
         2119  +          my keyword.Annotation info $commentblock variable [lindex $thisline 1] [list default [lindex $thisline 2]]
         2120  +          set commentblock {}
         2121  +        }
         2122  +        Dict -
         2123  +        Array {
         2124  +          set iinfo [lindex $thisline 2]
         2125  +          dict set iinfo type [string tolower $cmd]
         2126  +          my keyword.Annotation info $commentblock variable [lindex $thisline 1] $iinfo
         2127  +          set commentblock {}
         2128  +        }
         2129  +        Componant -
         2130  +        Delegate {
         2131  +          my keyword.Annotation info $commentblock delegate [lindex $thisline 1] [lindex $thisline 2]
         2132  +          set commentblock {}
         2133  +        }
         2134  +        superclass {
         2135  +          dict set info ancestors [lrange $thisline 1 end]
         2136  +          set commentblock {}
         2137  +        }
         2138  +        class_method {
         2139  +          my keyword.class_method info $commentblock  {*}[lrange $thisline 1 end-1]
         2140  +          set commentblock {}
         2141  +        }
         2142  +        destructor -
         2143  +        constructor {
         2144  +          my keyword.method info $commentblock {*}[lrange $thisline 0 end-1]
         2145  +          set commentblock {}
         2146  +        }
         2147  +        method -
         2148  +        Ensemble {
         2149  +          my keyword.method info $commentblock  {*}[lrange $thisline 1 end-1]
         2150  +          set commentblock {}
         2151  +        }
         2152  +      }
         2153  +      set thisline {}
         2154  +    }
         2155  +    dict set result class $name $info
         2156  +  }
         2157  +  method keyword.class_method {resultvar commentblock name args} {
         2158  +    upvar 1 $resultvar result
         2159  +    set info [my comment $commentblock]
         2160  +    if {[dict exists $info show_body] && [dict get $info show_body]} {
         2161  +      dict set info internals [lindex $args end]
         2162  +    }
         2163  +    if {[dict exists $info ensemble]} {
         2164  +      dict for {method minfo} [dict get $info ensemble] {
         2165  +        dict set result class_method "${name} $method" $minfo
         2166  +      }
         2167  +    } else {
         2168  +      switch [llength $args] {
         2169  +        1 {
         2170  +          set arglist [lindex $args 0]
         2171  +        }
         2172  +        0 {
         2173  +          set arglist dictargs
         2174  +          #set body [lindex $args 0]
         2175  +        }
         2176  +        default {error "could not interpret method $name {*}$args"}
         2177  +      }
         2178  +      if {![dict exists $info arglist]} {
         2179  +        dict set info arglist [my arglist $arglist]
         2180  +      }
         2181  +      dict set result class_method [string trim $name :] $info
         2182  +    }
         2183  +  }
         2184  +  method keyword.method {resultvar commentblock name args} {
         2185  +    upvar 1 $resultvar result
         2186  +    set info [my comment $commentblock]
         2187  +    if {[dict exists $info show_body] && [dict get $info show_body]} {
         2188  +      dict set info internals [lindex $args end]
         2189  +    }
         2190  +    if {[dict exists $info ensemble]} {
         2191  +      dict for {method minfo} [dict get $info ensemble] {
         2192  +        dict set result method "\"${name} $method\"" $minfo
         2193  +      }
         2194  +    } else {
         2195  +      switch [llength $args] {
         2196  +        1 {
         2197  +          set arglist [lindex $args 0]
         2198  +        }
         2199  +        0 {
         2200  +          set arglist dictargs
         2201  +          #set body [lindex $args 0]
         2202  +        }
         2203  +        default {error "could not interpret method $name {*}$args"}
         2204  +      }
         2205  +      if {![dict exists $info arglist]} {
         2206  +        dict set info arglist [my arglist $arglist]
         2207  +      }
         2208  +      dict set result method "\"[split [string trim $name :] ::]\"" $info
         2209  +    }
         2210  +  }
         2211  +  method keyword.proc {commentblock name arglist} {
         2212  +    set info [my comment $commentblock]
         2213  +    if {![dict exists $info arglist]} {
         2214  +      dict set info arglist [my arglist $arglist]
         2215  +    }
         2216  +    return $info
         2217  +  }
         2218  +  method reset {} {
         2219  +    my variable coro
         2220  +    set coro [info object namespace [self]]::coro
         2221  +    oo::objdefine [self] forward coro $coro
         2222  +    if {[info command $coro] ne {}} {
         2223  +      rename $coro {}
         2224  +    }
         2225  +    coroutine $coro {*}[namespace code {my Main}]
         2226  +  }
         2227  +  method Main {} {
         2228  +
         2229  +    my variable info
         2230  +    set info [dict create]
         2231  +    yield [info coroutine]
         2232  +    set thisline {}
         2233  +    set commentblock {}
         2234  +    set linec 0
         2235  +    while 1 {
         2236  +      set line [yield]
         2237  +      append thisline $line \n
         2238  +      if {![info complete $thisline]} continue
         2239  +      set thisline [string trim $thisline]
         2240  +      if {[string index $thisline 0] eq "#"} {
         2241  +        append commentblock [string trimleft $thisline #] \n
         2242  +        set thisline {}
         2243  +        continue
         2244  +      }
         2245  +      set cmd [string trim [lindex $thisline 0] ":"]
         2246  +      switch $cmd {
         2247  +        dictargs::proc {
         2248  +          set procinfo [my keyword.proc $commentblock [lindex $thisline 1] [list args [list dictargs [lindex $thisline 2]]]]
         2249  +          if {[dict exists $procinfo show_body] && [dict get $procinfo show_body]} {
         2250  +            dict set procinfo internals [lindex $thisline end]
         2251  +          }
         2252  +          dict set info proc [string trim [lindex $thisline 1] :] $procinfo
         2253  +          set commentblock {}
         2254  +        }
         2255  +        tcllib::PROC -
         2256  +        PROC -
         2257  +        Proc -
         2258  +        proc {
         2259  +          set procinfo [my keyword.proc $commentblock {*}[lrange $thisline 1 2]]
         2260  +          if {[dict exists $procinfo show_body] && [dict get $procinfo show_body]} {
         2261  +            dict set procinfo internals [lindex $thisline end]
         2262  +          }
         2263  +          dict set info proc [string trim [lindex $thisline 1] :] $procinfo
         2264  +          set commentblock {}
         2265  +        }
         2266  +        oo::objdefine {
         2267  +          if {[llength $thisline]==3} {
         2268  +            lassign $thisline tcmd name body
         2269  +            my keyword.Class info $commentblock $name $body
         2270  +          } else {
         2271  +            puts "Warning: bare oo::define in library"
         2272  +          }
         2273  +        }
         2274  +        oo::define {
         2275  +          if {[llength $thisline]==3} {
         2276  +            lassign $thisline tcmd name body
         2277  +            my keyword.class info $commentblock $name $body
         2278  +          } else {
         2279  +            puts "Warning: bare oo::define in library"
         2280  +          }
         2281  +        }
         2282  +        tao::define -
         2283  +        clay::define -
         2284  +        tool::define {
         2285  +          lassign $thisline tcmd name body
         2286  +          my keyword.class info $commentblock $name $body
         2287  +          set commentblock {}
         2288  +        }
         2289  +        oo::class {
         2290  +          lassign $thisline tcmd mthd name body
         2291  +          my keyword.class info $commentblock $name $body
         2292  +          set commentblock {}
         2293  +        }
         2294  +        default {
         2295  +          if {[lindex [split $cmd ::] end] eq "define"} {
         2296  +            lassign $thisline tcmd name body
         2297  +            my keyword.class info $commentblock $name $body
         2298  +            set commentblock {}
         2299  +          }
         2300  +          set commentblock {}
         2301  +        }
         2302  +      }
         2303  +      set thisline {}
         2304  +    }
         2305  +  }
         2306  +  method section.method {keyword method minfo} {
         2307  +    set result {}
         2308  +    set line "\[call $keyword \[cmd $method\]"
         2309  +    if {[dict exists $minfo arglist]} {
         2310  +      dict for {argname arginfo} [dict get $minfo arglist] {
         2311  +        set positional 1
         2312  +        set mandatory  1
         2313  +        set repeating 0
         2314  +        dict with arginfo {}
         2315  +        if {$mandatory==0} {
         2316  +          append line " \[opt \""
         2317  +        } else {
         2318  +          append line " "
         2319  +        }
         2320  +        if {$positional} {
         2321  +          append line "\[arg $argname"
         2322  +        } else {
         2323  +          append line "\[option \"$argname"
         2324  +          if {[dict exists $arginfo type]} {
         2325  +            append line " \[emph [dict get $arginfo type]\]"
         2326  +          } else {
         2327  +            append line " \[emph value\]"
         2328  +          }
         2329  +          append line "\""
         2330  +        }
         2331  +        append line "\]"
         2332  +        if {$mandatory==0} {
         2333  +          if {[dict exists $arginfo default]} {
         2334  +            append line " \[const \"[dict get $arginfo default]\"\]"
         2335  +          }
         2336  +          append line "\"\]"
         2337  +        }
         2338  +        if {$repeating} {
         2339  +          append line " \[opt \[option \"$argname...\"\]\]"
         2340  +        }
         2341  +      }
         2342  +    }
         2343  +    append line \]
         2344  +    putb result $line
         2345  +    if {[dict exists $minfo description]} {
         2346  +      putb result [dict get $minfo description]
         2347  +    }
         2348  +    if {[dict exists $minfo example]} {
         2349  +      putb result "\[para\]Example: \[example [list [dict get $minfo example]]\]"
         2350  +    }
         2351  +    if {[dict exists $minfo internals]} {
         2352  +      putb result "\[para\]Internals: \[example [list [dict get $minfo internals]]\]"
         2353  +    }
         2354  +    return $result
         2355  +  }
         2356  +  method section.annotation {type name iinfo} {
         2357  +    set result "\[call $type \[cmd $name\]\]"
         2358  +    if {[dict exists $iinfo description]} {
         2359  +      putb result [dict get $iinfo description]
         2360  +    }
         2361  +    if {[dict exists $iinfo example]} {
         2362  +      putb result "\[para\]Example: \[example [list [dict get $minfo example]]\]"
         2363  +    }
         2364  +    return $result
         2365  +  }
         2366  +  method section.class {class_name class_info} {
         2367  +    set result {}
         2368  +    putb result "\[subsection \{Class  $class_name\}\]"
         2369  +    if {[dict exists $class_info ancestors]} {
         2370  +      set line "\[emph \"ancestors\"\]:"
         2371  +      foreach {c} [dict get $class_info ancestors] {
         2372  +        append line " \[class [string trim $c :]\]"
         2373  +      }
         2374  +      putb result $line
         2375  +      putb result {[para]}
         2376  +    }
         2377  +    dict for {f v} $class_info {
         2378  +      if {$f in {class_method method description ancestors example option variable delegate}} continue
         2379  +      putb result "\[emph \"$f\"\]: $v"
         2380  +      putb result {[para]}
         2381  +    }
         2382  +    if {[dict exists $class_info example]} {
         2383  +      putb result "\[example \{[list [dict get $class_info example]]\}\]"
         2384  +      putb result {[para]}
         2385  +    }
         2386  +    if {[dict exists $class_info description]} {
         2387  +      putb result [dict get $class_info description]
         2388  +      putb result {[para]}
         2389  +    }
         2390  +    dict for {f v} $class_info {
         2391  +      if {$f ni {option variable delegate}} continue
         2392  +      putb result "\[class \{[string totitle $f]\}\]"
         2393  +      #putb result "Methods on the class object itself."
         2394  +      putb result {[list_begin definitions]}
         2395  +      dict for {item iinfo} [dict get $class_info $f] {
         2396  +        putb result [my section.annotation $f $item $iinfo]
         2397  +      }
         2398  +      putb result {[list_end]}
         2399  +      putb result {[para]}
         2400  +    }
         2401  +    if {[dict exists $class_info class_method]} {
         2402  +      putb result "\[class \{Class Methods\}\]"
         2403  +      #putb result "Methods on the class object itself."
         2404  +      putb result {[list_begin definitions]}
         2405  +      dict for {method minfo} [dict get $class_info class_method] {
         2406  +        putb result [my section.method classmethod $method $minfo]
         2407  +      }
         2408  +      putb result {[list_end]}
         2409  +      putb result {[para]}
         2410  +    }
         2411  +    if {[dict exists $class_info method]} {
         2412  +      putb result "\[class {Methods}\]"
         2413  +      putb result {[list_begin definitions]}
         2414  +      dict for {method minfo} [dict get $class_info method] {
         2415  +        putb result [my section.method method $method $minfo]
         2416  +      }
         2417  +      putb result {[list_end]}
         2418  +      putb result {[para]}
         2419  +    }
         2420  +    return $result
         2421  +  }
         2422  +  method section.command {procinfo} {
         2423  +    set result {}
         2424  +    putb result "\[section \{Commands\}\]"
         2425  +    putb result {[list_begin definitions]}
         2426  +    dict for {method minfo} $procinfo {
         2427  +      putb result [my section.method proc $method $minfo]
         2428  +    }
         2429  +    putb result {[list_end]}
         2430  +    return $result
         2431  +  }
         2432  +  method manpage args {
         2433  +    my variable info
         2434  +    set map {%version% 0.0 %module% {Your_Module_Here}}
         2435  +    set result {}
         2436  +    set header {}
         2437  +    set footer {}
         2438  +    set authors {}
         2439  +    dict with args {}
         2440  +    dict set map %keyword% comment
         2441  +    putb result $map {[%keyword% {-*- tcl -*- doctools manpage}]
         2442  +[vset PACKAGE_VERSION %version%]
         2443  +[manpage_begin %module% n [vset PACKAGE_VERSION]]}
         2444  +    putb result $map $header
         2445  +
         2446  +    dict for {sec_type sec_info} $info {
         2447  +      switch $sec_type {
         2448  +        proc {
         2449  +          putb result [my section.command $sec_info]
         2450  +        }
         2451  +        class {
         2452  +          putb result "\[section Classes\]"
         2453  +          dict for {class_name class_info} $sec_info {
         2454  +            putb result [my section.class $class_name $class_info]
         2455  +          }
         2456  +        }
         2457  +        default {
         2458  +          putb result "\[section [list $sec_type $sec_name]\]"
         2459  +          if {[dict exists $sec_info description]} {
         2460  +            putb result [dict get $sec_info description]
         2461  +          }
         2462  +        }
         2463  +      }
         2464  +    }
         2465  +    if {[llength $authors]} {
         2466  +      putb result {[section AUTHORS]}
         2467  +      foreach {name email} $authors {
         2468  +        putb result "$name \[uri mailto:$email\]\[para\]"
         2469  +      }
         2470  +    }
         2471  +    putb result $footer
         2472  +    putb result {[manpage_end]}
         2473  +    return $result
         2474  +  }
         2475  +  method scan_text {text} {
         2476  +    my variable linecount coro
         2477  +    set linecount 0
         2478  +    foreach line [split $text \n] {
         2479  +      incr linecount
         2480  +      $coro $line
         2481  +    }
         2482  +  }
         2483  +  method scan_file {filename} {
         2484  +    my variable linecount coro
         2485  +    set fin [open $filename r]
         2486  +    set linecount 0
         2487  +    while {[gets $fin line]>=0} {
         2488  +      incr linecount
         2489  +      $coro $line
         2490  +    }
         2491  +    close $fin
         2492  +  }
         2493  +}
         2494  +
         2495  +###
         2496  +# END: doctool.tcl
         2497  +###
         2498  +###
         2499  +# START: buildutil.tcl
         2500  +###
         2501  +proc Proc {name arglist body} {
         2502  +  if {[info command $name] ne {}} return
         2503  +  proc $name $arglist $body
         2504  +}
         2505  +Proc ::noop args {}
         2506  +proc ::practcl::debug args {
         2507  +  #puts $args
         2508  +  ::practcl::cputs ::DEBUG_INFO $args
         2509  +}
         2510  +proc ::practcl::doexec args {
         2511  +  puts [list {*}$args]
         2512  +  exec {*}$args >&@ stdout
         2513  +}
         2514  +proc ::practcl::doexec_in {path args} {
         2515  +  set PWD [pwd]
         2516  +  cd $path
         2517  +  puts [list {*}$args]
         2518  +  exec {*}$args >&@ stdout
         2519  +  cd $PWD
         2520  +}
         2521  +proc ::practcl::dotclexec args {
         2522  +  puts [list [info nameofexecutable] {*}$args]
         2523  +  exec [info nameofexecutable] {*}$args >&@ stdout
         2524  +}
         2525  +proc ::practcl::domake {path args} {
         2526  +  set PWD [pwd]
         2527  +  cd $path
         2528  +  puts [list *** $path ***]
         2529  +  puts [list make {*}$args]
         2530  +  exec make {*}$args >&@ stdout
         2531  +  cd $PWD
         2532  +}
         2533  +proc ::practcl::domake.tcl {path args} {
         2534  +  set PWD [pwd]
         2535  +  cd $path
         2536  +  puts [list *** $path ***]
         2537  +  puts [list make.tcl {*}$args]
         2538  +  exec [info nameofexecutable] make.tcl {*}$args >&@ stdout
         2539  +  cd $PWD
         2540  +}
         2541  +proc ::practcl::fossil {path args} {
         2542  +  set PWD [pwd]
         2543  +  cd $path
         2544  +  puts [list {*}$args]
         2545  +  exec fossil {*}$args >&@ stdout
         2546  +  cd $PWD
         2547  +}
         2548  +proc ::practcl::fossil_status {dir} {
         2549  +  if {[info exists ::fosdat($dir)]} {
         2550  +    return $::fosdat($dir)
         2551  +  }
         2552  +  set result {
         2553  +tags experimental
         2554  +version {}
         2555  +  }
         2556  +  set pwd [pwd]
         2557  +  cd $dir
         2558  +  set info [exec fossil status]
         2559  +  cd $pwd
         2560  +  foreach line [split $info \n] {
         2561  +    if {[lindex $line 0] eq "checkout:"} {
         2562  +      set hash [lindex $line end-3]
         2563  +      set maxdate [lrange $line end-2 end-1]
         2564  +      dict set result hash $hash
         2565  +      dict set result maxdate $maxdate
         2566  +      regsub -all {[^0-9]} $maxdate {} isodate
         2567  +      dict set result isodate $isodate
         2568  +    }
         2569  +    if {[lindex $line 0] eq "tags:"} {
         2570  +      set tags [lrange $line 1 end]
         2571  +      dict set result tags $tags
         2572  +      break
         2573  +    }
         2574  +  }
         2575  +  set ::fosdat($dir) $result
         2576  +  return $result
         2577  +}
         2578  +proc ::practcl::os {} {
         2579  +  return [${::practcl::MAIN} define get TEACUP_OS]
         2580  +}
         2581  +proc ::practcl::mkzip {exename barekit vfspath} {
         2582  +  ::practcl::tcllib_require zipfile::mkzip
         2583  +  ::zipfile::mkzip::mkzip $exename -runtime $barekit -directory $vfspath
         2584  +}
         2585  +proc ::practcl::sort_dict list {
         2586  +  return [::lsort -stride 2 -dictionary $list]
         2587  +}
         2588  +if {[::package vcompare $::tcl_version 8.6] < 0} {
         2589  +  # Approximate ::zipfile::mkzip with exec calls
         2590  +  proc ::practcl::mkzip {exename barekit vfspath} {
         2591  +    set path [file dirname [file normalize $exename]]
         2592  +    set zipfile [file join $path [file rootname $exename].zip]
         2593  +    file copy -force $barekit $exename
         2594  +    set pwd [pwd]
         2595  +    cd $vfspath
         2596  +    exec zip -r $zipfile .
         2597  +    cd $pwd
         2598  +    set fout [open $exename a]
         2599  +    set fin [open $zipfile r]
         2600  +    chan configure $fout -translation binary
         2601  +    chan configure $fin -translation binary
         2602  +    chan copy $fin $fout
         2603  +    chan close $fin
         2604  +    chan close $fout
         2605  +    exec zip -A $exename
         2606  +  }
         2607  +  proc ::practcl::sort_dict list {
         2608  +    set result {}
         2609  +    foreach key [lsort -dictionary [dict keys $list]] {
         2610  +      dict set result $key [dict get $list $key]
         2611  +    }
         2612  +    return $result
         2613  +  }
         2614  +}
         2615  +proc ::practcl::local_os {} {
         2616  +  # If we have already run this command, return
         2617  +  # a cached copy of the data
         2618  +  if {[info exists ::practcl::LOCAL_INFO]} {
         2619  +    return $::practcl::LOCAL_INFO
         2620  +  }
         2621  +  set result [array get ::practcl::CONFIG]
         2622  +  dict set result TEACUP_PROFILE unknown
         2623  +  dict set result TEACUP_OS unknown
         2624  +  dict set result EXEEXT {}
         2625  +  set windows 0
         2626  +  if {$::tcl_platform(platform) eq "windows"} {
         2627  +    set windows 1
         2628  +  }
         2629  +  if {$windows} {
         2630  +    set system "windows"
         2631  +    set arch ix86
         2632  +    dict set result TEACUP_PROFILE win32-ix86
         2633  +    dict set result TEACUP_OS windows
         2634  +    dict set result EXEEXT .exe
         2635  +  } else {
         2636  +    set system [exec uname -s]-[exec uname -r]
         2637  +    set arch unknown
         2638  +    dict set result TEACUP_OS generic
         2639  +  }
         2640  +  dict set result TEA_PLATFORM $system
         2641  +  dict set result TEA_SYSTEM $system
         2642  +  if {[info exists ::SANDBOX]} {
         2643  +    dict set result sandbox $::SANDBOX
         2644  +  }
         2645  +  switch -glob $system {
         2646  +    Linux* {
         2647  +      dict set result TEACUP_OS linux
         2648  +      set arch [exec uname -m]
         2649  +      dict set result TEACUP_PROFILE "linux-glibc2.3-$arch"
         2650  +    }
         2651  +    GNU* {
         2652  +      set arch [exec uname -m]
         2653  +      dict set result TEACUP_OS "gnu"
         2654  +    }
         2655  +    NetBSD-Debian {
         2656  +      set arch [exec uname -m]
         2657  +      dict set result TEACUP_OS "netbsd-debian"
         2658  +    }
         2659  +    OpenBSD-* {
         2660  +      set arch [exec arch -s]
         2661  +      dict set result TEACUP_OS "openbsd"
         2662  +    }
         2663  +    Darwin* {
         2664  +      set arch [exec uname -m]
         2665  +      dict set result TEACUP_OS "macosx"
         2666  +      if {$arch eq "x86_64"} {
         2667  +        dict set result TEACUP_PROFILE "macosx10.5-i386-x86_84"
         2668  +      } else {
         2669  +        dict set result TEACUP_PROFILE "macosx-universal"
         2670  +      }
         2671  +    }
         2672  +    OpenBSD* {
         2673  +      set arch [exec arch -s]
         2674  +      dict set result TEACUP_OS "openbsd"
         2675  +    }
         2676  +  }
         2677  +  if {$arch eq "unknown"} {
         2678  +    catch {set arch [exec uname -m]}
         2679  +  }
         2680  +  switch -glob $arch {
         2681  +    i*86 {
         2682  +      set arch "ix86"
         2683  +    }
         2684  +    amd64 {
         2685  +      set arch "x86_64"
         2686  +    }
         2687  +  }
         2688  +  dict set result TEACUP_ARCH $arch
         2689  +  if {[dict get $result TEACUP_PROFILE] eq "unknown"} {
         2690  +    dict set result TEACUP_PROFILE [dict get $result TEACUP_OS]-$arch
         2691  +  }
         2692  +  set OS [dict get $result TEACUP_OS]
         2693  +  dict set result os $OS
         2694  +
         2695  +  # Look for a local preference file
         2696  +  set pathlist {}
         2697  +  set userhome [file normalize ~/tcl]
         2698  +  set local_install [file join $userhome lib]
         2699  +  switch $OS {
         2700  +    windows {
         2701  +      set userhome [file join [file normalize $::env(LOCALAPPDATA)] Tcl]
         2702  +      if {[file exists c:/Tcl/Teapot]} {
         2703  +        dict set result teapot c:/Tcl/Teapot
         2704  +      }
         2705  +    }
         2706  +    macosx {
         2707  +      set userhome [file join [file normalize {~/Library/Application Support/}] Tcl]
         2708  +      if {[file exists {~/Library/Application Support/ActiveState/Teapot/repository/}]} {
         2709  +        dict set result teapot [file normalize {~/Library/Application Support/ActiveState/Teapot/repository/}]
         2710  +      }
         2711  +      dict set result local_install [file normalize ~/Library/Tcl]
         2712  +      if {![dict exists $result sandbox]} {
         2713  +        dict set result sandbox       [file normalize ~/Library/Tcl/sandbox]
         2714  +      }
         2715  +    }
         2716  +    default {
         2717  +    }
         2718  +  }
         2719  +  dict set result userhome $userhome
         2720  +  # Load user preferences
         2721  +  if {[file exists [file join $userhome practcl.rc]]} {
         2722  +    set dat [::practcl::read_rc_file [file join $userhome practcl.rc]]
         2723  +    foreach {f v} $dat {
         2724  +      dict set result $f $v
         2725  +    }
         2726  +  }
         2727  +  if {![dict exists $result prefix]} {
         2728  +    dict set result prefix   $userhome
         2729  +  }
         2730  +
         2731  +  # Create a default path for the teapot
         2732  +  if {![dict exists $result teapot]} {
         2733  +    dict set result teapot [file join $userhome teapot]
         2734  +  }
         2735  +  # Create a default path for the local sandbox
         2736  +  if {![dict exists $result sandbox]} {
         2737  +    dict set result sandbox [file join $userhome sandbox]
         2738  +  }
         2739  +  # Create a default path for download folder
         2740  +  if {![dict exists $result download]} {
         2741  +    dict set result download [file join $userhome download]
         2742  +  }
         2743  +  # Path to install local packages
         2744  +  if {![dict exists $result local_install]} {
         2745  +    dict set result local_install [file join $userhome lib]
         2746  +  }
         2747  +  if {![dict exists result fossil_mirror] && [::info exists ::env(FOSSIL_MIRROR)]} {
         2748  +    dict set result fossil_mirror $::env(FOSSIL_MIRROR)
         2749  +  }
         2750  +
         2751  +  set ::practcl::LOCAL_INFO $result
         2752  +  return $result
         2753  +}
         2754  +proc ::practcl::config.tcl {path} {
         2755  +   return [read_configuration $path]
         2756  +}
         2757  +proc ::practcl::read_configuration {path} {
         2758  +  dict set result buildpath $path
         2759  +  set result [local_os]
         2760  +  set OS [dict get $result TEACUP_OS]
         2761  +  set windows 0
         2762  +  dict set result USEMSVC 0
         2763  +  if {[file exists [file join $path config.tcl]]} {
         2764  +    # We have a definitive configuration file. Read its content
         2765  +    # and take it as gospel
         2766  +    set cresult [read_rc_file [file join $path config.tcl]]
         2767  +    set cresult [::practcl::de_shell $cresult]
         2768  +    if {[dict exists $cresult srcdir] && ![dict exists $cresult sandbox]} {
         2769  +      dict set cresult sandbox  [file dirname [dict get $cresult srcdir]]
         2770  +    }
         2771  +    set result [dict merge $result [::practcl::de_shell $cresult]]
         2772  +  }
         2773  +  if {[file exists [file join $path config.site]]} {
         2774  +    # No config.tcl file is present but we do seed
         2775  +    dict set result USEMSVC 0
         2776  +    foreach {f v} [::practcl::de_shell [::practcl::read_sh_file [file join $path config.site]]] {
         2777  +      dict set result $f $v
         2778  +      dict set result XCOMPILE_${f} $v
         2779  +    }
         2780  +    dict set result CONFIG_SITE [file join $path config.site]
         2781  +    if {[dict exist $result XCOMPILE_CC] && [regexp mingw [dict get $result XCOMPILE_CC]]} {
         2782  +      set windows 1
         2783  +    }
         2784  +  } elseif {[info exists ::env(VisualStudioVersion)]} {
         2785  +    set windows 1
         2786  +    dict set result USEMSVC 1
         2787  +  }
         2788  +  if {$windows && [dict get $result TEACUP_OS] ne "windows"} {
         2789  +    if {![dict exists exists $result TEACUP_ARCH]} {
         2790  +      dict set result TEACUP_ARCH ix86
         2791  +    }
         2792  +    dict set result TEACUP_PROFILE win32-[dict get $result TEACUP_ARCH]
         2793  +    dict set result TEACUP_OS windows
         2794  +    dict set result EXEEXT .exe
         2795  +  }
         2796  +  return $result
         2797  +}
         2798  +if {$::tcl_platform(platform) eq "windows"} {
         2799  +proc ::practcl::msys_to_tclpath msyspath {
         2800  +  return [exec sh -c "cd $msyspath ; pwd -W"]
         2801  +}
         2802  +proc ::practcl::tcl_to_myspath tclpath {
         2803  +  set path [file normalize $tclpath]
         2804  +  return "/[string index $path 0][string range $path 2 end]"
         2805  +  #return [exec sh -c "cd $tclpath ; pwd"]
         2806  +}
         2807  +} else {
         2808  +proc ::practcl::msys_to_tclpath msyspath {
         2809  +  return [file normalize $msyspath]
         2810  +}
         2811  +proc ::practcl::tcl_to_myspath msyspath {
         2812  +  return [file normalize $msyspath]
         2813  +}
         2814  +}
         2815  +proc ::practcl::tcllib_require {pkg args} {
         2816  +  # Try to load the package from the local environment
         2817  +  if {[catch [list ::package require $pkg {*}$args] err]==0} {
         2818  +    return $err
         2819  +  }
         2820  +  ::practcl::LOCAL tool tcllib env-load
         2821  +  uplevel #0 [list ::package require $pkg {*}$args]
         2822  +}
         2823  +namespace eval ::practcl::platform {
         2824  +}
         2825  +proc ::practcl::platform::tcl_core_options {os} {
         2826  +  ###
         2827  +  # Download our required packages
         2828  +  ###
         2829  +  set tcl_config_opts {}
         2830  +  # Auto-guess options for the local operating system
         2831  +  switch $os {
         2832  +    windows {
         2833  +      #lappend tcl_config_opts --disable-stubs
         2834  +    }
         2835  +    linux {
         2836  +    }
         2837  +    macosx {
         2838  +      lappend tcl_config_opts --enable-corefoundation=yes  --enable-framework=no
         2839  +    }
         2840  +  }
         2841  +  lappend tcl_config_opts --with-tzdata
         2842  +  return $tcl_config_opts
         2843  +}
         2844  +proc ::practcl::platform::tk_core_options {os} {
         2845  +  ###
         2846  +  # Download our required packages
         2847  +  ###
         2848  +  set tk_config_opts {}
         2849  +
         2850  +  # Auto-guess options for the local operating system
         2851  +  switch $os {
         2852  +    windows {
         2853  +    }
         2854  +    linux {
         2855  +      lappend tk_config_opts --enable-xft=no --enable-xss=no
         2856  +    }
         2857  +    macosx {
         2858  +      lappend tk_config_opts --enable-aqua=yes
         2859  +    }
         2860  +  }
         2861  +  return $tk_config_opts
         2862  +}
         2863  +proc ::practcl::read_rc_file {filename {localdat {}}} {
         2864  +  set result $localdat
         2865  +  set fin [open $filename r]
         2866  +  set bufline {}
         2867  +  set rawcount 0
         2868  +  set linecount 0
         2869  +  while {[gets $fin thisline]>=0} {
         2870  +    incr rawcount
         2871  +    append bufline \n $thisline
         2872  +    if {![info complete $bufline]} continue
         2873  +    set line [string trimleft $bufline]
         2874  +    set bufline {}
         2875  +    if {[string index [string trimleft $line] 0] eq "#"} continue
         2876  +    append result \n $line
         2877  +    #incr linecount
         2878  +    #set key [lindex $line 0]
         2879  +    #set value [lindex $line 1]
         2880  +    #dict set result $key $value
         2881  +  }
         2882  +  close $fin
         2883  +  return $result
         2884  +}
         2885  +proc ::practcl::read_sh_subst {line info} {
         2886  +  regsub -all {\x28} $line \x7B line
         2887  +  regsub -all {\x29} $line \x7D line
         2888  +
         2889  +  #set line [string map $key [string trim $line]]
         2890  +  foreach {field value} $info {
         2891  +    catch {set $field $value}
         2892  +  }
         2893  +  if [catch {subst $line} result] {
         2894  +    return {}
         2895  +  }
         2896  +  set result [string trim $result]
         2897  +  return [string trim $result ']
         2898  +}
         2899  +proc ::practcl::read_sh_file {filename {localdat {}}} {
         2900  +  set fin [open $filename r]
         2901  +  set result {}
         2902  +  if {$localdat eq {}} {
         2903  +    set top 1
         2904  +    set local [array get ::env]
         2905  +    dict set local EXE {}
         2906  +  } else {
         2907  +    set top 0
         2908  +    set local $localdat
         2909  +  }
         2910  +  while {[gets $fin line] >= 0} {
         2911  +    set line [string trim $line]
         2912  +    if {[string index $line 0] eq "#"} continue
         2913  +    if {$line eq {}} continue
         2914  +    catch {
         2915  +    if {[string range $line 0 6] eq "export "} {
         2916  +      set eq [string first "=" $line]
         2917  +      set field [string trim [string range $line 6 [expr {$eq - 1}]]]
         2918  +      set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local]
         2919  +      dict set result $field [read_sh_subst $value $local]
         2920  +      dict set local $field $value
         2921  +    } elseif {[string range $line 0 7] eq "include "} {
         2922  +      set subfile [read_sh_subst [string range $line 7 end] $local]
         2923  +      foreach {field value} [read_sh_file $subfile $local] {
         2924  +        dict set result $field $value
         2925  +      }
         2926  +    } else {
         2927  +      set eq [string first "=" $line]
         2928  +      if {$eq > 0} {
         2929  +        set field [read_sh_subst [string range $line 0 [expr {$eq - 1}]] $local]
         2930  +        set value [string trim [string range $line [expr {$eq+1}] end] ']
         2931  +        #set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local]
         2932  +        dict set local $field $value
         2933  +        dict set result $field $value
         2934  +      }
         2935  +    }
         2936  +    } err opts
         2937  +    if {[dict get $opts -code] != 0} {
         2938  +      #puts $opts
         2939  +      puts "Error reading line:\n$line\nerr: $err\n***"
         2940  +      return $err {*}$opts
         2941  +    }
         2942  +  }
         2943  +  return $result
         2944  +}
         2945  +proc ::practcl::read_Config.sh filename {
         2946  +  set fin [open $filename r]
         2947  +  set result {}
         2948  +  set linecount 0
         2949  +  while {[gets $fin line] >= 0} {
         2950  +    set line [string trim $line]
         2951  +    if {[string index $line 0] eq "#"} continue
         2952  +    if {$line eq {}} continue
         2953  +    catch {
         2954  +      set eq [string first "=" $line]
         2955  +      if {$eq > 0} {
         2956  +        set field [string range $line 0 [expr {$eq - 1}]]
         2957  +        set value [string trim [string range $line [expr {$eq+1}] end] ']
         2958  +        #set value [read_sh_subst [string range $line [expr {$eq+1}] end] $local]
         2959  +        dict set result $field $value
         2960  +        incr $linecount
         2961  +      }
         2962  +    } err opts
         2963  +    if {[dict get $opts -code] != 0} {
         2964  +      #puts $opts
         2965  +      puts "Error reading line:\n$line\nerr: $err\n***"
         2966  +      return $err {*}$opts
         2967  +    }
         2968  +  }
         2969  +  return $result
         2970  +}
         2971  +proc ::practcl::read_Makefile filename {
         2972  +  set fin [open $filename r]
         2973  +  set result {}
         2974  +  while {[gets $fin line] >= 0} {
         2975  +    set line [string trim $line]
         2976  +    if {[string index $line 0] eq "#"} continue
         2977  +    if {$line eq {}} continue
         2978  +    catch {
         2979  +      set eq [string first "=" $line]
         2980  +      if {$eq > 0} {
         2981  +        set field [string trim [string range $line 0 [expr {$eq - 1}]]]
         2982  +        set value [string trim [string trim [string range $line [expr {$eq+1}] end] ']]
         2983  +        switch $field {
         2984  +          PKG_LIB_FILE {
         2985  +            dict set result libfile $value
         2986  +          }
         2987  +          srcdir {
         2988  +            if {$value eq "."} {
         2989  +              dict set result srcdir [file dirname $filename]
         2990  +            } else {
         2991  +              dict set result srcdir $value
         2992  +            }
         2993  +          }
         2994  +          PACKAGE_NAME {
         2995  +            dict set result name $value
         2996  +          }
         2997  +          PACKAGE_VERSION {
         2998  +            dict set result version $value
         2999  +          }
         3000  +          LIBS {
         3001  +            dict set result PRACTCL_LIBS $value
         3002  +          }
         3003  +          PKG_LIB_FILE {
         3004  +            dict set result libfile $value
         3005  +          }
         3006  +        }
         3007  +      }
         3008  +    } err opts
         3009  +    if {[dict get $opts -code] != 0} {
         3010  +      #puts $opts
         3011  +      puts "Error reading line:\n$line\nerr: $err\n***"
         3012  +      return $err {*}$opts
         3013  +    }
         3014  +    # the Compile field is about where most TEA files start getting silly
         3015  +    if {$field eq "compile"} {
         3016  +      break
         3017  +    }
         3018  +  }
         3019  +  return $result
         3020  +}
         3021  +proc ::practcl::cputs {varname args} {
         3022  +  upvar 1 $varname buffer
         3023  +  if {[llength $args]==1 && [string length [string trim [lindex $args 0]]] == 0} {
         3024  +
         3025  +  }
         3026  +  if {[info exist buffer]} {
         3027  +    if {[string index $buffer end] ne "\n"} {
         3028  +      append buffer \n
         3029  +    }
         3030  +  } else {
         3031  +    set buffer \n
         3032  +  }
         3033  +  # Trim leading \n's
         3034  +  append buffer [string trimleft [lindex $args 0] \n] {*}[lrange $args 1 end]
         3035  +}
         3036  +proc ::practcl::tcl_to_c {body} {
         3037  +  set result {}
         3038  +  foreach rawline [split $body \n] {
         3039  +    set line [string map [list \" \\\" \\ \\\\] $rawline]
         3040  +    cputs result "\n        \"$line\\n\" \\"
         3041  +  }
         3042  +  return [string trimright $result \\]
         3043  +}
         3044  +proc ::practcl::_tagblock {text {style tcl} {note {}}} {
         3045  +  if {[string length [string trim $text]]==0} {
         3046  +    return {}
         3047  +  }
         3048  +  set output {}
         3049  +  switch $style {
         3050  +    tcl {
         3051  +      ::practcl::cputs output "# BEGIN $note"
         3052  +    }
         3053  +    c {
         3054  +      ::practcl::cputs output "/* BEGIN $note */"
         3055  +    }
         3056  +    default {
         3057  +      ::practcl::cputs output "# BEGIN $note"
         3058  +    }
         3059  +  }
         3060  +  ::practcl::cputs output $text
         3061  +  switch $style {
         3062  +    tcl {
         3063  +      ::practcl::cputs output "# END $note"
         3064  +    }
         3065  +    c {
         3066  +      ::practcl::cputs output "/* END $note */"
         3067  +    }
         3068  +    default {
         3069  +      ::practcl::cputs output "# END $note"
         3070  +    }
         3071  +  }
         3072  +  return $output
         3073  +}
         3074  +proc ::practcl::de_shell {data} {
         3075  +  set values {}
         3076  +  foreach flag {DEFS TCL_DEFS TK_DEFS} {
         3077  +    if {[dict exists $data $flag]} {
         3078  +      #set value {}
         3079  +      #foreach item [dict get $data $flag] {
         3080  +      #  append value " " [string map {{ } {\ }} $item]
         3081  +      #}
         3082  +      dict set values $flag [dict get $data $flag]
         3083  +    }
         3084  +  }
         3085  +  set map {}
         3086  +  lappend map {${PKG_OBJECTS}} %LIBRARY_OBJECTS%
         3087  +  lappend map {$(PKG_OBJECTS)} %LIBRARY_OBJECTS%
         3088  +  lappend map {${PKG_STUB_OBJECTS}} %LIBRARY_STUB_OBJECTS%
         3089  +  lappend map {$(PKG_STUB_OBJECTS)} %LIBRARY_STUB_OBJECTS%
         3090  +
         3091  +  if {[dict exists $data name]} {
         3092  +    lappend map %LIBRARY_NAME% [dict get $data name]
         3093  +    lappend map %LIBRARY_VERSION% [dict get $data version]
         3094  +    lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} [dict get $data version]]
         3095  +    if {[dict exists $data libprefix]} {
         3096  +      lappend map %LIBRARY_PREFIX% [dict get $data libprefix]
         3097  +    } else {
         3098  +      lappend map %LIBRARY_PREFIX% [dict get $data prefix]
         3099  +    }
         3100  +  }
         3101  +  foreach flag [dict keys $data] {
         3102  +    if {$flag in {TCL_DEFS TK_DEFS DEFS}} continue
         3103  +    set value [string trim [dict get $data $flag] \"]
         3104  +    dict set map "\$\{${flag}\}" $value
         3105  +    dict set map "\$\(${flag}\)" $value
         3106  +    #dict set map "\$${flag}" $value
         3107  +    dict set map "%${flag}%" $value
         3108  +    dict set values $flag [dict get $data $flag]
         3109  +    #dict set map "\$\{${flag}\}" $proj($flag)
         3110  +  }
         3111  +  set changed 1
         3112  +  while {$changed} {
         3113  +    set changed 0
         3114  +    foreach {field value} $values {
         3115  +      if {$field in {TCL_DEFS TK_DEFS DEFS}} continue
         3116  +      dict with values {}
         3117  +      set newval [string map $map $value]
         3118  +      if {$newval eq $value} continue
         3119  +      set changed 1
         3120  +      dict set values $field $newval
         3121  +    }
         3122  +  }
         3123  +  return $values
         3124  +}
         3125  +
         3126  +###
         3127  +# END: buildutil.tcl
         3128  +###
         3129  +###
         3130  +# START: fileutil.tcl
         3131  +###
         3132  +proc ::practcl::grep {pattern {files {}}} {
         3133  +    set result [list]
         3134  +    if {[llength $files] == 0} {
         3135  +            # read from stdin
         3136  +            set lnum 0
         3137  +            while {[gets stdin line] >= 0} {
         3138  +                incr lnum
         3139  +                if {[regexp -- $pattern $line]} {
         3140  +                        lappend result "${lnum}:${line}"
         3141  +                }
         3142  +            }
         3143  +    } else {
         3144  +            foreach filename $files {
         3145  +            set file [open $filename r]
         3146  +            set lnum 0
         3147  +            while {[gets $file line] >= 0} {
         3148  +                incr lnum
         3149  +                if {[regexp -- $pattern $line]} {
         3150  +                    lappend result "${filename}:${lnum}:${line}"
         3151  +                }
         3152  +            }
         3153  +            close $file
         3154  +            }
         3155  +    }
         3156  +    return $result
         3157  +}
         3158  +proc ::practcl::file_lexnormalize {sp} {
         3159  +    set spx [file split $sp]
         3160  +
         3161  +    # Resolution of embedded relative modifiers (., and ..).
         3162  +
         3163  +    if {
         3164  +      ([lsearch -exact $spx . ] < 0) &&
         3165  +      ([lsearch -exact $spx ..] < 0)
         3166  +    } {
         3167  +      # Quick path out if there are no relative modifiers
         3168  +      return $sp
         3169  +    }
         3170  +
         3171  +    set absolute [expr {![string equal [file pathtype $sp] relative]}]
         3172  +    # A volumerelative path counts as absolute for our purposes.
         3173  +
         3174  +    set sp $spx
         3175  +    set np {}
         3176  +    set noskip 1
         3177  +
         3178  +    while {[llength $sp]} {
         3179  +      set ele    [lindex $sp 0]
         3180  +      set sp     [lrange $sp 1 end]
         3181  +      set islast [expr {[llength $sp] == 0}]
         3182  +
         3183  +      if {[string equal $ele ".."]} {
         3184  +          if {
         3185  +            ($absolute  && ([llength $np] >  1)) ||
         3186  +            (!$absolute && ([llength $np] >= 1))
         3187  +          } {
         3188  +            # .. : Remove the previous element added to the
         3189  +            # new path, if there actually is enough to remove.
         3190  +            set np [lrange $np 0 end-1]
         3191  +          }
         3192  +      } elseif {[string equal $ele "."]} {
         3193  +          # Ignore .'s, they stay at the current location
         3194  +          continue
         3195  +      } else {
         3196  +          # A regular element.
         3197  +          lappend np $ele
         3198  +      }
         3199  +    }
         3200  +    if {[llength $np] > 0} {
         3201  +      return [eval [linsert $np 0 file join]]
         3202  +      # 8.5: return [file join {*}$np]
         3203  +    }
         3204  +    return {}
         3205  +}
         3206  +proc ::practcl::file_relative {base dst} {
         3207  +    # Ensure that the link to directory 'dst' is properly done relative to
         3208  +    # the directory 'base'.
         3209  +
         3210  +    if {![string equal [file pathtype $base] [file pathtype $dst]]} {
         3211  +      return -code error "Unable to compute relation for paths of different pathtypes: [file pathtype $base] vs. [file pathtype $dst], ($base vs. $dst)"
         3212  +    }
         3213  +
         3214  +    set base [file_lexnormalize [file join [pwd] $base]]
         3215  +    set dst  [file_lexnormalize [file join [pwd] $dst]]
         3216  +
         3217  +    set save $dst
         3218  +    set base [file split $base]
         3219  +    set dst  [file split $dst]
         3220  +
         3221  +    while {[string equal [lindex $dst 0] [lindex $base 0]]} {
         3222  +      set dst  [lrange $dst  1 end]
         3223  +      set base [lrange $base 1 end]
         3224  +      if {![llength $dst]} {break}
         3225  +    }
         3226  +
         3227  +    set dstlen  [llength $dst]
         3228  +    set baselen [llength $base]
         3229  +
         3230  +    if {($dstlen == 0) && ($baselen == 0)} {
         3231  +      # Cases:
         3232  +      # (a) base == dst
         3233  +
         3234  +      set dst .
         3235  +    } else {
         3236  +      # Cases:
         3237  +      # (b) base is: base/sub = sub
         3238  +      #     dst  is: base     = {}
         3239  +
         3240  +      # (c) base is: base     = {}
         3241  +      #     dst  is: base/sub = sub
         3242  +
         3243  +      while {$baselen > 0} {
         3244  +          set dst [linsert $dst 0 ..]
         3245  +          incr baselen -1
         3246  +      }
         3247  +      # 8.5: set dst [file join {*}$dst]
         3248  +      set dst [eval [linsert $dst 0 file join]]
         3249  +    }
         3250  +
         3251  +    return $dst
         3252  +}
         3253  +proc ::practcl::findByPattern {basedir patterns} {
         3254  +    set queue $basedir
         3255  +    set result {}
         3256  +    while {[llength $queue]} {
         3257  +      set item [lindex $queue 0]
         3258  +      set queue [lrange $queue 1 end]
         3259  +      if {[file isdirectory $item]} {
         3260  +        foreach path [glob -nocomplain [file join $item *]] {
         3261  +          lappend queue $path
         3262  +        }
         3263  +        continue
         3264  +      }
         3265  +      foreach pattern $patterns {
         3266  +        set fname [file tail $item]
         3267  +        if {[string match $pattern $fname]} {
         3268  +          lappend result $item
         3269  +          break
         3270  +        }
         3271  +      }
         3272  +    }
         3273  +    return $result
         3274  +}
         3275  +proc ::practcl::log {fname comment} {
         3276  +  set fname [file normalize $fname]
         3277  +  if {[info exists ::practcl::logchan($fname)]} {
         3278  +    set fout $::practcl::logchan($fname)
         3279  +    after cancel $::practcl::logevent($fname)
         3280  +  } else {
         3281  +    set fout [open $fname a]
         3282  +  }
         3283  +  puts $fout $comment
         3284  +  # Defer close until idle
         3285  +  set ::practcl::logevent($fname) [after idle "close $fout ; unset ::practcl::logchan($fname)"]
         3286  +}
         3287  +
         3288  +###
         3289  +# END: fileutil.tcl
         3290  +###
         3291  +###
         3292  +# START: installutil.tcl
         3293  +###
         3294  +proc ::practcl::_pkgindex_simpleIndex {path} {
         3295  +set buffer {}
         3296  +  set pkgidxfile    [file join $path pkgIndex.tcl]
         3297  +  set modfile       [file join $path [file tail $path].tcl]
         3298  +  set use_pkgindex  [file exists $pkgidxfile]
         3299  +  set tclfiles      {}
         3300  +  set found 0
         3301  +  set mlist [list pkgIndex.tcl index.tcl [file tail $modfile] version_info.tcl]
         3302  +  foreach file [glob -nocomplain [file join $path *.tcl]] {
         3303  +    if {[file tail $file] ni $mlist} {
         3304  +      puts [list NONMODFILE $file]
         3305  +      return {}
         3306  +    }
         3307  +  }
         3308  +  foreach file [glob -nocomplain [file join $path *.tcl]] {
         3309  +    if { [file tail $file] == "version_info.tcl" } continue
         3310  +    set fin [open $file r]
         3311  +    set dat [read $fin]
         3312  +    close $fin
         3313  +    if {![regexp "package provide" $dat]} continue
         3314  +    set fname [file rootname [file tail $file]]
         3315  +    # Look for a package provide statement
         3316  +    foreach line [split $dat \n] {
         3317  +      set line [string trim $line]
         3318  +      if { [string range $line 0 14] != "package provide" } continue
         3319  +      set package [lindex $line 2]
         3320  +      set version [lindex $line 3]
         3321  +      if {[string index $package 0] in "\$ \[ @"} continue
         3322  +      if {[string index $version 0] in "\$ \[ @"} continue
         3323  +      puts "PKGLINE $line"
         3324  +      append buffer "package ifneeded $package $version \[list source \[file join %DIR% [file tail $file]\]\]" \n
         3325  +      break
         3326  +    }
         3327  +  }
         3328  +  return $buffer
         3329  +}
         3330  +proc ::practcl::_pkgindex_directory {path} {
         3331  +  set buffer {}
         3332  +  set pkgidxfile    [file join $path pkgIndex.tcl]
         3333  +  set modfile       [file join $path [file tail $path].tcl]
         3334  +  set use_pkgindex  [file exists $pkgidxfile]
         3335  +  set tclfiles      {}
         3336  +  if {$use_pkgindex && [file exists $modfile]} {
         3337  +    set use_pkgindex 0
         3338  +    set mlist [list pkgIndex.tcl [file tail $modfile]]
         3339  +    foreach file [glob -nocomplain [file join $path *.tcl]] {
         3340  +      lappend tclfiles [file tail $file]
         3341  +      if {[file tail $file] in $mlist} continue
         3342  +      incr use_pkgindex
         3343  +    }
         3344  +  }
         3345  +  if {!$use_pkgindex} {
         3346  +    # No pkgIndex file, read the source
         3347  +    foreach file [glob -nocomplain $path/*.tm] {
         3348  +      set file [file normalize $file]
         3349  +      set fname [file rootname [file tail $file]]
         3350  +      ###
         3351  +      # We used to be able to ... Assume the package is correct in the filename
         3352  +      # No hunt for a "package provides"
         3353  +      ###
         3354  +      set package [lindex [split $fname -] 0]
         3355  +      set version [lindex [split $fname -] 1]
         3356  +      ###
         3357  +      # Read the file, and override assumptions as needed
         3358  +      ###
         3359  +      set fin [open $file r]
         3360  +      set dat [read $fin]
         3361  +      close $fin
         3362  +      # Look for a teapot style Package statement
         3363  +      foreach line [split $dat \n] {
         3364  +        set line [string trim $line]
         3365  +        if { [string range $line 0 9] != "# Package " } continue
         3366  +        set package [lindex $line 2]
         3367  +        set version [lindex $line 3]
         3368  +        break
         3369  +      }
         3370  +      # Look for a package provide statement
         3371  +      foreach line [split $dat \n] {
         3372  +        set line [string trim $line]
         3373  +        if { [string range $line 0 14] != "package provide" } continue
         3374  +        set package [lindex $line 2]
         3375  +        set version [lindex $line 3]
         3376  +        break
         3377  +      }
         3378  +      if {[string trim $version] ne {}} {
         3379  +        append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
         3380  +      }
         3381  +    }
         3382  +    foreach file [glob -nocomplain $path/*.tcl] {
         3383  +      if { [file tail $file] == "version_info.tcl" } continue
         3384  +      set fin [open $file r]
         3385  +      set dat [read $fin]
         3386  +      close $fin
         3387  +      if {![regexp "package provide" $dat]} continue
         3388  +      set fname [file rootname [file tail $file]]
         3389  +      # Look for a package provide statement
         3390  +      foreach line [split $dat \n] {
         3391  +        set line [string trim $line]
         3392  +        if { [string range $line 0 14] != "package provide" } continue
         3393  +        set package [lindex $line 2]
         3394  +        set version [lindex $line 3]
         3395  +        if {[string index $package 0] in "\$ \[ @"} continue
         3396  +        if {[string index $version 0] in "\$ \[ @"} continue
         3397  +        append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
         3398  +        break
         3399  +      }
         3400  +    }
         3401  +    return $buffer
         3402  +  }
         3403  +  set fin [open $pkgidxfile r]
         3404  +  set dat [read $fin]
         3405  +  close $fin
         3406  +  set trace 0
         3407  +  #if {[file tail $path] eq "tool"} {
         3408  +  #  set trace 1
         3409  +  #}
         3410  +  set thisline {}
         3411  +  foreach line [split $dat \n] {
         3412  +    append thisline $line \n
         3413  +    if {![info complete $thisline]} continue
         3414  +    set line [string trim $line]
         3415  +    if {[string length $line]==0} {
         3416  +      set thisline {} ; continue
         3417  +    }
         3418  +    if {[string index $line 0] eq "#"} {
         3419  +      set thisline {} ; continue
         3420  +    }
         3421  +    if {[regexp "if.*catch.*package.*Tcl.*return" $thisline]} {
         3422  +      if {$trace} {puts "[file dirname $pkgidxfile] Ignoring $thisline"}
         3423  +      set thisline {} ; continue
         3424  +    }
         3425  +    if {[regexp "if.*package.*vsatisfies.*package.*provide.*return" $thisline]} {
         3426  +      if {$trace} { puts "[file dirname $pkgidxfile] Ignoring $thisline" }
         3427  +      set thisline {} ; continue
         3428  +    }
         3429  +    if {![regexp "package.*ifneeded" $thisline]} {
         3430  +      # This package index contains arbitrary code
         3431  +      # source instead of trying to add it to the master
         3432  +      # package index
         3433  +      if {$trace} { puts "[file dirname $pkgidxfile] Arbitrary code $thisline" }
         3434  +      return {source [file join $dir pkgIndex.tcl]}
         3435  +    }
         3436  +    append buffer $thisline \n
         3437  +    set thisline {}
         3438  +  }
         3439  +  if {$trace} {puts [list [file dirname $pkgidxfile] $buffer]}
         3440  +  return $buffer
         3441  +}
         3442  +proc ::practcl::_pkgindex_path_subdir {path} {
         3443  +  set result {}
         3444  +  if {[file exists [file join $path src build.tcl]]} {
         3445  +    # Tool style module, don't dive into subdirectories
         3446  +    return $path
         3447  +  }
         3448  +  foreach subpath [glob -nocomplain [file join $path *]] {
         3449  +    if {[file isdirectory $subpath]} {
         3450  +      if {[file tail $subpath] eq "build" && [file exists [file join $subpath build.tcl]]} continue
         3451  +      lappend result $subpath {*}[_pkgindex_path_subdir $subpath]
         3452  +    }
         3453  +  }
         3454  +  return $result
         3455  +}
         3456  +proc ::practcl::pkgindex_path {args} {
         3457  +  set stack {}
         3458  +  set buffer {
         3459  +lappend ::PATHSTACK $dir
         3460  +set IDXPATH [lindex $::PATHSTACK end]
         3461  +  }
         3462  +  set preindexed {}
         3463  +  foreach base $args {
         3464  +    set base [file normalize $base]
         3465  +    set paths {}
         3466  +    foreach dir [glob -nocomplain [file join $base *]] {
         3467  +      set thisdir [file tail $dir]
         3468  +      if {$thisdir eq "teapot"} continue
         3469  +      if {$thisdir eq "pkgs"} {
         3470  +        foreach subdir [glob -nocomplain [file join $dir *]] {
         3471  +          set thissubdir [file tail $subdir]
         3472  +          set skip 0
         3473  +          foreach file {pkgIndex.tcl tclIndex} {
         3474  +            if {[file exists [file join $subdir $file]]} {
         3475  +              set skip 1
         3476  +              append buffer "set dir \[file join \$::IDXPATH [list $thisdir] [list $thissubdir]\] \; "
         3477  +              append buffer "source \[file join \$dir ${file}\]" \n
         3478  +            }
         3479  +          }
         3480  +          if {$skip} continue
         3481  +          lappend paths {*}[::practcl::_pkgindex_path_subdir $subdir]
         3482  +        }
         3483  +        continue
         3484  +      }
         3485  +      lappend paths $dir {*}[::practcl::_pkgindex_path_subdir $dir]
         3486  +    }
         3487  +    append buffer ""
         3488  +    set i    [string length  $base]
         3489  +    # Build a list of all of the paths
         3490  +    if {[llength $paths]} {
         3491  +      foreach path $paths {
         3492  +        if {$path eq $base} continue
         3493  +        set path_indexed($path) 0
         3494  +      }
         3495  +    } else {
         3496  +      puts [list WARNING: NO PATHS FOUND IN $base]
         3497  +    }
         3498  +    set path_indexed($base) 1
         3499  +    set path_indexed([file join $base boot tcl]) 1
         3500  +    append buffer \n {# SINGLE FILE MODULES BEGIN} \n {set dir [file dirname $::PKGIDXFILE]} \n
         3501  +    foreach path $paths {
         3502  +      if {$path_indexed($path)} continue
         3503  +      set thisdir [file_relative $base $path]
         3504  +      set simpleIdx [_pkgindex_simpleIndex $path]
         3505  +      if {[string length $simpleIdx]==0} continue
         3506  +      incr path_indexed($path)
         3507  +      if {[string length $simpleIdx]} {
         3508  +        incr path_indexed($path)
         3509  +        append buffer [string map [list %DIR% "\$dir \{$thisdir\}"] [string trimright $simpleIdx]] \n
         3510  +      }
         3511  +    }
         3512  +    append buffer {# SINGLE FILE MODULES END} \n
         3513  +    foreach path $paths {
         3514  +      if {$path_indexed($path)} continue
         3515  +      set thisdir [file_relative $base $path]
         3516  +      set idxbuf [::practcl::_pkgindex_directory $path]
         3517  +      if {[string length $idxbuf]} {
         3518  +        incr path_indexed($path)
         3519  +        append buffer "set dir \[set PKGDIR \[file join \[lindex \$::PATHSTACK end\] $thisdir\]\]" \n
         3520  +        append buffer [string map {$dir $PKGDIR} [string trimright $idxbuf]] \n
         3521  +      }
         3522  +    }
         3523  +  }
         3524  +  append buffer {
         3525  +set dir [lindex $::PATHSTACK end]
         3526  +set ::PATHSTACK [lrange $::PATHSTACK 0 end-1]
         3527  +}
         3528  +  return $buffer
         3529  +}
         3530  +proc ::practcl::installDir {d1 d2} {
         3531  +  puts [format {%*sCreating %s} [expr {4 * [info level]}] {} [file tail $d2]]
         3532  +  file delete -force -- $d2
         3533  +  file mkdir $d2
         3534  +
         3535  +  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
         3536  +    set f [file join $d1 $ftail]
         3537  +    if {[file isdirectory $f] && [string compare CVS $ftail]} {
         3538  +      installDir $f [file join $d2 $ftail]
         3539  +    } elseif {[file isfile $f]} {
         3540  +	    file copy -force $f [file join $d2 $ftail]
         3541  +	    if {$::tcl_platform(platform) eq {unix}} {
         3542  +        file attributes [file join $d2 $ftail] -permissions 0644
         3543  +	    } else {
         3544  +        file attributes [file join $d2 $ftail] -readonly 1
         3545  +	    }
         3546  +    }
         3547  +  }
         3548  +
         3549  +  if {$::tcl_platform(platform) eq {unix}} {
         3550  +    file attributes $d2 -permissions 0755
         3551  +  } else {
         3552  +    file attributes $d2 -readonly 1
         3553  +  }
         3554  +}
         3555  +proc ::practcl::copyDir {d1 d2 {toplevel 1}} {
         3556  +  #if {$toplevel} {
         3557  +  #  puts [list ::practcl::copyDir $d1 -> $d2]
         3558  +  #}
         3559  +  #file delete -force -- $d2
         3560  +  file mkdir $d2
         3561  +  if {[file isfile $d1]} {
         3562  +    file copy -force $d1 $d2
         3563  +    set ftail [file tail $d1]
         3564  +    if {$::tcl_platform(platform) eq {unix}} {
         3565  +      file attributes [file join $d2 $ftail] -permissions 0644
         3566  +    } else {
         3567  +      file attributes [file join $d2 $ftail] -readonly 1
         3568  +    }
         3569  +  } else {
         3570  +    foreach ftail [glob -directory $d1 -nocomplain -tails *] {
         3571  +      set f [file join $d1 $ftail]
         3572  +      if {[file isdirectory $f] && [string compare CVS $ftail]} {
         3573  +        copyDir $f [file join $d2 $ftail] 0
         3574  +      } elseif {[file isfile $f]} {
         3575  +        file copy -force $f [file join $d2 $ftail]
         3576  +        if {$::tcl_platform(platform) eq {unix}} {
         3577  +          file attributes [file join $d2 $ftail] -permissions 0644
         3578  +        } else {
         3579  +          file attributes [file join $d2 $ftail] -readonly 1
         3580  +        }
         3581  +      }
         3582  +    }
         3583  +  }
         3584  +}
         3585  +proc ::practcl::buildModule {modpath} {
         3586  +  set buildscript [file join $modpath build build.tcl]
         3587  +  if {![file exists $buildscript]} return
         3588  +  set pkgIndexFile [file join $modpath pkgIndex.tcl]
         3589  +  if {[file exists $pkgIndexFile]} {
         3590  +    set latest 0
         3591  +    foreach file [::practcl::findByPattern [file dirname $buildscript] *.tcl] {
         3592  +      set mtime [file mtime $file]
         3593  +      if {$mtime>$latest} {
         3594  +        set latest $mtime
         3595  +      }
         3596  +    }
         3597  +    set IdxTime [file mtime $pkgIndexFile]
         3598  +    if {$latest<$IdxTime} return
         3599  +  }
         3600  +  ::practcl::dotclexec $buildscript
         3601  +}
         3602  +proc ::practcl::installModule {modpath DEST} {
         3603  +  puts [list installModule $modpath $DEST]
         3604  +  set dpath  [file join $DEST modules [file tail $modpath]]
         3605  +  if {[file exists [file join $modpath build build.tcl]]} {
         3606  +    buildModule $modpath
         3607  +  } elseif {![file exists [file join $modpath pkgIndex.tcl]]} {
         3608  +    puts [list Reindex $modpath]
         3609  +    pkg_mkIndex $modpath
         3610  +  }
         3611  +  file delete -force $dpath
         3612  +  file mkdir $dpath
         3613  +  foreach file [glob  [file join $modpath *.tcl]] {
         3614  +    file copy $file $dpath
         3615  +  }
         3616  +  if {[file exists [file join $modpath htdocs]]} {
         3617  +    ::practcl::copyDir [file join $modpath htdocs] [file join $dpath htdocs]
         3618  +  }
         3619  +}
         3620  +
         3621  +###
         3622  +# END: installutil.tcl
         3623  +###
         3624  +###
         3625  +# START: makeutil.tcl
         3626  +###
         3627  +proc ::practcl::trigger {args} {
         3628  +  ::practcl::LOCAL make trigger {*}$args
         3629  +  foreach {name obj} [::practcl::LOCAL make objects] {
         3630  +    set ::make($name) [$obj do]
         3631  +  }
         3632  +}
         3633  +proc ::practcl::depends {args} {
         3634  +  ::practcl::LOCAL make depends {*}$args
         3635  +}
         3636  +proc ::practcl::target {name info {action {}}} {
         3637  +  set obj [::practcl::LOCAL make task $name $info $action]
         3638  +  set ::make($name) 0
         3639  +  set filename [$obj define get filename]
         3640  +  if {$filename ne {}} {
         3641  +    set ::target($name) $filename
         3642  +  }
         3643  +}
         3644  +
         3645  +###
         3646  +# END: makeutil.tcl
         3647  +###
         3648  +###
         3649  +# START: class metaclass.tcl
         3650  +###
         3651  +::clay::define ::practcl::metaclass {
         3652  +  method _MorphPatterns {} {
         3653  +    return {{@[email protected]} {::practcl::@[email protected]} {::practcl::*@[email protected]} {::practcl::*@[email protected]*}}
         3654  +  }
         3655  +  method define {submethod args} {
         3656  +    my variable define
         3657  +    switch $submethod {
         3658  +      dump {
         3659  +        return [array get define]
         3660  +      }
         3661  +      add {
         3662  +        set field [lindex $args 0]
         3663  +        if {![info exists define($field)]} {
         3664  +          set define($field) {}
         3665  +        }
         3666  +        foreach arg [lrange $args 1 end] {
         3667  +          if {$arg ni $define($field)} {
         3668  +            lappend define($field) $arg
         3669  +          }
         3670  +        }
         3671  +        return $define($field)
         3672  +      }
         3673  +      remove {
         3674  +        set field [lindex $args 0]
         3675  +        if {![info exists define($field)]} {
         3676  +          return
         3677  +        }
         3678  +        set rlist [lrange $args 1 end]
         3679  +        set olist $define($field)
         3680  +        set nlist {}
         3681  +        foreach arg $olist {
         3682  +          if {$arg in $rlist} continue
         3683  +          lappend nlist $arg
         3684  +        }
         3685  +        set define($field) $nlist
         3686  +        return $nlist
         3687  +      }
         3688  +      exists {
         3689  +        set field [lindex $args 0]
         3690  +        return [info exists define($field)]
         3691  +      }
         3692  +      getnull -
         3693  +      get -
         3694  +      cget {
         3695  +        set field [lindex $args 0]
         3696  +        if {[info exists define($field)]} {
         3697  +          return $define($field)
         3698  +        }
         3699  +        return [lindex $args 1]
         3700  +      }
         3701  +      set {
         3702  +        if {[llength $args]==1} {
         3703  +          set arglist [lindex $args 0]
         3704  +        } else {
         3705  +          set arglist $args
         3706  +        }
         3707  +        array set define $arglist
         3708  +        if {[dict exists $arglist class]} {
         3709  +          my select
         3710  +        }
         3711  +      }
         3712  +      default {
         3713  +        array $submethod define {*}$args
         3714  +      }
         3715  +    }
         3716  +  }
         3717  +  method graft args {
         3718  +    return [my clay delegate {*}$args]
         3719  +  }
         3720  +  method initialize {} {}
         3721  +  method link {command args} {
         3722  +    my variable links
         3723  +    switch $command {
         3724  +      object {
         3725  +        foreach obj $args {
         3726  +          foreach linktype [$obj linktype] {
         3727  +            my link add $linktype $obj
         3728  +          }
         3729  +        }
         3730  +      }
         3731  +      add {
         3732  +        ###
         3733  +        # Add a link to an object that was externally created
         3734  +        ###
         3735  +        if {[llength $args] ne 2} { error "Usage: link add LINKTYPE OBJECT"}
         3736  +        lassign $args linktype object
         3737  +        if {[info exists links($linktype)] && $object in $links($linktype)} {
         3738  +          return
         3739  +        }
         3740  +        lappend links($linktype) $object
         3741  +      }
         3742  +      remove {
         3743  +        set object [lindex $args 0]
         3744  +        if {[llength $args]==1} {
         3745  +          set ltype *
         3746  +        } else {
         3747  +          set ltype [lindex $args 1]
         3748  +        }
         3749  +        foreach {linktype elements} [array get links $ltype] {
         3750  +          if {$object in $elements} {
         3751  +            set nlist {}
         3752  +            foreach e $elements {
         3753  +              if { $object ne $e } { lappend nlist $e }
         3754  +            }
         3755  +            set links($linktype) $nlist
         3756  +          }
         3757  +        }
         3758  +      }
         3759  +      list {
         3760  +        if {[llength $args]==0} {
         3761  +          return [array get links]
         3762  +        }
         3763  +        if {[llength $args] != 1} { error "Usage: link list LINKTYPE"}
         3764  +        set linktype [lindex $args 0]
         3765  +        if {![info exists links($linktype)]} {
         3766  +          return {}
         3767  +        }
         3768  +        return $links($linktype)
         3769  +      }
         3770  +      dump {
         3771  +        return [array get links]
         3772  +      }
         3773  +    }
         3774  +  }
         3775  +  method morph classname {
         3776  +    my variable define
         3777  +    if {$classname ne {}} {
         3778  +      set map [list @[email protected] $classname]
         3779  +      foreach pattern [string map $map [my _MorphPatterns]] {
         3780  +        set pattern [string trim $pattern]
         3781  +        set matches [info commands $pattern]
         3782  +        if {![llength $matches]} continue
         3783  +        set class [lindex $matches 0]
         3784  +        break
         3785  +      }
         3786  +      set mixinslot {}
         3787  +      foreach {slot pattern} {
         3788  +        distribution ::practcl::distribution*
         3789  +        product      ::practcl::product*
         3790  +        toolset      ::practcl::toolset*
         3791  +      } {
         3792  +        if {[string match $pattern $class]} {
         3793  +           set mixinslot $slot
         3794  +           break
         3795  +        }
         3796  +      }
         3797  +      if {$mixinslot ne {}} {
         3798  +        my clay mixinmap $mixinslot $class
         3799  +      } elseif {[info command $class] ne {}} {
         3800  +        if {[info object class [self]] ne $class} {
         3801  +          ::oo::objdefine [self] class $class
         3802  +          ::practcl::debug [self] morph $class
         3803  +           my define set class $class
         3804  +        }
         3805  +      } else {
         3806  +        error "[self] Could not detect class for $classname"
         3807  +      }
         3808  +    }
         3809  +    if {[::info exists define(oodefine)]} {
         3810  +      ::oo::objdefine [self] $define(oodefine)
         3811  +      #unset define(oodefine)
         3812  +    }
         3813  +  }
         3814  +  method script script {
         3815  +    eval $script
         3816  +  }
         3817  +  method select {} {
         3818  +    my variable define
         3819  +    if {[info exists define(class)]} {
         3820  +      my morph $define(class)
         3821  +    } else {
         3822  +      if {[::info exists define(oodefine)]} {
         3823  +        ::oo::objdefine [self] $define(oodefine)
         3824  +        #unset define(oodefine)
         3825  +      }
         3826  +    }
         3827  +  }
         3828  +  method source filename {
         3829  +    source $filename
         3830  +  }
         3831  +}
         3832  +
         3833  +###
         3834  +# END: class metaclass.tcl
         3835  +###
         3836  +###
         3837  +# START: class toolset baseclass.tcl
         3838  +###
         3839  +::clay::define ::practcl::toolset {
         3840  +  method config.sh {} {
         3841  +    return [my read_configuration]
         3842  +  }
         3843  +  method BuildDir {PWD} {
         3844  +    set name [my define get name]
         3845  +    set debug [my define get debug 0]
         3846  +    if {[my <project> define get LOCAL 0]} {
         3847  +      return [my define get builddir [file join $PWD local $name]]
         3848  +    }
         3849  +    if {$debug} {
         3850  +      return [my define get builddir [file join $PWD debug $name]]
         3851  +    } else {
         3852  +      return [my define get builddir [file join $PWD pkg $name]]
         3853  +    }
         3854  +  }
         3855  +  method MakeDir {srcdir} {
         3856  +    return $srcdir
         3857  +  }
         3858  +  method read_configuration {} {
         3859  +    my variable conf_result
         3860  +    if {[info exists conf_result]} {
         3861  +      return $conf_result
         3862  +    }
         3863  +    set result {}
         3864  +    set name [my define get name]
         3865  +    set PWD $::CWD
         3866  +    set builddir [my define get builddir]
         3867  +    my unpack
         3868  +    set srcdir [my define get srcdir]
         3869  +    if {![file exists $builddir]} {
         3870  +      my Configure
         3871  +    }
         3872  +    set filename [file join $builddir config.tcl]
         3873  +    # Project uses the practcl template. Use the leavings from autoconf
         3874  +    if {[file exists $filename]} {
         3875  +      set dat [::practcl::read_configuration $builddir]
         3876  +      foreach {item value} [::practcl::sort_dict $dat] {
         3877  +        dict set result $item $value
         3878  +      }
         3879  +      set conf_result $result
         3880  +      return $result
         3881  +    }
         3882  +    set filename [file join $builddir ${name}Config.sh]
         3883  +    if {[file exists $filename]} {
         3884  +      set l [expr {[string length $name]+1}]
         3885  +      foreach {field dat} [::practcl::read_Config.sh $filename] {
         3886  +        set field [string tolower $field]
         3887  +        if {[string match ${name}_* $field]} {
         3888  +          set field [string range $field $l end]
         3889  +        }
         3890  +        switch $field {
         3891  +          version {
         3892  +            dict set result pkg_vers $dat
         3893  +          }
         3894  +          lib_file {
         3895  +            set field libfile
         3896  +          }
         3897  +        }
         3898  +        dict set result $field $dat
         3899  +      }
         3900  +      set conf_result $result
         3901  +      return $result
         3902  +    }
         3903  +    ###
         3904  +    # Oh man... we have to guess
         3905  +    ###
         3906  +    if {![file exists [file join $builddir Makefile]]} {
         3907  +      my Configure
         3908  +    }
         3909  +    set filename [file join $builddir Makefile]
         3910  +    if {![file exists $filename]} {
         3911  +      error "Could not locate any configuration data in $srcdir"
         3912  +    }
         3913  +    foreach {field dat} [::practcl::read_Makefile $filename] {
         3914  +      dict set result $field $dat
         3915  +    }
         3916  +    if {![dict exists $result PRACTCL_PKG_LIBS] && [dict exists $result LIBS]} {
         3917  +      dict set result PRACTCL_PKG_LIBS [dict get $result LIBS]
         3918  +    }
         3919  +    set conf_result $result
         3920  +    cd $PWD
         3921  +    return $result
         3922  +  }
         3923  +  method build-cflags {PROJECT DEFS namevar versionvar defsvar} {
         3924  +    upvar 1 $namevar name $versionvar version NAME NAME $defsvar defs
         3925  +    set name [string tolower [${PROJECT} define get name [${PROJECT} define get pkg_name]]]
         3926  +    set NAME [string toupper $name]
         3927  +    set version [${PROJECT} define get version [${PROJECT} define get pkg_vers]]
         3928  +    if {$version eq {}} {
         3929  +      set version 0.1a
         3930  +    }
         3931  +    set defs $DEFS
         3932  +    foreach flag {
         3933  +      -DPACKAGE_NAME
         3934  +      -DPACKAGE_VERSION
         3935  +      -DPACKAGE_TARNAME
         3936  +      -DPACKAGE_STRING
         3937  +    } {
         3938  +      if {[set i [string first $flag $defs]] >= 0} {
         3939  +        set j [string first -D $flag [expr {$i+[string length $flag]}]]
         3940  +        set predef [string range $defs 0 [expr {$i-1}]]
         3941  +        set postdef [string range $defs $j end]
         3942  +        set defs "$predef $postdef"
         3943  +      }
         3944  +    }
         3945  +    append defs " -DPACKAGE_NAME=\"${name}\" -DPACKAGE_VERSION=\"${version}\""
         3946  +    append defs " -DPACKAGE_TARNAME=\"${name}\" -DPACKAGE_STRING=\"${name}\x5c\x20${version}\""
         3947  +    return $defs
         3948  +  }
         3949  +  method critcl args {
         3950  +    if {![info exists critcl]} {
         3951  +      ::practcl::LOCAL tool critcl env-load
         3952  +      set critcl [file join [::practcl::LOCAL tool critcl define get srcdir] main.tcl
         3953  +    }
         3954  +    set srcdir [my SourceRoot]
         3955  +    set PWD [pwd]
         3956  +    cd $srcdir
         3957  +    ::practcl::dotclexec $critcl {*}$args
         3958  +    cd $PWD
         3959  +  }
         3960  +}
         3961  +oo::objdefine ::practcl::toolset {
         3962  +  # Perform the selection for the toolset mixin
         3963  +  method select object {
         3964  +    ###
         3965  +    # Select the toolset to use for this project
         3966  +    ###
         3967  +    if {[$object define exists toolset]} {
         3968  +      return [$object define get toolset]
         3969  +    }
         3970  +    set class [$object define get toolset]
         3971  +    if {$class ne {}} {
         3972  +      $object clay mixinmap toolset $class
         3973  +    } else {
         3974  +      if {[info exists ::env(VisualStudioVersion)]} {
         3975  +        $object clay mixinmap toolset ::practcl::toolset.msvc
         3976  +      } else {
         3977  +        $object clay mixinmap toolset ::practcl::toolset.gcc
         3978  +      }
         3979  +    }
         3980  +  }
         3981  +}
         3982  +
         3983  +###
         3984  +# END: class toolset baseclass.tcl
         3985  +###
         3986  +###
         3987  +# START: class toolset gcc.tcl
         3988  +###
         3989  +::clay::define ::practcl::toolset.gcc {
         3990  +  superclass ::practcl::toolset
         3991  +  method Autoconf {} {
         3992  +    ###
         3993  +    # Re-run autoconf for this project
         3994  +    # Not a good idea in practice... but in the right hands it can be useful
         3995  +    ###
         3996  +    set pwd [pwd]
         3997  +    set srcdir [file normalize [my define get srcdir]]
         3998  +    cd $srcdir
         3999  +    foreach template {configure.ac configure.in} {
         4000  +      set input [file join $srcdir $template]
         4001  +      if {[file exists $input]} {
         4002  +        puts "autoconf -f $input > [file join $srcdir configure]"
         4003  +        exec autoconf -f $input > [file join $srcdir configure]
         4004  +      }
         4005  +    }
         4006  +    cd $pwd
         4007  +  }
         4008  +  method BuildDir {PWD} {
         4009  +    set name [my define get name]
         4010  +    set debug [my define get debug 0]
         4011  +    if {[my <project> define get LOCAL 0]} {
         4012  +      return [my define get builddir [file join $PWD local $name]]
         4013  +    }
         4014  +    if {$debug} {
         4015  +      return [my define get builddir [file join $PWD debug $name]]
         4016  +    } else {
         4017  +      return [my define get builddir [file join $PWD pkg $name]]
         4018  +    }
         4019  +  }
         4020  +  method ConfigureOpts {} {
         4021  +    set opts {}
         4022  +    set builddir [my define get builddir]
         4023  +
         4024  +    if {[my define get broken_destroot 0]} {
         4025  +      set PREFIX [my <project> define get prefix_broken_destdir]
         4026  +    } else {
         4027  +      set PREFIX [my <project> define get prefix]
         4028  +    }
         4029  +    switch [my define get name] {
         4030  +      tcl {
         4031  +        set opts [::practcl::platform::tcl_core_options [my <project> define get TEACUP_OS]]
         4032  +      }
         4033  +      tk {
         4034  +        set opts [::practcl::platform::tk_core_options  [my <project> define get TEACUP_OS]]
         4035  +      }
         4036  +    }
         4037  +    if {[my <project> define get CONFIG_SITE] != {}} {
         4038  +      lappend opts --host=[my <project> define get HOST]
         4039  +    }
         4040  +    set inside_msys [string is true -strict [my <project> define get MSYS_ENV 0]]
         4041  +    lappend opts --with-tclsh=[info nameofexecutable]
         4042  +
         4043  +    if {[my define get tk 0]} {
         4044  +      if {![my <project> define get LOCAL 0]} {
         4045  +        set obj [my <project> tclcore]
         4046  +        if {$obj ne {}} {
         4047  +          if {$inside_msys} {
         4048  +            lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj define get builddir]]
         4049  +          } else {
         4050  +            lappend opts --with-tcl=[file normalize [$obj define get builddir]]
         4051  +          }
         4052  +        }
         4053  +        set obj [my <project> tkcore]
         4054  +        if {$obj ne {}} {
         4055  +          if {$inside_msys} {
         4056  +            lappend opts --with-tk=[::practcl::file_relative [file normalize $builddir] [$obj define get builddir]]
         4057  +          } else {
         4058  +            lappend opts --with-tk=[file normalize [$obj define get builddir]]
         4059  +          }
         4060  +        }
         4061  +      } else {
         4062  +        lappend opts --with-tcl=[file join $PREFIX lib]
         4063  +        lappend opts --with-tk=[file join $PREFIX lib]
         4064  +      }
         4065  +    } else {
         4066  +      if {![my <project> define get LOCAL 0]} {
         4067  +        set obj [my <project> tclcore]
         4068  +        if {$obj ne {}} {
         4069  +          if {$inside_msys} {
         4070  +            lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj define get builddir]]
         4071  +          } else {
         4072  +            lappend opts --with-tcl=[file normalize [$obj define get builddir]]
         4073  +          }
         4074  +        }
         4075  +      } else {
         4076  +        lappend opts --with-tcl=[file join $PREFIX lib]
         4077  +      }
         4078  +    }
         4079  +
         4080  +    lappend opts {*}[my define get config_opts]
         4081  +    if {![regexp -- "--prefix" $opts]} {
         4082  +      lappend opts --prefix=$PREFIX --exec-prefix=$PREFIX
         4083  +    }
         4084  +    if {[my define get debug 0]} {
         4085  +      lappend opts --enable-symbols=true
         4086  +    }
         4087  +    #--exec_prefix=$PREFIX
         4088  +    #if {$::tcl_platform(platform) eq "windows"} {
         4089  +    #  lappend opts --disable-64bit
         4090  +    #}
         4091  +    if {[my define get static 1]} {
         4092  +      lappend opts --disable-shared
         4093  +      #--disable-stubs
         4094  +      #
         4095  +    } else {
         4096  +      lappend opts --enable-shared
         4097  +    }
         4098  +    return $opts
         4099  +  }
         4100  +  method MakeDir {srcdir} {
         4101  +    set localsrcdir $srcdir
         4102  +    if {[file exists [file join $srcdir generic]]} {
         4103  +      my define add include_dir [file join $srcdir generic]
         4104  +    }
         4105  +    set os [my <project> define get TEACUP_OS]
         4106  +    switch $os {
         4107  +      windows {
         4108  +        if {[file exists [file join $srcdir win]]} {
         4109  +          my define add include_dir [file join $srcdir win]
         4110  +        }
         4111  +        if {[file exists [file join $srcdir win Makefile.in]]} {
         4112  +          set localsrcdir [file join $srcdir win]
         4113  +        }
         4114  +      }
         4115  +      default {
         4116  +        if {[file exists [file join $srcdir $os]]} {
         4117  +          my define add include_dir [file join $srcdir $os]
         4118  +        }
         4119  +        if {[file exists [file join $srcdir unix]]} {
         4120  +          my define add include_dir [file join $srcdir unix]
         4121  +        }
         4122  +        if {[file exists [file join $srcdir $os Makefile.in]]} {
         4123  +          set localsrcdir [file join $srcdir $os]
         4124  +        } elseif {[file exists [file join $srcdir unix Makefile.in]]} {
         4125  +          set localsrcdir [file join $srcdir unix]
         4126  +        }
         4127  +      }
         4128  +    }
         4129  +    return $localsrcdir
         4130  +  }
         4131  +  Ensemble make::autodetect {} {
         4132  +    set srcdir [my define get srcdir]
         4133  +    set localsrcdir [my define get localsrcdir]
         4134  +    if {$localsrcdir eq {}} {
         4135  +      set localsrcdir $srcdir
         4136  +    }
         4137  +    if {$srcdir eq $localsrcdir} {
         4138  +      if {![file exists [file join $srcdir tclconfig install-sh]]} {
         4139  +        # ensure we have tclconfig with all of the trimmings
         4140  +        set teapath {}
         4141  +        if {[file exists [file join $srcdir .. tclconfig install-sh]]} {
         4142  +          set teapath [file join $srcdir .. tclconfig]
         4143  +        } else {
         4144  +          set tclConfigObj [::practcl::LOCAL tool tclconfig]
         4145  +          $tclConfigObj load
         4146  +          set teapath [$tclConfigObj define get srcdir]
         4147  +        }
         4148  +        set teapath [file normalize $teapath]
         4149  +        #file mkdir [file join $srcdir tclconfig]
         4150  +        if {[catch {file link -symbolic [file join $srcdir tclconfig] $teapath}]} {
         4151  +          ::practcl::copyDir [file join $teapath] [file join $srcdir tclconfig]
         4152  +        }
         4153  +      }
         4154  +    }
         4155  +    set builddir [my define get builddir]
         4156  +    file mkdir $builddir
         4157  +    if {![file exists [file join $localsrcdir configure]]} {
         4158  +      if {[file exists [file join $localsrcdir autogen.sh]]} {
         4159  +        cd $localsrcdir
         4160  +        catch {exec sh autogen.sh >>& [file join $builddir autoconf.log]}
         4161  +        cd $::CWD
         4162  +      }
         4163  +    }
         4164  +    set opts [my ConfigureOpts]
         4165  +    if {[file exists [file join $builddir autoconf.log]]} {
         4166  +      file delete [file join $builddir autoconf.log]
         4167  +    }
         4168  +    ::practcl::debug [list PKG [my define get name] CONFIGURE {*}$opts]
         4169  +    ::practcl::log   [file join $builddir autoconf.log] [list  CONFIGURE {*}$opts]
         4170  +    cd $builddir
         4171  +    if {[my <project> define get CONFIG_SITE] ne {}} {
         4172  +      set ::env(CONFIG_SITE) [my <project> define get CONFIG_SITE]
         4173  +    }
         4174  +    catch {exec sh [file join $localsrcdir configure] {*}$opts >>& [file join $builddir autoconf.log]}
         4175  +    cd $::CWD
         4176  +  }
         4177  +  Ensemble make::clean {} {
         4178  +    set builddir [file normalize [my define get builddir]]
         4179  +    catch {::practcl::domake $builddir clean}
         4180  +  }
         4181  +  Ensemble make::compile {} {
         4182  +    set name [my define get name]
         4183  +    set srcdir [my define get srcdir]
         4184  +    if {[my define get static 1]} {
         4185  +      puts "BUILDING Static $name $srcdir"
         4186  +    } else {
         4187  +      puts "BUILDING Dynamic $name $srcdir"
         4188  +    }
         4189  +    cd $::CWD
         4190  +    set builddir [file normalize [my define get builddir]]
         4191  +    file mkdir $builddir
         4192  +    if {![file exists [file join $builddir Makefile]]} {
         4193  +      my Configure
         4194  +    }
         4195  +    if {[file exists [file join $builddir make.tcl]]} {
         4196  +      if {[my define get debug 0]} {
         4197  +        ::practcl::domake.tcl $builddir debug all
         4198  +      } else {
         4199  +        ::practcl::domake.tcl $builddir all
         4200  +      }
         4201  +    } else {
         4202  +      ::practcl::domake $builddir all
         4203  +    }
         4204  +  }
         4205  +  Ensemble make::install DEST {
         4206  +    set PWD [pwd]
         4207  +    set builddir [my define get builddir]
         4208  +    if {[my <project> define get LOCAL 0] || $DEST eq {}} {
         4209  +      if {[file exists [file join $builddir make.tcl]]} {
         4210  +        puts "[self] Local INSTALL (Practcl)"
         4211  +        ::practcl::domake.tcl $builddir install
         4212  +      } elseif {[my define get broken_destroot 0] == 0} {
         4213  +        puts "[self] Local INSTALL (TEA)"
         4214  +        ::practcl::domake $builddir install
         4215  +      }
         4216  +    } else {
         4217  +      if {[file exists [file join $builddir make.tcl]]} {
         4218  +        # Practcl builds can inject right to where we need them
         4219  +        puts "[self] VFS INSTALL $DEST (Practcl)"
         4220  +        ::practcl::domake.tcl $builddir install-package $DEST
         4221  +      } elseif {[my define get broken_destroot 0] == 0} {
         4222  +        # Most modern TEA projects understand DESTROOT in the makefile
         4223  +        puts "[self] VFS INSTALL $DEST (TEA)"
         4224  +        ::practcl::domake $builddir install DESTDIR=[::practcl::file_relative $builddir $DEST]
         4225  +      } else {
         4226  +        # But some require us to do an install into a fictitious filesystem
         4227  +        # and then extract the gooey parts within.
         4228  +        # (*cough*) TkImg
         4229  +        set PREFIX [my <project> define get prefix]
         4230  +        set BROKENROOT [::practcl::msys_to_tclpath [my <project> define get prefix_broken_destdir]]
         4231  +        file delete -force $BROKENROOT
         4232  +        file mkdir $BROKENROOT
         4233  +        ::practcl::domake $builddir $install
         4234  +        ::practcl::copyDir $BROKENROOT  [file join $DEST [string trimleft $PREFIX /]]
         4235  +        file delete -force $BROKENROOT
         4236  +      }
         4237  +    }
         4238  +    cd $PWD
         4239  +  }
         4240  +  method build-compile-sources {PROJECT COMPILE CPPCOMPILE INCLUDES} {
         4241  +    set objext [my define get OBJEXT o]
         4242  +    set EXTERN_OBJS {}
         4243  +    set OBJECTS {}
         4244  +    set result {}
         4245  +    set builddir [$PROJECT define get builddir]
         4246  +    file mkdir [file join $builddir objs]
         4247  +    set debug [$PROJECT define get debug 0]
         4248  +
         4249  +    set task {}
         4250  +    ###
         4251  +    # Compile the C sources
         4252  +    ###
         4253  +    ::practcl::debug ### COMPILE PRODUCTS
         4254  +    foreach {ofile info} [${PROJECT} project-compile-products] {
         4255  +      ::practcl::debug $ofile $info
         4256  +      if {[dict exists $info library]} {
         4257  +        #dict set task $ofile done 1
         4258  +        continue
         4259  +      }
         4260  +      # Products with no cfile aren't compiled
         4261  +      if {![dict exists $info cfile] || [set cfile [dict get $info cfile]] eq {}} {
         4262  +        #dict set task $ofile done 1
         4263  +        continue
         4264  +      }
         4265  +      set ofile [file rootname $ofile]
         4266  +      dict set task $ofile done 0
         4267  +      if {[dict exists $info external] && [dict get $info external]==1} {
         4268  +        dict set task $ofile external 1
         4269  +      } else {
         4270  +        dict set task $ofile external 0
         4271  +      }
         4272  +      set cfile [dict get $info cfile]
         4273  +      if {$debug} {
         4274  +        set ofilename [file join $builddir objs [file rootname [file tail $ofile]].debug.${objext}]
         4275  +      } else {
         4276  +        set ofilename [file join $builddir objs [file tail $ofile]].${objext}
         4277  +      }
         4278  +      dict set task $ofile source $cfile
         4279  +      dict set task $ofile objfile $ofilename
         4280  +      if {![dict exist $info command]} {
         4281  +        if {[file extension $cfile] in {.c++ .cpp}} {
         4282  +          set cmd $CPPCOMPILE
         4283  +        } else {
         4284  +          set cmd $COMPILE
         4285  +        }
         4286  +        if {[dict exists $info extra]} {
         4287  +          append cmd " [dict get $info extra]"
         4288  +        }
         4289  +        append cmd " $INCLUDES"
         4290  +        append cmd " -c $cfile"
         4291  +        append cmd " -o $ofilename"
         4292  +        dict set task $ofile command $cmd
         4293  +      }
         4294  +    }
         4295  +    set completed 0
         4296  +    while {$completed==0} {
         4297  +      set completed 1
         4298  +      foreach {ofile info} $task {
         4299  +        set waiting {}
         4300  +        if {[dict exists $info done] && [dict get $info done]} continue
         4301  +        ::practcl::debug COMPILING $ofile $info
         4302  +        set filename [dict get $info objfile]
         4303  +        if {[file exists $filename] && [file mtime $filename]>[file mtime [dict get $info source]]} {
         4304  +          lappend result $filename
         4305  +          dict set task $ofile done 1
         4306  +          continue
         4307  +        }
         4308  +        if {[dict exists $info depend]} {
         4309  +          foreach file [dict get $info depend] {
         4310  +            if {[dict exists $task $file command] && [dict exists $task $file done] && [dict get $task $file done] != 1} {
         4311  +              set waiting $file
         4312  +              break
         4313  +            }
         4314  +          }
         4315  +        }
         4316  +        if {$waiting ne {}} {
         4317  +          set completed 0
         4318  +          puts "$ofile waiting for $waiting"
         4319  +          continue
         4320  +        }
         4321  +        if {[dict exists $info command]} {
         4322  +          set cmd [dict get $info command]
         4323  +          puts "$cmd"
         4324  +          exec {*}$cmd >&@ stdout
         4325  +        }
         4326  +        if {[file exists $filename]} {
         4327  +          lappend result $filename
         4328  +          dict set task $ofile done 1
         4329  +          continue
         4330  +        }
         4331  +        error "Failed to produce $filename"
         4332  +      }
         4333  +    }
         4334  +    return $result
         4335  +  }
         4336  +method build-Makefile {path PROJECT} {
         4337  +  array set proj [$PROJECT define dump]
         4338  +  set path $proj(builddir)
         4339  +  cd $path
         4340  +  set includedir .
         4341  +  set objext [my define get OBJEXT o]
         4342  +
         4343  +  #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)]
         4344  +  lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]]
         4345  +  lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]]
         4346  +  foreach include [$PROJECT toolset-include-directory] {
         4347  +    set cpath [::practcl::file_relative $path [file normalize $include]]
         4348  +    if {$cpath ni $includedir} {
         4349  +      lappend includedir $cpath
         4350  +    }
         4351  +  }
         4352  +  set INCLUDES  "-I[join $includedir " -I"]"
         4353  +  set NAME [string toupper $proj(name)]
         4354  +  set result {}
         4355  +  set products {}
         4356  +  set libraries {}
         4357  +  set thisline {}
         4358  +  ::practcl::cputs result "${NAME}_DEFS = $proj(DEFS)\n"
         4359  +  ::practcl::cputs result "${NAME}_INCLUDES = -I\"[join $includedir "\" -I\""]\"\n"
         4360  +  ::practcl::cputs result "${NAME}_COMPILE = \$(CC) \$(CFLAGS) \$(PKG_CFLAGS) \$(${NAME}_DEFS) \$(${NAME}_INCLUDES) \$(INCLUDES) \$(AM_CPPFLAGS) \$(CPPFLAGS) \$(AM_CFLAGS)"
         4361  +  ::practcl::cputs result "${NAME}_CPPCOMPILE = \$(CXX) \$(CFLAGS) \$(PKG_CFLAGS) \$(${NAME}_DEFS) \$(${NAME}_INCLUDES) \$(INCLUDES) \$(AM_CPPFLAGS) \$(CPPFLAGS) \$(AM_CFLAGS)"
         4362  +
         4363  +  foreach {ofile info} [$PROJECT project-compile-products] {
         4364  +    dict set products $ofile $info
         4365  +    set fname [file rootname ${ofile}].${objext}
         4366  +    if {[dict exists $info library]} {
         4367  +lappend libraries $ofile
         4368  +continue
         4369  +    }
         4370  +    if {[dict exists $info depend]} {
         4371  +      ::practcl::cputs result "\n${fname}: [dict get $info depend]"
         4372  +    } else {
         4373  +      ::practcl::cputs result "\n${fname}:"
         4374  +    }
         4375  +    set cfile [dict get $info cfile]
         4376  +    if {[file extension $cfile] in {.c++ .cpp}} {
         4377  +      set cmd "\t\$\(${NAME}_CPPCOMPILE\)"
         4378  +    } else {
         4379  +      set cmd "\t\$\(${NAME}_COMPILE\)"
         4380  +    }
         4381  +    if {[dict exists $info extra]} {
         4382  +      append cmd " [dict get $info extra]"
         4383  +    }
         4384  +    append cmd " -c [dict get $info cfile] -o \[email protected]\n\t"
         4385  +    ::practcl::cputs result  $cmd
         4386  +  }
         4387  +
         4388  +  set map {}
         4389  +  lappend map %LIBRARY_NAME% $proj(name)
         4390  +  lappend map %LIBRARY_VERSION% $proj(version)
         4391  +  lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)]
         4392  +  lappend map %LIBRARY_PREFIX% [$PROJECT define getnull libprefix]
         4393  +
         4394  +  if {[string is true [$PROJECT define get SHARED_BUILD]]} {
         4395  +    set outfile [$PROJECT define get libfile]
         4396  +  } else {
         4397  +    set outfile [$PROJECT shared_library]
         4398  +  }
         4399  +  $PROJECT define set shared_library $outfile
         4400  +  ::practcl::cputs result "
         4401  +${NAME}_SHLIB = $outfile
         4402  +${NAME}_OBJS = [dict keys $products]
         4403  +"
         4404  +
         4405  +  #lappend map %OUTFILE% {\[$]@}
         4406  +  lappend map %OUTFILE% $outfile
         4407  +  lappend map %LIBRARY_OBJECTS% "\$(${NAME}_OBJS)"
         4408  +  ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)"
         4409  +  ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_SHARED_LIB]]"
         4410  +  if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} {
         4411  +    ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]]"
         4412  +  }
         4413  +  ::practcl::cputs result {}
         4414  +  if {[string is true [$PROJECT define get SHARED_BUILD]]} {
         4415  +    #set outfile [$PROJECT static_library]
         4416  +    set outfile $proj(name).a
         4417  +  } else {
         4418  +    set outfile [$PROJECT define get libfile]
         4419  +  }
         4420  +  $PROJECT define set static_library $outfile
         4421  +  dict set map %OUTFILE% $outfile
         4422  +  ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)"
         4423  +  ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_STATIC_LIB]]"
         4424  +  ::practcl::cputs result {}
         4425  +  return $result
         4426  +}
         4427  +method build-library {outfile PROJECT} {
         4428  +  array set proj [$PROJECT define dump]
         4429  +  set path $proj(builddir)
         4430  +  cd $path
         4431  +  set includedir .
         4432  +  #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)]
         4433  +  lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]]
         4434  +  if {[$PROJECT define get TEA_PRIVATE_TCL_HEADERS 0]} {
         4435  +    if {[$PROJECT define get TEA_PLATFORM] eq "windows"} {
         4436  +      lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) win]]]
         4437  +    } else {
         4438  +      lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) unix]]]
         4439  +    }
         4440  +  }
         4441  +
         4442  +  lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]]
         4443  +
         4444  +  if {[$PROJECT define get tk 0]} {
         4445  +    lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) generic]]]
         4446  +    lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) ttk]]]
         4447  +    lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) xlib]]]
         4448  +    if {[$PROJECT define get TEA_PRIVATE_TK_HEADERS 0]} {
         4449  +      if {[$PROJECT define get TEA_PLATFORM] eq "windows"} {
         4450  +        lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) win]]]
         4451  +      } else {
         4452  +        lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) unix]]]
         4453  +      }
         4454  +    }
         4455  +    lappend includedir [::practcl::file_relative $path [file normalize $proj(TK_BIN_DIR)]]
         4456  +  }
         4457  +  foreach include [$PROJECT toolset-include-directory] {
         4458  +    set cpath [::practcl::file_relative $path [file normalize $include]]
         4459  +    if {$cpath ni $includedir} {
         4460  +      lappend includedir $cpath
         4461  +    }
         4462  +  }
         4463  +  my build-cflags $PROJECT $proj(DEFS) name version defs
         4464  +  set NAME [string toupper $name]
         4465  +  set debug [$PROJECT define get debug 0]
         4466  +  set os [$PROJECT define get TEACUP_OS]
         4467  +
         4468  +  set INCLUDES  "-I[join $includedir " -I"]"
         4469  +  if {$debug} {
         4470  +    set COMPILE "$proj(CC) $proj(CFLAGS_DEBUG) -ggdb \
         4471  +$proj(CFLAGS_WARNING) $INCLUDES $defs"
         4472  +
         4473  +    if {[info exists proc(CXX)]} {
         4474  +      set COMPILECPP "$proj(CXX) $defs $INCLUDES $proj(CFLAGS_DEBUG) -ggdb \
         4475  +  $defs $proj(CFLAGS_WARNING)"
         4476  +    } else {
         4477  +      set COMPILECPP $COMPILE
         4478  +    }
         4479  +  } else {
         4480  +    set COMPILE "$proj(CC) $proj(CFLAGS) $defs"
         4481  +
         4482  +    if {[info exists proc(CXX)]} {
         4483  +      set COMPILECPP "$proj(CXX) $defs $proj(CFLAGS)"
         4484  +    } else {
         4485  +      set COMPILECPP $COMPILE
         4486  +    }
         4487  +  }
         4488  +
         4489  +  set products [my build-compile-sources $PROJECT $COMPILE $COMPILECPP $INCLUDES]
         4490  +
         4491  +  set map {}
         4492  +  lappend map %LIBRARY_NAME% $proj(name)
         4493  +  lappend map %LIBRARY_VERSION% $proj(version)
         4494  +  lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)]
         4495  +  lappend map %OUTFILE% $outfile
         4496  +  lappend map %LIBRARY_OBJECTS% $products
         4497  +  lappend map {${CFLAGS}} "$proj(CFLAGS_DEFAULT) $proj(CFLAGS_WARNING)"
         4498  +
         4499  +  if {[string is true [$PROJECT define get SHARED_BUILD 1]]} {
         4500  +    set cmd [$PROJECT define get PRACTCL_SHARED_LIB]
         4501  +    append cmd " [$PROJECT define get PRACTCL_LIBS]"
         4502  +    set cmd [string map $map $cmd]
         4503  +    puts $cmd
         4504  +    exec {*}$cmd >&@ stdout
         4505  +    if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} {
         4506  +      set cmd [string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]]
         4507  +      puts $cmd
         4508  +      exec {*}$cmd >&@ stdout
         4509  +    }
         4510  +  } else {
         4511  +    set cmd [string map $map [$PROJECT define get PRACTCL_STATIC_LIB]]
         4512  +    puts $cmd
         4513  +    exec {*}$cmd >&@ stdout
         4514  +  }
         4515  +  set ranlib [$PROJECT define get RANLIB]
         4516  +  if {$ranlib ni {{} :}} {
         4517  +    catch {exec $ranlib $outfile}
         4518  +  }
         4519  +}
         4520  +method build-tclsh {outfile PROJECT} {
         4521  +  if {[my define get tk 0] && [my define get static_tk 0]} {
         4522  +    puts " BUILDING STATIC TCL/TK EXE $PROJECT"
         4523  +    set TKOBJ  [$PROJECT tkcore]
         4524  +    if {[info command $TKOBJ] eq {}} {
         4525  +      set TKOBJ ::noop
         4526  +      $PROJECT define set static_tk 0
         4527  +    } else {
         4528  +      ::practcl::toolset select $TKOBJ
         4529  +      array set TK  [$TKOBJ read_configuration]
         4530  +      set do_tk [$TKOBJ define get static]
         4531  +      $PROJECT define set static_tk $do_tk
         4532  +      $PROJECT define set tk $do_tk
         4533  +      set TKSRCDIR [$TKOBJ define get srcdir]
         4534  +    }
         4535  +  } else {
         4536  +    puts " BUILDING STATIC TCL EXE $PROJECT"
         4537  +    set TKOBJ ::noop
         4538  +    my define set static_tk 0
         4539  +  }
         4540  +  set TCLOBJ [$PROJECT tclcore]
         4541  +  ::practcl::toolset select $TCLOBJ
         4542  +  set PKG_OBJS {}
         4543  +  foreach item [$PROJECT link list core.library] {
         4544  +    if {[string is true [$item define get static]]} {
         4545  +      lappend PKG_OBJS $item
         4546  +    }
         4547  +  }
         4548  +  foreach item [$PROJECT link list package] {
         4549  +    if {[string is true [$item define get static]]} {
         4550  +      lappend PKG_OBJS $item
         4551  +    }
         4552  +  }
         4553  +  array set TCL [$TCLOBJ read_configuration]
         4554  +  set path [file dirname $outfile]
         4555  +  cd $path
         4556  +  ###
         4557  +  # For a static Tcl shell, we need to build all local sources
         4558  +  # with the same DEFS flags as the tcl core was compiled with.
         4559  +  # The DEFS produced by a TEA extension aren't intended to operate
         4560  +  # with the internals of a staticly linked Tcl
         4561  +  ###
         4562  +  my build-cflags $PROJECT $TCL(defs) name version defs
         4563  +  set debug [$PROJECT define get debug 0]
         4564  +  set NAME [string toupper $name]
         4565  +  set result {}
         4566  +  set libraries {}
         4567  +  set thisline {}
         4568  +  set OBJECTS {}
         4569  +  set EXTERN_OBJS {}
         4570  +  foreach obj $PKG_OBJS {
         4571  +    $obj compile
         4572  +    set config($obj) [$obj read_configuration]
         4573  +  }
         4574  +  set os [$PROJECT define get TEACUP_OS]
         4575  +  set TCLSRCDIR [$TCLOBJ define get srcdir]
         4576  +
         4577  +  set includedir .
         4578  +  foreach include [$TCLOBJ toolset-include-directory] {
         4579  +    set cpath [::practcl::file_relative $path [file normalize $include]]
         4580  +    if {$cpath ni $includedir} {
         4581  +      lappend includedir $cpath
         4582  +    }
         4583  +  }
         4584  +  lappend includedir [::practcl::file_relative $path [file normalize ../tcl/compat/zlib]]
         4585  +  if {[$PROJECT define get static_tk]} {
         4586  +    lappend includedir [::practcl::file_relative $path [file normalize [file join $TKSRCDIR generic]]]
         4587  +    lappend includedir [::practcl::file_relative $path [file normalize [file join $TKSRCDIR ttk]]]
         4588  +    lappend includedir [::practcl::file_relative $path [file normalize [file join $TKSRCDIR xlib]]]
         4589  +    lappend includedir [::practcl::file_relative $path [file normalize $TKSRCDIR]]
         4590  +  }
         4591  +
         4592  +  foreach include [$PROJECT toolset-include-directory] {
         4593  +    set cpath [::practcl::file_relative $path [file normalize $include]]
         4594  +    if {$cpath ni $includedir} {
         4595  +      lappend includedir $cpath
         4596  +    }
         4597  +  }
         4598  +
         4599  +  set INCLUDES  "-I[join $includedir " -I"]"
         4600  +  if {$debug} {
         4601  +      set COMPILE "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_debug) -ggdb \
         4602  +$TCL(cflags_warning) $TCL(extra_cflags)"
         4603  +  } else {
         4604  +      set COMPILE "$TCL(cc) $TCL(shlib_cflags) $TCL(cflags_optimize) \
         4605  +$TCL(cflags_warning) $TCL(extra_cflags)"
         4606  +  }
         4607  +  append COMPILE " " $defs
         4608  +  lappend OBJECTS {*}[my build-compile-sources $PROJECT $COMPILE $COMPILE $INCLUDES]
         4609  +
         4610  +  set TCLSRC [file normalize $TCLSRCDIR]
         4611  +
         4612  +  if {[${PROJECT} define get TEACUP_OS] eq "windows"} {
         4613  +    set windres [$PROJECT define get RC windres]
         4614  +    set RSOBJ [file join $path build tclkit.res.o]
         4615  +    set RCSRC [${PROJECT} define get kit_resource_file]
         4616  +    set RCMAN [${PROJECT} define get kit_manifest_file]
         4617  +
         4618  +    set cmd [list $windres -o $RSOBJ -DSTATIC_BUILD --include [::practcl::file_relative $path [file join $TCLSRC generic]]]
         4619  +    if {[$PROJECT define get static_tk]} {
         4620  +      if {$RCSRC eq {} || ![file exists $RCSRC]} {
         4621  +        set RCSRC [file join $TKSRCDIR win rc wish.rc]
         4622  +      }
         4623  +      if {$RCMAN eq {} || ![file exists $RCMAN]} {
         4624  +        set RCMAN [file join [$TKOBJ define get builddir] wish.exe.manifest]
         4625  +      }
         4626  +      set TKSRC [file normalize $TKSRCDIR]
         4627  +      lappend cmd --include [::practcl::file_relative $path [file join $TKSRC generic]] \
         4628  +        --include [::practcl::file_relative $path [file join $TKSRC win]] \
         4629  +        --include [::practcl::file_relative $path [file join $TKSRC win rc]]
         4630  +    } else {
         4631  +      if {$RCSRC eq {} || ![file exists $RCSRC]} {
         4632  +        set RCSRC [file join $TCLSRCDIR tclsh.rc]
         4633  +      }
         4634  +      if {$RCMAN eq {} || ![file exists $RCMAN]} {
         4635  +        set RCMAN [file join [$TCLOBJ define get builddir] tclsh.exe.manifest]
         4636  +      }
         4637  +    }
         4638  +    foreach item [${PROJECT} define get resource_include] {
         4639  +      lappend cmd --include [::practcl::file_relative $path [file normalize $item]]
         4640  +    }
         4641  +    lappend cmd [file tail $RCSRC]
         4642  +    if {![file exists [file join $path [file tail $RCSRC]]]} {
         4643  +      file copy -force $RCSRC [file join $path [file tail $RCSRC]]
         4644  +    }
         4645  +    if {![file exists [file join $path [file tail $RCMAN]]]} {
         4646  +      file copy -force $RCMAN [file join $path [file tail $RCMAN]]
         4647  +    }
         4648  +    ::practcl::doexec {*}$cmd
         4649  +    lappend OBJECTS $RSOBJ
         4650  +  }
         4651  +  puts "***"
         4652  +  set cmd "$TCL(cc)"
         4653  +  if {$debug} {
         4654  +   append cmd " $TCL(cflags_debug)"
         4655  +  } else {
         4656  +   append cmd " $TCL(cflags_optimize)"
         4657  +  }
         4658  +  append cmd " $TCL(ld_flags)"
         4659  +  if {$debug} {
         4660  +   append cmd " $TCL(ldflags_debug)"
         4661  +  } else {
         4662  +   append cmd " $TCL(ldflags_optimize)"
         4663  +  }
         4664  +
         4665  +  append cmd " $OBJECTS"
         4666  +  append cmd " $EXTERN_OBJS"
         4667  +  if {$debug && $os eq "windows"} {
         4668  +    ###
         4669  +    # There is bug in the core's autoconf and the value for
         4670  +    # tcl_build_lib_spec does not have the 'g' suffix
         4671  +    ###
         4672  +    append cmd " -L[file dirname $TCL(build_stub_lib_path)] -ltcl86g"
         4673  +    if {[$PROJECT define get static_tk]} {
         4674  +      append cmd " -L[file dirname $TK(build_stub_lib_path)] -ltk86g"
         4675  +    }
         4676  +  } else {
         4677  +    append cmd " $TCL(build_lib_spec)"
         4678  +    if {[$PROJECT define get static_tk]} {
         4679  +      append cmd  " $TK(build_lib_spec)"
         4680  +    }
         4681  +  }
         4682  +  foreach obj $PKG_OBJS {
         4683  +    append cmd " [$obj linker-products $config($obj)]"
         4684  +  }
         4685  +  set LIBS {}
         4686  +  foreach item $TCL(libs) {
         4687  +    if {[string range $item 0 1] eq "-l" && $item in $LIBS } continue
         4688  +    lappend LIBS $item
         4689  +  }
         4690  +  if {[$PROJECT define get static_tk]} {
         4691  +    foreach item $TK(libs) {
         4692  +      if {[string range $item 0 1] eq "-l" && $item in $LIBS } continue
         4693  +      lappend LIBS $item
         4694  +    }
         4695  +  }
         4696  +  if {[info exists TCL(extra_libs)]} {
         4697  +    foreach item $TCL(extra_libs) {
         4698  +      if {[string range $item 0 1] eq "-l" && $item in $LIBS } continue
         4699  +      lappend LIBS $item
         4700  +    }
         4701  +  }
         4702  +  foreach obj $PKG_OBJS {
         4703  +    puts [list Checking $obj for external dependencies]
         4704  +    foreach item [$obj linker-external $config($obj)] {
         4705  +      puts [list $obj adds $item]
         4706  +      if {[string range $item 0 1] eq "-l" && $item in $LIBS } continue
         4707  +      lappend LIBS $item
         4708  +    }
         4709  +  }
         4710  +  append cmd " ${LIBS}"
         4711  +  foreach obj $PKG_OBJS {
         4712  +    puts [list Checking $obj for additional link items]
         4713  +    foreach item [$obj linker-extra $config($obj)] {
         4714  +      append cmd $item
         4715  +    }
         4716  +  }
         4717  +  if {$debug && $os eq "windows"} {
         4718  +    append cmd " -L[file dirname $TCL(build_stub_lib_path)] ${TCL(stub_lib_flag)}"
         4719  +    if {[$PROJECT define get static_tk]} {
         4720  +      append cmd " -L[file dirname $TK(build_stub_lib_path)] ${TK(stub_lib_flag)}"
         4721  +    }
         4722  +  } else {
         4723  +    append cmd " $TCL(build_stub_lib_spec)"
         4724  +    if {[$PROJECT define get static_tk]} {
         4725  +      append cmd " $TK(build_stub_lib_spec)"
         4726  +    }
         4727  +  }
         4728  +  if {[info exists TCL(cc_search_flags)]} {
         4729  +    append cmd " $TCL(cc_search_flags)"
         4730  +  }
         4731  +  append cmd " -o $outfile "
         4732  +  if {$os eq "windows"} {
         4733  +    set LDFLAGS_CONSOLE {-mconsole -pipe -static-libgcc}
         4734  +    set LDFLAGS_WINDOW  {-mwindows -pipe -static-libgcc}
         4735  +    append cmd " $LDFLAGS_CONSOLE"
         4736  +  }
         4737  +  puts "LINK: $cmd"
         4738  +  exec {*}[string map [list "\n" " " "  " " "] $cmd] >&@ stdout
         4739  +}
         4740  +}
         4741  +
         4742  +###
         4743  +# END: class toolset gcc.tcl
         4744  +###
         4745  +###
         4746  +# START: class toolset msvc.tcl
         4747  +###
         4748  +::clay::define ::practcl::toolset.msvc {
         4749  +  superclass ::practcl::toolset
         4750  +  method BuildDir {PWD} {
         4751  +    set srcdir [my define get srcdir]
         4752  +    return $srcdir
         4753  +  }
         4754  +  Ensemble make::autodetect {} {
         4755  +  }
         4756  +  Ensemble make::clean {} {
         4757  +    set PWD [pwd]
         4758  +    set srcdir [my define get srcdir]
         4759  +    cd $srcdir
         4760  +    catch {::practcl::doexec nmake -f makefile.vc clean}
         4761  +    cd $PWD
         4762  +  }
         4763  +  Ensemble make::compile {} {
         4764  +    set srcdir [my define get srcdir]
         4765  +    if {[my define get static 1]} {
         4766  +      puts "BUILDING Static $name $srcdir"
         4767  +    } else {
         4768  +      puts "BUILDING Dynamic $name $srcdir"
         4769  +    }
         4770  +    cd $srcdir
         4771  +    if {[file exists [file join $srcdir make.tcl]]} {
         4772  +      if {[my define get debug 0]} {
         4773  +        ::practcl::domake.tcl $srcdir debug all
         4774  +      } else {
         4775  +        ::practcl::domake.tcl $srcdir all
         4776  +      }
         4777  +    } else {
         4778  +      if {[file exists [file join $srcdir makefile.vc]]} {
         4779  +        ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> define get installdir]  {*}[my NmakeOpts] release
         4780  +      } elseif {[file exists [file join $srcdir win makefile.vc]]} {
         4781  +        cd [file join $srcdir win]
         4782  +        ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> define get installdir]  {*}[my NmakeOpts] release
         4783  +      } else {
         4784  +        error "No make.tcl or makefile.vc found for project $name"
         4785  +      }
         4786  +    }
         4787  +  }
         4788  +  Ensemble make::install DEST {
         4789  +    set PWD [pwd]
         4790  +    set srcdir [my define get srcdir]
         4791  +    cd $srcdir
         4792  +    if {$DEST eq {}} {
         4793  +      error "No destination given"
         4794  +    }
         4795  +    if {[my <project> define get LOCAL 0] || $DEST eq {}} {
         4796  +      if {[file exists [file join $srcdir make.tcl]]} {
         4797  +        # Practcl builds can inject right to where we need them
         4798  +        puts "[self] Local Install (Practcl)"
         4799  +        ::practcl::domake.tcl $srcdir install
         4800  +      } else {
         4801  +        puts "[self] Local Install (Nmake)"
         4802  +        ::practcl::doexec nmake -f makefile.vc {*}[my NmakeOpts] install
         4803  +      }
         4804  +    } else {
         4805  +      if {[file exists [file join $srcdir make.tcl]]} {
         4806  +        # Practcl builds can inject right to where we need them
         4807  +        puts "[self] VFS INSTALL $DEST (Practcl)"
         4808  +        ::practcl::domake.tcl $srcdir install-package $DEST
         4809  +      } else {
         4810  +        puts "[self] VFS INSTALL $DEST"
         4811  +        ::practcl::doexec nmake -f makefile.vc INSTALLDIR=$DEST {*}[my NmakeOpts] install
         4812  +      }
         4813  +    }
         4814  +    cd $PWD
         4815  +  }
         4816  +  method MakeDir {srcdir} {
         4817  +    set localsrcdir $srcdir
         4818  +    if {[file exists [file join $srcdir generic]]} {
         4819  +      my define add include_dir [file join $srcdir generic]
         4820  +    }
         4821  +    if {[file exists [file join $srcdir win]]} {
         4822  +       my define add include_dir [file join $srcdir win]
         4823  +    }
         4824  +    if {[file exists [file join $srcdir makefile.vc]]} {
         4825  +      set localsrcdir [file join $srcdir win]
         4826  +    }
         4827  +    return $localsrcdir
         4828  +  }
         4829  +  method NmakeOpts {} {
         4830  +    set opts {}
         4831  +    set builddir [file normalize [my define get builddir]]
         4832  +
         4833  +    if {[my <project> define exists tclsrcdir]} {
         4834  +      ###
         4835  +      # On Windows we are probably running under MSYS, which doesn't deal with
         4836  +      # spaces in filename well
         4837  +      ###
         4838  +      set TCLSRCDIR  [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tclsrcdir] ..]]]
         4839  +      set TCLGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tclsrcdir] .. generic]]]
         4840  +      lappend opts TCLDIR=[file normalize $TCLSRCDIR]
         4841  +      #--with-tclinclude=$TCLGENERIC
         4842  +    }
         4843  +    if {[my <project> define exists tksrcdir]} {
         4844  +      set TKSRCDIR  [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tksrcdir] ..]]]
         4845  +      set TKGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tksrcdir] .. generic]]]
         4846  +      #lappend opts --with-tk=$TKSRCDIR --with-tkinclude=$TKGENERIC
         4847  +      lappend opts TKDIR=[file normalize $TKSRCDIR]
         4848  +    }
         4849  +    return $opts
         4850  +  }
         4851  +}
         4852  +
         4853  +###
         4854  +# END: class toolset msvc.tcl
         4855  +###
         4856  +###
         4857  +# START: class target.tcl
         4858  +###
         4859  +::clay::define ::practcl::make_obj {
         4860  +  superclass ::practcl::metaclass
         4861  +  constructor {module_object name info {action_body {}}} {
         4862  +    my variable define triggered domake
         4863  +    set triggered 0
         4864  +    set domake 0
         4865  +    set define(name) $name
         4866  +    set define(action) {}
         4867  +    array set define $info
         4868  +    my select
         4869  +    my initialize
         4870  +    foreach {stub obj} [$module_object child organs] {
         4871  +      my graft $stub $obj
         4872  +    }
         4873  +    if {$action_body ne {}} {
         4874  +      set define(action) $action_body
         4875  +    }
         4876  +  }
         4877  +  method do {} {
         4878  +    my variable domake
         4879  +    return $domake
         4880  +  }
         4881  +  method check {} {
         4882  +    my variable needs_make domake
         4883  +    if {$domake} {
         4884  +      return 1
         4885  +    }
         4886  +    if {[info exists needs_make]} {
         4887  +      return $needs_make
         4888  +    }
         4889  +    set make_objects [my <module> make objects]
         4890  +    set needs_make 0
         4891  +    foreach item [my define get depends] {
         4892  +      if {![dict exists $make_objects $item]} continue
         4893  +      set depobj [dict get $make_objects $item]
         4894  +      if {$depobj eq [self]} {
         4895  +        puts "WARNING [self] depends on itself"
         4896  +        continue
         4897  +      }
         4898  +      if {[$depobj check]} {
         4899  +        set needs_make 1
         4900  +      }
         4901  +    }
         4902  +    if {!$needs_make} {
         4903  +      foreach filename [my output] {
         4904  +        if {$filename ne {} && ![file exists $filename]} {
         4905  +          set needs_make 1
         4906  +        }
         4907  +      }
         4908  +    }
         4909  +    return $needs_make
         4910  +  }
         4911  +  method output {} {
         4912  +    set result {}
         4913  +    set filename [my define get filename]
         4914  +    if {$filename ne {}} {
         4915  +      lappend result $filename
         4916  +    }
         4917  +    foreach filename [my define get files] {
         4918  +      if {$filename ne {}} {
         4919  +        lappend result $filename
         4920  +      }
         4921  +    }
         4922  +    return $result
         4923  +  }
         4924  +  method reset {} {
         4925  +    my variable triggered domake needs_make
         4926  +    set triggerd 0
         4927  +    set domake 0
         4928  +    set needs_make 0
         4929  +  }
         4930  +  method triggers {} {
         4931  +    my variable triggered domake define
         4932  +    if {$triggered} {
         4933  +      return $domake
         4934  +    }
         4935  +    set triggered 1
         4936  +    set make_objects [my <module> make objects]
         4937  +
         4938  +    foreach item [my define get depends] {
         4939  +      if {![dict exists $make_objects $item]} continue
         4940  +      set depobj [dict get $make_objects $item]
         4941  +      if {$depobj eq [self]} {
         4942  +        puts "WARNING [self] triggers itself"
         4943  +        continue
         4944  +      } else {
         4945  +        set r [$depobj check]
         4946  +        if {$r} {
         4947  +          $depobj triggers
         4948  +        }
         4949  +      }
         4950  +    }
         4951  +    set domake 1
         4952  +    my <module> make trigger {*}[my define get triggers]
         4953  +  }
         4954  +}
         4955  +
         4956  +###
         4957  +# END: class target.tcl
         4958  +###
         4959  +###
         4960  +# START: class object.tcl
         4961  +###
         4962  +::clay::define ::practcl::object {
         4963  +  superclass ::practcl::metaclass
         4964  +  constructor {parent args} {
         4965  +    my variable links define
         4966  +    set organs [$parent child organs]
         4967  +    my clay delegate {*}$organs
         4968  +    array set define $organs
         4969  +    array set define [$parent child define]
         4970  +    array set links {}
         4971  +    if {[llength $args]==1 && [file exists [lindex $args 0]]} {
         4972  +      my define set filename [lindex $args 0]
         4973  +      ::practcl::product select [self]
         4974  +    } elseif {[llength $args] == 1} {
         4975  +      set data  [uplevel 1 [list subst [lindex $args 0]]]
         4976  +      array set define $data
         4977  +      my select
         4978  +    } else {
         4979  +      array set define [uplevel 1 [list subst $args]]
         4980  +      my select
         4981  +    }
         4982  +    my initialize
         4983  +
         4984  +  }
         4985  +  method child {method} {
         4986  +    return {}
         4987  +  }
         4988  +  method go {} {
         4989  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         4990  +    my variable links
         4991  +    foreach {linktype objs} [array get links] {
         4992  +      foreach obj $objs {
         4993  +        $obj go
         4994  +      }
         4995  +    }
         4996  +    ::practcl::debug [list /[self] [self method] [self class]]
         4997  +  }
         4998  +}
         4999  +
         5000  +###
         5001  +# END: class object.tcl
         5002  +###
         5003  +###
         5004  +# START: class dynamic.tcl
         5005  +###
         5006  +::clay::define ::practcl::dynamic {
         5007  +  method cstructure {name definition {argdat {}}} {
         5008  +    my variable cstruct
         5009  +    dict set cstruct $name body $definition
         5010  +    foreach {f v} $argdat {
         5011  +      dict set cstruct $name $f $v
         5012  +    }
         5013  +    if {![dict exists $cstruct $name public]} {
         5014  +      dict set cstruct $name public 1
         5015  +    }
         5016  +  }
         5017  +  method include header {
         5018  +    my define add include $header
         5019  +  }
         5020  +  method include_dir args {
         5021  +    my define add include_dir {*}$args
         5022  +  }
         5023  +  method include_directory args {
         5024  +    my define add include_dir {*}$args
         5025  +  }
         5026  +  method c_header body {
         5027  +    my variable code
         5028  +    ::practcl::cputs code(header) $body
         5029  +  }
         5030  +  method c_code body {
         5031  +    my variable code
         5032  +    ::practcl::cputs code(funct) $body
         5033  +  }
         5034  +  method c_function {header body {info {}}} {
         5035  +    set header [string map "\t \  \n \ \ \  \ " $header]
         5036  +    my variable code cfunct
         5037  +    foreach regexp {
         5038  +         {(.*) ([a-zA-Z_][a-zA-Z0-9_]*) *\((.*)\)}
         5039  +         {(.*) (\x2a[a-zA-Z_][a-zA-Z0-9_]*) *\((.*)\)}
         5040  +    } {
         5041  +      if {[regexp $regexp $header all keywords funcname arglist]} {
         5042  +        set dat [dict merge {export 0 extern 0 public 1 inline 0} $info]
         5043  +        dict set dat header $header
         5044  +        dict set dat body $body
         5045  +        dict set dat keywords $keywords
         5046  +        dict set dat arglist $arglist
         5047  +        if {"IRM_INLINE" in $keywords || "CTHULHU_INLINE" in $keywords} {
         5048  +          dict set dat public 1
         5049  +          dict set dat extern 0
         5050  +          dict set dat inline 1
         5051  +        } else {
         5052  +          if {"inline" in $keywords} {
         5053  +            dict set dat inline 1
         5054  +          }
         5055  +          if {"STUB_EXPORT" in $keywords} {
         5056  +            dict set dat extern 1
         5057  +            dict set dat public 1
         5058  +            dict set dat export 1
         5059  +            dict set dat inline 0
         5060  +          } elseif {"extern" in $keywords} {
         5061  +            dict set dat extern 1
         5062  +            dict set dat public 1
         5063  +          } elseif {"static" in $keywords} {
         5064  +            dict set dat public 0
         5065  +          }
         5066  +        }
         5067  +        if {[dict get $dat inline] && [dict get $dat public]} {
         5068  +          set header [string map {IRM_INLINE {} CTHULHU_INLINE {} static {} inline {} extern {}} [dict get $dat header]]
         5069  +          dict set dat header "extern $header"
         5070  +        }
         5071  +        dict set cfunct $funcname $dat
         5072  +        return
         5073  +      }
         5074  +    }
         5075  +    puts "WARNING: NON CONFORMING FUNCTION DEFINITION: $headers $body"
         5076  +    ::practcl::cputs code(header) "$header\;"
         5077  +    # Could not parse that block as a function
         5078  +    # append it verbatim to our c_implementation
         5079  +    ::practcl::cputs code(funct) "$header [list $body]"
         5080  +  }
         5081  +  method c_tcloomethod {name body {arginfo {}}} {
         5082  +    my variable methods code
         5083  +    foreach {f v} $arginfo {
         5084  +      dict set methods $name $f $v
         5085  +    }
         5086  +    dict set methods $name body "Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */
         5087  +$body"
         5088  +  }
         5089  +  method cmethod {name body {arginfo {}}} {
         5090  +    my variable methods code
         5091  +    foreach {f v} $arginfo {
         5092  +      dict set methods $name $f $v
         5093  +    }
         5094  +    dict set methods $name body "Tcl_Object thisObject = Tcl_ObjectContextObject(objectContext); /* The current connection object */
         5095  +$body"
         5096  +  }
         5097  +  method c_tclproc_nspace nspace {
         5098  +    my variable code
         5099  +    if {![info exists code(nspace)]} {
         5100  +      set code(nspace) {}
         5101  +    }
         5102  +    if {$nspace ni $code(nspace)} {
         5103  +      lappend code(nspace) $nspace
         5104  +    }
         5105  +  }
         5106  +  method c_tclcmd {name body {arginfo {}}} {
         5107  +    my variable tclprocs code
         5108  +
         5109  +    foreach {f v} $arginfo {
         5110  +      dict set tclprocs $name $f $v
         5111  +    }
         5112  +    dict set tclprocs $name body $body
         5113  +  }
         5114  +  method c_tclproc_raw {name body {arginfo {}}} {
         5115  +    my variable tclprocs code
         5116  +
         5117  +    foreach {f v} $arginfo {
         5118  +      dict set tclprocs $name $f $v
         5119  +    }
         5120  +    dict set tclprocs $name body $body
         5121  +  }
         5122  +  method tcltype {name argdat} {
         5123  +    my variable tcltype
         5124  +    foreach {f v} $argdat {
         5125  +      dict set tcltype $name $f $v
         5126  +    }
         5127  +    if {![dict exists tcltype $name cname]} {
         5128  +      dict set tcltype $name cname [string tolower $name]_tclobjtype
         5129  +    }
         5130  +    lappend map @[email protected] $name
         5131  +    set info [dict get $tcltype $name]
         5132  +    foreach {f v} $info {
         5133  +      lappend map @[string toupper $f]@ $v
         5134  +    }
         5135  +    foreach {func fpat template} {
         5136  +      freeproc         {@[email protected]_freeIntRepProc}       {void @[email protected](Tcl_Obj *objPtr)}
         5137  +      dupproc          {@[email protected]_dupIntRepProc}        {void @[email protected](Tcl_Obj *srcPtr,Tcl_Obj *dupPtr)}
         5138  +      updatestringproc {@[email protected]_updateStringRepProc} {void @[email protected](Tcl_Obj *objPtr)}
         5139  +      setfromanyproc   {@[email protected]_setFromAnyProc}       {int @[email protected](Tcl_Interp *interp,Tcl_Obj *objPtr)}
         5140  +    } {
         5141  +      if {![dict exists $info $func]} {
         5142  +        error "$name does not define $func"
         5143  +      }
         5144  +      set body [dict get $info $func]
         5145  +      # We were given a function name to call
         5146  +      if {[llength $body] eq 1} continue
         5147  +      set fname [string map [list @[email protected] [string totitle $name]] $fpat]
         5148  +      my c_function [string map [list @[email protected] $fname] $template] [string map $map $body]
         5149  +      dict set tcltype $name $func $fname
         5150  +    }
         5151  +  }
         5152  +  method project-compile-products {} {
         5153  +    set filename [my define get output_c]
         5154  +    set result {}
         5155  +    if {$filename ne {}} {
         5156  +      ::practcl::debug [self] [self class] [self method] project-compile-products $filename
         5157  +
         5158  +      if {[my define exists ofile]} {
         5159  +        set ofile [my define get ofile]
         5160  +      } else {
         5161  +        set ofile [my Ofile $filename]
         5162  +        my define set ofile $ofile
         5163  +      }
         5164  +      lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]]
         5165  +    } else {
         5166  +      set filename [my define get cfile]
         5167  +      if {$filename ne {}} {
         5168  +        ::practcl::debug [self] [self class] [self method] project-compile-products $filename
         5169  +        if {[my define exists ofile]} {
         5170  +          set ofile [my define get ofile]
         5171  +        } else {
         5172  +          set ofile [my Ofile $filename]
         5173  +          my define set ofile $ofile
         5174  +        }
         5175  +        lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]]
         5176  +      }
         5177  +    }
         5178  +    foreach item [my link list subordinate] {
         5179  +      lappend result {*}[$item project-compile-products]
         5180  +    }
         5181  +    return $result
         5182  +  }
         5183  +  method implement path {
         5184  +    my go
         5185  +    my Collate_Source $path
         5186  +    if {[my define get output_c] eq {}} return
         5187  +    set filename [file join $path [my define get output_c]]
         5188  +    ::practcl::debug [self] [my define get filename] WANTS TO GENERATE $filename
         5189  +    my define set cfile $filename
         5190  +    set fout [open $filename w]
         5191  +    puts $fout [my generate-c]
         5192  +    if {[my define get initfunc] ne {}} {
         5193  +      puts $fout "extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \x7B"
         5194  +      puts $fout [my generate-loader-module]
         5195  +      if {[my define get pkg_name] ne {}} {
         5196  +        puts $fout "   Tcl_PkgProvide(interp, \"[my define get pkg_name]\", \"[my define get pkg_vers]\");"
         5197  +      }
         5198  +      puts $fout "  return TCL_OK\;"
         5199  +      puts $fout "\x7D"
         5200  +    }
         5201  +    close $fout
         5202  +  }
         5203  +  method initialize {} {
         5204  +    set filename [my define get filename]
         5205  +    if {$filename eq {}} {
         5206  +      return
         5207  +    }
         5208  +    if {[my define get name] eq {}} {
         5209  +      my define set name [file tail [file rootname $filename]]
         5210  +    }
         5211  +    if {[my define get localpath] eq {}} {
         5212  +      my define set localpath [my <module> define get localpath]_[my define get name]
         5213  +    }
         5214  +    ::source $filename
         5215  +  }
         5216  +  method linktype {} {
         5217  +    return {subordinate product dynamic}
         5218  +  }
         5219  +  method generate-cfile-constant {} {
         5220  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5221  +    set result {}
         5222  +    my variable code cstruct methods tcltype
         5223  +    if {[info exists code(constant)]} {
         5224  +      ::practcl::cputs result "/* [my define get filename] CONSTANT */"
         5225  +      ::practcl::cputs result $code(constant)
         5226  +    }
         5227  +    if {[info exists cstruct]} {
         5228  +      foreach {name info} $cstruct {
         5229  +        set map {}
         5230  +        lappend map @[email protected] $name
         5231  +        lappend map @[email protected] GET[string toupper $name]
         5232  +
         5233  +        if {[dict exists $info deleteproc]} {
         5234  +          lappend map @[email protected] [dict get $info deleteproc]
         5235  +        } else {
         5236  +          lappend map @[email protected] NULL
         5237  +        }
         5238  +        if {[dict exists $info cloneproc]} {
         5239  +          lappend map @[email protected] [dict get $info cloneproc]
         5240  +        } else {
         5241  +          lappend map @[email protected] NULL
         5242  +        }
         5243  +        ::practcl::cputs result [string map $map {
         5244  +const static Tcl_ObjectMetadataType @[email protected] = {
         5245  +  TCL_OO_METADATA_VERSION_CURRENT,
         5246  +  "@[email protected]",
         5247  +  @[email protected],
         5248  +  @[email protected]
         5249  +};
         5250  +#define @[email protected](OBJCONTEXT) (@[email protected] *) Tcl_ObjectGetMetadata(OBJCONTEXT,&@[email protected])
         5251  +}]
         5252  +      }
         5253  +    }
         5254  +    if {[info exists tcltype]} {
         5255  +      foreach {type info} $tcltype {
         5256  +        dict with info {}
         5257  +        ::practcl::cputs result "const Tcl_ObjType $cname = \{\n .name=\"$type\",\n .freeIntRepProc = &${freeproc},\n  .dupIntRepProc = &${dupproc},\n  .updateStringProc = &${updatestringproc},\n  .setFromAnyProc = &${setfromanyproc}\n\}\;"
         5258  +      }
         5259  +    }
         5260  +
         5261  +    if {[info exists methods]} {
         5262  +      set mtypes {}
         5263  +      foreach {name info} $methods {
         5264  +        set callproc   [dict get $info callproc]
         5265  +        set methodtype [dict get $info methodtype]
         5266  +        if {$methodtype in $mtypes} continue
         5267  +        lappend mtypes $methodtype
         5268  +        ###
         5269  +        # Build the data struct for this method
         5270  +        ###
         5271  +        ::practcl::cputs result "const static Tcl_MethodType $methodtype = \{"
         5272  +        ::practcl::cputs result "  .version = TCL_OO_METADATA_VERSION_CURRENT,\n  .name = \"$name\",\n  .callProc = $callproc,"
         5273  +        if {[dict exists $info deleteproc]} {
         5274  +          set deleteproc [dict get $info deleteproc]
         5275  +        } else {
         5276  +          set deleteproc NULL
         5277  +        }
         5278  +        if {$deleteproc ni { {} NULL }} {
         5279  +          ::practcl::cputs result "  .deleteProc = $deleteproc,"
         5280  +        } else {
         5281  +          ::practcl::cputs result "  .deleteProc = NULL,"
         5282  +        }
         5283  +        if {[dict exists $info cloneproc]} {
         5284  +          set cloneproc [dict get $info cloneproc]
         5285  +        } else {
         5286  +          set cloneproc NULL
         5287  +        }
         5288  +        if {$cloneproc ni { {} NULL }} {
         5289  +          ::practcl::cputs result "  .cloneProc = $cloneproc\n\}\;"
         5290  +        } else {
         5291  +          ::practcl::cputs result "  .cloneProc = NULL\n\}\;"
         5292  +        }
         5293  +        dict set methods $name methodtype $methodtype
         5294  +      }
         5295  +    }
         5296  +    foreach obj [my link list product] {
         5297  +      # Exclude products that will generate their own C files
         5298  +      if {[$obj define get output_c] ne {}} continue
         5299  +      ::practcl::cputs result [$obj generate-cfile-constant]
         5300  +    }
         5301  +    return $result
         5302  +  }
         5303  +  method generate-cfile-header {} {
         5304  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5305  +    my variable code cfunct cstruct methods tcltype tclprocs
         5306  +    set result {}
         5307  +    if {[info exists code(header)]} {
         5308  +      ::practcl::cputs result $code(header)
         5309  +    }
         5310  +    ::practcl::debug [list cfunct [info exists cfunct]]
         5311  +    if {[info exists cfunct]} {
         5312  +      foreach {funcname info} $cfunct {
         5313  +        if {[dict get $info public]} continue
         5314  +        ::practcl::cputs result "[dict get $info header]\;"
         5315  +      }
         5316  +    }
         5317  +    ::practcl::debug [list tclprocs [info exists tclprocs]]
         5318  +    if {[info exists tclprocs]} {
         5319  +      foreach {name info} $tclprocs {
         5320  +        if {[dict exists $info header]} {
         5321  +          ::practcl::cputs result "[dict get $info header]\;"
         5322  +        }
         5323  +      }
         5324  +    }
         5325  +    ::practcl::debug [list methods [info exists methods] [my define get cclass]]
         5326  +    if {[info exists methods]} {
         5327  +      set thisclass [my define get cclass]
         5328  +      foreach {name info} $methods {
         5329  +        if {[dict exists $info header]} {
         5330  +          ::practcl::cputs result "[dict get $info header]\;"
         5331  +        }
         5332  +      }
         5333  +      # Add the initializer wrapper for the class
         5334  +      ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp)\;"
         5335  +    }
         5336  +    foreach obj [my link list product] {
         5337  +      # Exclude products that will generate their own C files
         5338  +      if {[$obj define get output_c] ne {}} continue
         5339  +      set dat [$obj generate-cfile-header]
         5340  +      if {[string length [string trim $dat]]} {
         5341  +        ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */"
         5342  +        ::practcl::cputs result $dat
         5343  +        ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */"
         5344  +      }
         5345  +    }
         5346  +    return $result
         5347  +  }
         5348  +  method generate-cfile-tclapi {} {
         5349  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5350  +    my variable code methods tclprocs
         5351  +    set result {}
         5352  +    if {[info exists code(method)]} {
         5353  +      ::practcl::cputs result $code(method)
         5354  +    }
         5355  +
         5356  +    if {[info exists tclprocs]} {
         5357  +      foreach {name info} $tclprocs {
         5358  +        if {![dict exists $info body]} continue
         5359  +        set callproc [dict get $info callproc]
         5360  +        set header [dict get $info header]
         5361  +        set body [dict get $info body]
         5362  +        ::practcl::cputs result "/* Tcl Proc $name */"
         5363  +        ::practcl::cputs result "${header} \{${body}\}"
         5364  +      }
         5365  +    }
         5366  +
         5367  +
         5368  +    if {[info exists methods]} {
         5369  +      set thisclass [my define get cclass]
         5370  +      foreach {name info} $methods {
         5371  +        if {![dict exists $info body]} continue
         5372  +        set callproc [dict get $info callproc]
         5373  +        set header [dict get $info header]
         5374  +        set body [dict get $info body]
         5375  +        ::practcl::cputs result "/* OO Method $thisclass $name */"
         5376  +        ::practcl::cputs result "${header} \{${body}\}"
         5377  +      }
         5378  +      # Build the OO_Init function
         5379  +      ::practcl::cputs result "/* Loader for $thisclass */"
         5380  +      ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp) \{"
         5381  +      ::practcl::cputs result [string map [list @[email protected] $thisclass @[email protected] [my define get class]] {
         5382  +  /*
         5383  +  ** Build the "@[email protected]" class
         5384  +  */
         5385  +  Tcl_Obj* nameObj;		/* Name of a class or method being looked up */
         5386  +  Tcl_Object curClassObject;  /* Tcl_Object representing the current class */
         5387  +  Tcl_Class curClass;		/* Tcl_Class representing the current class */
         5388  +
         5389  +  /*
         5390  +   * Find the "@[email protected]" class, and attach an 'init' method to it.
         5391  +   */
         5392  +
         5393  +  nameObj = Tcl_NewStringObj("@[email protected]", -1);
         5394  +  Tcl_IncrRefCount(nameObj);
         5395  +  if ((curClassObject = Tcl_GetObjectFromObj(interp, nameObj)) == NULL) {
         5396  +      Tcl_DecrRefCount(nameObj);
         5397  +      return TCL_ERROR;
         5398  +  }
         5399  +  Tcl_DecrRefCount(nameObj);
         5400  +  curClass = Tcl_GetObjectAsClass(curClassObject);
         5401  +}]
         5402  +      if {[dict exists $methods constructor]} {
         5403  +        set mtype [dict get $methods constructor methodtype]
         5404  +        ::practcl::cputs result [string map [list @[email protected] $mtype] {
         5405  +  /* Attach the constructor to the class */
         5406  +  Tcl_ClassSetConstructor(interp, curClass, Tcl_NewMethod(interp, curClass, NULL, 1, &@[email protected], NULL));
         5407  +    }]
         5408  +      }
         5409  +      foreach {name info} $methods {
         5410  +        dict with info {}
         5411  +        if {$name in {constructor destructor}} continue
         5412  +        ::practcl::cputs result [string map [list @[email protected] $name @[email protected] $methodtype] {
         5413  +  nameObj=Tcl_NewStringObj("@[email protected]",-1);
         5414  +  Tcl_NewMethod(interp, curClass, nameObj, 1, &@[email protected], (ClientData) NULL);
         5415  +  Tcl_DecrRefCount(nameObj);
         5416  +}]
         5417  +        if {[dict exists $info aliases]} {
         5418  +          foreach alias [dict get $info aliases] {
         5419  +            if {[dict exists $methods $alias]} continue
         5420  +            ::practcl::cputs result [string map [list @[email protected] $alias @[email protected] $methodtype] {
         5421  +  nameObj=Tcl_NewStringObj("@[email protected]",-1);
         5422  +  Tcl_NewMethod(interp, curClass, nameObj, 1, &@[email protected], (ClientData) NULL);
         5423  +  Tcl_DecrRefCount(nameObj);
         5424  +}]
         5425  +          }
         5426  +        }
         5427  +      }
         5428  +      ::practcl::cputs result "  return TCL_OK\;\n\}\n"
         5429  +    }
         5430  +    foreach obj [my link list product] {
         5431  +      # Exclude products that will generate their own C files
         5432  +      if {[$obj define get output_c] ne {}} continue
         5433  +      ::practcl::cputs result [$obj generate-cfile-tclapi]
         5434  +    }
         5435  +    return $result
         5436  +  }
         5437  +  method generate-loader-module {} {
         5438  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5439  +    set result {}
         5440  +    my variable code methods tclprocs
         5441  +    if {[info exists code(nspace)]} {
         5442  +      ::practcl::cputs result "  \{\n    Tcl_Namespace *modPtr;"
         5443  +      foreach nspace $code(nspace) {
         5444  +        ::practcl::cputs result [string map [list @[email protected] $nspace] {
         5445  +    modPtr=Tcl_FindNamespace(interp,"@[email protected]",NULL,TCL_NAMESPACE_ONLY);
         5446  +    if(!modPtr) {
         5447  +      modPtr = Tcl_CreateNamespace(interp, "@[email protected]", NULL, NULL);
         5448  +    }
         5449  +}]
         5450  +      }
         5451  +      ::practcl::cputs result "  \}"
         5452  +    }
         5453  +    if {[info exists code(tclinit)]} {
         5454  +      ::practcl::cputs result $code(tclinit)
         5455  +    }
         5456  +    if {[info exists code(cinit)]} {
         5457  +      ::practcl::cputs result $code(cinit)
         5458  +    }
         5459  +    if {[info exists code(initfuncts)]} {
         5460  +      foreach func $code(initfuncts) {
         5461  +        ::practcl::cputs result "  if (${func}(interp) != TCL_OK) return TCL_ERROR\;"
         5462  +      }
         5463  +    }
         5464  +    if {[info exists tclprocs]} {
         5465  +      foreach {name info} $tclprocs {
         5466  +        set map [list @[email protected] $name @[email protected] [dict get $info callproc]]
         5467  +        ::practcl::cputs result [string map $map {  Tcl_CreateObjCommand(interp,"@[email protected]",(Tcl_ObjCmdProc *)@[email protected],NULL,NULL);}]
         5468  +        if {[dict exists $info aliases]} {
         5469  +          foreach alias [dict get $info aliases] {
         5470  +            set map [list @[email protected] $alias @[email protected] [dict get $info callproc]]
         5471  +            ::practcl::cputs result [string map $map {  Tcl_CreateObjCommand(interp,"@[email protected]",(Tcl_ObjCmdProc *)@[email protected],NULL,NULL);}]
         5472  +          }
         5473  +        }
         5474  +      }
         5475  +    }
         5476  +
         5477  +    if {[info exists code(nspace)]} {
         5478  +      ::practcl::cputs result "  \{\n    Tcl_Namespace *modPtr;"
         5479  +      foreach nspace $code(nspace) {
         5480  +        ::practcl::cputs result [string map [list @[email protected] $nspace] {
         5481  +    modPtr=Tcl_FindNamespace(interp,"@[email protected]",NULL,TCL_NAMESPACE_ONLY);
         5482  +    Tcl_CreateEnsemble(interp, modPtr->fullName, modPtr, TCL_ENSEMBLE_PREFIX);
         5483  +    Tcl_Export(interp, modPtr, "[a-z]*", 1);
         5484  +}]
         5485  +      }
         5486  +      ::practcl::cputs result "  \}"
         5487  +    }
         5488  +    set result [::practcl::_tagblock $result c [my define get filename]]
         5489  +    foreach obj [my link list product] {
         5490  +      # Exclude products that will generate their own C files
         5491  +      if {[$obj define get output_c] ne {}} {
         5492  +        ::practcl::cputs result [$obj generate-loader-external]
         5493  +      } else {
         5494  +        ::practcl::cputs result [$obj generate-loader-module]
         5495  +      }
         5496  +    }
         5497  +    return $result
         5498  +  }
         5499  +  method Collate_Source CWD {
         5500  +    my variable methods code cstruct tclprocs
         5501  +    if {[info exists methods]} {
         5502  +      ::practcl::debug [self] methods [my define get cclass]
         5503  +      set thisclass [my define get cclass]
         5504  +      foreach {name info} $methods {
         5505  +        # Provide a callproc
         5506  +        if {![dict exists $info callproc]} {
         5507  +          set callproc [string map {____ _ ___ _ __ _} [string map {{ } _ : _} OOMethod_${thisclass}_${name}]]
         5508  +          dict set methods $name callproc $callproc
         5509  +        } else {
         5510  +          set callproc [dict get $info callproc]
         5511  +        }
         5512  +        if {[dict exists $info body] && ![dict exists $info header]} {
         5513  +          dict set methods $name header "static int ${callproc}(ClientData clientData, Tcl_Interp *interp, Tcl_ObjectContext objectContext ,int objc ,Tcl_Obj *const *objv)"
         5514  +        }
         5515  +        if {![dict exists $info methodtype]} {
         5516  +          set methodtype [string map {{ } _ : _} OOMethodType_${thisclass}_${name}]
         5517  +          dict set methods $name methodtype $methodtype
         5518  +        }
         5519  +      }
         5520  +      if {![info exists code(initfuncts)] || "${thisclass}_OO_Init" ni $code(initfuncts)} {
         5521  +        lappend code(initfuncts) "${thisclass}_OO_Init"
         5522  +      }
         5523  +    }
         5524  +    set thisnspace [my define get nspace]
         5525  +
         5526  +    if {[info exists tclprocs]} {
         5527  +      ::practcl::debug [self] tclprocs [dict keys $tclprocs]
         5528  +      foreach {name info} $tclprocs {
         5529  +        if {![dict exists $info callproc]} {
         5530  +          set callproc [string map {____ _ ___ _ __ _} [string map {{ } _ : _} TclCmd_${thisnspace}_${name}]]
         5531  +          dict set tclprocs $name callproc $callproc
         5532  +        } else {
         5533  +          set callproc [dict get $info callproc]
         5534  +        }
         5535  +        if {[dict exists $info body] && ![dict exists $info header]} {
         5536  +          dict set tclprocs $name header "static int ${callproc}(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv\[\])"
         5537  +        }
         5538  +      }
         5539  +    }
         5540  +  }
         5541  +  method select {} {}
         5542  +}
         5543  +
         5544  +###
         5545  +# END: class dynamic.tcl
         5546  +###
         5547  +###
         5548  +# START: class product.tcl
         5549  +###
         5550  +::clay::define ::practcl::product {
         5551  +  method code {section body} {
         5552  +    my variable code
         5553  +    ::practcl::cputs code($section) $body
         5554  +  }
         5555  +  method Collate_Source CWD {}
         5556  +  method project-compile-products {} {
         5557  +    set result {}
         5558  +    noop {
         5559  +    set filename [my define get filename]
         5560  +    if {$filename ne {}} {
         5561  +      ::practcl::debug [self] [self class] [self method] project-compile-products $filename
         5562  +      if {[my define exists ofile]} {
         5563  +        set ofile [my define get ofile]
         5564  +      } else {
         5565  +        set ofile [my Ofile $filename]
         5566  +        my define set ofile $ofile
         5567  +      }
         5568  +      lappend result $ofile [list cfile $filename include [my define get include]  extra [my define get extra] external [string is true -strict [my define get external]] object [self]]
         5569  +    }
         5570  +    }
         5571  +    foreach item [my link list subordinate] {
         5572  +      lappend result {*}[$item project-compile-products]
         5573  +    }
         5574  +    return $result
         5575  +  }
         5576  +  method generate-debug {{spaces {}}} {
         5577  +    set result {}
         5578  +    ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my define get filename]] links [my link list]]"
         5579  +    foreach item [my link list subordinate] {
         5580  +      practcl::cputs result [$item generate-debug "$spaces  "]
         5581  +    }
         5582  +    return $result
         5583  +  }
         5584  +  method generate-cfile-constant {} {
         5585  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5586  +    set result {}
         5587  +    my variable code cstruct methods tcltype
         5588  +    if {[info exists code(constant)]} {
         5589  +      ::practcl::cputs result "/* [my define get filename] CONSTANT */"
         5590  +      ::practcl::cputs result $code(constant)
         5591  +    }
         5592  +    foreach obj [my link list product] {
         5593  +      # Exclude products that will generate their own C files
         5594  +      if {[$obj define get output_c] ne {}} continue
         5595  +      ::practcl::cputs result [$obj generate-cfile-constant]
         5596  +    }
         5597  +    return $result
         5598  +  }
         5599  +  method generate-cfile-public-structure {} {
         5600  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5601  +    my variable code cstruct methods tcltype
         5602  +    set result {}
         5603  +    if {[info exists code(struct)]} {
         5604  +      ::practcl::cputs result $code(struct)
         5605  +    }
         5606  +    foreach obj [my link list product] {
         5607  +      # Exclude products that will generate their own C files
         5608  +      if {[$obj define get output_c] ne {}} continue
         5609  +      ::practcl::cputs result [$obj generate-cfile-public-structure]
         5610  +    }
         5611  +    return $result
         5612  +  }
         5613  +  method generate-cfile-header {} {
         5614  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5615  +    my variable code cfunct cstruct methods tcltype tclprocs
         5616  +    set result {}
         5617  +    if {[info exists code(header)]} {
         5618  +      ::practcl::cputs result $code(header)
         5619  +    }
         5620  +    foreach obj [my link list product] {
         5621  +      # Exclude products that will generate their own C files
         5622  +      if {[$obj define get output_c] ne {}} continue
         5623  +      set dat [$obj generate-cfile-header]
         5624  +      if {[string length [string trim $dat]]} {
         5625  +        ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */"
         5626  +        ::practcl::cputs result $dat
         5627  +        ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */"
         5628  +      }
         5629  +    }
         5630  +    return $result
         5631  +  }
         5632  +  method generate-cfile-global {} {
         5633  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5634  +    my variable code cfunct cstruct methods tcltype tclprocs
         5635  +    set result {}
         5636  +    if {[info exists code(global)]} {
         5637  +      ::practcl::cputs result $code(global)
         5638  +    }
         5639  +    foreach obj [my link list product] {
         5640  +      # Exclude products that will generate their own C files
         5641  +      if {[$obj define get output_c] ne {}} continue
         5642  +      set dat [$obj generate-cfile-global]
         5643  +      if {[string length [string trim $dat]]} {
         5644  +        ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-global */"
         5645  +        ::practcl::cputs result $dat
         5646  +        ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-global */"
         5647  +      }
         5648  +    }
         5649  +    return $result
         5650  +  }
         5651  +  method generate-cfile-private-typedef {} {
         5652  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5653  +    my variable code cstruct
         5654  +    set result {}
         5655  +    if {[info exists code(private-typedef)]} {
         5656  +      ::practcl::cputs result $code(private-typedef)
         5657  +    }
         5658  +    if {[info exists cstruct]} {
         5659  +      # Add defintion for native c data structures
         5660  +      foreach {name info} $cstruct {
         5661  +        if {[dict get $info public]==1} continue
         5662  +        ::practcl::cputs result "typedef struct $name ${name}\;"
         5663  +        if {[dict exists $info aliases]} {
         5664  +          foreach n [dict get $info aliases] {
         5665  +            ::practcl::cputs result "typedef struct $name ${n}\;"
         5666  +          }
         5667  +        }
         5668  +      }
         5669  +    }
         5670  +    set result [::practcl::_tagblock $result c [my define get filename]]
         5671  +    foreach mod [my link list product] {
         5672  +      ::practcl::cputs result [$mod generate-cfile-private-typedef]
         5673  +    }
         5674  +    return $result
         5675  +  }
         5676  +  method generate-cfile-private-structure {} {
         5677  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5678  +    my variable code cstruct
         5679  +    set result {}
         5680  +    if {[info exists code(private-structure)]} {
         5681  +      ::practcl::cputs result $code(private-structure)
         5682  +    }
         5683  +    if {[info exists cstruct]} {
         5684  +      foreach {name info} $cstruct {
         5685  +        if {[dict get $info public]==1} continue
         5686  +        if {[dict exists $info comment]} {
         5687  +          ::practcl::cputs result [dict get $info comment]
         5688  +        }
         5689  +        ::practcl::cputs result "struct $name \{[dict get $info body]\}\;"
         5690  +      }
         5691  +    }
         5692  +    set result [::practcl::_tagblock $result c [my define get filename]]
         5693  +    foreach mod [my link list product] {
         5694  +      ::practcl::cputs result [$mod generate-cfile-private-structure]
         5695  +    }
         5696  +    return $result
         5697  +  }
         5698  +  method generate-cfile-functions {} {
         5699  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5700  +    my variable code cfunct
         5701  +    set result {}
         5702  +    if {[info exists code(funct)]} {
         5703  +      ::practcl::cputs result $code(funct)
         5704  +    }
         5705  +    if {[info exists cfunct]} {
         5706  +      foreach {funcname info} $cfunct {
         5707  +        ::practcl::cputs result "/* $funcname */"
         5708  +        if {[dict get $info inline] && [dict get $info public]} {
         5709  +          ::practcl::cputs result "\ninline [dict get $info header]\{[dict get $info body]\}"
         5710  +        } else {
         5711  +          ::practcl::cputs result "\n[dict get $info header]\{[dict get $info body]\}"
         5712  +        }
         5713  +      }
         5714  +    }
         5715  +    foreach obj [my link list product] {
         5716  +      # Exclude products that will generate their own C files
         5717  +      if {[$obj define get output_c] ne {}} {
         5718  +        continue
         5719  +      }
         5720  +      ::practcl::cputs result [$obj generate-cfile-functions]
         5721  +    }
         5722  +    return $result
         5723  +  }
         5724  +  method generate-cfile-tclapi {} {
         5725  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5726  +    my variable code methods tclprocs
         5727  +    set result {}
         5728  +    if {[info exists code(method)]} {
         5729  +      ::practcl::cputs result $code(method)
         5730  +    }
         5731  +    foreach obj [my link list product] {
         5732  +      # Exclude products that will generate their own C files
         5733  +      if {[$obj define get output_c] ne {}} continue
         5734  +      ::practcl::cputs result [$obj generate-cfile-tclapi]
         5735  +    }
         5736  +    return $result
         5737  +  }
         5738  +  method generate-hfile-public-define {} {
         5739  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5740  +    my variable code
         5741  +    set result {}
         5742  +    if {[info exists code(public-define)]} {
         5743  +      ::practcl::cputs result $code(public-define)
         5744  +    }
         5745  +    set result [::practcl::_tagblock $result c [my define get filename]]
         5746  +    foreach mod [my link list product] {
         5747  +      ::practcl::cputs result [$mod generate-hfile-public-define]
         5748  +    }
         5749  +    return $result
         5750  +  }
         5751  +  method generate-hfile-public-macro {} {
         5752  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5753  +    my variable code
         5754  +    set result {}
         5755  +    if {[info exists code(public-macro)]} {
         5756  +      ::practcl::cputs result $code(public-macro)
         5757  +    }
         5758  +    set result [::practcl::_tagblock $result c [my define get filename]]
         5759  +    foreach mod [my link list product] {
         5760  +      ::practcl::cputs result [$mod generate-hfile-public-macro]
         5761  +    }
         5762  +    return $result
         5763  +  }
         5764  +  method generate-hfile-public-typedef {} {
         5765  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5766  +    my variable code cstruct
         5767  +    set result {}
         5768  +    if {[info exists code(public-typedef)]} {
         5769  +      ::practcl::cputs result $code(public-typedef)
         5770  +    }
         5771  +    if {[info exists cstruct]} {
         5772  +      # Add defintion for native c data structures
         5773  +      foreach {name info} $cstruct {
         5774  +        if {[dict get $info public]==0} continue
         5775  +        ::practcl::cputs result "typedef struct $name ${name}\;"
         5776  +        if {[dict exists $info aliases]} {
         5777  +          foreach n [dict get $info aliases] {
         5778  +            ::practcl::cputs result "typedef struct $name ${n}\;"
         5779  +          }
         5780  +        }
         5781  +      }
         5782  +    }
         5783  +    set result [::practcl::_tagblock $result c [my define get filename]]
         5784  +    foreach mod [my link list product] {
         5785  +      ::practcl::cputs result [$mod generate-hfile-public-typedef]
         5786  +    }
         5787  +    return $result
         5788  +  }
         5789  +  method generate-hfile-public-structure {} {
         5790  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5791  +    my variable code cstruct
         5792  +    set result {}
         5793  +    if {[info exists code(public-structure)]} {
         5794  +      ::practcl::cputs result $code(public-structure)
         5795  +    }
         5796  +    if {[info exists cstruct]} {
         5797  +      foreach {name info} $cstruct {
         5798  +        if {[dict get $info public]==0} continue
         5799  +        if {[dict exists $info comment]} {
         5800  +          ::practcl::cputs result [dict get $info comment]
         5801  +        }
         5802  +        ::practcl::cputs result "struct $name \{[dict get $info body]\}\;"
         5803  +      }
         5804  +    }
         5805  +    set result [::practcl::_tagblock $result c [my define get filename]]
         5806  +    foreach mod [my link list product] {
         5807  +      ::practcl::cputs result [$mod generate-hfile-public-structure]
         5808  +    }
         5809  +    return $result
         5810  +  }
         5811  +  method generate-hfile-public-headers {} {
         5812  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5813  +    my variable code tcltype
         5814  +    set result {}
         5815  +    if {[info exists code(public-header)]} {
         5816  +      ::practcl::cputs result $code(public-header)
         5817  +    }
         5818  +    if {[info exists tcltype]} {
         5819  +      foreach {type info} $tcltype {
         5820  +        if {![dict exists $info cname]} {
         5821  +          set cname [string tolower ${type}]_tclobjtype
         5822  +          dict set tcltype $type cname $cname
         5823  +        } else {
         5824  +          set cname [dict get $info cname]
         5825  +        }
         5826  +        ::practcl::cputs result "extern const Tcl_ObjType $cname\;"
         5827  +      }
         5828  +    }
         5829  +    if {[info exists code(public)]} {
         5830  +      ::practcl::cputs result $code(public)
         5831  +    }
         5832  +    set result [::practcl::_tagblock $result c [my define get filename]]
         5833  +    foreach mod [my link list product] {
         5834  +      ::practcl::cputs result [$mod generate-hfile-public-headers]
         5835  +    }
         5836  +    return $result
         5837  +  }
         5838  +  method generate-hfile-public-function {} {
         5839  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5840  +    my variable code cfunct tcltype
         5841  +    set result {}
         5842  +
         5843  +    if {[my define get initfunc] ne {}} {
         5844  +      ::practcl::cputs result "int [my define get initfunc](Tcl_Interp *interp);"
         5845  +    }
         5846  +    if {[info exists cfunct]} {
         5847  +      foreach {funcname info} $cfunct {
         5848  +        if {![dict get $info public]} continue
         5849  +        ::practcl::cputs result "[dict get $info header]\;"
         5850  +      }
         5851  +    }
         5852  +    set result [::practcl::_tagblock $result c [my define get filename]]
         5853  +    foreach mod [my link list product] {
         5854  +      ::practcl::cputs result [$mod generate-hfile-public-function]
         5855  +    }
         5856  +    return $result
         5857  +  }
         5858  +  method generate-hfile-public-includes {} {
         5859  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5860  +    set includes {}
         5861  +    foreach item [my define get public-include] {
         5862  +      if {$item ni $includes} {
         5863  +        lappend includes $item
         5864  +      }
         5865  +    }
         5866  +    foreach mod [my link list product] {
         5867  +      foreach item [$mod generate-hfile-public-includes] {
         5868  +        if {$item ni $includes} {
         5869  +          lappend includes $item
         5870  +        }
         5871  +      }
         5872  +    }
         5873  +    return $includes
         5874  +  }
         5875  +  method generate-hfile-public-verbatim {} {
         5876  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5877  +    set includes {}
         5878  +    foreach item [my define get public-verbatim] {
         5879  +      if {$item ni $includes} {
         5880  +        lappend includes $item
         5881  +      }
         5882  +    }
         5883  +    foreach mod [my link list subordinate] {
         5884  +      foreach item [$mod generate-hfile-public-verbatim] {
         5885  +        if {$item ni $includes} {
         5886  +          lappend includes $item
         5887  +        }
         5888  +      }
         5889  +    }
         5890  +    return $includes
         5891  +  }
         5892  +  method generate-loader-external {} {
         5893  +    if {[my define get initfunc] eq {}} {
         5894  +      return "/*  [my define get filename] declared not initfunc */"
         5895  +    }
         5896  +    return "  if([my define get initfunc](interp)) return TCL_ERROR\;"
         5897  +  }
         5898  +  method generate-loader-module {} {
         5899  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5900  +    my variable code
         5901  +    set result {}
         5902  +    if {[info exists code(cinit)]} {
         5903  +      ::practcl::cputs result $code(cinit)
         5904  +    }
         5905  +    if {[my define get initfunc] ne {}} {
         5906  +      ::practcl::cputs result "  if([my define get initfunc](interp)!=TCL_OK) return TCL_ERROR\;"
         5907  +    }
         5908  +    set result [::practcl::_tagblock $result c [my define get filename]]
         5909  +    foreach item [my link list product] {
         5910  +      if {[$item define get output_c] ne {}} {
         5911  +        ::practcl::cputs result [$item generate-loader-external]
         5912  +      } else {
         5913  +        ::practcl::cputs result [$item generate-loader-module]
         5914  +      }
         5915  +    }
         5916  +    return $result
         5917  +  }
         5918  +  method generate-stub-function {} {
         5919  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5920  +    my variable code cfunct tcltype
         5921  +    set result {}
         5922  +    foreach mod [my link list product] {
         5923  +      foreach {funct def} [$mod generate-stub-function] {
         5924  +        dict set result $funct $def
         5925  +      }
         5926  +    }
         5927  +    if {[info exists cfunct]} {
         5928  +      foreach {funcname info} $cfunct {
         5929  +        if {![dict get $info export]} continue
         5930  +        dict set result $funcname [dict get $info header]
         5931  +      }
         5932  +    }
         5933  +    return $result
         5934  +  }
         5935  +  method IncludeAdd {headervar args} {
         5936  +    upvar 1 $headervar headers
         5937  +    foreach inc $args {
         5938  +      if {[string index $inc 0] ni {< \"}} {
         5939  +        set inc "\"$inc\""
         5940  +      }
         5941  +      if {$inc ni $headers} {
         5942  +        lappend headers $inc
         5943  +      }
         5944  +    }
         5945  +  }
         5946  +  method generate-tcl-loader {} {
         5947  +    set result {}
         5948  +    set PKGINIT [my define get pkginit]
         5949  +    set PKG_NAME [my define get name [my define get pkg_name]]
         5950  +    set PKG_VERSION [my define get pkg_vers [my define get version]]
         5951  +    if {[string is true [my define get SHARED_BUILD 0]]} {
         5952  +      set LIBFILE [my define get libfile]
         5953  +      ::practcl::cputs result [string map \
         5954  +        [list @[email protected] $LIBFILE @[email protected] $PKGINIT @[email protected] $PKG_NAME @[email protected] $PKG_VERSION] {
         5955  +# Shared Library Style
         5956  +load [file join [file dirname [file join [pwd] [info script]]] @[email protected]] @[email protected]
         5957  +package provide @[email protected] @[email protected]
         5958  +}]
         5959  +    } else {
         5960  +      ::practcl::cputs result [string map \
         5961  +      [list @[email protected] $PKGINIT @[email protected] $PKG_NAME @[email protected] $PKG_VERSION] {
         5962  +# Tclkit Style
         5963  +load {} @[email protected]
         5964  +package provide @[email protected] @[email protected]
         5965  +}]
         5966  +    }
         5967  +    return $result
         5968  +  }
         5969  +  method generate-tcl-pre {} {
         5970  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5971  +    set result {}
         5972  +    my variable code
         5973  +    if {[info exists code(tcl)]} {
         5974  +      set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]]
         5975  +    }
         5976  +    if {[info exists code(tcl-pre)]} {
         5977  +      set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]]
         5978  +    }
         5979  +    foreach mod [my link list product] {
         5980  +      ::practcl::cputs result [$mod generate-tcl-pre]
         5981  +    }
         5982  +    return $result
         5983  +  }
         5984  +  method generate-tcl-post {} {
         5985  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         5986  +    set result {}
         5987  +    my variable code
         5988  +    if {[info exists code(tcl-post)]} {
         5989  +      set result [::practcl::_tagblock $code(tcl-post) tcl [my define get filename]]
         5990  +    }
         5991  +    foreach mod [my link list product] {
         5992  +      ::practcl::cputs result [$mod generate-tcl-post]
         5993  +    }
         5994  +    return $result
         5995  +  }
         5996  +  method linktype {} {
         5997  +    return {subordinate product}
         5998  +  }
         5999  +  method Ofile filename {
         6000  +    set lpath [my <module> define get localpath]
         6001  +    if {$lpath eq {}} {
         6002  +      set lpath [my <module> define get name]
         6003  +    }
         6004  +    return ${lpath}_[file rootname [file tail $filename]]
         6005  +  }
         6006  +  method project-static-packages {} {
         6007  +    set result [my define get static_packages]
         6008  +    set initfunc [my define get initfunc]
         6009  +    if {$initfunc ne {}} {
         6010  +      set pkg_name [my define get pkg_name]
         6011  +      if {$pkg_name ne {}} {
         6012  +        dict set result $pkg_name initfunc $initfunc
         6013  +        dict set result $pkg_name version [my define get version [my define get pkg_vers]]
         6014  +        dict set result $pkg_name autoload [my define get autoload 0]
         6015  +      }
         6016  +    }
         6017  +    foreach item [my link list subordinate] {
         6018  +      foreach {pkg info} [$item project-static-packages] {
         6019  +        dict set result $pkg $info
         6020  +      }
         6021  +    }
         6022  +    return $result
         6023  +  }
         6024  +  method toolset-include-directory {} {
         6025  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         6026  +    set result [my define get include_dir]
         6027  +    foreach obj [my link list product] {
         6028  +      foreach path [$obj toolset-include-directory] {
         6029  +        lappend result $path
         6030  +      }
         6031  +    }
         6032  +    return $result
         6033  +  }
         6034  +  method target {method args} {
         6035  +    switch $method {
         6036  +      is_unix { return [expr {$::tcl_platform(platform) eq "unix"}] }
         6037  +    }
         6038  +  }
         6039  +}
         6040  +oo::objdefine ::practcl::product {
         6041  +
         6042  +  method select {object} {
         6043  +    set class [$object define get class]
         6044  +    set mixin [$object define get product]
         6045  +    if {$class eq {} && $mixin eq {}} {
         6046  +      set filename [$object define get filename]
         6047  +      if {$filename ne {} && [file exists $filename]} {
         6048  +        switch [file extension $filename] {
         6049  +          .tcl {
         6050  +            set mixin ::practcl::product.dynamic
         6051  +          }
         6052  +          .h {
         6053  +            set mixin ::practcl::product.cheader
         6054  +          }
         6055  +          .c {
         6056  +            set mixin ::practcl::product.csource
         6057  +          }
         6058  +          .ini {
         6059  +            switch [file tail $filename] {
         6060  +              module.ini {
         6061  +                set class ::practcl::module
         6062  +              }
         6063  +              library.ini {
         6064  +                set class ::practcl::subproject
         6065  +              }
         6066  +            }
         6067  +          }
         6068  +          .so -
         6069  +          .dll -
         6070  +          .dylib -
         6071  +          .a {
         6072  +            set mixin ::practcl::product.clibrary
         6073  +          }
         6074  +        }
         6075  +      }
         6076  +    }
         6077  +    if {$class ne {}} {
         6078  +      $object clay mixinmap core $class
         6079  +    }
         6080  +    if {$mixin ne {}} {
         6081  +      $object clay mixinmap product $mixin
         6082  +    }
         6083  +  }
         6084  +}
         6085  +::clay::define ::practcl::product.cheader {
         6086  +  superclass ::practcl::product
         6087  +  method project-compile-products {} {}
         6088  +  method generate-loader-module {} {}
         6089  +}
         6090  +::clay::define ::practcl::product.csource {
         6091  +  superclass ::practcl::product
         6092  +  method project-compile-products {} {
         6093  +    set result {}
         6094  +    set filename [my define get filename]
         6095  +    if {$filename ne {}} {
         6096  +      ::practcl::debug [self] [self class] [self method] project-compile-products $filename
         6097  +      if {[my define exists ofile]} {
         6098  +        set ofile [my define get ofile]
         6099  +      } else {
         6100  +        set ofile [my Ofile $filename]
         6101  +        my define set ofile $ofile
         6102  +      }
         6103  +      lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]] object [self]]
         6104  +    }
         6105  +    foreach item [my link list subordinate] {
         6106  +      lappend result {*}[$item project-compile-products]
         6107  +    }
         6108  +    return $result
         6109  +  }
         6110  +}
         6111  +::clay::define ::practcl::product.clibrary {
         6112  +  superclass ::practcl::product
         6113  +  method linker-products {configdict} {
         6114  +    return [my define get filename]
         6115  +  }
         6116  +}
         6117  +::clay::define ::practcl::product.dynamic {
         6118  +  superclass ::practcl::dynamic ::practcl::product
         6119  +  method initialize {} {
         6120  +    set filename [my define get filename]
         6121  +    if {$filename eq {}} {
         6122  +      return
         6123  +    }
         6124  +    if {[my define get name] eq {}} {
         6125  +      my define set name [file tail [file rootname $filename]]
         6126  +    }
         6127  +    if {[my define get localpath] eq {}} {
         6128  +      my define set localpath [my <module> define get localpath]_[my define get name]
         6129  +    }
         6130  +    # Future Development:
         6131  +    # Scan source file to see if it is encoded in criticl or practcl notation
         6132  +    #set thisline {}
         6133  +    #foreach line [split [::practcl::cat $filename] \n] {
         6134  +    #
         6135  +    #}
         6136  +    ::source $filename
         6137  +    if {[my define get output_c] ne {}} {
         6138  +      # Turn into a module if we have an output_c file
         6139  +      my morph ::practcl::module
         6140  +    }
         6141  +  }
         6142  +}
         6143  +::clay::define ::practcl::product.critcl {
         6144  +  superclass ::practcl::dynamic ::practcl::product
         6145  +}
         6146  +
         6147  +###
         6148  +# END: class product.tcl
         6149  +###
         6150  +###
         6151  +# START: class module.tcl
         6152  +###
         6153  +::clay::define ::practcl::module {
         6154  +  superclass ::practcl::object ::practcl::product.dynamic
         6155  +  Dict make_object {}
         6156  +  method _MorphPatterns {} {
         6157  +    return {{@[email protected]} {::practcl::[email protected]@} ::practcl::module}
         6158  +  }
         6159  +  method add args {
         6160  +    my variable links
         6161  +    set object [::practcl::object new [self] {*}$args]
         6162  +    foreach linktype [$object linktype] {
         6163  +      lappend links($linktype) $object
         6164  +    }
         6165  +    return $object
         6166  +  }
         6167  +  method install-headers args {}
         6168  +  Ensemble make::_preamble {} {
         6169  +    my variable make_object
         6170  +    if {![info exists make_object]} {
         6171  +      set make_object {}
         6172  +    }
         6173  +  }
         6174  +  Ensemble make::pkginfo {} {
         6175  +    ###
         6176  +    # Build local variables needed for install
         6177  +    ###
         6178  +    package require platform
         6179  +    set result {}
         6180  +    set dat [my define dump]
         6181  +    set PKG_DIR [dict get $dat name][dict get $dat version]
         6182  +    dict set result PKG_DIR $PKG_DIR
         6183  +    dict with dat {}
         6184  +    if {![info exists DESTDIR]} {
         6185  +      set DESTDIR {}
         6186  +    }
         6187  +    dict set result profile [::platform::identify]
         6188  +    dict set result os $::tcl_platform(os)
         6189  +    dict set result platform $::tcl_platform(platform)
         6190  +    foreach {field value} $dat {
         6191  +      switch $field {
         6192  +        includedir -
         6193  +        mandir -
         6194  +        datadir -
         6195  +        libdir -
         6196  +        libfile -
         6197  +        name -
         6198  +        output_tcl -
         6199  +        version -
         6200  +        authors -
         6201  +        license -
         6202  +        requires {
         6203  +          dict set result $field $value
         6204  +        }
         6205  +        TEA_PLATFORM {
         6206  +          dict set result platform $value
         6207  +        }
         6208  +        TEACUP_OS {
         6209  +          dict set result os $value
         6210  +        }
         6211  +        TEACUP_PROFILE {
         6212  +          dict set result profile $value
         6213  +        }
         6214  +        TEACUP_ZIPFILE {
         6215  +          dict set result zipfile $value
         6216  +        }
         6217  +      }
         6218  +    }
         6219  +    if {![dict exists $result zipfile]} {
         6220  +      dict set result zipfile "[dict get $result name]-[dict get $result version]-[dict get $result profile].zip"
         6221  +    }
         6222  +    return $result
         6223  +  }
         6224  +  Ensemble make::objects {} {
         6225  +    return $make_object
         6226  +  }
         6227  +  Ensemble make::object name {
         6228  +    if {[dict exists $make_object $name]} {
         6229  +      return [dict get $make_object $name]
         6230  +    }
         6231  +    return {}
         6232  +  }
         6233  +  Ensemble make::reset {} {
         6234  +    foreach {name obj} $make_object {
         6235  +      $obj reset
         6236  +    }
         6237  +  }
         6238  +  Ensemble make::trigger args {
         6239  +    foreach {name obj} $make_object {
         6240  +      if {$name in $args} {
         6241  +        $obj triggers
         6242  +      }
         6243  +    }
         6244  +  }
         6245  +  Ensemble make::depends args {
         6246  +    foreach {name obj} $make_object {
         6247  +      if {$name in $args} {
         6248  +        $obj check
         6249  +      }
         6250  +    }
         6251  +  }
         6252  +  Ensemble make::filename name {
         6253  +    if {[dict exists $make_object $name]} {
         6254  +      return [[dict get $make_object $name] define get filename]
         6255  +    }
         6256  +  }
         6257  +  Ensemble make::target {name Info body} {
         6258  +    set info [uplevel #0 [list subst $Info]]
         6259  +    set nspace [namespace current]
         6260  +    if {[dict exist $make_object $name]} {
         6261  +      set obj [dict get $$make_object $name]
         6262  +    } else {
         6263  +      set obj [::practcl::make_obj new [self] $name $info $body]
         6264  +      dict set make_object $name $obj
         6265  +      dict set target_make $name 0
         6266  +      dict set target_trigger $name 0
         6267  +    }
         6268  +    if {[dict exists $info aliases]} {
         6269  +      foreach item [dict get $info aliases] {
         6270  +        if {![dict exists $make_object $item]} {
         6271  +          dict set make_object $item $obj
         6272  +        }
         6273  +      }
         6274  +    }
         6275  +    return $obj
         6276  +  }
         6277  +  clay set method_ensemble make target aliases {task add}
         6278  +  Ensemble make::todo {} {
         6279  +    foreach {name obj} $make_object {
         6280  +      if {[$obj do]} {
         6281  +        lappend result $name
         6282  +      }
         6283  +    }
         6284  +    return $result
         6285  +  }
         6286  +  Ensemble make::do {} {
         6287  +    global CWD SRCDIR project SANDBOX
         6288  +    foreach {name obj} $make_object {
         6289  +      if {[$obj do]} {
         6290  +        eval [$obj define get action]
         6291  +      }
         6292  +    }
         6293  +  }
         6294  +  method child which {
         6295  +    switch $which {
         6296  +      delegate -
         6297  +      organs {
         6298  +        return [list project [my define get project] module [self]]
         6299  +      }
         6300  +    }
         6301  +  }
         6302  +  method generate-c {} {
         6303  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         6304  +    set result {
         6305  +/* This file was generated by practcl */
         6306  +    }
         6307  +    set includes {}
         6308  +
         6309  +    foreach mod [my link list product] {
         6310  +      # Signal modules to formulate final implementation
         6311  +      $mod go
         6312  +    }
         6313  +    set headers {}
         6314  +
         6315  +    my IncludeAdd headers <tcl.h> <tclOO.h>
         6316  +    if {[my define get tk 0]} {
         6317  +      my IncludeAdd headers <tk.h>
         6318  +    }
         6319  +    if {[my define get output_h] ne {}} {
         6320  +      my IncludeAdd headers [my define get output_h]
         6321  +    }
         6322  +    my IncludeAdd headers {*}[my define get include]
         6323  +
         6324  +    foreach mod [my link list dynamic] {
         6325  +      my IncludeAdd headers {*}[$mod define get include]
         6326  +    }
         6327  +    foreach inc $headers {
         6328  +      ::practcl::cputs result "#include $inc"
         6329  +    }
         6330  +    foreach {method} {
         6331  +      generate-cfile-header
         6332  +      generate-cfile-private-typedef
         6333  +      generate-cfile-private-structure
         6334  +      generate-cfile-public-structure
         6335  +      generate-cfile-constant
         6336  +      generate-cfile-global
         6337  +      generate-cfile-functions
         6338  +      generate-cfile-tclapi
         6339  +    } {
         6340  +      set dat [my $method]
         6341  +      if {[string length [string trim $dat]]} {
         6342  +        ::practcl::cputs result "/* BEGIN $method [my define get filename] */"
         6343  +        ::practcl::cputs result $dat
         6344  +        ::practcl::cputs result "/* END $method [my define get filename] */"
         6345  +      }
         6346  +    }
         6347  +    ::practcl::debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         6348  +    return $result
         6349  +  }
         6350  +  method generate-h {} {
         6351  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         6352  +    set result {}
         6353  +    foreach method {
         6354  +      generate-hfile-public-define
         6355  +      generate-hfile-public-macro
         6356  +    } {
         6357  +      ::practcl::cputs result "/* BEGIN SECTION $method */"
         6358  +      ::practcl::cputs result [my $method]
         6359  +      ::practcl::cputs result "/* END SECTION $method */"
         6360  +    }
         6361  +    set includes [my generate-hfile-public-includes]
         6362  +    foreach inc $includes {
         6363  +      if {[string index $inc 0] ni {< \"}} {
         6364  +        ::practcl::cputs result "#include \"$inc\""
         6365  +      } else {
         6366  +        ::practcl::cputs result "#include $inc"
         6367  +      }
         6368  +    }
         6369  +    foreach method {
         6370  +      generate-hfile-public-typedef
         6371  +      generate-hfile-public-structure
         6372  +    } {
         6373  +      ::practcl::cputs result "/* BEGIN SECTION $method */"
         6374  +      ::practcl::cputs result [my $method]
         6375  +      ::practcl::cputs result "/* END SECTION $method */"
         6376  +    }
         6377  +
         6378  +    foreach file [my generate-hfile-public-verbatim] {
         6379  +      ::practcl::cputs result "/* BEGIN $file */"
         6380  +      ::practcl::cputs result [::practcl::cat $file]
         6381  +      ::practcl::cputs result "/* END $file */"
         6382  +    }
         6383  +
         6384  +    foreach method {
         6385  +      generate-hfile-public-headers
         6386  +      generate-hfile-public-function
         6387  +    } {
         6388  +      ::practcl::cputs result "/* BEGIN SECTION $method */"
         6389  +      ::practcl::cputs result [my $method]
         6390  +      ::practcl::cputs result "/* END SECTION $method */"
         6391  +    }
         6392  +    return $result
         6393  +  }
         6394  +  method generate-loader {} {
         6395  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         6396  +    set result {}
         6397  +    if {[my define get initfunc] eq {}} return
         6398  +    ::practcl::cputs result  "
         6399  +extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \{"
         6400  +    ::practcl::cputs result  {
         6401  +  /* Initialise the stubs tables. */
         6402  +  #ifdef USE_TCL_STUBS
         6403  +    if (Tcl_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR;
         6404  +    if (TclOOInitializeStubs(interp, "1.0") == NULL) return TCL_ERROR;
         6405  +}
         6406  +    if {[my define get tk 0]} {
         6407  +      ::practcl::cputs result  {    if (Tk_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR;}
         6408  +    }
         6409  +    ::practcl::cputs result {  #endif}
         6410  +    set TCLINIT [my generate-tcl-pre]
         6411  +    if {[string length [string trim $TCLINIT]]} {
         6412  +      ::practcl::cputs result "  if(interp) {\nif(Tcl_Eval(interp,[::practcl::tcl_to_c $TCLINIT])) return TCL_ERROR;\n  }"
         6413  +    }
         6414  +    ::practcl::cputs result [my generate-loader-module]
         6415  +
         6416  +    set TCLINIT [my generate-tcl-post]
         6417  +    if {[string length [string trim $TCLINIT]]} {
         6418  +      ::practcl::cputs result "  if(interp) {\nif(Tcl_Eval(interp,[::practcl::tcl_to_c $TCLINIT])) return TCL_ERROR;\n }"
         6419  +    }
         6420  +    if {[my define exists pkg_name]} {
         6421  +      ::practcl::cputs result  "    if (Tcl_PkgProvide(interp, \"[my define get pkg_name [my define get name]]\" , \"[my define get pkg_vers [my define get version]]\" )) return TCL_ERROR\;"
         6422  +    }
         6423  +    ::practcl::cputs result  "  return TCL_OK\;\n\}\n"
         6424  +    return $result
         6425  +  }
         6426  +  method initialize {} {
         6427  +    set filename [my define get filename]
         6428  +    if {$filename eq {}} {
         6429  +      return
         6430  +    }
         6431  +    if {[my define get name] eq {}} {
         6432  +      my define set name [file tail [file dirname $filename]]
         6433  +    }
         6434  +    if {[my define get localpath] eq {}} {
         6435  +      my define set localpath [my <project> define get name]_[my define get name]
         6436  +    }
         6437  +    my graft module [self]
         6438  +    ::practcl::debug [self] SOURCE $filename
         6439  +    my source $filename
         6440  +  }
         6441  +  method implement path {
         6442  +    my go
         6443  +    my Collate_Source $path
         6444  +    set errs {}
         6445  +    foreach item [my link list dynamic] {
         6446  +      if {[catch {$item implement $path} err errdat]} {
         6447  +        lappend errs "Skipped $item: [$item define get filename] $err"
         6448  +        if {[dict exists $errdat -errorinfo]} {
         6449  +          lappend errs [dict get $errdat -errorinfo]
         6450  +        } else {
         6451  +          lappend errs $errdat
         6452  +        }
         6453  +      }
         6454  +    }
         6455  +    foreach item [my link list module] {
         6456  +      if {[catch {$item implement $path} err errdat]} {
         6457  +        lappend errs "Skipped $item: [$item define get filename] $err"
         6458  +        if {[dict exists $errdat -errorinfo]} {
         6459  +          lappend errs [dict get $errdat -errorinfo]
         6460  +        } else {
         6461  +          lappend errs $errdat
         6462  +        }
         6463  +      }
         6464  +    }
         6465  +    if {[llength $errs]} {
         6466  +      set logfile [file join $::CWD practcl.log]
         6467  +      ::practcl::log $logfile "*** ERRORS ***"
         6468  +      foreach {item trace} $errs {
         6469  +        ::practcl::log $logfile "###\n# ERROR\n###\n$item"
         6470  +       ::practcl::log $logfile "###\n# TRACE\n###\n$trace"
         6471  +      }
         6472  +      ::practcl::log $logfile "*** DEBUG INFO ***"
         6473  +      ::practcl::log $logfile $::DEBUG_INFO
         6474  +      puts stderr "Errors saved to $logfile"
         6475  +      exit 1
         6476  +    }
         6477  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         6478  +    set filename [my define get output_c]
         6479  +    if {$filename eq {}} {
         6480  +      ::practcl::debug [list /[self] [self method] [self class]]
         6481  +      return
         6482  +    }
         6483  +    set cout [open [file join $path [file rootname $filename].c] w]
         6484  +    puts $cout [subst {/*
         6485  +** This file is generated by the [info script] script
         6486  +** any changes will be overwritten the next time it is run
         6487  +*/}]
         6488  +    puts $cout [my generate-c]
         6489  +    puts $cout [my generate-loader]
         6490  +    close $cout
         6491  +    ::practcl::debug [list /[self] [self method] [self class]]
         6492  +  }
         6493  +  method linktype {} {
         6494  +    return {subordinate product dynamic module}
         6495  +  }
         6496  +}
         6497  +
         6498  +###
         6499  +# END: class module.tcl
         6500  +###
         6501  +###
         6502  +# START: class project baseclass.tcl
         6503  +###
         6504  +::clay::define ::practcl::project {
         6505  +  superclass ::practcl::module
         6506  +  method _MorphPatterns {} {
         6507  +    return {{@[email protected]} {::practcl::@[email protected]} {::practcl::[email protected]@} {::practcl::project}}
         6508  +  }
         6509  +  constructor args {
         6510  +    my variable define
         6511  +    if {[llength $args] == 1} {
         6512  +      set rawcontents [lindex $args 0]
         6513  +    } else {
         6514  +      set rawcontents $args
         6515  +    }
         6516  +    if {[catch {uplevel 1 [list subst $rawcontents]} contents]} {
         6517  +      set contents $rawcontents
         6518  +    }
         6519  +    ###
         6520  +    # The first instance of ::practcl::project (or its descendents)
         6521  +    # registers itself as the ::practcl::MAIN. If a project other
         6522  +    # than ::practcl::LOCAL is created, odds are that was the one
         6523  +    # the developer intended to be the main project
         6524  +    ###
         6525  +    if {$::practcl::MAIN eq "::practcl::LOCAL"} {
         6526  +      set ::practcl::MAIN [self]
         6527  +    }
         6528  +    # DEFS fields need to be passed unchanged and unsubstituted
         6529  +    # as we need to preserve their escape characters
         6530  +    foreach field {TCL_DEFS DEFS TK_DEFS} {
         6531  +      if {[dict exists $rawcontents $field]} {
         6532  +        dict set contents $field [dict get $rawcontents $field]
         6533  +      }
         6534  +    }
         6535  +    my graft module [self]
         6536  +    array set define $contents
         6537  +    ::practcl::toolset select [self]
         6538  +    my initialize
         6539  +  }
         6540  +  method add_object object {
         6541  +    my link object $object
         6542  +  }
         6543  +  method add_project {pkg info {oodefine {}}} {
         6544  +    ::practcl::debug [self] add_project $pkg $info
         6545  +    set os [my define get TEACUP_OS]
         6546  +    if {$os eq {}} {
         6547  +      set os [::practcl::os]
         6548  +      my define set os $os
         6549  +    }
         6550  +    set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]]
         6551  +    if {[dict exists $info os] && ($os ni [dict get $info os])} return
         6552  +    # Select which tag to use here.
         6553  +    # For production builds: tag-release
         6554  +    set profile [my define get profile release]:
         6555  +    if {[dict exists $info profile $profile]} {
         6556  +      dict set info tag [dict get $info profile $profile]
         6557  +    }
         6558  +    dict set info USEMSVC [my define get USEMSVC 0]
         6559  +    dict set info debug [my define get debug 0]
         6560  +    set obj [namespace current]::PROJECT.$pkg
         6561  +    if {[info command $obj] eq {}} {
         6562  +      set obj [::practcl::subproject create $obj [self] [dict merge $fossilinfo [list name $pkg pkg_name $pkg static 0 class subproject.binary] $info]]
         6563  +    }
         6564  +    my link object $obj
         6565  +    oo::objdefine $obj $oodefine
         6566  +    $obj define set masterpath $::CWD
         6567  +    $obj go
         6568  +    return $obj
         6569  +  }
         6570  +  method add_tool {pkg info {oodefine {}}} {
         6571  +    ::practcl::debug [self] add_tool $pkg $info
         6572  +    set info [dict merge [::practcl::local_os] $info]
         6573  +
         6574  +    set os [dict get $info TEACUP_OS]
         6575  +    set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]]
         6576  +    if {[dict exists $info os] && ($os ni [dict get $info os])} return
         6577  +    # Select which tag to use here.
         6578  +    # For production builds: tag-release
         6579  +    set profile [my define get profile release]:
         6580  +    if {[dict exists $info profile $profile]} {
         6581  +      dict set info tag [dict get $info profile $profile]
         6582  +    }
         6583  +    set obj ::practcl::OBJECT::TOOL.$pkg
         6584  +    if {[info command $obj] eq {}} {
         6585  +      set obj [::practcl::subproject create $obj [self] [dict merge $fossilinfo [list name $pkg pkg_name $pkg static 0] $info]]
         6586  +    }
         6587  +    my link add tool $obj
         6588  +    oo::objdefine $obj $oodefine
         6589  +    $obj define set masterpath $::CWD
         6590  +    $obj go
         6591  +    return $obj
         6592  +  }
         6593  +  method build-tclcore {} {
         6594  +    set os [my define get TEACUP_OS]
         6595  +    set tcl_config_opts [::practcl::platform::tcl_core_options $os]
         6596  +    set tk_config_opts  [::practcl::platform::tk_core_options $os]
         6597  +
         6598  +    lappend tcl_config_opts --prefix [my define get prefix] --exec-prefix [my define get prefix]
         6599  +    set tclobj [my tclcore]
         6600  +    if {[my define get debug 0]} {
         6601  +      $tclobj define set debug 1
         6602  +      lappend tcl_config_opts --enable-symbols=true
         6603  +    }
         6604  +    $tclobj define set config_opts $tcl_config_opts
         6605  +    $tclobj go
         6606  +    $tclobj compile
         6607  +
         6608  +    set _TclSrcDir [$tclobj define get localsrcdir]
         6609  +    my define set tclsrcdir $_TclSrcDir
         6610  +    if {[my define get tk 0]} {
         6611  +      set tkobj [my tkcore]
         6612  +      lappend tk_config_opts --with-tcl=[::practcl::file_relative [$tkobj define get builddir]  [$tclobj define get builddir]]
         6613  +      if {[my define get debug 0]} {
         6614  +        $tkobj define set debug 1
         6615  +        lappend tk_config_opts --enable-symbols=true
         6616  +      }
         6617  +      $tkobj define set config_opts $tk_config_opts
         6618  +      $tkobj compile
         6619  +    }
         6620  +  }
         6621  +  method child which {
         6622  +    switch $which {
         6623  +      delegate -
         6624  +      organs {
         6625  +	# A library can be a project, it can be a module. Any
         6626  +	# subordinate modules will indicate their existance
         6627  +        return [list project [self] module [self]]
         6628  +      }
         6629  +    }
         6630  +  }
         6631  +  method linktype {} {
         6632  +    return project
         6633  +  }
         6634  +  method project {pkg args} {
         6635  +    set obj [namespace current]::PROJECT.$pkg
         6636  +    if {[llength $args]==0} {
         6637  +      return $obj
         6638  +    }
         6639  +    ${obj} {*}$args
         6640  +  }
         6641  +  method tclcore {} {
         6642  +    if {[info commands [set obj [my clay delegate tclcore]]] ne {}} {
         6643  +      return $obj
         6644  +    }
         6645  +    if {[info commands [set obj [my project TCLCORE]]] ne {}} {
         6646  +      my graft tclcore $obj
         6647  +      return $obj
         6648  +    }
         6649  +    if {[info commands [set obj [my project tcl]]] ne {}} {
         6650  +      my graft tclcore $obj
         6651  +      return $obj
         6652  +    }
         6653  +    if {[info commands [set obj [my tool tcl]]] ne {}} {
         6654  +      my graft tclcore $obj
         6655  +      return $obj
         6656  +    }
         6657  +    # Provide a fallback
         6658  +    set obj [my add_tool tcl {
         6659  +      tag release class subproject.core
         6660  +      fossil_url http://core.tcl.tk/tcl
         6661  +    }]
         6662  +    my graft tclcore $obj
         6663  +    return $obj
         6664  +  }
         6665  +  method tkcore {} {
         6666  +    if {[set obj [my clay delegate tkcore]] ne {}} {
         6667  +      return $obj
         6668  +    }
         6669  +    if {[set obj [my project tk]] ne {}} {
         6670  +      my graft tkcore $obj
         6671  +      return $obj
         6672  +    }
         6673  +    if {[set obj [my tool tk]] ne {}} {
         6674  +      my graft tkcore $obj
         6675  +      return $obj
         6676  +    }
         6677  +    # Provide a fallback
         6678  +    set obj [my add_tool tk {
         6679  +      tag release class tool.core
         6680  +      fossil_url http://core.tcl.tk/tk
         6681  +    }]
         6682  +    my graft tkcore $obj
         6683  +    return $obj
         6684  +  }
         6685  +  method tool {pkg args} {
         6686  +    set obj ::practcl::OBJECT::TOOL.$pkg
         6687  +    if {[llength $args]==0} {
         6688  +      return $obj
         6689  +    }
         6690  +    ${obj} {*}$args
         6691  +  }
         6692  +}
         6693  +
         6694  +###
         6695  +# END: class project baseclass.tcl
         6696  +###
         6697  +###
         6698  +# START: class project library.tcl
         6699  +###
         6700  +::clay::define ::practcl::library {
         6701  +  superclass ::practcl::project
         6702  +  method clean {PATH} {
         6703  +    set objext [my define get OBJEXT o]
         6704  +    foreach {ofile info} [my project-compile-products] {
         6705  +      if {[file exists [file join $PATH objs $ofile].${objext}]} {
         6706  +        file delete [file join $PATH objs $ofile].${objext}
         6707  +      }
         6708  +    }
         6709  +    foreach ofile [glob -nocomplain [file join $PATH *.${objext}]] {
         6710  +      file delete $ofile
         6711  +    }
         6712  +    foreach ofile [glob -nocomplain [file join $PATH objs *]] {
         6713  +      file delete $ofile
         6714  +    }
         6715  +    set libfile [my define get libfile]
         6716  +    if {[file exists [file join $PATH $libfile]]} {
         6717  +      file delete [file join $PATH $libfile]
         6718  +    }
         6719  +    my implement $PATH
         6720  +  }
         6721  +  method project-compile-products {} {
         6722  +    set result {}
         6723  +    foreach item [my link list subordinate] {
         6724  +      lappend result {*}[$item project-compile-products]
         6725  +    }
         6726  +    set filename [my define get output_c]
         6727  +    if {$filename ne {}} {
         6728  +      ::practcl::debug [self] [self class] [self method] project-compile-products $filename
         6729  +      set ofile [file rootname [file tail $filename]]_main
         6730  +      lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]]
         6731  +    }
         6732  +    return $result
         6733  +  }
         6734  +  method go {} {
         6735  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         6736  +    set name [my define getnull name]
         6737  +    if {$name eq {}} {
         6738  +      set name generic
         6739  +      my define name generic
         6740  +    }
         6741  +    if {[my define get tk] eq {@[email protected]}} {
         6742  +      my define set tk 0
         6743  +    }
         6744  +    set output_c [my define getnull output_c]
         6745  +    if {$output_c eq {}} {
         6746  +      set output_c [file rootname $name].c
         6747  +      my define set output_c $output_c
         6748  +    }
         6749  +    set output_h [my define getnull output_h]
         6750  +    if {$output_h eq {}} {
         6751  +      set output_h [file rootname $output_c].h
         6752  +      my define set output_h $output_h
         6753  +    }
         6754  +    set output_tcl [my define getnull output_tcl]
         6755  +    #if {$output_tcl eq {}} {
         6756  +    #  set output_tcl [file rootname $output_c].tcl
         6757  +    #  my define set output_tcl $output_tcl
         6758  +    #}
         6759  +    #set output_mk [my define getnull output_mk]
         6760  +    #if {$output_mk eq {}} {
         6761  +    #  set output_mk [file rootname $output_c].mk
         6762  +    #  my define set output_mk $output_mk
         6763  +    #}
         6764  +    set initfunc [my define getnull initfunc]
         6765  +    if {$initfunc eq {}} {
         6766  +      set initfunc [string totitle $name]_Init
         6767  +      my define set initfunc $initfunc
         6768  +    }
         6769  +    set output_decls [my define getnull output_decls]
         6770  +    if {$output_decls eq {}} {
         6771  +      set output_decls [file rootname $output_c].decls
         6772  +      my define set output_decls $output_decls
         6773  +    }
         6774  +    my variable links
         6775  +    foreach {linktype objs} [array get links] {
         6776  +      foreach obj $objs {
         6777  +        $obj go
         6778  +      }
         6779  +    }
         6780  +    ::practcl::debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         6781  +  }
         6782  +  method generate-decls {pkgname path} {
         6783  +    ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]]
         6784  +    set outfile [file join $path/$pkgname.decls]
         6785  +
         6786  +    ###
         6787  +    # Build the decls file
         6788  +    ## #
         6789  +    set fout [open $outfile w]
         6790  +    puts $fout [subst {###
         6791  +  # $outfile
         6792  +  #
         6793  +  # This file was generated by [info script]
         6794  +  ###
         6795  +
         6796  +library $pkgname
         6797  +interface $pkgname
         6798  +}]
         6799  +
         6800  +    ###
         6801  +    # Generate list of functions
         6802  +    ###
         6803  +    set stubfuncts [my generate-stub-function]
         6804  +    set thisline {}
         6805  +    set functcount 0
         6806  +    foreach {func header} $stubfuncts {
         6807  +      puts $fout [list declare [incr functcount] $header]
         6808  +    }
         6809  +    puts $fout [list export "int [my define get initfunc](Tcl_Inter *interp)"]
         6810  +    puts $fout [list export "char *[string totitle [my define get name]]_InitStubs(Tcl_Inter *interp, char *version, int exact)"]
         6811  +
         6812  +    close $fout
         6813  +
         6814  +    ###
         6815  +    # Build [package]Decls.h
         6816  +    ###
         6817  +    set hout [open [file join $path ${pkgname}Decls.h] w]
         6818  +    close $hout
         6819  +
         6820  +    set cout [open [file join $path ${pkgname}StubInit.c] w]
         6821  +    puts $cout [string map [list %pkgname% $pkgname %PkgName% [string totitle $pkgname]] {
         6822  +#ifndef USE_TCL_STUBS
         6823  +#define USE_TCL_STUBS
         6824  +#endif
         6825  +#undef USE_TCL_STUB_PROCS
         6826  +
         6827  +#include "tcl.h"
         6828  +#include "%pkgname%.h"
         6829  +
         6830  +/*
         6831  +** Ensure that Tdom_InitStubs is built as an exported symbol.  The other stub
         6832  +** functions should be built as non-exported symbols.
         6833  +*/
         6834  +
         6835  +#undef TCL_STORAGE_CLASS
         6836  +#define TCL_STORAGE_CLASS DLLEXPORT
         6837  +
         6838  +%PkgName%Stubs *%pkgname%StubsPtr;
         6839  +
         6840  + /*
         6841  + **----------------------------------------------------------------------
         6842  + **
         6843  + **  %PkgName%_InitStubs --
         6844  + **
         6845  + **        Checks that the correct version of %PkgName% is loaded and that it
         6846  + **        supports stubs. It then initialises the stub table pointers.
         6847  + **
         6848  + **  Results:
         6849  + **        The actual version of %PkgName% that satisfies the request, or
         6850  + **        NULL to indicate that an error occurred.
         6851  + **
         6852  + **  Side effects:
         6853  + **        Sets the stub table pointers.
         6854  + **
         6855  + **----------------------------------------------------------------------
         6856  + */
         6857  +
         6858  +char *
         6859  +%PkgName%_InitStubs (Tcl_Interp *interp, char *version, int exact)
         6860  +{
         6861  +  char *actualVersion;
         6862  +  actualVersion = Tcl_PkgRequireEx(interp, "%pkgname%", version, exact,(ClientData *) &%pkgname%StubsPtr);
         6863  +  if (!actualVersion) {
         6864  +    return NULL;
         6865  +  }
         6866  +  if (!%pkgname%StubsPtr) {
         6867  +    Tcl_SetResult(interp,"This implementation of %PkgName% does not support stubs",TCL_STATIC);
         6868  +    return NULL;
         6869  +  }
         6870  +  return actualVersion;
         6871  +}
         6872  +}]
         6873  +    close $cout
         6874  +  }
         6875  +  method implement path {
         6876  +    my go
         6877  +    my Collate_Source $path
         6878  +    set errs {}
         6879  +    foreach item [my link list dynamic] {
         6880  +      if {[catch {$item implement $path} err errdat]} {
         6881  +        lappend errs "Skipped $item: [$item define get filename] $err"
         6882  +        if {[dict exists $errdat -errorinfo]} {
         6883  +          lappend errs [dict get $errdat -errorinfo]
         6884  +        } else {
         6885  +          lappend errs $errdat
         6886  +        }
         6887  +      }
         6888  +    }
         6889  +    foreach item [my link list module] {
         6890  +      if {[catch {$item implement $path} err errdat]} {
         6891  +        lappend errs "Skipped $item: [$item define get filename] $err"
         6892  +        if {[dict exists $errdat -errorinfo]} {
         6893  +          lappend errs [dict get $errdat -errorinfo]
         6894  +        } else {
         6895  +          lappend errs $errdat
         6896  +        }
         6897  +      }
         6898  +    }
         6899  +    if {[llength $errs]} {
         6900  +      set logfile [file join $::CWD practcl.log]
         6901  +      ::practcl::log $logfile "*** ERRORS ***"
         6902  +      foreach {item trace} $errs {
         6903  +        ::practcl::log $logfile "###\n# ERROR\n###$item"
         6904  +        ::practcl::log $logfile "###\n# TRACE\n###$trace"
         6905  +      }
         6906  +      ::practcl::log $logfile "*** DEBUG INFO ***"
         6907  +      ::practcl::log $logfile $::DEBUG_INFO
         6908  +      puts stderr "Errors saved to $logfile"
         6909  +      exit 1
         6910  +    }
         6911  +    set cout [open [file join $path [my define get output_c]] w]
         6912  +    puts $cout [subst {/*
         6913  +** This file is generated by the [info script] script
         6914  +** any changes will be overwritten the next time it is run
         6915  +*/}]
         6916  +    puts $cout [my generate-c]
         6917  +    puts $cout [my generate-loader]
         6918  +    close $cout
         6919  +
         6920  +    set macro HAVE_[string toupper [file rootname [my define get output_h]]]_H
         6921  +    set hout [open [file join $path [my define get output_h]] w]
         6922  +    puts $hout [subst {/*
         6923  +** This file is generated by the [info script] script
         6924  +** any changes will be overwritten the next time it is run
         6925  +*/}]
         6926  +    puts $hout "#ifndef ${macro}"
         6927  +    puts $hout "#define ${macro} 1"
         6928  +    puts $hout [my generate-h]
         6929  +    puts $hout "#endif"
         6930  +    close $hout
         6931  +
         6932  +    set output_tcl [my define get output_tcl]
         6933  +    if {$output_tcl ne {}} {
         6934  +      set tclout [open [file join $path [my define get output_tcl]] w]
         6935  +      puts $tclout "###
         6936  +# This file is generated by the [info script] script
         6937  +# any changes will be overwritten the next time it is run
         6938  +###"
         6939  +      puts $tclout [my generate-tcl-pre]
         6940  +      puts $tclout [my generate-tcl-loader]
         6941  +      puts $tclout [my generate-tcl-post]
         6942  +      close $tclout
         6943  +    }
         6944  +  }
         6945  +  method generate-make path {
         6946  +    my build-Makefile $path [self]
         6947  +  }
         6948  +  method linktype {} {
         6949  +    return library
         6950  +  }
         6951  +  method package-ifneeded {args} {
         6952  +    set result {}
         6953  +    set name [my define get pkg_name [my define get name]]
         6954  +    set version [my define get pkg_vers [my define get version]]
         6955  +    if {$version eq {}} {
         6956  +      set version 0.1a
         6957  +    }
         6958  +    set output_tcl [my define get output_tcl]
         6959  +    if {$output_tcl ne {}} {
         6960  +      set script "\[list source \[file join \$dir $output_tcl\]\]"
         6961  +    } elseif {[my define get SHARED_BUILD 0]} {
         6962  +      set script "\[list load \[file join \$dir [my define get libfile]\] $name\]"
         6963  +    } else {
         6964  +      # Provide a null passthrough
         6965  +      set script "\[list package provide $name $version\]"
         6966  +    }
         6967  +    set result "package ifneeded [list $name] [list $version] $script"
         6968  +    foreach alias $args {
         6969  +      set script "package require $name $version \; package provide $alias $version"
         6970  +      append result \n\n [list package ifneeded $alias $version $script]
         6971  +    }
         6972  +    return $result
         6973  +  }
         6974  +  method shared_library {{filename {}}} {
         6975  +    set name [string tolower [my define get name [my define get pkg_name]]]
         6976  +    set NAME [string toupper $name]
         6977  +    set version [my define get version [my define get pkg_vers]]
         6978  +    set map {}
         6979  +    lappend map %LIBRARY_NAME% $name
         6980  +    lappend map %LIBRARY_VERSION% $version
         6981  +    lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $version]
         6982  +    lappend map %LIBRARY_PREFIX% [my define getnull libprefix]
         6983  +    set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]][my define get SHLIB_SUFFIX]
         6984  +    return $outfile
         6985  +  }
         6986  +  method static_library {{filename {}}} {
         6987  +    set name [string tolower [my define get name [my define get pkg_name]]]
         6988  +    set NAME [string toupper $name]
         6989  +    set version [my define get version [my define get pkg_vers]]
         6990  +    set map {}
         6991  +    lappend map %LIBRARY_NAME% $name
         6992  +    lappend map %LIBRARY_VERSION% $version
         6993  +    lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $version]
         6994  +    lappend map %LIBRARY_PREFIX% [my define getnull libprefix]
         6995  +    set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]].a
         6996  +    return $outfile
         6997  +  }
         6998  +}
         6999  +
         7000  +###
         7001  +# END: class project library.tcl
         7002  +###
         7003  +###
         7004  +# START: class project tclkit.tcl
         7005  +###
         7006  +::clay::define ::practcl::tclkit {
         7007  +  superclass ::practcl::library
         7008  +  method build-tclkit_main {PROJECT PKG_OBJS} {
         7009  +    ###
         7010  +    # Build static package list
         7011  +    ###
         7012  +    set statpkglist {}
         7013  +    foreach cobj [list {*}${PKG_OBJS} $PROJECT] {
         7014  +      foreach {pkg info} [$cobj project-static-packages] {
         7015  +        dict set statpkglist $pkg $info
         7016  +      }
         7017  +    }
         7018  +    foreach {ofile info} [${PROJECT} project-compile-products] {
         7019  +      if {![dict exists $info object]} continue
         7020  +      set cobj [dict get $info object]
         7021  +      foreach {pkg info} [$cobj project-static-packages] {
         7022  +        dict set statpkglist $pkg $info
         7023  +      }
         7024  +    }
         7025  +
         7026  +    set result {}
         7027  +    $PROJECT include {<tcl.h>}
         7028  +    $PROJECT include {"tclInt.h"}
         7029  +    $PROJECT include {"tclFileSystem.h"}
         7030  +    $PROJECT include {<assert.h>}
         7031  +    $PROJECT include {<stdio.h>}
         7032  +    $PROJECT include {<stdlib.h>}
         7033  +    $PROJECT include {<string.h>}
         7034  +    $PROJECT include {<math.h>}
         7035  +
         7036  +    $PROJECT code header {
         7037  +#ifndef MODULE_SCOPE
         7038  +#   define MODULE_SCOPE extern
         7039  +#endif
         7040  +
         7041  +/*
         7042  +** Provide a dummy Tcl_InitStubs if we are using this as a static
         7043  +** library.
         7044  +*/
         7045  +#ifndef USE_TCL_STUBS
         7046  +# undef  Tcl_InitStubs
         7047  +# define Tcl_InitStubs(a,b,c) TCL_VERSION
         7048  +#endif
         7049  +#define STATIC_BUILD 1
         7050  +#undef USE_TCL_STUBS
         7051  +
         7052  +/* Make sure the stubbed variants of those are never used. */
         7053  +#undef Tcl_ObjSetVar2
         7054  +#undef Tcl_NewStringObj
         7055  +#undef Tk_Init
         7056  +#undef Tk_MainEx
         7057  +#undef Tk_SafeInit
         7058  +}
         7059  +
         7060  +    # Build an area of the file for #define directives and
         7061  +    # function declarations
         7062  +    set define {}
         7063  +    set mainhook   [$PROJECT define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook]
         7064  +    set mainfunc   [$PROJECT define get TCL_LOCAL_APPINIT Tclkit_AppInit]
         7065  +    set mainscript [$PROJECT define get main.tcl main.tcl]
         7066  +    set vfsroot    [$PROJECT define get vfsroot "[$PROJECT define get ZIPFS_VOLUME]app"]
         7067  +    set vfs_main "${vfsroot}/${mainscript}"
         7068  +
         7069  +    set map {}
         7070  +    foreach var {
         7071  +      vfsroot mainhook mainfunc vfs_main
         7072  +    } {
         7073  +      dict set map %${var}% [set $var]
         7074  +    }
         7075  +    set preinitscript {
         7076  +set ::odie(boot_vfs) %vfsroot%
         7077  +set ::SRCDIR $::odie(boot_vfs)
         7078  +if {[file exists [file join %vfsroot% tcl_library init.tcl]]} {
         7079  +  set ::tcl_library [file join %vfsroot% tcl_library]
         7080  +  set ::auto_path {}
         7081  +}
         7082  +if {[file exists [file join %vfsroot% tk_library tk.tcl]]} {
         7083  +  set ::tk_library [file join %vfsroot% tk_library]
         7084  +}
         7085  +} ; # Preinitscript
         7086  +
         7087  +    set zvfsboot {
         7088  +/*
         7089  + * %mainhook% --
         7090  + * Performs the argument munging for the shell
         7091  + */
         7092  +  }
         7093  +    ::practcl::cputs zvfsboot {
         7094  +  CONST char *archive;
         7095  +  Tcl_FindExecutable(*argv[0]);
         7096  +  archive=Tcl_GetNameOfExecutable();
         7097  +}
         7098  +    # We have to initialize the virtual filesystem before calling
         7099  +    # Tcl_Init().  Otherwise, Tcl_Init() will not be able to find
         7100  +    # its startup script files.
         7101  +    if {![$PROJECT define get tip_430 0]} {
         7102  +      # Add declarations of functions that tip430 puts in the stub files
         7103  +      $PROJECT code public-header {
         7104  +int TclZipfs_Init(Tcl_Interp *interp);
         7105  +int TclZipfs_Mount(
         7106  +    Tcl_Interp *interp,
         7107  +    const char *mntpt,
         7108  +    const char *zipname,
         7109  +    const char *passwd
         7110  +);
         7111  +int TclZipfs_Mount_Buffer(
         7112  +    Tcl_Interp *interp,
         7113  +    const char *mntpt,
         7114  +    unsigned char *data,
         7115  +    size_t datalen,
         7116  +    int copy
         7117  +);
         7118  +}
         7119  +      ::practcl::cputs zvfsboot {  TclZipfs_Init(NULL);}
         7120  +    }
         7121  +    ::practcl::cputs zvfsboot "  if(!TclZipfs_Mount(NULL, \"app\", archive, NULL)) \x7B "
         7122  +    ::practcl::cputs zvfsboot {
         7123  +      Tcl_Obj *vfsinitscript;
         7124  +      vfsinitscript=Tcl_NewStringObj("%vfs_main%",-1);
         7125  +      Tcl_IncrRefCount(vfsinitscript);
         7126  +      if(Tcl_FSAccess(vfsinitscript,F_OK)==0) {
         7127  +        /* Startup script should be set before calling Tcl_AppInit */
         7128  +        Tcl_SetStartupScript(vfsinitscript,NULL);
         7129  +      }
         7130  +    }
         7131  +    ::practcl::cputs zvfsboot "    TclSetPreInitScript([::practcl::tcl_to_c $preinitscript])\;"
         7132  +    ::practcl::cputs zvfsboot "  \x7D else \x7B"
         7133  +    ::practcl::cputs zvfsboot "    TclSetPreInitScript([::practcl::tcl_to_c {
         7134  +foreach path {../tcl} {
         7135  +  set p  [file join $path library init.tcl]
         7136  +  if {[file exists [file join $path library init.tcl]]} {
         7137  +    set ::tcl_library [file normalize [file join $path library]]
         7138  +    break
         7139  +  }
         7140  +}
         7141  +foreach path {
         7142  +  ../tk
         7143  +} {
         7144  +  if {[file exists [file join $path library tk.tcl]]} {
         7145  +    set ::tk_library [file normalize [file join $path library]]
         7146  +    break
         7147  +  }
         7148  +}
         7149  +}])\;"
         7150  +    ::practcl::cputs zvfsboot "  \x7D"
         7151  +    ::practcl::cputs zvfsboot "  return TCL_OK;"
         7152  +
         7153  +    if {[$PROJECT define get TEACUP_OS] eq "windows"} {
         7154  +      set header {int %mainhook%(int *argc, TCHAR ***argv)}
         7155  +    } else {
         7156  +      set header {int %mainhook%(int *argc, char ***argv)}
         7157  +    }
         7158  +    $PROJECT c_function  [string map $map $header] [string map $map $zvfsboot]
         7159  +
         7160  +    practcl::cputs appinit "int %mainfunc%(Tcl_Interp *interp) \x7B"
         7161  +
         7162  +  # Build AppInit()
         7163  +  set appinit {}
         7164  +  practcl::cputs appinit {
         7165  +  if ((Tcl_Init)(interp) == TCL_ERROR) {
         7166  +      return TCL_ERROR;
         7167  +  }
         7168  +
         7169  +}
         7170  +    if {![$PROJECT define get tip_430 0]} {
         7171  +      ::practcl::cputs appinit {  TclZipfs_Init(interp);}
         7172  +    }
         7173  +    set main_init_script {}
         7174  +
         7175  +    foreach {statpkg info} $statpkglist {
         7176  +      set initfunc {}
         7177  +      if {[dict exists $info initfunc]} {
         7178  +        set initfunc [dict get $info initfunc]
         7179  +      }
         7180  +      if {$initfunc eq {}} {
         7181  +        set initfunc [string totitle ${statpkg}]_Init
         7182  +      }
         7183  +      if {![dict exists $info version]} {
         7184  +        error "$statpkg HAS NO VERSION"
         7185  +      }
         7186  +      # We employ a NULL to prevent the package system from thinking the
         7187  +      # package is actually loaded into the interpreter
         7188  +      $PROJECT code header "extern Tcl_PackageInitProc $initfunc\;\n"
         7189  +      set script [list package ifneeded $statpkg [dict get $info version] [list ::load {} $statpkg]]
         7190  +      append main_init_script \n [list set ::kitpkg(${statpkg}) $script]
         7191  +      if {[dict get $info autoload]} {
         7192  +        ::practcl::cputs appinit "  if(${initfunc}(interp)) return TCL_ERROR\;"
         7193  +        ::practcl::cputs appinit "  Tcl_StaticPackage(interp,\"$statpkg\",$initfunc,NULL)\;"
         7194  +      } else {
         7195  +        ::practcl::cputs appinit "\n  Tcl_StaticPackage(NULL,\"$statpkg\",$initfunc,NULL)\;"
         7196  +        append main_init_script \n $script
         7197  +      }
         7198  +    }
         7199  +    append main_init_script \n {
         7200  +puts [list SRCDIR IS $::SRCDIR]
         7201  +if {[file exists [file join $::SRCDIR pkgIndex.tcl]]} {
         7202  +  #In a wrapped exe, we don't go out to the environment
         7203  +  set dir $::SRCDIR
         7204  +  source [file join $::SRCDIR pkgIndex.tcl]
         7205  +}
         7206  +# Specify a user-specific startup file to invoke if the application
         7207  +# is run interactively.  Typically the startup file is "~/.apprc"
         7208  +# where "app" is the name of the application.  If this line is deleted
         7209  +# then no user-specific startup file will be run under any conditions.
         7210  +}
         7211  +    append main_init_script \n [list set tcl_rcFileName [$PROJECT define get tcl_rcFileName ~/.tclshrc]]
         7212  +    practcl::cputs appinit "  Tcl_Eval(interp,[::practcl::tcl_to_c  $main_init_script]);"
         7213  +    practcl::cputs appinit {  return TCL_OK;}
         7214  +    $PROJECT c_function [string map $map "int %mainfunc%(Tcl_Interp *interp)"] [string map $map $appinit]
         7215  +  }
         7216  +  method Collate_Source CWD {
         7217  +    next $CWD
         7218  +    set name [my define get name]
         7219  +    # Assume a static shell
         7220  +    if {[my define exists SHARED_BUILD]} {
         7221  +      my define set SHARED_BUILD 0
         7222  +    }
         7223  +    if {![my define exists TCL_LOCAL_APPINIT]} {
         7224  +      my define set TCL_LOCAL_APPINIT Tclkit_AppInit
         7225  +    }
         7226  +    if {![my define exists TCL_LOCAL_MAIN_HOOK]} {
         7227  +      my define set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook
         7228  +    }
         7229  +    set PROJECT [self]
         7230  +    set os [$PROJECT define get TEACUP_OS]
         7231  +    if {[my define get SHARED_BUILD 0]} {
         7232  +      puts [list BUILDING TCLSH FOR OS $os]
         7233  +    } else {
         7234  +      puts [list BUILDING KIT FOR OS $os]
         7235  +    }
         7236  +    set TCLOBJ [$PROJECT tclcore]
         7237  +    ::practcl::toolset select $TCLOBJ
         7238  +
         7239  +    set TCLSRCDIR [$TCLOBJ define get srcdir]
         7240  +    set PKG_OBJS {}
         7241  +    foreach item [$PROJECT link list core.library] {
         7242  +      if {[string is true [$item define get static]]} {
         7243  +        lappend PKG_OBJS $item
         7244  +      }
         7245  +    }
         7246  +    foreach item [$PROJECT link list package] {
         7247  +      if {[string is true [$item define get static]]} {
         7248  +        lappend PKG_OBJS $item
         7249  +      }
         7250  +    }
         7251  +    # Arrange to build an main.c that utilizes TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK
         7252  +    if {$os eq "windows"} {
         7253  +      set PLATFORM_SRC_DIR win
         7254  +      if {[my define get SHARED_BUILD 0]} {
         7255  +        my add class csource filename [file join $TCLSRCDIR win tclWinReg.c] initfunc Registry_Init pkg_name registry pkg_vers 1.3.1 autoload 1
         7256  +        my add class csource filename [file join $TCLSRCDIR win tclWinDde.c] initfunc Dde_Init pkg_name dde pkg_vers 1.4.0 autoload 1
         7257  +      }
         7258  +      my add class csource ofile [my define get name]_appinit.o filename [file join $TCLSRCDIR win tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my define get TCL_LOCAL_APPINIT Tclkit_AppInit]]
         7259  +    } else {
         7260  +      set PLATFORM_SRC_DIR unix
         7261  +      my add class csource ofile [my define get name]_appinit.o filename [file join $TCLSRCDIR unix tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my define get TCL_LOCAL_APPINIT Tclkit_AppInit]]
         7262  +    }
         7263  +
         7264  +    if {[my define get SHARED_BUILD 0]} {
         7265  +      ###
         7266  +      # Add local static Zlib implementation
         7267  +      ###
         7268  +      set cdir [file join $TCLSRCDIR compat zlib]
         7269  +      foreach file {
         7270  +        adler32.c compress.c crc32.c
         7271  +        deflate.c infback.c inffast.c
         7272  +        inflate.c inftrees.c trees.c
         7273  +        uncompr.c zutil.c
         7274  +      } {
         7275  +        my add [file join $cdir $file]
         7276  +      }
         7277  +    }
         7278  +    ###
         7279  +    # Pre 8.7, Tcl doesn't include a Zipfs implementation
         7280  +    # in the core. Grab the one from odielib
         7281  +    ###
         7282  +    set zipfs [file join $TCLSRCDIR generic tclZipfs.c]
         7283  +    if {![$PROJECT define exists ZIPFS_VOLUME]} {
         7284  +      $PROJECT define set ZIPFS_VOLUME "zipfs:/"
         7285  +    }
         7286  +    $PROJECT code header "#define ZIPFS_VOLUME \"[$PROJECT define get ZIPFS_VOLUME]\""
         7287  +    if {[file exists $zipfs]} {
         7288  +      $TCLOBJ define set tip_430 1
         7289  +      my define set tip_430 1
         7290  +    } else {
         7291  +      # The Tclconfig project maintains a mirror of the version
         7292  +      # released with the Tcl core
         7293  +      my define set tip_430 0
         7294  +      ::practcl::LOCAL tool tclconfig unpack
         7295  +      set COMPATSRCROOT [::practcl::LOCAL tool tclconfig define get srcdir]
         7296  +      my add class csource ofile tclZipfs.o filename [file join $COMPATSRCROOT compat tclZipfs.c] extra -I[::practcl::file_relative $CWD [file join $TCLSRCDIR compat zlib contrib minizip]]
         7297  +    }
         7298  +
         7299  +    my define add include_dir [file join $TCLSRCDIR generic]
         7300  +    my define add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR]
         7301  +    # This file will implement TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK
         7302  +    my build-tclkit_main $PROJECT $PKG_OBJS
         7303  +  }
         7304  +  method wrap {PWD exename vfspath args} {
         7305  +    cd $PWD
         7306  +    if {![file exists $vfspath]} {
         7307  +      file mkdir $vfspath
         7308  +    }
         7309  +    foreach item [my link list core.library] {
         7310  +      set name  [$item define get name]
         7311  +      set libsrcdir [$item define get srcdir]
         7312  +      if {[file exists [file join $libsrcdir library]]} {
         7313  +        ::practcl::copyDir [file join $libsrcdir library] [file join $vfspath ${name}_library]
         7314  +      }
         7315  +    }
         7316  +    # Assume the user will populate the VFS path
         7317  +    #if {[my define get installdir] ne {}} {
         7318  +    #  ::practcl::copyDir [file join [my define get installdir] [string trimleft [my define get prefix] /] lib] [file join $vfspath lib]
         7319  +    #}
         7320  +    foreach arg $args {
         7321  +       ::practcl::copyDir $arg $vfspath
         7322  +    }
         7323  +
         7324  +    set fout [open [file join $vfspath pkgIndex.tcl] w]
         7325  +    puts $fout [string map [list %platform% [my define get TEACUP_PROFILE]] {set ::tcl_teapot_profile {%platform%}}]
         7326  +    puts $fout {
         7327  +set ::PKGIDXFILE [info script]
         7328  +set dir [file dirname $::PKGIDXFILE]
         7329  +if {$::tcl_platform(platform) eq "windows"} {
         7330  +  set ::g(HOME) [file join [file normalize $::env(LOCALAPPDATA)] tcl]
         7331  +} else {
         7332  +  set ::g(HOME) [file normalize ~/tcl]
         7333  +}
         7334  +set ::tcl_teapot [file join $::g(HOME) teapot $::tcl_teapot_profile]
         7335  +lappend ::auto_path $::tcl_teapot
         7336  +}
         7337  +    puts $fout [list proc installDir [info args ::practcl::installDir] [info body ::practcl::installDir]]
         7338  +    set buffer [::practcl::pkgindex_path $vfspath]
         7339  +    puts $fout $buffer
         7340  +    puts $fout {
         7341  +# Advertise statically linked packages
         7342  +foreach {pkg script} [array get ::kitpkg] {
         7343  +  eval $script
         7344  +}
         7345  +}
         7346  +    puts $fout {
         7347  +###
         7348  +# Cache binary packages distributed as dynamic libraries in a known location
         7349  +###
         7350  +foreach teapath [glob -nocomplain [file join $dir teapot $::tcl_teapot_profile *]] {
         7351  +  set pkg [file tail $teapath]
         7352  +  set pkginstall [file join $::tcl_teapot $pkg]
         7353  +  if {![file exists $pkginstall]} {
         7354  +    installDir $teapath $pkginstall
         7355  +  }
         7356  +}
         7357  +}
         7358  +    close $fout
         7359  +
         7360  +    set EXEEXT [my define get EXEEXT]
         7361  +    set tclkit_bare [my define get tclkit_bare]
         7362  +    ::practcl::mkzip ${exename}${EXEEXT} $tclkit_bare $vfspath
         7363  +    if { [my define get TEACUP_OS] ne "windows" } {
         7364  +      file attributes ${exename}${EXEEXT} -permissions a+x
         7365  +    }
         7366  +  }
         7367  +}
         7368  +
         7369  +###
         7370  +# END: class project tclkit.tcl
         7371  +###
         7372  +###
         7373  +# START: class distro baseclass.tcl
         7374  +###
         7375  +::clay::define ::practcl::distribution {
         7376  +  method scm_info {} {
         7377  +    return {
         7378  +      scm  None
         7379  +      hash {}
         7380  +      maxdate {}
         7381  +      tags {}
         7382  +      isodate {}
         7383  +    }
         7384  +  }
         7385  +  method DistroMixIn {} {
         7386  +    my define set scm none
         7387  +  }
         7388  +  method Sandbox {} {
         7389  +    if {[my define exists sandbox]} {
         7390  +      return [my define get sandbox]
         7391  +    }
         7392  +    if {[my clay delegate project] ni {::noop {}}} {
         7393  +      set sandbox [my <project> define get sandbox]
         7394  +      if {$sandbox ne {}} {
         7395  +        my define set sandbox $sandbox
         7396  +        return $sandbox
         7397  +      }
         7398  +    }
         7399  +    set sandbox [file normalize [file join $::CWD ..]]
         7400  +    my define set sandbox $sandbox
         7401  +    return $sandbox
         7402  +  }
         7403  +  method SrcDir {} {
         7404  +    set pkg [my define get name]
         7405  +    if {[my define exists srcdir]} {
         7406  +      return [my define get srcdir]
         7407  +    }
         7408  +    set sandbox [my Sandbox]
         7409  +    set srcdir [file join [my Sandbox] $pkg]
         7410  +    my define set srcdir $srcdir
         7411  +    return $srcdir
         7412  +  }
         7413  +  method ScmTag    {} {}
         7414  +  method ScmClone  {} {}
         7415  +  method ScmUnpack {} {}
         7416  +  method ScmUpdate {} {}
         7417  +  method Unpack {} {
         7418  +    set srcdir [my SrcDir]
         7419  +    if {[file exists $srcdir]} {
         7420  +      return
         7421  +    }
         7422  +    set pkg [my define get name]
         7423  +    if {[my define exists download]} {
         7424  +      # Utilize a staged download
         7425  +      set download [my define get download]
         7426  +      if {[file exists [file join $download $pkg.zip]]} {
         7427  +        ::practcl::tcllib_require zipfile::decode
         7428  +        ::zipfile::decode::unzipfile [file join $download $pkg.zip] $srcdir
         7429  +        return
         7430  +      }
         7431  +    }
         7432  +    my ScmUnpack
         7433  +  }
         7434  +}
         7435  +oo::objdefine ::practcl::distribution {
         7436  +  method Sandbox {object} {
         7437  +    if {[$object define exists sandbox]} {
         7438  +      return [$object define get sandbox]
         7439  +    }
         7440  +    if {[$object clay delegate project] ni {::noop {}}} {
         7441  +      set sandbox [$object <project> define get sandbox]
         7442  +      if {$sandbox ne {}} {
         7443  +        $object define set sandbox $sandbox
         7444  +        return $sandbox
         7445  +      }
         7446  +    }
         7447  +    set pkg [$object define get name]
         7448  +    set sandbox [file normalize [file join $::CWD ..]]
         7449  +    $object define set sandbox $sandbox
         7450  +    return $sandbox
         7451  +  }
         7452  +
         7453  +  method select object {
         7454  +    if {[$object define exists scm]} {
         7455  +      return [$object define get scm]
         7456  +    }
         7457  +
         7458  +    set pkg [$object define get name]
         7459  +    if {[$object define get srcdir] ne {}} {
         7460  +      set srcdir [$object define get srcdir]
         7461  +    } else {
         7462  +      set srcdir [file join [my Sandbox $object] $pkg]
         7463  +      $object define set srcdir $srcdir
         7464  +    }
         7465  +
         7466  +    set classprefix ::practcl::distribution.
         7467  +    if {[file exists $srcdir]} {
         7468  +      foreach class [::info commands ${classprefix}*] {
         7469  +        if {[$class claim_path $srcdir]} {
         7470  +          $object clay mixinmap distribution $class
         7471  +          set name [$class claim_option]
         7472  +          $object define set scm $name
         7473  +          return $name
         7474  +        }
         7475  +      }
         7476  +    }
         7477  +    foreach class [::info commands ${classprefix}*] {
         7478  +      if {[$class claim_object $object]} {
         7479  +        $object clay mixinmap distribution $class
         7480  +        set name [$class claim_option]
         7481  +        $object define set scm $name
         7482  +        return $name
         7483  +      }
         7484  +    }
         7485  +    if {[$object define get scm] eq {} && [$object define exists file_url]} {
         7486  +      set class ::practcl::distribution.snapshot
         7487  +      set name [$class claim_option]
         7488  +      $object define set scm $name
         7489  +      $object clay mixinmap distribution $class
         7490  +      return $name
         7491  +    }
         7492  +    error "Cannot determine source distribution method"
         7493  +  }
         7494  +
         7495  +  method claim_option {} {
         7496  +    return Unknown
         7497  +  }
         7498  +
         7499  +  method claim_object object {
         7500  +    return false
         7501  +  }
         7502  +
         7503  +  method claim_path path {
         7504  +    return false
         7505  +  }
         7506  +}
         7507  +
         7508  +###
         7509  +# END: class distro baseclass.tcl
         7510  +###
         7511  +###
         7512  +# START: class distro snapshot.tcl
         7513  +###
         7514  +::clay::define ::practcl::distribution.snapshot {
         7515  +  superclass ::practcl::distribution
         7516  +  method ScmUnpack {} {
         7517  +    set srcdir [my SrcDir]
         7518  +    if {[file exists [file join $srcdir .download]]} {
         7519  +      return 0
         7520  +    }
         7521  +    set dpath [::practcl::LOCAL define get download]
         7522  +    set url [my define get file_url]
         7523  +    set fname [file tail $url]
         7524  +    set archive [file join $dpath $fname]
         7525  +    if {![file exists $archive]} {
         7526  +      ::http::wget $url $archive
         7527  +    }
         7528  +    set CWD [pwd]
         7529  +    switch [file extension $fname] {
         7530  +      .zip {
         7531  +        # Zipfile
         7532  +
         7533  +      }
         7534  +      .tar {
         7535  +        ::practcl::tcllib_require tar
         7536  +      }
         7537  +      .tgz -
         7538  +      .gz {
         7539  +        # Tarball
         7540  +        ::practcl::tcllib_require tcl::transform::zlib
         7541  +        ::practcl::tcllib_require tar
         7542  +        set fh [::open $archive]
         7543  +        fconfigure $fh -encoding binary -translation lf -eofchar {}
         7544  +        ::tcl::transform::zlib $fh
         7545  +      }
         7546  +    }
         7547  +    set fosdb [my ScmClone]
         7548  +    set tag [my ScmTag]
         7549  +    file mkdir $srcdir
         7550  +    ::practcl::fossil $srcdir open $fosdb $tag
         7551  +    return 1
         7552  +  }
         7553  +}
         7554  +oo::objdefine ::practcl::distribution.snapshot {
         7555  +
         7556  +  method claim_object object {
         7557  +    return false
         7558  +  }
         7559  +
         7560  +  method claim_option {} {
         7561  +    return snapshot
         7562  +  }
         7563  +
         7564  +  method claim_path path {
         7565  +    if {[file exists [file join $path .download]]} {
         7566  +      return true
         7567  +    }
         7568  +    return false
         7569  +  }
         7570  +}
         7571  +
         7572  +###
         7573  +# END: class distro snapshot.tcl
         7574  +###
         7575  +###
         7576  +# START: class distro fossil.tcl
         7577  +###
         7578  +::clay::define ::practcl::distribution.fossil {
         7579  +  superclass ::practcl::distribution
         7580  +  method scm_info {} {
         7581  +    set info [next]
         7582  +    dict set info scm fossil
         7583  +    foreach {field value} [::practcl::fossil_status [my define get srcdir]] {
         7584  +      dict set info $field $value
         7585  +    }
         7586  +    return $info
         7587  +  }
         7588  +  method ScmClone  {} {
         7589  +    set srcdir [my SrcDir]
         7590  +    if {[file exists [file join $srcdir .fslckout]]} {
         7591  +      return
         7592  +    }
         7593  +    if {[file exists [file join $srcdir _FOSSIL_]]} {
         7594  +      return
         7595  +    }
         7596  +    if {![::info exists ::practcl::fossil_dbs]} {
         7597  +      # Get a list of local fossil databases
         7598  +      set ::practcl::fossil_dbs [exec fossil all list]
         7599  +    }
         7600  +    set pkg [my define get name]
         7601  +    # Return an already downloaded fossil repo
         7602  +    foreach line [split $::practcl::fossil_dbs \n] {
         7603  +      set line [string trim $line]
         7604  +      if {[file rootname [file tail $line]] eq $pkg} {
         7605  +        return $line
         7606  +      }
         7607  +    }
         7608  +    set download [::practcl::LOCAL define get download]
         7609  +    set fosdb [file join $download $pkg.fos]
         7610  +    if {[file exists $fosdb]} {
         7611  +      return $fosdb
         7612  +    }
         7613  +
         7614  +    file mkdir [file join $download fossil]
         7615  +    set fosdb [file join $download fossil $pkg.fos]
         7616  +    if {[file exists $fosdb]} {
         7617  +      return $fosdb
         7618  +    }
         7619  +
         7620  +    set cloned 0
         7621  +    # Attempt to clone from a local network mirror
         7622  +    if {[::practcl::LOCAL define exists fossil_mirror]} {
         7623  +      set localmirror [::practcl::LOCAL define get fossil_mirror]
         7624  +      catch {
         7625  +        ::practcl::doexec fossil clone $localmirror/$pkg $fosdb
         7626  +        set cloned 1
         7627  +      }
         7628  +      if {$cloned} {
         7629  +        return $fosdb
         7630  +      }
         7631  +    }
         7632  +    # Attempt to clone from the canonical source
         7633  +    if {[my define get fossil_url] ne {}} {
         7634  +      catch {
         7635  +        ::practcl::doexec fossil clone [my define get fossil_url] $fosdb
         7636  +        set cloned 1
         7637  +      }
         7638  +      if {$cloned} {
         7639  +        return $fosdb
         7640  +      }
         7641  +    }
         7642  +    # Fall back to the fossil mirror on the island of misfit toys
         7643  +    ::practcl::doexec fossil clone http://fossil.etoyoc.com/fossil/$pkg $fosdb
         7644  +    return $fosdb
         7645  +  }
         7646  +  method ScmTag {} {
         7647  +    if {[my define exists scm_tag]} {
         7648  +      return [my define get scm_tag]
         7649  +    }
         7650  +    if {[my define exists tag]} {
         7651  +      set tag [my define get tag]
         7652  +    } else {
         7653  +      set tag trunk
         7654  +    }
         7655  +    my define set scm_tag $tag
         7656  +    return $tag
         7657  +  }
         7658  +  method ScmUnpack {} {
         7659  +    set srcdir [my SrcDir]
         7660  +    if {[file exists [file join $srcdir .fslckout]]} {
         7661  +      return 0
         7662  +    }
         7663  +    if {[file exists [file join $srcdir _FOSSIL_]]} {
         7664  +      return 0
         7665  +    }
         7666  +    set CWD [pwd]
         7667  +    set fosdb [my ScmClone]
         7668  +    set tag [my ScmTag]
         7669  +    file mkdir $srcdir
         7670  +    ::practcl::fossil $srcdir open $fosdb $tag
         7671  +    return 1
         7672  +  }
         7673  +  method ScmUpdate {} {
         7674  +    if {[my ScmUnpack]} {
         7675  +      return
         7676  +    }
         7677  +    set srcdir [my SrcDir]
         7678  +    set tag [my ScmTag]
         7679  +    ::practcl::fossil $srcdir update $tag
         7680  +  }
         7681  +}
         7682  +oo::objdefine ::practcl::distribution.fossil {
         7683  +
         7684  +  # Check for markers in the metadata
         7685  +  method claim_object obj {
         7686  +    set path [$obj define get srcdir]
         7687  +    if {[my claim_path $path]} {
         7688  +      return true
         7689  +    }
         7690  +    if {[$obj define get fossil_url] ne {}} {
         7691  +      return true
         7692  +    }
         7693  +    return false
         7694  +  }
         7695  +
         7696  +  method claim_option {} {
         7697  +    return fossil
         7698  +  }
         7699  +
         7700  +  # Check for markers in the source root
         7701  +  method claim_path path {
         7702  +    if {[file exists [file join $path .fslckout]]} {
         7703  +      return true
         7704  +    }
         7705  +    if {[file exists [file join $path _FOSSIL_]]} {
         7706  +      return true
         7707  +    }
         7708  +    return false
         7709  +  }
         7710  +}
         7711  +
         7712  +###
         7713  +# END: class distro fossil.tcl
         7714  +###
         7715  +###
         7716  +# START: class distro git.tcl
         7717  +###
         7718  +::clay::define ::practcl::distribution.git {
         7719  +  superclass ::practcl::distribution
         7720  +  method ScmTag {} {
         7721  +    if {[my define exists scm_tag]} {
         7722  +      return [my define get scm_tag]
         7723  +    }
         7724  +    if {[my define exists tag]} {
         7725  +      set tag [my define get tag]
         7726  +    } else {
         7727  +      set tag master
         7728  +    }
         7729  +    my define set scm_tag $tag
         7730  +    return $tag
         7731  +  }
         7732  +  method ScmUnpack {} {
         7733  +    set srcdir [my SrcDir]
         7734  +    if {[file exists [file join $srcdir .git]]} {
         7735  +      return 0
         7736  +    }
         7737  +    set CWD [pwd]
         7738  +    set tag [my ScmTag]
         7739  +    set pkg [my define get name]
         7740  +    if {[my define exists git_url]} {
         7741  +      ::practcl::doexec git clone --branch $tag [my define get git_url] $srcdir
         7742  +    } else {
         7743  +      ::practcl::doexec git clone --branch $tag https://github.com/eviltwinskippy/$pkg $srcdir
         7744  +    }
         7745  +    return 1
         7746  +  }
         7747  +  method ScmUpdate {} {
         7748  +    if {[my ScmUnpack]} {
         7749  +      return
         7750  +    }
         7751  +    set CWD [pwd]
         7752  +    set srcdir [my SrcDir]
         7753  +    set tag [my ScmTag]
         7754  +    ::practcl::doexec_in $srcdir git pull
         7755  +    cd $CWD
         7756  +  }
         7757  +}
         7758  +oo::objdefine ::practcl::distribution.git {
         7759  +
         7760  +  method claim_object obj {
         7761  +    set path [$obj define get srcdir]
         7762  +    if {[my claim_path $path]} {
         7763  +      return true
         7764  +    }
         7765  +    if {[$obj define get git_url] ne {}} {
         7766  +      return true
         7767  +    }
         7768  +    return false
         7769  +  }
         7770  +
         7771  +  method claim_option {} {
         7772  +    return git
         7773  +  }
         7774  +
         7775  +  method claim_path path {
         7776  +   if {[file exists [file join $path .git]]} {
         7777  +      return true
         7778  +    }
         7779  +    return false
         7780  +  }
         7781  +}
         7782  +
         7783  +###
         7784  +# END: class distro git.tcl
         7785  +###
         7786  +###
         7787  +# START: class subproject baseclass.tcl
         7788  +###
         7789  +::clay::define ::practcl::subproject {
         7790  +  superclass ::practcl::module
         7791  +  method _MorphPatterns {} {
         7792  +    return {{::practcl::[email protected]@} {::practcl::@[email protected]} {@[email protected]} {::practcl::subproject}}
         7793  +  }
         7794  +  method BuildDir {PWD} {
         7795  +    return [my define get srcdir]
         7796  +  }
         7797  +  method child which {
         7798  +    switch $which {
         7799  +      delegate -
         7800  +      organs {
         7801  +	# A library can be a project, it can be a module. Any
         7802  +	# subordinate modules will indicate their existance
         7803  +        return [list project [self] module [self]]
         7804  +      }
         7805  +    }
         7806  +  }
         7807  +  method compile {} {}
         7808  +  method go {} {
         7809  +    ::practcl::distribution select [self]
         7810  +    set name [my define get name]
         7811  +    my define set builddir [my BuildDir [my define get masterpath]]
         7812  +    my define set builddir [my BuildDir [my define get masterpath]]
         7813  +    my sources
         7814  +  }
         7815  +  method install args {}
         7816  +  method linktype {} {
         7817  +    return {subordinate package}
         7818  +  }
         7819  +  method linker-products {configdict} {}
         7820  +  method linker-external {configdict} {
         7821  +    if {[dict exists $configdict PRACTCL_PKG_LIBS]} {
         7822  +      return [dict get $configdict PRACTCL_PKG_LIBS]
         7823  +    }
         7824  +    if {[dict exists $configdict LIBS]} {
         7825  +      return [dict get $configdict LIBS]
         7826  +    }
         7827  +  }
         7828  +  method linker-extra {configdict} {
         7829  +    if {[dict exists $configdict PRACTCL_LINKER_EXTRA]} {
         7830  +      return [dict get $configdict PRACTCL_LINKER_EXTRA]
         7831  +    }
         7832  +    return {}
         7833  +  }
         7834  +  method env-bootstrap {} {
         7835  +    set pkg [my define get pkg_name [my define get name]]
         7836  +    package require $pkg
         7837  +  }
         7838  +  method env-exec {} {}
         7839  +  method env-install {} {
         7840  +    my unpack
         7841  +  }
         7842  +  method env-load {} {
         7843  +    my variable loaded
         7844  +    if {[info exists loaded]} {
         7845  +      return 0
         7846  +    }
         7847  +    if {![my env-present]} {
         7848  +      my env-install
         7849  +    }
         7850  +    my env-bootstrap
         7851  +    set loaded 1
         7852  +  }
         7853  +  method env-present {} {
         7854  +    set pkg [my define get pkg_name [my define get name]]
         7855  +    if {[catch [list package require $pkg]]} {
         7856  +      return 0
         7857  +    }
         7858  +    return 1
         7859  +  }
         7860  +  method sources {} {}
         7861  +  method update {} {
         7862  +    my ScmUpdate
         7863  +  }
         7864  +  method unpack {} {
         7865  +    cd $::CWD
         7866  +    ::practcl::distribution select [self]
         7867  +    my Unpack
         7868  +    ::practcl::toolset select [self]
         7869  +    cd $::CWD
         7870  +  }
         7871  +}
         7872  +::clay::define ::practcl::subproject.source {
         7873  +  superclass ::practcl::subproject ::practcl::library
         7874  +  method env-bootstrap {} {
         7875  +    set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]]
         7876  +    if {[file exists $LibraryRoot] && $LibraryRoot ni $::auto_path} {
         7877  +      set ::auto_path [linsert $::auto_path 0 $LibraryRoot]
         7878  +    }
         7879  +  }
         7880  +  method env-present {} {
         7881  +    set path [my define get srcdir]
         7882  +    return [file exists $path]
         7883  +  }
         7884  +  method linktype {} {
         7885  +    return {subordinate package source}
         7886  +  }
         7887  +}
         7888  +::clay::define ::practcl::subproject.teapot {
         7889  +  superclass ::practcl::subproject
         7890  +  method env-bootstrap {} {
         7891  +    set pkg [my define get pkg_name [my define get name]]
         7892  +    package require $pkg
         7893  +  }
         7894  +  method env-install {} {
         7895  +    set pkg [my define get pkg_name [my define get name]]
         7896  +    set download [my <project> define get download]
         7897  +    my unpack
         7898  +    set prefix [string trimleft [my <project> define get prefix] /]
         7899  +    ::practcl::tcllib_require zipfile::decode
         7900  +    ::zipfile::decode::unzipfile [file join $download $pkg.zip] [file join $prefix lib $pkg]
         7901  +  }
         7902  +  method env-present {} {
         7903  +    set pkg [my define get pkg_name [my define get name]]
         7904  +    if {[catch [list package require $pkg]]} {
         7905  +      return 0
         7906  +    }
         7907  +    return 1
         7908  +  }
         7909  +  method install DEST {
         7910  +    set pkg [my define get pkg_name [my define get name]]
         7911  +    set download [my <project> define get download]
         7912  +    my unpack
         7913  +    set prefix [string trimleft [my <project> define get prefix] /]
         7914  +    ::practcl::tcllib_require zipfile::decode
         7915  +    ::zipfile::decode::unzipfile [file join $download $pkg.zip] [file join $DEST $prefix lib $pkg]
         7916  +  }
         7917  +}
         7918  +::clay::define ::practcl::subproject.kettle {
         7919  +  superclass ::practcl::subproject
         7920  +  method kettle {path args} {
         7921  +    my variable kettle
         7922  +    if {![info exists kettle]} {
         7923  +      ::practcl::LOCAL tool kettle env-load
         7924  +      set kettle [file join [::practcl::LOCAL tool kettle define get srcdir] kettle]
         7925  +    }
         7926  +    set srcdir [my SourceRoot]
         7927  +    ::practcl::dotclexec $kettle -f [file join $srcdir build.tcl] {*}$args
         7928  +  }
         7929  +  method install DEST {
         7930  +    my kettle reinstall --prefix $DEST
         7931  +  }
         7932  +}
         7933  +::clay::define ::practcl::subproject.critcl {
         7934  +  superclass ::practcl::subproject
         7935  +  method install DEST {
         7936  +    my critcl -pkg [my define get name]
         7937  +    set srcdir [my SourceRoot]
         7938  +    ::practcl::copyDir [file join $srcdir [my define get name]] [file join $DEST lib [my define get name]]
         7939  +  }
         7940  +}
         7941  +::clay::define ::practcl::subproject.sak {
         7942  +  superclass ::practcl::subproject
         7943  +  method env-bootstrap {} {
         7944  +    set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]]
         7945  +    if {[file exists $LibraryRoot] && $LibraryRoot ni $::auto_path} {
         7946  +      set ::auto_path [linsert $::auto_path 0 $LibraryRoot]
         7947  +    }
         7948  +  }
         7949  +  method env-install {} {
         7950  +    ###
         7951  +    # Handle teapot installs
         7952  +    ###
         7953  +    set pkg [my define get pkg_name [my define get name]]
         7954  +    my unpack
         7955  +    set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]]
         7956  +    set srcdir [my define get srcdir]
         7957  +    ::practcl::dotclexec [file join $srcdir installer.tcl] \
         7958  +      -apps -app-path [file join $prefix apps] \
         7959  +      -html -html-path [file join $prefix doc html $pkg] \
         7960  +      -pkg-path [file join $prefix lib $pkg]  \
         7961  +      -no-nroff -no-wait -no-gui
         7962  +  }
         7963  +  method env-present {} {
         7964  +    set path [my define get srcdir]
         7965  +    return [file exists $path]
         7966  +  }
         7967  +  method install DEST {
         7968  +    ###
         7969  +    # Handle teapot installs
         7970  +    ###
         7971  +    set pkg [my define get pkg_name [my define get name]]
         7972  +    my unpack
         7973  +    set prefix [string trimleft [my <project> define get prefix] /]
         7974  +    set srcdir [my define get srcdir]
         7975  +    ::practcl::dotclexec [file join $srcdir installer.tcl] \
         7976  +      -pkg-path [file join $DEST $prefix lib $pkg]  \
         7977  +      -no-examples -no-html -no-nroff \
         7978  +      -no-wait -no-gui -no-apps
         7979  +  }
         7980  +  method install-module {DEST args} {
         7981  +    set srcdir [my define get srcdir]
         7982  +    if {[llength $args]==1 && [lindex $args 0] in {* all}} {
         7983  +      set pkg [my define get pkg_name [my define get name]]
         7984  +      ::practcl::dotclexec [file join $srcdir installer.tcl] \
         7985  +        -pkg-path [file join $DEST $pkg]  \
         7986  +        -no-examples -no-html -no-nroff \
         7987  +        -no-wait -no-gui -no-apps
         7988  +    } else {
         7989  +      foreach module $args {
         7990  +        ::practcl::installModule [file join $srcdir modules $module] [file join $DEST $module]
         7991  +      }
         7992  +    }
         7993  +  }
         7994  +}
         7995  +::clay::define ::practcl::subproject.practcl {
         7996  +  superclass ::practcl::subproject
         7997  +  method env-bootstrap {} {
         7998  +    set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]]
         7999  +    if {[file exists $LibraryRoot] && $LibraryRoot ni $::auto_path} {
         8000  +      set ::auto_path [linsert $::auto_path 0 $LibraryRoot]
         8001  +    }
         8002  +  }
         8003  +  method env-install {} {
         8004  +    ###
         8005  +    # Handle teapot installs
         8006  +    ###
         8007  +    set pkg [my define get pkg_name [my define get name]]
         8008  +    my unpack
         8009  +    set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]]
         8010  +    set srcdir [my define get srcdir]
         8011  +    ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $prefix lib $pkg]
         8012  +  }
         8013  +  method install DEST {
         8014  +    ###
         8015  +    # Handle teapot installs
         8016  +    ###
         8017  +    set pkg [my define get pkg_name [my define get name]]
         8018  +    my unpack
         8019  +    set prefix [string trimleft [my <project> define get prefix] /]
         8020  +    set srcdir [my define get srcdir]
         8021  +    puts [list INSTALLING  [my define get name] to [file join $DEST $prefix lib $pkg]]
         8022  +    ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $DEST $prefix lib $pkg]
         8023  +  }
         8024  +  method install-module {DEST args} {
         8025  +    set pkg [my define get pkg_name [my define get name]]
         8026  +    set srcdir [my define get srcdir]
         8027  +    ::practcl::dotclexec [file join $srcdir make.tcl] install-module $DEST {*}$args
         8028  +  }
         8029  +}
         8030  +
         8031  +###
         8032  +# END: class subproject baseclass.tcl
         8033  +###
         8034  +###
         8035  +# START: class subproject binary.tcl
         8036  +###
         8037  +::clay::define ::practcl::subproject.binary {
         8038  +  superclass ::practcl::subproject
         8039  +  method clean {} {
         8040  +    set builddir [file normalize [my define get builddir]]
         8041  +    if {![file exists $builddir]} return
         8042  +    if {[file exists [file join $builddir make.tcl]]} {
         8043  +      ::practcl::domake.tcl $builddir clean
         8044  +    } else {
         8045  +      catch {::practcl::domake $builddir clean}
         8046  +    }
         8047  +  }
         8048  + method env-install {} {
         8049  +    ###
         8050  +    # Handle tea installs
         8051  +    ###
         8052  +    set pkg [my define get pkg_name [my define get name]]
         8053  +    set os [::practcl::local_os]
         8054  +    my define set os $os
         8055  +    my unpack
         8056  +    set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]]
         8057  +    set srcdir [my define get srcdir]
         8058  +    lappend options --prefix $prefix --exec-prefix $prefix
         8059  +    my define set config_opts $options
         8060  +    my go
         8061  +    my clean
         8062  +    my compile
         8063  +    my make install {}
         8064  +  }
         8065  +  method project-compile-products {} {}
         8066  +  method ComputeInstall {} {
         8067  +    if {[my define exists install]} {
         8068  +      switch [my define get install] {
         8069  +        static {
         8070  +          my define set static 1
         8071  +          my define set autoload 0
         8072  +        }
         8073  +        static-autoload {
         8074  +          my define set static 1
         8075  +          my define set autoload 1
         8076  +        }
         8077  +        vfs {
         8078  +          my define set static 0
         8079  +          my define set autoload 0
         8080  +          my define set vfsinstall 1
         8081  +        }
         8082  +        null {
         8083  +          my define set static 0
         8084  +          my define set autoload 0
         8085  +          my define set vfsinstall 0
         8086  +        }
         8087  +        default {
         8088  +
         8089  +        }
         8090  +      }
         8091  +    }
         8092  +  }
         8093  +  method go {} {
         8094  +    next
         8095  +    ::practcl::distribution select [self]
         8096  +    my ComputeInstall
         8097  +    my define set builddir [my BuildDir [my define get masterpath]]
         8098  +  }
         8099  +  method linker-products {configdict} {
         8100  +    if {![my define get static 0]} {
         8101  +      return {}
         8102  +    }
         8103  +    set srcdir [my define get builddir]
         8104  +    if {[dict exists $configdict libfile]} {
         8105  +      return " [file join $srcdir [dict get $configdict libfile]]"
         8106  +    }
         8107  +  }
         8108  +  method project-static-packages {} {
         8109  +    if {![my define get static 0]} {
         8110  +      return {}
         8111  +    }
         8112  +    set result [my define get static_packages]
         8113  +    set statpkg  [my define get static_pkg]
         8114  +    set initfunc [my define get initfunc]
         8115  +    if {$initfunc ne {}} {
         8116  +      set pkg_name [my define get pkg_name]
         8117  +      if {$pkg_name ne {}} {
         8118  +        dict set result $pkg_name initfunc $initfunc
         8119  +        set version [my define get version]
         8120  +        if {$version eq {}} {
         8121  +          my unpack
         8122  +          set info [my read_configuration]
         8123  +          set version [dict get $info version]
         8124  +          set pl {}
         8125  +          if {[dict exists $info patch_level]} {
         8126  +            set pl [dict get $info patch_level]
         8127  +            append version $pl
         8128  +          }
         8129  +          my define set version $version
         8130  +        }
         8131  +        dict set result $pkg_name version $version
         8132  +        dict set result $pkg_name autoload [my define get autoload 0]
         8133  +      }
         8134  +    }
         8135  +    foreach item [my link list subordinate] {
         8136  +      foreach {pkg info} [$item project-static-packages] {
         8137  +        dict set result $pkg $info
         8138  +      }
         8139  +    }
         8140  +    return $result
         8141  +  }
         8142  +  method BuildDir {PWD} {
         8143  +    set name [my define get name]
         8144  +    set debug [my define get debug 0]
         8145  +    if {[my <project> define get LOCAL 0]} {
         8146  +      return [my define get builddir [file join $PWD local $name]]
         8147  +    }
         8148  +    if {$debug} {
         8149  +      return [my define get builddir [file join $PWD debug $name]]
         8150  +    } else {
         8151  +      return [my define get builddir [file join $PWD pkg $name]]
         8152  +    }
         8153  +  }
         8154  +  method compile {} {
         8155  +    set name [my define get name]
         8156  +    set PWD $::CWD
         8157  +    cd $PWD
         8158  +    my unpack
         8159  +    set srcdir [file normalize [my SrcDir]]
         8160  +    set localsrcdir [my MakeDir $srcdir]
         8161  +    my define set localsrcdir $localsrcdir
         8162  +    my Collate_Source $PWD
         8163  +    ###
         8164  +    # Build a starter VFS for both Tcl and wish
         8165  +    ###
         8166  +    set srcdir [my define get srcdir]
         8167  +    if {[my define get static 1]} {
         8168  +      puts "BUILDING Static $name $srcdir"
         8169  +    } else {
         8170  +      puts "BUILDING Dynamic $name $srcdir"
         8171  +    }
         8172  +    my make compile
         8173  +    cd $PWD
         8174  +  }
         8175  +  method Configure {} {
         8176  +    cd $::CWD
         8177  +    my unpack
         8178  +    ::practcl::toolset select [self]
         8179  +    set srcdir [file normalize [my define get srcdir]]
         8180  +    set builddir [file normalize [my define get builddir]]
         8181  +    file mkdir $builddir
         8182  +    my make autodetect
         8183  +  }
         8184  +  method install DEST {
         8185  +    set PWD [pwd]
         8186  +    set PREFIX  [my <project> define get prefix]
         8187  +    ###
         8188  +    # Handle teapot installs
         8189  +    ###
         8190  +    set pkg [my define get pkg_name [my define get name]]
         8191  +    if {[my <project> define get teapot] ne {}} {
         8192  +      set TEAPOT [my <project> define get teapot]
         8193  +      set found 0
         8194  +      foreach ver [my define get pkg_vers [my define get version]] {
         8195  +        set teapath [file join $TEAPOT $pkg$ver]
         8196  +        if {[file exists $teapath]} {
         8197  +          set dest  [file join $DEST [string trimleft $PREFIX /] lib [file tail $teapath]]
         8198  +          ::practcl::copyDir $teapath $dest
         8199  +          return
         8200  +        }
         8201  +      }
         8202  +    }
         8203  +    my compile
         8204  +    my make install $DEST
         8205  +    cd $PWD
         8206  +  }
         8207  +}
         8208  +::clay::define ::practcl::subproject.tea {
         8209  +  superclass ::practcl::subproject.binary
         8210  +}
         8211  +::clay::define ::practcl::subproject.library {
         8212  +  superclass ::practcl::subproject.binary ::practcl::library
         8213  +  method install DEST {
         8214  +    my compile
         8215  +  }
         8216  +}
         8217  +::clay::define ::practcl::subproject.external {
         8218  +  superclass ::practcl::subproject.binary
         8219  +  method install DEST {
         8220  +    my compile
         8221  +  }
         8222  +}
         8223  +
         8224  +###
         8225  +# END: class subproject binary.tcl
         8226  +###
         8227  +###
         8228  +# START: class subproject core.tcl
         8229  +###
         8230  +::clay::define ::practcl::subproject.core {
         8231  +  superclass ::practcl::subproject.binary
         8232  +  method env-bootstrap {} {}
         8233  +  method env-present {} {
         8234  +    set PREFIX [my <project> define get prefix]
         8235  +    set name [my define get name]
         8236  +    set fname [file join $PREFIX lib ${name}Config.sh]
         8237  +    return [file exists $fname]
         8238  +  }
         8239  +  method env-install {} {
         8240  +    my unpack
         8241  +    set os [::practcl::local_os]
         8242  +
         8243  +    set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]]
         8244  +    lappend options --prefix $prefix --exec-prefix $prefix
         8245  +    my define set config_opts $options
         8246  +    puts [list [self] OS [dict get $os TEACUP_OS] options $options]
         8247  +    my go
         8248  +    my compile
         8249  +    my make install {}
         8250  +  }
         8251  +  method go {} {
         8252  +    my define set core_binary 1
         8253  +    next
         8254  +  }
         8255  +  method linktype {} {
         8256  +    return {subordinate core.library}
         8257  +  }
         8258  +}
         8259  +
         8260  +###
         8261  +# END: class subproject core.tcl
         8262  +###
         8263  +###
         8264  +# START: class tool.tcl
         8265  +###
         8266  +set ::practcl::MAIN ::practcl::LOCAL
         8267  +set ::auto_index(::practcl::LOCAL) {
         8268  +  ::practcl::project create ::practcl::LOCAL
         8269  +  ::practcl::LOCAL define set [::practcl::local_os]
         8270  +  ::practcl::LOCAL define set LOCAL 1
         8271  +
         8272  +  # Until something better comes along, use ::practcl::LOCAL
         8273  +  # as our main project
         8274  +  # Add tclconfig as a project of record
         8275  +  ::practcl::LOCAL add_tool tclconfig {
         8276  +    name tclconfig tag practcl class subproject.source fossil_url http://core.tcl.tk/tclconfig
         8277  +  }
         8278  +  # Add tcllib as a project of record
         8279  +  ::practcl::LOCAL add_tool tcllib {
         8280  +    tag trunk class sak fossil_url http://core.tcl.tk/tcllib
         8281  +  }
         8282  +  ::practcl::LOCAL add_tool kettle {
         8283  +    tag trunk class sak fossil_url http://fossil.etoyoc.com/fossil/kettle
         8284  +  }
         8285  +  ::practcl::LOCAL add_tool tclvfs {
         8286  +    tag trunk class tea
         8287  +    fossil_url http://fossil.etoyoc.com/fossil/tclvfs
         8288  +  }
         8289  +  ::practcl::LOCAL add_tool critcl {
         8290  +    tag master class subproject.binary
         8291  +    git_url http://github.com/andreas-kupries/critcl
         8292  +    modules lib
         8293  +  } {
         8294  +    method env-bootstrap {} {
         8295  +      package require critcl::app
         8296  +    }
         8297  +    method env-install {} {
         8298  +      my unpack
         8299  +      set prefix [my <project> define get prefix [file join [file normalize ~] tcl]]
         8300  +      set srcdir [my define get srcdir]
         8301  +      ::practcl::dotclexec [file join $srcdir build.tcl] install [file join $prefix lib]
         8302  +    }
         8303  +  }
         8304  +  ::practcl::LOCAL add_tool odie {
         8305  +    tag trunk class subproject.source
         8306  +    fossil_url http://fossil.etoyoc.com/fossil/odie
         8307  +  }
         8308  +  ::practcl::LOCAL add_tool tcl {
         8309  +    tag release class subproject.core
         8310  +    fossil_url http://core.tcl.tk/tcl
         8311  +  }
         8312  +  ::practcl::LOCAL add_tool tk {
         8313  +    tag release class subproject.core
         8314  +    fossil_url http://core.tcl.tk/tcl
         8315  +  }
         8316  +  ::practcl::LOCAL add_tool sqlite {
         8317  +    tag practcl
         8318  +    class subproject.tea
         8319  +    pkg_name sqlite3
         8320  +    fossil_url http://fossil.etoyoc.com/fossil/sqlite
         8321  +  }
         8322  +}
         8323  +
         8324  +###
         8325  +# END: class tool.tcl
         8326  +###
         8327  +
         8328  +namespace eval ::practcl {
         8329  +  namespace export *
         8330  +}
         8331  +