Index: example/gilgamesh/class/avatar.tcl ================================================================== --- example/gilgamesh/class/avatar.tcl +++ example/gilgamesh/class/avatar.tcl @@ -9,13 +9,13 @@ } method cuneiform_structure {} { my clay delegate [my Tag head] my clay delegate [my <head> tag title] - my <head> tag meta charset [my config get charset] + my <head> tag meta charset [my Config_get charset] my clay delegate <stylesheet> [my <head> tag link rel stylesheet type text/css href /style.css] - set sheethref [my config get stylesheet] + set sheethref [my Config_get stylesheet] if {$sheethref ne {}} { my <stylesheet> html set href $sheethref } set styleobj [my <head> tag style] @@ -36,11 +36,11 @@ height 600px }] my clay delegate <bottom> [$bodyobj tag div id bottom] my clay delegate <footer> [$bodyobj tag footer id footer] - my <title> content [my config get title] + my <title> content [my Config_get title] } } ::clay::define ::gilgamesh::core/avatar { Index: modules/practcl/build/build.tcl ================================================================== --- modules/practcl/build/build.tcl +++ modules/practcl/build/build.tcl @@ -2,11 +2,11 @@ set moddir [file dirname $srcdir] source [file join $srcdir doctool.tcl] ::practcl::doctool create AutoDoc -set version 0.17 +set version 0.16.3 set tclversion 8.6 set module [file tail $moddir] set filename $module set fout [open [file join $moddir $filename.tcl] w] @@ -35,11 +35,10 @@ # Load other module code that this module will need ### foreach {omod files} { httpwget wget.tcl clay {clay.tcl} - clay-yggdrasil {clay-yggdrasil.tcl} } { foreach fname $files { set file [file join $moddir .. $omod $fname] puts $fout "###\n# START: [file join $omod $fname]\n###" set content [::practcl::cat [file join $moddir .. $omod $fname]] Index: modules/practcl/build/buildutil.tcl ================================================================== --- modules/practcl/build/buildutil.tcl +++ modules/practcl/build/buildutil.tcl @@ -102,11 +102,11 @@ set ::fosdat($dir) $result return $result } proc ::practcl::os {} { - return [${::practcl::MAIN} config get TEACUP_OS] + return [${::practcl::MAIN} define get TEACUP_OS] } ### # Build a zipfile. On tcl8.6 this invokes the native Zip implementation # on older interpreters this invokes zip via exec Index: modules/practcl/build/class/distro/baseclass.tcl ================================================================== --- modules/practcl/build/class/distro/baseclass.tcl +++ modules/practcl/build/class/distro/baseclass.tcl @@ -15,37 +15,37 @@ isodate {} } } method DistroMixIn {} { - my Config_set scm none + my define set scm none } method Sandbox {} { if {[my define exists sandbox]} { - return [my Config_get sandbox] + return [my define get sandbox] } if {[my clay delegate project] ni {::noop {}}} { - set sandbox [my <project> config get sandbox] + set sandbox [my <project> define get sandbox] if {$sandbox ne {}} { - my Config_set sandbox $sandbox + my define set sandbox $sandbox return $sandbox } } set sandbox [file normalize [file join $::CWD ..]] - my Config_set sandbox $sandbox + my define set sandbox $sandbox return $sandbox } method SrcDir {} { - set pkg [my Config_get name] + set pkg [my define get name] if {[my define exists srcdir]} { - return [my Config_get srcdir] + return [my define get srcdir] } set sandbox [my Sandbox] set srcdir [file join [my Sandbox] $pkg] - my Config_set srcdir $srcdir + my define set srcdir $srcdir return $srcdir } method ScmTag {} {} method ScmClone {} {} @@ -55,14 +55,14 @@ method Unpack {} { set srcdir [my SrcDir] if {[file exists $srcdir]} { return } - set pkg [my Config_get name] + set pkg [my define get name] if {[my define exists download]} { # Utilize a staged download - set download [my Config_get download] + set download [my define get download] if {[file exists [file join $download $pkg.zip]]} { ::practcl::tcllib_require zipfile::decode ::zipfile::decode::unzipfile [file join $download $pkg.zip] $srcdir return } @@ -71,61 +71,61 @@ } } oo::objdefine ::practcl::distribution { method Sandbox {object} { if {[$object define exists sandbox]} { - return [$object config get sandbox] + return [$object define get sandbox] } if {[$object clay delegate project] ni {::noop {}}} { - set sandbox [$object <project> config get sandbox] + set sandbox [$object <project> define get sandbox] if {$sandbox ne {}} { - $object config set sandbox $sandbox + $object define set sandbox $sandbox return $sandbox } } - set pkg [$object config get name] + set pkg [$object define get name] set sandbox [file normalize [file join $::CWD ..]] - $object config set sandbox $sandbox + $object define set sandbox $sandbox return $sandbox } method select object { if {[$object define exists scm]} { - return [$object config get scm] + return [$object define get scm] } - set pkg [$object config get name] - if {[$object config get srcdir] ne {}} { - set srcdir [$object config get srcdir] + set pkg [$object define get name] + if {[$object define get srcdir] ne {}} { + set srcdir [$object define get srcdir] } else { set srcdir [file join [my Sandbox $object] $pkg] - $object config set srcdir $srcdir + $object define set srcdir $srcdir } set classprefix ::practcl::distribution. if {[file exists $srcdir]} { foreach class [::info commands ${classprefix}*] { if {[$class claim_path $srcdir]} { $object clay mixinmap distribution $class set name [$class claim_option] - $object config set scm $name + $object define set scm $name return $name } } } foreach class [::info commands ${classprefix}*] { if {[$class claim_object $object]} { $object clay mixinmap distribution $class set name [$class claim_option] - $object config set scm $name + $object define set scm $name return $name } } - if {[$object config get scm] eq {} && [$object define exists file_url]} { + if {[$object define get scm] eq {} && [$object define exists file_url]} { set class ::practcl::distribution.snapshot set name [$class claim_option] - $object config set scm $name + $object define set scm $name $object clay mixinmap distribution $class return $name } error "Cannot determine source distribution method" } Index: modules/practcl/build/class/distro/fossil.tcl ================================================================== --- modules/practcl/build/class/distro/fossil.tcl +++ modules/practcl/build/class/distro/fossil.tcl @@ -5,11 +5,11 @@ superclass ::practcl::distribution method scm_info {} { set info [next] dict set info scm fossil - foreach {field value} [::practcl::fossil_status [my Config_get srcdir]] { + foreach {field value} [::practcl::fossil_status [my define get srcdir]] { dict set info $field $value } return $info } @@ -24,19 +24,19 @@ } if {![::info exists ::practcl::fossil_dbs]} { # Get a list of local fossil databases set ::practcl::fossil_dbs [exec fossil all list] } - set pkg [my Config_get name] + set pkg [my define get name] # Return an already downloaded fossil repo foreach line [split $::practcl::fossil_dbs \n] { set line [string trim $line] if {[file rootname [file tail $line]] eq $pkg} { return $line } } - set download [::practcl::LOCAL config get download] + set download [::practcl::LOCAL define get download] set fosdb [file join $download $pkg.fos] if {[file exists $fosdb]} { return $fosdb } @@ -47,23 +47,23 @@ } set cloned 0 # Attempt to clone from a local network mirror if {[::practcl::LOCAL define exists fossil_mirror]} { - set localmirror [::practcl::LOCAL config get fossil_mirror] + set localmirror [::practcl::LOCAL define get fossil_mirror] catch { ::practcl::doexec fossil clone $localmirror/$pkg $fosdb set cloned 1 } if {$cloned} { return $fosdb } } # Attempt to clone from the canonical source - if {[my Config_get fossil_url] ne {}} { + if {[my define get fossil_url] ne {}} { catch { - ::practcl::doexec fossil clone [my Config_get fossil_url] $fosdb + ::practcl::doexec fossil clone [my define get fossil_url] $fosdb set cloned 1 } if {$cloned} { return $fosdb } @@ -73,18 +73,18 @@ return $fosdb } method ScmTag {} { if {[my define exists scm_tag]} { - return [my Config_get scm_tag] + return [my define get scm_tag] } if {[my define exists tag]} { - set tag [my Config_get tag] + set tag [my define get tag] } else { set tag trunk } - my Config_set scm_tag $tag + my define set scm_tag $tag return $tag } method ScmUnpack {} { set srcdir [my SrcDir] @@ -114,15 +114,15 @@ oo::objdefine ::practcl::distribution.fossil { # Check for markers in the metadata method claim_object obj { - set path [$obj config get srcdir] + set path [$obj define get srcdir] if {[my claim_path $path]} { return true } - if {[$obj config get fossil_url] ne {}} { + if {[$obj define get fossil_url] ne {}} { return true } return false } Index: modules/practcl/build/class/distro/git.tcl ================================================================== --- modules/practcl/build/class/distro/git.tcl +++ modules/practcl/build/class/distro/git.tcl @@ -4,18 +4,18 @@ ::clay::define ::practcl::distribution.git { superclass ::practcl::distribution method ScmTag {} { if {[my define exists scm_tag]} { - return [my Config_get scm_tag] + return [my define get scm_tag] } if {[my define exists tag]} { - set tag [my Config_get tag] + set tag [my define get tag] } else { set tag master } - my Config_set scm_tag $tag + my define set scm_tag $tag return $tag } method ScmUnpack {} { set srcdir [my SrcDir] @@ -22,13 +22,13 @@ if {[file exists [file join $srcdir .git]]} { return 0 } set CWD [pwd] set tag [my ScmTag] - set pkg [my Config_get name] + set pkg [my define get name] if {[my define exists git_url]} { - ::practcl::doexec git clone --branch $tag [my Config_get git_url] $srcdir + ::practcl::doexec git clone --branch $tag [my define get git_url] $srcdir } else { ::practcl::doexec git clone --branch $tag https://github.com/eviltwinskippy/$pkg $srcdir } return 1 } @@ -46,15 +46,15 @@ } oo::objdefine ::practcl::distribution.git { method claim_object obj { - set path [$obj config get srcdir] + set path [$obj define get srcdir] if {[my claim_path $path]} { return true } - if {[$obj config get git_url] ne {}} { + if {[$obj define get git_url] ne {}} { return true } return false } Index: modules/practcl/build/class/distro/snapshot.tcl ================================================================== --- modules/practcl/build/class/distro/snapshot.tcl +++ modules/practcl/build/class/distro/snapshot.tcl @@ -7,12 +7,12 @@ method ScmUnpack {} { set srcdir [my SrcDir] if {[file exists [file join $srcdir .download]]} { return 0 } - set dpath [::practcl::LOCAL config get download] - set url [my Config_get file_url] + set dpath [::practcl::LOCAL define get download] + set url [my define get file_url] set fname [file tail $url] set archive [file join $dpath $fname] if {![file exists $archive]} { ::http::wget $url $archive } Index: modules/practcl/build/class/dynamic.tcl ================================================================== --- modules/practcl/build/class/dynamic.tcl +++ modules/practcl/build/class/dynamic.tcl @@ -20,19 +20,19 @@ dict set cstruct $name public 1 } } method include header { - my Config_add include $header + my define add include $header } method include_dir args { - my Config_add include_dir {*}$args + my define add include_dir {*}$args } method include_directory args { - my Config_add include_dir {*}$args + my define add include_dir {*}$args } method c_header body { my variable code ::practcl::cputs code(header) $body @@ -172,33 +172,33 @@ ### # Module interactions ### method project-compile-products {} { - set filename [my Config_get output_c] + set filename [my define get output_c] set result {} if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my Config_get ofile] + set ofile [my define get ofile] } else { set ofile [my Ofile $filename] - my Config_set ofile $ofile + my define set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] } else { - set filename [my Config_get cfile] + set filename [my define get cfile] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my Config_get ofile] + set ofile [my define get ofile] } else { set ofile [my Ofile $filename] - my Config_set ofile $ofile + my define set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] } } foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } @@ -206,21 +206,21 @@ } method implement path { my go my Collate_Source $path - if {[my Config_get output_c] eq {}} return - set filename [file join $path [my Config_get output_c]] - ::practcl::debug [self] [my Config_get filename] WANTS TO GENERATE $filename - my Config_set cfile $filename + if {[my define get output_c] eq {}} return + set filename [file join $path [my define get output_c]] + ::practcl::debug [self] [my define get filename] WANTS TO GENERATE $filename + my define set cfile $filename set fout [open $filename w] puts $fout [my generate-c] - if {[my Config_get initfunc] ne {}} { - puts $fout "extern int DLLEXPORT [my Config_get initfunc]( Tcl_Interp *interp ) \x7B" + if {[my define get initfunc] ne {}} { + puts $fout "extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \x7B" puts $fout [my generate-loader-module] - if {[my Config_get pkg_name] ne {}} { - puts $fout " Tcl_PkgProvide(interp, \"[my Config_get pkg_name]\", \"[my Config_get pkg_vers]\");" + if {[my define get pkg_name] ne {}} { + puts $fout " Tcl_PkgProvide(interp, \"[my define get pkg_name]\", \"[my define get pkg_vers]\");" } puts $fout " return TCL_OK\;" puts $fout "\x7D" } close $fout @@ -228,33 +228,33 @@ ### # Practcl internals ### method initialize {} { - set filename [my Config_get filename] + set filename [my define get filename] if {$filename eq {}} { return } - if {[my Config_get name] eq {}} { - my Config_set name [file tail [file rootname $filename]] + if {[my define get name] eq {}} { + my define set name [file tail [file rootname $filename]] } - if {[my Config_get localpath] eq {}} { - my Config_set localpath [my <module> config get localpath]_[my Config_get name] + if {[my define get localpath] eq {}} { + my define set localpath [my <module> define get localpath]_[my define get name] } ::source $filename } method linktype {} { return {subordinate product dynamic} } method generate-cfile-constant {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} my variable code cstruct methods tcltype if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my Config_get filename] CONSTANT */" + ::practcl::cputs result "/* [my define get filename] CONSTANT */" ::practcl::cputs result $code(constant) } if {[info exists cstruct]} { foreach {name info} $cstruct { set map {} @@ -324,18 +324,18 @@ dict set methods $name methodtype $methodtype } } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue ::practcl::cputs result [$obj generate-cfile-constant] } return $result } method generate-cfile-header {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cfunct cstruct methods tcltype tclprocs set result {} if {[info exists code(header)]} { ::practcl::cputs result $code(header) } @@ -352,13 +352,13 @@ if {[dict exists $info header]} { ::practcl::cputs result "[dict get $info header]\;" } } } - ::practcl::debug [list methods [info exists methods] [my Config_get cclass]] + ::practcl::debug [list methods [info exists methods] [my define get cclass]] if {[info exists methods]} { - set thisclass [my Config_get cclass] + set thisclass [my define get cclass] foreach {name info} $methods { if {[dict exists $info header]} { ::practcl::cputs result "[dict get $info header]\;" } } @@ -365,16 +365,16 @@ # Add the initializer wrapper for the class ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp)\;" } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue set dat [$obj generate-cfile-header] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-header */" + ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-header */" + ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */" } } return $result } @@ -381,11 +381,11 @@ ### # Generate code that provides implements Tcl API # calls ### method generate-cfile-tclapi {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code methods tclprocs set result {} if {[info exists code(method)]} { ::practcl::cputs result $code(method) } @@ -401,11 +401,11 @@ } } if {[info exists methods]} { - set thisclass [my Config_get cclass] + set thisclass [my define get cclass] foreach {name info} $methods { if {![dict exists $info body]} continue set callproc [dict get $info callproc] set header [dict get $info header] set body [dict get $info body] @@ -413,11 +413,11 @@ ::practcl::cputs result "${header} \{${body}\}" } # Build the OO_Init function ::practcl::cputs result "/* Loader for $thisclass */" ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp) \{" - ::practcl::cputs result [string map [list @CCLASS@ $thisclass @TCLCLASS@ [my Config_get class]] { + ::practcl::cputs result [string map [list @CCLASS@ $thisclass @TCLCLASS@ [my define get class]] { /* ** Build the "@TCLCLASS@" class */ Tcl_Obj* nameObj; /* Name of a class or method being looked up */ Tcl_Object curClassObject; /* Tcl_Object representing the current class */ @@ -464,11 +464,11 @@ } ::practcl::cputs result " return TCL_OK\;\n\}\n" } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue ::practcl::cputs result [$obj generate-cfile-tclapi] } return $result } @@ -475,11 +475,11 @@ ### # Generate code that runs when the package/module is # initialized into the interpreter ### method generate-loader-module {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} my variable code methods tclprocs if {[info exists code(nspace)]} { ::practcl::cputs result " \{\n Tcl_Namespace *modPtr;" foreach nspace $code(nspace) { @@ -525,14 +525,14 @@ Tcl_Export(interp, modPtr, "[a-z]*", 1); }] } ::practcl::cputs result " \}" } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} { + if {[$obj define get output_c] ne {}} { ::practcl::cputs result [$obj generate-loader-external] } else { ::practcl::cputs result [$obj generate-loader-module] } } @@ -540,12 +540,12 @@ } method Collate_Source CWD { my variable methods code cstruct tclprocs if {[info exists methods]} { - ::practcl::debug [self] methods [my Config_get cclass] - set thisclass [my Config_get cclass] + ::practcl::debug [self] methods [my define get cclass] + set thisclass [my define get cclass] foreach {name info} $methods { # Provide a callproc if {![dict exists $info callproc]} { set callproc [string map {____ _ ___ _ __ _} [string map {{ } _ : _} OOMethod_${thisclass}_${name}]] dict set methods $name callproc $callproc @@ -562,11 +562,11 @@ } if {![info exists code(initfuncts)] || "${thisclass}_OO_Init" ni $code(initfuncts)} { lappend code(initfuncts) "${thisclass}_OO_Init" } } - set thisnspace [my Config_get nspace] + set thisnspace [my define get nspace] if {[info exists tclprocs]} { ::practcl::debug [self] tclprocs [dict keys $tclprocs] foreach {name info} $tclprocs { if {![dict exists $info callproc]} { Index: modules/practcl/build/class/metaclass.tcl ================================================================== --- modules/practcl/build/class/metaclass.tcl +++ modules/practcl/build/class/metaclass.tcl @@ -1,29 +1,139 @@ ### # The metaclass for all practcl objects ### ::clay::define ::practcl::metaclass { - superclass ::clay::yggdrasil method _MorphPatterns {} { return {{@name@} {::practcl::@name@} {::practcl::*@name@} {::practcl::*@name@*}} } - method Child_define {} { - return {} - } - - method define {method args} { - tailcall my Config_$method {*}$args + method define {submethod args} { + my variable define + switch $submethod { + dump { + return [array get define] + } + add { + set field [lindex $args 0] + if {![info exists define($field)]} { + set define($field) {} + } + foreach arg [lrange $args 1 end] { + if {$arg ni $define($field)} { + lappend define($field) $arg + } + } + return $define($field) + } + remove { + set field [lindex $args 0] + if {![info exists define($field)]} { + return + } + set rlist [lrange $args 1 end] + set olist $define($field) + set nlist {} + foreach arg $olist { + if {$arg in $rlist} continue + lappend nlist $arg + } + set define($field) $nlist + return $nlist + } + exists { + set field [lindex $args 0] + return [info exists define($field)] + } + getnull - + get - + cget { + set field [lindex $args 0] + if {[info exists define($field)]} { + return $define($field) + } + return [lindex $args 1] + } + set { + if {[llength $args]==1} { + set arglist [lindex $args 0] + } else { + set arglist $args + } + array set define $arglist + if {[dict exists $arglist class]} { + my select + } + } + default { + array $submethod define {*}$args + } + } } method graft args { return [my clay delegate {*}$args] } method initialize {} {} + + method link {command args} { + my variable links + switch $command { + object { + foreach obj $args { + foreach linktype [$obj linktype] { + my link add $linktype $obj + } + } + } + add { + ### + # Add a link to an object that was externally created + ### + if {[llength $args] ne 2} { error "Usage: link add LINKTYPE OBJECT"} + lassign $args linktype object + if {[info exists links($linktype)] && $object in $links($linktype)} { + return + } + lappend links($linktype) $object + } + remove { + set object [lindex $args 0] + if {[llength $args]==1} { + set ltype * + } else { + set ltype [lindex $args 1] + } + foreach {linktype elements} [array get links $ltype] { + if {$object in $elements} { + set nlist {} + foreach e $elements { + if { $object ne $e } { lappend nlist $e } + } + set links($linktype) $nlist + } + } + } + list { + if {[llength $args]==0} { + return [array get links] + } + if {[llength $args] != 1} { error "Usage: link list LINKTYPE"} + set linktype [lindex $args 0] + if {![info exists links($linktype)]} { + return {} + } + return $links($linktype) + } + dump { + return [array get links] + } + } + } + method morph classname { my variable define if {$classname ne {}} { set map [list @name@ $classname] foreach pattern [string map $map [my _MorphPatterns]] { @@ -48,11 +158,11 @@ my clay mixinmap $mixinslot $class } elseif {[info command $class] ne {}} { if {[info object class [self]] ne $class} { ::oo::objdefine [self] class $class ::practcl::debug [self] morph $class - my Config_set class $class + my define set class $class } } else { error "[self] Could not detect class for $classname" } } Index: modules/practcl/build/class/module.tcl ================================================================== --- modules/practcl/build/class/module.tcl +++ modules/practcl/build/class/module.tcl @@ -34,11 +34,11 @@ ### # Build local variables needed for install ### package require platform set result {} - set dat [my Config_dump] + set dat [my define dump] set PKG_DIR [dict get $dat name][dict get $dat version] dict set result PKG_DIR $PKG_DIR dict with dat {} if {![info exists DESTDIR]} { set DESTDIR {} @@ -121,11 +121,11 @@ # Return the file name of the build product for the listed # handle Ensemble make::filename name { if {[dict exists $make_object $name]} { - return [[dict get $make_object $name] config get filename] + return [[dict get $make_object $name] define get filename] } } Ensemble make::target {name Info body} { set info [uplevel #0 [list subst $Info]] @@ -164,28 +164,30 @@ # definition if the [emph do] method returns true Ensemble make::do {} { global CWD SRCDIR project SANDBOX foreach {name obj} $make_object { if {[$obj do]} { - eval [$obj config get action] + eval [$obj define get action] + } + } + } + + method child which { + switch $which { + delegate - + organs { + return [list project [my define get project] module [self]] } } } - method Child_delegate {} { - return [list project [my Config_get project] module [self]] - } - method Child_organs {} { - return [list project [my Config_get project] module [self]] - } - ### # This methods generates the contents of an amalgamated .c file # which implements the loader for a batch of tools ### method generate-c {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result { /* This file was generated by practcl */ } set includes {} @@ -194,20 +196,20 @@ $mod go } set headers {} my IncludeAdd headers <tcl.h> <tclOO.h> - if {[my Config_get tk 0]} { + if {[my define get tk 0]} { my IncludeAdd headers <tk.h> } - if {[my Config_get output_h] ne {}} { - my IncludeAdd headers [my Config_get output_h] + if {[my define get output_h] ne {}} { + my IncludeAdd headers [my define get output_h] } - my IncludeAdd headers {*}[my Config_get include] + my IncludeAdd headers {*}[my define get include] foreach mod [my link list dynamic] { - my IncludeAdd headers {*}[$mod config get include] + my IncludeAdd headers {*}[$mod define get include] } foreach inc $headers { ::practcl::cputs result "#include $inc" } foreach {method} { @@ -220,26 +222,26 @@ generate-cfile-functions generate-cfile-tclapi } { set dat [my $method] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN $method [my Config_get filename] */" + ::practcl::cputs result "/* BEGIN $method [my define get filename] */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END $method [my Config_get filename] */" + ::practcl::cputs result "/* END $method [my define get filename] */" } } - ::practcl::debug [list /[self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] return $result } ### # This methods generates the contents of an amalgamated .h file # which describes the public API of this module ### method generate-h {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} foreach method { generate-hfile-public-define generate-hfile-public-macro } { @@ -280,22 +282,22 @@ } return $result } method generate-loader {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} - if {[my Config_get initfunc] eq {}} return + if {[my define get initfunc] eq {}} return ::practcl::cputs result " -extern int DLLEXPORT [my Config_get initfunc]( Tcl_Interp *interp ) \{" +extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \{" ::practcl::cputs result { /* Initialise the stubs tables. */ #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR; if (TclOOInitializeStubs(interp, "1.0") == NULL) return TCL_ERROR; } - if {[my Config_get tk 0]} { + if {[my define get tk 0]} { ::practcl::cputs result { if (Tk_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR;} } ::practcl::cputs result { #endif} set TCLINIT [my generate-tcl-pre] if {[string length [string trim $TCLINIT]]} { @@ -306,25 +308,25 @@ set TCLINIT [my generate-tcl-post] if {[string length [string trim $TCLINIT]]} { ::practcl::cputs result " if(interp) {\nif(Tcl_Eval(interp,[::practcl::tcl_to_c $TCLINIT])) return TCL_ERROR;\n }" } if {[my define exists pkg_name]} { - ::practcl::cputs result " if (Tcl_PkgProvide(interp, \"[my Config_get pkg_name [my Config_get name]]\" , \"[my Config_get pkg_vers [my Config_get version]]\" )) return TCL_ERROR\;" + ::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\;" } ::practcl::cputs result " return TCL_OK\;\n\}\n" return $result } method initialize {} { - set filename [my Config_get filename] + set filename [my define get filename] if {$filename eq {}} { return } - if {[my Config_get name] eq {}} { - my Config_set name [file tail [file dirname $filename]] + if {[my define get name] eq {}} { + my define set name [file tail [file dirname $filename]] } - if {[my Config_get localpath] eq {}} { - my Config_set localpath [my <project> config get name]_[my Config_get name] + if {[my define get localpath] eq {}} { + my define set localpath [my <project> define get name]_[my define get name] } my graft module [self] ::practcl::debug [self] SOURCE $filename my source $filename } @@ -333,21 +335,21 @@ my go my Collate_Source $path set errs {} foreach item [my link list dynamic] { if {[catch {$item implement $path} err errdat]} { - lappend errs "Skipped $item: [$item config get filename] $err" + lappend errs "Skipped $item: [$item define get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } } } foreach item [my link list module] { if {[catch {$item implement $path} err errdat]} { - lappend errs "Skipped $item: [$item config get filename] $err" + lappend errs "Skipped $item: [$item define get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } @@ -363,12 +365,12 @@ ::practcl::log $logfile "*** DEBUG INFO ***" ::practcl::log $logfile $::DEBUG_INFO puts stderr "Errors saved to $logfile" exit 1 } - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] - set filename [my Config_get output_c] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set filename [my define get output_c] if {$filename eq {}} { ::practcl::debug [list /[self] [self method] [self class]] return } set cout [open [file join $path [file rootname $filename].c] w] Index: modules/practcl/build/class/object.tcl ================================================================== --- modules/practcl/build/class/object.tcl +++ modules/practcl/build/class/object.tcl @@ -3,40 +3,37 @@ ### ::clay::define ::practcl::object { superclass ::practcl::metaclass constructor {parent args} { - my variable links + my variable links define set organs [$parent child organs] my clay delegate {*}$organs - my Config_merge $organs - my Config_merge [$parent child define] + array set define $organs + array set define [$parent child define] array set links {} if {[llength $args]==1 && [file exists [lindex $args 0]]} { - my Config_set filename [lindex $args 0] + my define set filename [lindex $args 0] ::practcl::product select [self] } elseif {[llength $args] == 1} { set data [uplevel 1 [list subst [lindex $args 0]]] - my Config_merge $data + array set define $data my select } else { - my Config_merge [uplevel 1 [list subst $args]] + array set define [uplevel 1 [list subst $args]] my select } my initialize } - method Child_delegate {} { - return {} - } - method Child_organs {} { + method child {method} { return {} } method go {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable links foreach {linktype objs} [array get links] { foreach obj $objs { $obj go } Index: modules/practcl/build/class/product.tcl ================================================================== --- modules/practcl/build/class/product.tcl +++ modules/practcl/build/class/product.tcl @@ -11,20 +11,20 @@ method Collate_Source CWD {} method project-compile-products {} { set result {} noop { - set filename [my Config_get filename] + set filename [my define get filename] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my Config_get ofile] + set ofile [my define get ofile] } else { set ofile [my Ofile $filename] - my Config_set ofile $ofile + my define set ofile $ofile } - lappend result $ofile [list cfile $filename include [my Config_get include] extra [my Config_get extra] external [string is true -strict [my Config_get external]] object [self]] + 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]] } } foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } @@ -31,93 +31,93 @@ return $result } method generate-debug {{spaces {}}} { set result {} - ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my Config_get filename]] links [my link list]]" + ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my define get filename]] links [my link list]]" foreach item [my link list subordinate] { practcl::cputs result [$item generate-debug "$spaces "] } return $result } method generate-cfile-constant {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} my variable code cstruct methods tcltype if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my Config_get filename] CONSTANT */" + ::practcl::cputs result "/* [my define get filename] CONSTANT */" ::practcl::cputs result $code(constant) } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue ::practcl::cputs result [$obj generate-cfile-constant] } return $result } ### # Populate const static data structures ### method generate-cfile-public-structure {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cstruct methods tcltype set result {} if {[info exists code(struct)]} { ::practcl::cputs result $code(struct) } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue ::practcl::cputs result [$obj generate-cfile-public-structure] } return $result } method generate-cfile-header {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cfunct cstruct methods tcltype tclprocs set result {} if {[info exists code(header)]} { ::practcl::cputs result $code(header) } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue set dat [$obj generate-cfile-header] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-header */" + ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-header */" + ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */" } } return $result } method generate-cfile-global {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cfunct cstruct methods tcltype tclprocs set result {} if {[info exists code(global)]} { ::practcl::cputs result $code(global) } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue set dat [$obj generate-cfile-global] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-global */" + ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-global */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-global */" + ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-global */" } } return $result } method generate-cfile-private-typedef {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(private-typedef)]} { ::practcl::cputs result $code(private-typedef) } @@ -131,19 +131,19 @@ ::practcl::cputs result "typedef struct $name ${n}\;" } } } } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-cfile-private-typedef] } return $result } method generate-cfile-private-structure {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(private-structure)]} { ::practcl::cputs result $code(private-structure) } @@ -154,11 +154,11 @@ ::practcl::cputs result [dict get $info comment] } ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" } } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-cfile-private-structure] } return $result } @@ -167,11 +167,11 @@ ### # Generate code that provides subroutines called by # Tcl API methods ### method generate-cfile-functions {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cfunct set result {} if {[info exists code(funct)]} { ::practcl::cputs result $code(funct) } @@ -185,11 +185,11 @@ } } } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} { + if {[$obj define get output_c] ne {}} { continue } ::practcl::cputs result [$obj generate-cfile-functions] } return $result @@ -198,55 +198,55 @@ ### # Generate code that provides implements Tcl API # calls ### method generate-cfile-tclapi {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code methods tclprocs set result {} if {[info exists code(method)]} { ::practcl::cputs result $code(method) } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue ::practcl::cputs result [$obj generate-cfile-tclapi] } return $result } method generate-hfile-public-define {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code set result {} if {[info exists code(public-define)]} { ::practcl::cputs result $code(public-define) } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-hfile-public-define] } return $result } method generate-hfile-public-macro {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code set result {} if {[info exists code(public-macro)]} { ::practcl::cputs result $code(public-macro) } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-hfile-public-macro] } return $result } method generate-hfile-public-typedef {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(public-typedef)]} { ::practcl::cputs result $code(public-typedef) } @@ -260,19 +260,19 @@ ::practcl::cputs result "typedef struct $name ${n}\;" } } } } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-hfile-public-typedef] } return $result } method generate-hfile-public-structure {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(public-structure)]} { ::practcl::cputs result $code(public-structure) } @@ -283,19 +283,19 @@ ::practcl::cputs result [dict get $info comment] } ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" } } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-hfile-public-structure] } return $result } method generate-hfile-public-headers {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code tcltype set result {} if {[info exists code(public-header)]} { ::practcl::cputs result $code(public-header) } @@ -311,42 +311,42 @@ } } if {[info exists code(public)]} { ::practcl::cputs result $code(public) } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-hfile-public-headers] } return $result } method generate-hfile-public-function {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cfunct tcltype set result {} - if {[my Config_get initfunc] ne {}} { - ::practcl::cputs result "int [my Config_get initfunc](Tcl_Interp *interp);" + if {[my define get initfunc] ne {}} { + ::practcl::cputs result "int [my define get initfunc](Tcl_Interp *interp);" } if {[info exists cfunct]} { foreach {funcname info} $cfunct { if {![dict get $info public]} continue ::practcl::cputs result "[dict get $info header]\;" } } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-hfile-public-function] } return $result } method generate-hfile-public-includes {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set includes {} - foreach item [my Config_get public-include] { + foreach item [my define get public-include] { if {$item ni $includes} { lappend includes $item } } foreach mod [my link list product] { @@ -358,13 +358,13 @@ } return $includes } method generate-hfile-public-verbatim {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set includes {} - foreach item [my Config_get public-verbatim] { + foreach item [my define get public-verbatim] { if {$item ni $includes} { lappend includes $item } } foreach mod [my link list subordinate] { @@ -376,39 +376,39 @@ } return $includes } method generate-loader-external {} { - if {[my Config_get initfunc] eq {}} { - return "/* [my Config_get filename] declared not initfunc */" + if {[my define get initfunc] eq {}} { + return "/* [my define get filename] declared not initfunc */" } - return " if([my Config_get initfunc](interp)) return TCL_ERROR\;" + return " if([my define get initfunc](interp)) return TCL_ERROR\;" } method generate-loader-module {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code set result {} if {[info exists code(cinit)]} { ::practcl::cputs result $code(cinit) } - if {[my Config_get initfunc] ne {}} { - ::practcl::cputs result " if([my Config_get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" + if {[my define get initfunc] ne {}} { + ::practcl::cputs result " if([my define get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach item [my link list product] { - if {[$item config get output_c] ne {}} { + if {[$item define get output_c] ne {}} { ::practcl::cputs result [$item generate-loader-external] } else { ::practcl::cputs result [$item generate-loader-module] } } return $result } method generate-stub-function {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cfunct tcltype set result {} foreach mod [my link list product] { foreach {funct def} [$mod generate-stub-function] { dict set result $funct $def @@ -436,15 +436,15 @@ } } method generate-tcl-loader {} { set result {} - set PKGINIT [my Config_get pkginit] - set PKG_NAME [my Config_get name [my Config_get pkg_name]] - set PKG_VERSION [my Config_get pkg_vers [my Config_get version]] - if {[string is true [my Config_get SHARED_BUILD 0]]} { - set LIBFILE [my Config_get libfile] + set PKGINIT [my define get pkginit] + set PKG_NAME [my define get name [my define get pkg_name]] + set PKG_VERSION [my define get pkg_vers [my define get version]] + if {[string is true [my define get SHARED_BUILD 0]]} { + set LIBFILE [my define get libfile] ::practcl::cputs result [string map \ [list @LIBFILE@ $LIBFILE @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] { # Shared Library Style load [file join [file dirname [file join [pwd] [info script]]] @LIBFILE@] @PKGINIT@ package provide @PKG_NAME@ @PKG_VERSION@ @@ -463,31 +463,31 @@ ### # This methods generates any Tcl script file # which is required to pre-initialize the C library ### method generate-tcl-pre {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} my variable code if {[info exists code(tcl)]} { - set result [::practcl::_tagblock $code(tcl) tcl [my Config_get filename]] + set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] } if {[info exists code(tcl-pre)]} { - set result [::practcl::_tagblock $code(tcl) tcl [my Config_get filename]] + set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] } foreach mod [my link list product] { ::practcl::cputs result [$mod generate-tcl-pre] } return $result } method generate-tcl-post {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} my variable code if {[info exists code(tcl-post)]} { - set result [::practcl::_tagblock $code(tcl-post) tcl [my Config_get filename]] + set result [::practcl::_tagblock $code(tcl-post) tcl [my define get filename]] } foreach mod [my link list product] { ::practcl::cputs result [$mod generate-tcl-post] } return $result @@ -497,30 +497,30 @@ method linktype {} { return {subordinate product} } method Ofile filename { - set lpath [my <module> config get localpath] + set lpath [my <module> define get localpath] if {$lpath eq {}} { - set lpath [my <module> config get name] + set lpath [my <module> define get name] } return ${lpath}_[file rootname [file tail $filename]] } ### # Methods called by the master project ### method project-static-packages {} { - set result [my Config_get static_packages] - set initfunc [my Config_get initfunc] + set result [my define get static_packages] + set initfunc [my define get initfunc] if {$initfunc ne {}} { - set pkg_name [my Config_get pkg_name] + set pkg_name [my define get pkg_name] if {$pkg_name ne {}} { dict set result $pkg_name initfunc $initfunc - dict set result $pkg_name version [my Config_get version [my Config_get pkg_vers]] - dict set result $pkg_name autoload [my Config_get autoload 0] + dict set result $pkg_name version [my define get version [my define get pkg_vers]] + dict set result $pkg_name autoload [my define get autoload 0] } } foreach item [my link list subordinate] { foreach {pkg info} [$item project-static-packages] { dict set result $pkg $info @@ -532,12 +532,12 @@ ### # Methods called by the toolset ### method toolset-include-directory {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] - set result [my Config_get include_dir] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result [my define get include_dir] foreach obj [my link list product] { foreach path [$obj toolset-include-directory] { lappend result $path } } @@ -551,14 +551,14 @@ } } oo::objdefine ::practcl::product { method select {object} { - set class [$object config get class] - set mixin [$object config get product] + set class [$object define get class] + set mixin [$object define get product] if {$class eq {} && $mixin eq {}} { - set filename [$object config get filename] + set filename [$object define get filename] if {$filename ne {} && [file exists $filename]} { switch [file extension $filename] { .tcl { set mixin ::practcl::product.dynamic } @@ -612,20 +612,20 @@ ::clay::define ::practcl::product.csource { superclass ::practcl::product method project-compile-products {} { set result {} - set filename [my Config_get filename] + set filename [my define get filename] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my Config_get ofile] + set ofile [my define get ofile] } else { set ofile [my Ofile $filename] - my Config_set ofile $ofile + my define set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]] object [self]] + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]] object [self]] } foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } return $result @@ -640,11 +640,11 @@ ### ::clay::define ::practcl::product.clibrary { superclass ::practcl::product method linker-products {configdict} { - return [my Config_get filename] + return [my define get filename] } } ### @@ -655,28 +655,28 @@ ### ::clay::define ::practcl::product.dynamic { superclass ::practcl::dynamic ::practcl::product method initialize {} { - set filename [my Config_get filename] + set filename [my define get filename] if {$filename eq {}} { return } - if {[my Config_get name] eq {}} { - my Config_set name [file tail [file rootname $filename]] + if {[my define get name] eq {}} { + my define set name [file tail [file rootname $filename]] } - if {[my Config_get localpath] eq {}} { - my Config_set localpath [my <module> config get localpath]_[my Config_get name] + if {[my define get localpath] eq {}} { + my define set localpath [my <module> define get localpath]_[my define get name] } # Future Development: # Scan source file to see if it is encoded in criticl or practcl notation #set thisline {} #foreach line [split [::practcl::cat $filename] \n] { # #} ::source $filename - if {[my Config_get output_c] ne {}} { + if {[my define get output_c] ne {}} { # Turn into a module if we have an output_c file my morph ::practcl::module } } } Index: modules/practcl/build/class/project/baseclass.tcl ================================================================== --- modules/practcl/build/class/project/baseclass.tcl +++ modules/practcl/build/class/project/baseclass.tcl @@ -33,11 +33,11 @@ if {[dict exists $rawcontents $field]} { dict set contents $field [dict get $rawcontents $field] } } my graft module [self] - my Config_merge $contents + array set define $contents ::practcl::toolset select [self] my initialize } method add_object object { @@ -44,100 +44,102 @@ my link object $object } method add_project {pkg info {oodefine {}}} { ::practcl::debug [self] add_project $pkg $info - set os [my Config_get TEACUP_OS] + set os [my define get TEACUP_OS] if {$os eq {}} { set os [::practcl::os] - my Config_set os $os + my define set os $os } - set fossilinfo [list download [my Config_get download] tag trunk sandbox [my Config_get sandbox]] + set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]] if {[dict exists $info os] && ($os ni [dict get $info os])} return # Select which tag to use here. # For production builds: tag-release - set profile [my Config_get profile release]: + set profile [my define get profile release]: if {[dict exists $info profile $profile]} { dict set info tag [dict get $info profile $profile] } - dict set info USEMSVC [my Config_get USEMSVC 0] - dict set info debug [my Config_get debug 0] + dict set info USEMSVC [my define get USEMSVC 0] + dict set info debug [my define get debug 0] set obj [namespace current]::PROJECT.$pkg if {[info command $obj] eq {}} { set obj [::practcl::subproject create $obj [self] [dict merge $fossilinfo [list name $pkg pkg_name $pkg static 0 class subproject.binary] $info]] } my link object $obj oo::objdefine $obj $oodefine - $obj config set masterpath $::CWD + $obj define set masterpath $::CWD $obj go return $obj } method add_tool {pkg info {oodefine {}}} { ::practcl::debug [self] add_tool $pkg $info set info [dict merge [::practcl::local_os] $info] set os [dict get $info TEACUP_OS] - set fossilinfo [list download [my Config_get download] tag trunk sandbox [my Config_get sandbox]] + set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]] if {[dict exists $info os] && ($os ni [dict get $info os])} return # Select which tag to use here. # For production builds: tag-release - set profile [my Config_get profile release]: + set profile [my define get profile release]: if {[dict exists $info profile $profile]} { dict set info tag [dict get $info profile $profile] } set obj ::practcl::OBJECT::TOOL.$pkg if {[info command $obj] eq {}} { set obj [::practcl::subproject create $obj [self] [dict merge $fossilinfo [list name $pkg pkg_name $pkg static 0] $info]] } my link add tool $obj oo::objdefine $obj $oodefine - $obj config set masterpath $::CWD + $obj define set masterpath $::CWD $obj go return $obj } ### # Compile the Tcl core. If the define [emph tk] is true, compile the # Tk core as well ### method build-tclcore {} { - set os [my Config_get TEACUP_OS] + set os [my define get TEACUP_OS] set tcl_config_opts [::practcl::platform::tcl_core_options $os] set tk_config_opts [::practcl::platform::tk_core_options $os] - lappend tcl_config_opts --prefix [my Config_get prefix] --exec-prefix [my Config_get prefix] + lappend tcl_config_opts --prefix [my define get prefix] --exec-prefix [my define get prefix] set tclobj [my tclcore] - if {[my Config_get debug 0]} { - $tclobj config set debug 1 + if {[my define get debug 0]} { + $tclobj define set debug 1 lappend tcl_config_opts --enable-symbols=true } - $tclobj config set config_opts $tcl_config_opts + $tclobj define set config_opts $tcl_config_opts $tclobj go $tclobj compile - set _TclSrcDir [$tclobj config get localsrcdir] - my Config_set tclsrcdir $_TclSrcDir - if {[my Config_get tk 0]} { + set _TclSrcDir [$tclobj define get localsrcdir] + my define set tclsrcdir $_TclSrcDir + if {[my define get tk 0]} { set tkobj [my tkcore] - lappend tk_config_opts --with-tcl=[::practcl::file_relative [$tkobj config get builddir] [$tclobj config get builddir]] - if {[my Config_get debug 0]} { - $tkobj config set debug 1 + lappend tk_config_opts --with-tcl=[::practcl::file_relative [$tkobj define get builddir] [$tclobj define get builddir]] + if {[my define get debug 0]} { + $tkobj define set debug 1 lappend tk_config_opts --enable-symbols=true } - $tkobj config set config_opts $tk_config_opts + $tkobj define set config_opts $tk_config_opts $tkobj compile } } + method child which { + switch $which { + delegate - + organs { # A library can be a project, it can be a module. Any # subordinate modules will indicate their existance - method Child_delegate {} { - return [list project [self] module [self]] - } - method Child_organs {} { - return [list project [self] module [self]] + return [list project [self] module [self]] + } + } } method linktype {} { return project } Index: modules/practcl/build/class/project/library.tcl ================================================================== --- modules/practcl/build/class/project/library.tcl +++ modules/practcl/build/class/project/library.tcl @@ -4,11 +4,11 @@ ::clay::define ::practcl::library { superclass ::practcl::project method clean {PATH} { - set objext [my Config_get OBJEXT o] + set objext [my define get OBJEXT o] foreach {ofile info} [my project-compile-products] { if {[file exists [file join $PATH objs $ofile].${objext}]} { file delete [file join $PATH objs $ofile].${objext} } } @@ -16,11 +16,11 @@ file delete $ofile } foreach ofile [glob -nocomplain [file join $PATH objs *]] { file delete $ofile } - set libfile [my Config_get libfile] + set libfile [my define get libfile] if {[file exists [file join $PATH $libfile]]} { file delete [file join $PATH $libfile] } my implement $PATH } @@ -28,72 +28,72 @@ method project-compile-products {} { set result {} foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } - set filename [my Config_get output_c] + set filename [my define get output_c] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename set ofile [file rootname [file tail $filename]]_main - lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] } return $result } method go {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] - set name [my Config_get name] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set name [my define getnull name] if {$name eq {}} { set name generic my define name generic } - if {[my Config_get tk] eq {@TEA_TK_EXTENSION@}} { - my Config_set tk 0 + if {[my define get tk] eq {@TEA_TK_EXTENSION@}} { + my define set tk 0 } - set output_c [my Config_get output_c] + set output_c [my define getnull output_c] if {$output_c eq {}} { set output_c [file rootname $name].c - my Config_set output_c $output_c + my define set output_c $output_c } - set output_h [my Config_get output_h] + set output_h [my define getnull output_h] if {$output_h eq {}} { set output_h [file rootname $output_c].h - my Config_set output_h $output_h + my define set output_h $output_h } - set output_tcl [my Config_get output_tcl] + set output_tcl [my define getnull output_tcl] #if {$output_tcl eq {}} { # set output_tcl [file rootname $output_c].tcl - # my Config_set output_tcl $output_tcl + # my define set output_tcl $output_tcl #} - #set output_mk [my Config_get output_mk] + #set output_mk [my define getnull output_mk] #if {$output_mk eq {}} { # set output_mk [file rootname $output_c].mk - # my Config_set output_mk $output_mk + # my define set output_mk $output_mk #} - set initfunc [my Config_get initfunc] + set initfunc [my define getnull initfunc] if {$initfunc eq {}} { set initfunc [string totitle $name]_Init - my Config_set initfunc $initfunc + my define set initfunc $initfunc } - set output_decls [my Config_get output_decls] + set output_decls [my define getnull output_decls] if {$output_decls eq {}} { set output_decls [file rootname $output_c].decls - my Config_set output_decls $output_decls + my define set output_decls $output_decls } my variable links foreach {linktype objs} [array get links] { foreach obj $objs { $obj go } } - ::practcl::debug [list /[self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] } method generate-decls {pkgname path} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set outfile [file join $path/$pkgname.decls] ### # Build the decls file ## # @@ -115,12 +115,12 @@ set thisline {} set functcount 0 foreach {func header} $stubfuncts { puts $fout [list declare [incr functcount] $header] } - puts $fout [list export "int [my Config_get initfunc](Tcl_Inter *interp)"] - puts $fout [list export "char *[string totitle [my Config_get name]]_InitStubs(Tcl_Inter *interp, char *version, int exact)"] + puts $fout [list export "int [my define get initfunc](Tcl_Inter *interp)"] + puts $fout [list export "char *[string totitle [my define get name]]_InitStubs(Tcl_Inter *interp, char *version, int exact)"] close $fout ### # Build [package]Decls.h @@ -188,21 +188,21 @@ my go my Collate_Source $path set errs {} foreach item [my link list dynamic] { if {[catch {$item implement $path} err errdat]} { - lappend errs "Skipped $item: [$item config get filename] $err" + lappend errs "Skipped $item: [$item define get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } } } foreach item [my link list module] { if {[catch {$item implement $path} err errdat]} { - lappend errs "Skipped $item: [$item config get filename] $err" + lappend errs "Skipped $item: [$item define get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } @@ -218,21 +218,21 @@ ::practcl::log $logfile "*** DEBUG INFO ***" ::practcl::log $logfile $::DEBUG_INFO puts stderr "Errors saved to $logfile" exit 1 } - set cout [open [file join $path [my Config_get output_c]] w] + set cout [open [file join $path [my define get output_c]] w] puts $cout [subst {/* ** This file is generated by the [info script] script ** any changes will be overwritten the next time it is run */}] puts $cout [my generate-c] puts $cout [my generate-loader] close $cout - set macro HAVE_[string toupper [file rootname [my Config_get output_h]]]_H - set hout [open [file join $path [my Config_get output_h]] w] + set macro HAVE_[string toupper [file rootname [my define get output_h]]]_H + set hout [open [file join $path [my define get output_h]] w] puts $hout [subst {/* ** This file is generated by the [info script] script ** any changes will be overwritten the next time it is run */}] puts $hout "#ifndef ${macro}" @@ -239,13 +239,13 @@ puts $hout "#define ${macro} 1" puts $hout [my generate-h] puts $hout "#endif" close $hout - set output_tcl [my Config_get output_tcl] + set output_tcl [my define get output_tcl] if {$output_tcl ne {}} { - set tclout [open [file join $path [my Config_get output_tcl]] w] + set tclout [open [file join $path [my define get output_tcl]] w] puts $tclout "### # This file is generated by the [info script] script # any changes will be overwritten the next time it is run ###" puts $tclout [my generate-tcl-pre] @@ -266,20 +266,20 @@ # Create a "package ifneeded" # Args are a list of aliases for which this package will answer to method package-ifneeded {args} { set result {} - set name [my Config_get pkg_name [my Config_get name]] - set version [my Config_get pkg_vers [my Config_get version]] + set name [my define get pkg_name [my define get name]] + set version [my define get pkg_vers [my define get version]] if {$version eq {}} { set version 0.1a } - set output_tcl [my Config_get output_tcl] + set output_tcl [my define get output_tcl] if {$output_tcl ne {}} { set script "\[list source \[file join \$dir $output_tcl\]\]" - } elseif {[my Config_get SHARED_BUILD 0]} { - set script "\[list load \[file join \$dir [my Config_get libfile]\] $name\]" + } elseif {[my define get SHARED_BUILD 0]} { + set script "\[list load \[file join \$dir [my define get libfile]\] $name\]" } else { # Provide a null passthrough set script "\[list package provide $name $version\]" } set result "package ifneeded [list $name] [list $version] $script" @@ -290,30 +290,30 @@ return $result } method shared_library {{filename {}}} { - set name [string tolower [my Config_get name [my Config_get pkg_name]]] + set name [string tolower [my define get name [my define get pkg_name]]] set NAME [string toupper $name] - set version [my Config_get version [my Config_get pkg_vers]] + set version [my define get version [my define get pkg_vers]] set map {} lappend map %LIBRARY_NAME% $name lappend map %LIBRARY_VERSION% $version lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $version] - lappend map %LIBRARY_PREFIX% [my Config_get libprefix] - set outfile [string map $map [my Config_get PRACTCL_NAME_LIBRARY]][my Config_get SHLIB_SUFFIX] + lappend map %LIBRARY_PREFIX% [my define getnull libprefix] + set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]][my define get SHLIB_SUFFIX] return $outfile } method static_library {{filename {}}} { - set name [string tolower [my Config_get name [my Config_get pkg_name]]] + set name [string tolower [my define get name [my define get pkg_name]]] set NAME [string toupper $name] - set version [my Config_get version [my Config_get pkg_vers]] + set version [my define get version [my define get pkg_vers]] set map {} lappend map %LIBRARY_NAME% $name lappend map %LIBRARY_VERSION% $version lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $version] - lappend map %LIBRARY_PREFIX% [my Config_get libprefix] - set outfile [string map $map [my Config_get PRACTCL_NAME_LIBRARY]].a + lappend map %LIBRARY_PREFIX% [my define getnull libprefix] + set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]].a return $outfile } } Index: modules/practcl/build/class/project/tclkit.tcl ================================================================== --- modules/practcl/build/class/project/tclkit.tcl +++ modules/practcl/build/class/project/tclkit.tcl @@ -57,14 +57,14 @@ } # Build an area of the file for #define directives and # function declarations set define {} - set mainhook [$PROJECT config get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] - set mainfunc [$PROJECT config get TCL_LOCAL_APPINIT Tclkit_AppInit] - set mainscript [$PROJECT config get main.tcl main.tcl] - set vfsroot [$PROJECT config get vfsroot "[$PROJECT config get ZIPFS_VOLUME]app"] + set mainhook [$PROJECT define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] + set mainfunc [$PROJECT define get TCL_LOCAL_APPINIT Tclkit_AppInit] + set mainscript [$PROJECT define get main.tcl main.tcl] + set vfsroot [$PROJECT define get vfsroot "[$PROJECT define get ZIPFS_VOLUME]app"] set vfs_main "${vfsroot}/${mainscript}" set map {} foreach var { vfsroot mainhook mainfunc vfs_main @@ -107,11 +107,11 @@ append main_init_script \n {if {[file exists [file join $::starkit::topdir pkgIndex.tcl]]} { #In a wrapped exe, we don't go out to the environment set dir $::starkit::topdir source [file join $::starkit::topdir pkgIndex.tcl] }} - append main_init_script \n [list set tcl_rcFileName [$PROJECT config get tcl_rcFileName ~/.tclshrc]] + append main_init_script \n [list set tcl_rcFileName [$PROJECT define get tcl_rcFileName ~/.tclshrc]] append preinitscript \n [list set ::starkit::thread_init $thread_init_script] append preinitscript \n {eval $::starkit::thread_init} set zvfsboot { /* * %mainhook% -- @@ -124,11 +124,11 @@ archive=Tcl_GetNameOfExecutable(); } # We have to initialize the virtual filesystem before calling # Tcl_Init(). Otherwise, Tcl_Init() will not be able to find # its startup script files. - if {![$PROJECT config get tip_430 0]} { + if {![$PROJECT define get tip_430 0]} { # Add declarations of functions that tip430 puts in the stub files $PROJECT code public-header { int TclZipfs_Init(Tcl_Interp *interp); int TclZipfs_Mount( Tcl_Interp *interp, @@ -176,11 +176,11 @@ } }])\;" ::practcl::cputs zvfsboot " \x7D" ::practcl::cputs zvfsboot " return TCL_OK;" - if {[$PROJECT config get TEACUP_OS] eq "windows"} { + if {[$PROJECT define get TEACUP_OS] eq "windows"} { set header {int %mainhook%(int *argc, TCHAR ***argv)} } else { set header {int %mainhook%(int *argc, char ***argv)} } $PROJECT c_function [string map $map $header] [string map $map $zvfsboot] @@ -193,11 +193,11 @@ if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } } - if {![$PROJECT config get tip_430 0]} { + if {![$PROJECT define get tip_430 0]} { ::practcl::cputs appinit { TclZipfs_Init(interp);} } foreach {statpkg info} $statpkglist { set initfunc {} if {[dict exists $info initfunc]} { @@ -225,57 +225,57 @@ $PROJECT c_function [string map $map "int %mainfunc%(Tcl_Interp *interp)"] [string map $map $appinit] } method Collate_Source CWD { next $CWD - set name [my Config_get name] + set name [my define get name] # Assume a static shell if {[my define exists SHARED_BUILD]} { - my Config_set SHARED_BUILD 0 + my define set SHARED_BUILD 0 } if {![my define exists TCL_LOCAL_APPINIT]} { - my Config_set TCL_LOCAL_APPINIT Tclkit_AppInit + my define set TCL_LOCAL_APPINIT Tclkit_AppInit } if {![my define exists TCL_LOCAL_MAIN_HOOK]} { - my Config_set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook + my define set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook } set PROJECT [self] - set os [$PROJECT config get TEACUP_OS] - if {[my Config_get SHARED_BUILD 0]} { + set os [$PROJECT define get TEACUP_OS] + if {[my define get SHARED_BUILD 0]} { puts [list BUILDING TCLSH FOR OS $os] } else { puts [list BUILDING KIT FOR OS $os] } set TCLOBJ [$PROJECT tclcore] ::practcl::toolset select $TCLOBJ - set TCLSRCDIR [$TCLOBJ config get srcdir] + set TCLSRCDIR [$TCLOBJ define get srcdir] set PKG_OBJS {} foreach item [$PROJECT link list core.library] { - if {[string is true [$item config get static]]} { + if {[string is true [$item define get static]]} { lappend PKG_OBJS $item } } foreach item [$PROJECT link list package] { - if {[string is true [$item config get static]]} { + if {[string is true [$item define get static]]} { lappend PKG_OBJS $item } } # Arrange to build an main.c that utilizes TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK if {$os eq "windows"} { set PLATFORM_SRC_DIR win - if {![my Config_get SHARED_BUILD 0]} { + if {![my define get SHARED_BUILD 0]} { my add class csource filename [file join $TCLSRCDIR win tclWinReg.c] initfunc Registry_Init pkg_name registry pkg_vers 1.3.1 autoload 1 my add class csource filename [file join $TCLSRCDIR win tclWinDde.c] initfunc Dde_Init pkg_name dde pkg_vers 1.4.0 autoload 1 } - my add class csource ofile [my Config_get name]_appinit.o filename [file join $TCLSRCDIR win tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my Config_get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my Config_get TCL_LOCAL_APPINIT Tclkit_AppInit]] + 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]] } else { set PLATFORM_SRC_DIR unix - my add class csource ofile [my Config_get name]_appinit.o filename [file join $TCLSRCDIR unix tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my Config_get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my Config_get TCL_LOCAL_APPINIT Tclkit_AppInit]] + 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]] } - if {![my Config_get SHARED_BUILD 0]} { + if {![my define get SHARED_BUILD 0]} { ### # Add local static Zlib implementation ### set cdir [file join $TCLSRCDIR compat zlib] foreach file { @@ -291,32 +291,32 @@ # Pre 8.7, Tcl doesn't include a Zipfs implementation # in the core. Grab the one from odielib ### set zipfs [file join $TCLSRCDIR generic tclZipfs.c] if {![$PROJECT define exists ZIPFS_VOLUME]} { - $PROJECT config set ZIPFS_VOLUME "zipfs:/" + $PROJECT define set ZIPFS_VOLUME "zipfs:/" } - $PROJECT code header "#define ZIPFS_VOLUME \"[$PROJECT config get ZIPFS_VOLUME]\"" + $PROJECT code header "#define ZIPFS_VOLUME \"[$PROJECT define get ZIPFS_VOLUME]\"" if {[file exists $zipfs]} { - $TCLOBJ config set tip_430 1 - my Config_set tip_430 1 + $TCLOBJ define set tip_430 1 + my define set tip_430 1 } else { # The Tclconfig project maintains a mirror of the version # released with the Tcl core - my Config_set tip_430 0 - set tclzipfs_c [my Config_get tclzipfs_c] + my define set tip_430 0 + set tclzipfs_c [my define get tclzipfs_c] if {![file exists $tclzipfs_c]} { ::practcl::LOCAL tool tclconfig unpack - set COMPATSRCROOT [::practcl::LOCAL tool tclconfig config get srcdir] + set COMPATSRCROOT [::practcl::LOCAL tool tclconfig define get srcdir] set tclzipfs_c [file join $COMPATSRCROOT compat tclZipfs.c] } my add class csource ofile tclZipfs.o filename $tclzipfs_c \ extra -I[::practcl::file_relative $CWD [file join $TCLSRCDIR compat zlib contrib minizip]] } - my Config_add include_dir [file join $TCLSRCDIR generic] - my Config_add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR] + my define add include_dir [file join $TCLSRCDIR generic] + my define add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR] # This file will implement TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK my build-tclkit_main $PROJECT $PKG_OBJS } ## Wrap an executable @@ -325,26 +325,26 @@ cd $PWD if {![file exists $vfspath]} { file mkdir $vfspath } foreach item [my link list core.library] { - set name [$item config get name] - set libsrcdir [$item config get srcdir] + set name [$item define get name] + set libsrcdir [$item define get srcdir] if {[file exists [file join $libsrcdir library]]} { ::practcl::copyDir [file join $libsrcdir library] [file join $vfspath ${name}_library] } } # Assume the user will populate the VFS path - #if {[my Config_get installdir] ne {}} { - # ::practcl::copyDir [file join [my Config_get installdir] [string trimleft [my Config_get prefix] /] lib] [file join $vfspath lib] + #if {[my define get installdir] ne {}} { + # ::practcl::copyDir [file join [my define get installdir] [string trimleft [my define get prefix] /] lib] [file join $vfspath lib] #} foreach arg $args { ::practcl::copyDir $arg $vfspath } set fout [open [file join $vfspath pkgIndex.tcl] w] - puts $fout [string map [list %platform% [my Config_get TEACUP_PROFILE]] {set ::tcl_teapot_profile {%platform%}}] + puts $fout [string map [list %platform% [my define get TEACUP_PROFILE]] {set ::tcl_teapot_profile {%platform%}}] puts $fout { namespace eval ::starkit {} set ::PKGIDXFILE [info script] set dir [file dirname $::PKGIDXFILE] if {$::tcl_platform(platform) eq "windows"} { @@ -376,13 +376,13 @@ } } } close $fout - set EXEEXT [my Config_get EXEEXT] - set tclkit_bare [my Config_get tclkit_bare] + set EXEEXT [my define get EXEEXT] + set tclkit_bare [my define get tclkit_bare] ::practcl::mkzip ${exename}${EXEEXT} $tclkit_bare $vfspath - if { [my Config_get TEACUP_OS] ne "windows" } { + if { [my define get TEACUP_OS] ne "windows" } { file attributes ${exename}${EXEEXT} -permissions a+x } } } Index: modules/practcl/build/class/subproject/baseclass.tcl ================================================================== --- modules/practcl/build/class/subproject/baseclass.tcl +++ modules/practcl/build/class/subproject/baseclass.tcl @@ -8,30 +8,32 @@ return {{::practcl::subproject.@name@} {::practcl::@name@} {@name@} {::practcl::subproject}} } method BuildDir {PWD} { - return [my Config_get srcdir] + return [my define get srcdir] } + method child which { + switch $which { + delegate - + organs { # A library can be a project, it can be a module. Any # subordinate modules will indicate their existance - method Child_delegate {} { - return [list project [self] module [self]] - } - method Child_organs {} { - return [list project [self] module [self]] + return [list project [self] module [self]] + } + } } method compile {} {} method go {} { ::practcl::distribution select [self] - set name [my Config_get name] - my Config_set builddir [my BuildDir [my Config_get masterpath]] - my Config_set builddir [my BuildDir [my Config_get masterpath]] + set name [my define get name] + my define set builddir [my BuildDir [my define get masterpath]] + my define set builddir [my BuildDir [my define get masterpath]] my sources } # Install project into the local build system method install args {} @@ -66,11 +68,11 @@ ### # Load the facility into the interpreter ### method env-bootstrap {} { - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] package require $pkg } ### # Return a file path that exec can call @@ -102,11 +104,11 @@ ### # Check if tool is available for load/already loaded ### method env-present {} { - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] if {[catch [list package require $pkg]]} { return 0 } return 1 } @@ -137,18 +139,18 @@ ### ::clay::define ::practcl::subproject.source { superclass ::practcl::subproject ::practcl::library method env-bootstrap {} { - set LibraryRoot [file join [my Config_get srcdir] [my Config_get module_root modules]] + set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] if {[file exists $LibraryRoot] && $LibraryRoot ni $::auto_path} { set ::auto_path [linsert $::auto_path 0 $LibraryRoot] } } method env-present {} { - set path [my Config_get srcdir] + set path [my define get srcdir] return [file exists $path] } method linktype {} { return {subordinate package source} @@ -159,36 +161,36 @@ # a copy from the teapot ::clay::define ::practcl::subproject.teapot { superclass ::practcl::subproject method env-bootstrap {} { - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] package require $pkg } method env-install {} { - set pkg [my Config_get pkg_name [my Config_get name]] - set download [my <project> config get download] + set pkg [my define get pkg_name [my define get name]] + set download [my <project> define get download] my unpack - set prefix [string trimleft [my <project> config get prefix] /] + set prefix [string trimleft [my <project> define get prefix] /] ::practcl::tcllib_require zipfile::decode ::zipfile::decode::unzipfile [file join $download $pkg.zip] [file join $prefix lib $pkg] } method env-present {} { - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] if {[catch [list package require $pkg]]} { return 0 } return 1 } method install DEST { - set pkg [my Config_get pkg_name [my Config_get name]] - set download [my <project> config get download] + set pkg [my define get pkg_name [my define get name]] + set download [my <project> define get download] my unpack - set prefix [string trimleft [my <project> config get prefix] /] + set prefix [string trimleft [my <project> define get prefix] /] ::practcl::tcllib_require zipfile::decode ::zipfile::decode::unzipfile [file join $download $pkg.zip] [file join $DEST $prefix lib $pkg] } } @@ -197,11 +199,11 @@ method kettle {path args} { my variable kettle if {![info exists kettle]} { ::practcl::LOCAL tool kettle env-load - set kettle [file join [::practcl::LOCAL tool kettle config get srcdir] kettle] + set kettle [file join [::practcl::LOCAL tool kettle define get srcdir] kettle] } set srcdir [my SourceRoot] ::practcl::dotclexec $kettle -f [file join $srcdir build.tcl] {*}$args } @@ -212,64 +214,64 @@ ::clay::define ::practcl::subproject.critcl { superclass ::practcl::subproject method install DEST { - my critcl -pkg [my Config_get name] + my critcl -pkg [my define get name] set srcdir [my SourceRoot] - ::practcl::copyDir [file join $srcdir [my Config_get name]] [file join $DEST lib [my Config_get name]] + ::practcl::copyDir [file join $srcdir [my define get name]] [file join $DEST lib [my define get name]] } } ::clay::define ::practcl::subproject.sak { superclass ::practcl::subproject method env-bootstrap {} { - set LibraryRoot [file join [my Config_get srcdir] [my Config_get module_root modules]] + set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] if {[file exists $LibraryRoot] && $LibraryRoot ni $::auto_path} { set ::auto_path [linsert $::auto_path 0 $LibraryRoot] } } method env-install {} { ### # Handle teapot installs ### - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] my unpack - set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] - set srcdir [my Config_get srcdir] + set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] + set srcdir [my define get srcdir] ::practcl::dotclexec [file join $srcdir installer.tcl] \ -apps -app-path [file join $prefix apps] \ -html -html-path [file join $prefix doc html $pkg] \ -pkg-path [file join $prefix lib $pkg] \ -no-nroff -no-wait -no-gui } method env-present {} { - set path [my Config_get srcdir] + set path [my define get srcdir] return [file exists $path] } method install DEST { ### # Handle teapot installs ### - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] my unpack - set prefix [string trimleft [my <project> config get prefix] /] - set srcdir [my Config_get srcdir] + set prefix [string trimleft [my <project> define get prefix] /] + set srcdir [my define get srcdir] ::practcl::dotclexec [file join $srcdir installer.tcl] \ -pkg-path [file join $DEST $prefix lib $pkg] \ -no-examples -no-html -no-nroff \ -no-wait -no-gui -no-apps } method install-module {DEST args} { - set srcdir [my Config_get srcdir] + set srcdir [my define get srcdir] if {[llength $args]==1 && [lindex $args 0] in {* all}} { - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] ::practcl::dotclexec [file join $srcdir installer.tcl] \ -pkg-path [file join $DEST $pkg] \ -no-examples -no-html -no-nroff \ -no-wait -no-gui -no-apps } else { @@ -283,42 +285,42 @@ ::clay::define ::practcl::subproject.practcl { superclass ::practcl::subproject method env-bootstrap {} { - set LibraryRoot [file join [my Config_get srcdir] [my Config_get module_root modules]] + set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] if {[file exists $LibraryRoot] && $LibraryRoot ni $::auto_path} { set ::auto_path [linsert $::auto_path 0 $LibraryRoot] } } method env-install {} { ### # Handle teapot installs ### - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] my unpack - set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] - set srcdir [my Config_get srcdir] + set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] + set srcdir [my define get srcdir] ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $prefix lib $pkg] } method install DEST { ### # Handle teapot installs ### - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] my unpack - set prefix [string trimleft [my <project> config get prefix] /] - set srcdir [my Config_get srcdir] - puts [list INSTALLING [my Config_get name] to [file join $DEST $prefix lib $pkg]] + set prefix [string trimleft [my <project> define get prefix] /] + set srcdir [my define get srcdir] + puts [list INSTALLING [my define get name] to [file join $DEST $prefix lib $pkg]] ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $DEST $prefix lib $pkg] } method install-module {DEST args} { - set pkg [my Config_get pkg_name [my Config_get name]] - set srcdir [my Config_get srcdir] + set pkg [my define get pkg_name [my define get name]] + set srcdir [my define get srcdir] ::practcl::dotclexec [file join $srcdir make.tcl] install-module $DEST {*}$args } } Index: modules/practcl/build/class/subproject/binary.tcl ================================================================== --- modules/practcl/build/class/subproject/binary.tcl +++ modules/practcl/build/class/subproject/binary.tcl @@ -3,11 +3,11 @@ ### ::clay::define ::practcl::subproject.binary { superclass ::practcl::subproject method clean {} { - set builddir [file normalize [my Config_get builddir]] + set builddir [file normalize [my define get builddir]] if {![file exists $builddir]} return if {[file exists [file join $builddir make.tcl]]} { ::practcl::domake.tcl $builddir clean } else { catch {::practcl::domake $builddir clean} @@ -16,18 +16,18 @@ method env-install {} { ### # Handle tea installs ### - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] set os [::practcl::local_os] - my Config_set os $os + my define set os $os my unpack - set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] - set srcdir [my Config_get srcdir] + set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] + set srcdir [my define get srcdir] lappend options --prefix $prefix --exec-prefix $prefix - my Config_set config_opts $options + my define set config_opts $options my go my clean my compile my make install {} } @@ -34,28 +34,28 @@ method project-compile-products {} {} method ComputeInstall {} { if {[my define exists install]} { - switch [my Config_get install] { + switch [my define get install] { static { - my Config_set static 1 - my Config_set autoload 0 + my define set static 1 + my define set autoload 0 } static-autoload { - my Config_set static 1 - my Config_set autoload 1 + my define set static 1 + my define set autoload 1 } vfs { - my Config_set static 0 - my Config_set autoload 0 - my Config_set vfsinstall 1 + my define set static 0 + my define set autoload 0 + my define set vfsinstall 1 } null { - my Config_set static 0 - my Config_set autoload 0 - my Config_set vfsinstall 0 + my define set static 0 + my define set autoload 0 + my define set vfsinstall 0 } default { } } @@ -64,48 +64,48 @@ method go {} { next ::practcl::distribution select [self] my ComputeInstall - my Config_set builddir [my BuildDir [my Config_get masterpath]] + my define set builddir [my BuildDir [my define get masterpath]] } method linker-products {configdict} { - if {![my Config_get static 0]} { + if {![my define get static 0]} { return {} } - set srcdir [my Config_get builddir] + set srcdir [my define get builddir] if {[dict exists $configdict libfile]} { return " [file join $srcdir [dict get $configdict libfile]]" } } method project-static-packages {} { - if {![my Config_get static 0]} { + if {![my define get static 0]} { return {} } - set result [my Config_get static_packages] - set statpkg [my Config_get static_pkg] - set initfunc [my Config_get initfunc] + set result [my define get static_packages] + set statpkg [my define get static_pkg] + set initfunc [my define get initfunc] if {$initfunc ne {}} { - set pkg_name [my Config_get pkg_name] + set pkg_name [my define get pkg_name] if {$pkg_name ne {}} { dict set result $pkg_name initfunc $initfunc - set version [my Config_get version] + set version [my define get version] if {$version eq {}} { my unpack set info [my read_configuration] set version [dict get $info version] set pl {} if {[dict exists $info patch_level]} { set pl [dict get $info patch_level] append version $pl } - my Config_set version $version + my define set version $version } dict set result $pkg_name version $version - dict set result $pkg_name autoload [my Config_get autoload 0] + dict set result $pkg_name autoload [my define get autoload 0] } } foreach item [my link list subordinate] { foreach {pkg info} [$item project-static-packages] { dict set result $pkg $info @@ -113,36 +113,36 @@ } return $result } method BuildDir {PWD} { - set name [my Config_get name] - set debug [my Config_get debug 0] - if {[my <project> config get LOCAL 0]} { - return [my Config_get builddir [file join $PWD local $name]] + set name [my define get name] + set debug [my define get debug 0] + if {[my <project> define get LOCAL 0]} { + return [my define get builddir [file join $PWD local $name]] } if {$debug} { - return [my Config_get builddir [file join $PWD debug $name]] + return [my define get builddir [file join $PWD debug $name]] } else { - return [my Config_get builddir [file join $PWD pkg $name]] + return [my define get builddir [file join $PWD pkg $name]] } } method compile {} { - set name [my Config_get name] + set name [my define get name] set PWD $::CWD cd $PWD my unpack set srcdir [file normalize [my SrcDir]] set localsrcdir [my MakeDir $srcdir] - my Config_set localsrcdir $localsrcdir + my define set localsrcdir $localsrcdir my Collate_Source $PWD ### # Build a starter VFS for both Tcl and wish ### - set srcdir [my Config_get srcdir] - if {[my Config_get static 1]} { + set srcdir [my define get srcdir] + if {[my define get static 1]} { puts "BUILDING Static $name $srcdir" } else { puts "BUILDING Dynamic $name $srcdir" } my make compile @@ -151,27 +151,27 @@ method Configure {} { cd $::CWD my unpack ::practcl::toolset select [self] - set srcdir [file normalize [my Config_get srcdir]] - set builddir [file normalize [my Config_get builddir]] + set srcdir [file normalize [my define get srcdir]] + set builddir [file normalize [my define get builddir]] file mkdir $builddir my make autodetect } method install DEST { set PWD [pwd] - set PREFIX [my <project> config get prefix] + set PREFIX [my <project> define get prefix] ### # Handle teapot installs ### - set pkg [my Config_get pkg_name [my Config_get name]] - if {[my <project> config get teapot] ne {}} { - set TEAPOT [my <project> config get teapot] + set pkg [my define get pkg_name [my define get name]] + if {[my <project> define get teapot] ne {}} { + set TEAPOT [my <project> define get teapot] set found 0 - foreach ver [my Config_get pkg_vers [my Config_get version]] { + foreach ver [my define get pkg_vers [my define get version]] { set teapath [file join $TEAPOT $pkg$ver] if {[file exists $teapath]} { set dest [file join $DEST [string trimleft $PREFIX /] lib [file tail $teapath]] ::practcl::copyDir $teapath $dest return Index: modules/practcl/build/class/subproject/core.tcl ================================================================== --- modules/practcl/build/class/subproject/core.tcl +++ modules/practcl/build/class/subproject/core.tcl @@ -3,31 +3,31 @@ superclass ::practcl::subproject.binary method env-bootstrap {} {} method env-present {} { - set PREFIX [my <project> config get prefix] - set name [my Config_get name] + set PREFIX [my <project> define get prefix] + set name [my define get name] set fname [file join $PREFIX lib ${name}Config.sh] return [file exists $fname] } method env-install {} { my unpack set os [::practcl::local_os] - set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] lappend options --prefix $prefix --exec-prefix $prefix - my Config_set config_opts $options + my define set config_opts $options puts [list [self] OS [dict get $os TEACUP_OS] options $options] my go my compile my make install {} } method go {} { - my Config_set core_binary 1 + my define set core_binary 1 next } method linktype {} { return {subordinate core.library} Index: modules/practcl/build/class/target.tcl ================================================================== --- modules/practcl/build/class/target.tcl +++ modules/practcl/build/class/target.tcl @@ -7,19 +7,20 @@ constructor {module_object name info {action_body {}}} { my variable define triggered domake set triggered 0 set domake 0 - my Config_set name $name action {} - my Config_merge $info + set define(name) $name + set define(action) {} + array set define $info my select my initialize foreach {stub obj} [$module_object child organs] { my graft $stub $obj } if {$action_body ne {}} { - my Config_set action $action_body + set define(action) $action_body } } method do {} { my variable domake @@ -34,11 +35,11 @@ if {[info exists needs_make]} { return $needs_make } set make_objects [my <module> make objects] set needs_make 0 - foreach item [my Config_get depends] { + foreach item [my define get depends] { if {![dict exists $make_objects $item]} continue set depobj [dict get $make_objects $item] if {$depobj eq [self]} { puts "WARNING [self] depends on itself" continue @@ -57,15 +58,15 @@ return $needs_make } method output {} { set result {} - set filename [my Config_get filename] + set filename [my define get filename] if {$filename ne {}} { lappend result $filename } - foreach filename [my Config_get files] { + foreach filename [my define get files] { if {$filename ne {}} { lappend result $filename } } return $result @@ -84,11 +85,11 @@ return $domake } set triggered 1 set make_objects [my <module> make objects] - foreach item [my Config_get depends] { + foreach item [my define get depends] { if {![dict exists $make_objects $item]} continue set depobj [dict get $make_objects $item] if {$depobj eq [self]} { puts "WARNING [self] triggers itself" continue @@ -98,8 +99,8 @@ $depobj triggers } } } set domake 1 - my <module> make trigger {*}[my Config_get triggers] + my <module> make trigger {*}[my define get triggers] } } Index: modules/practcl/build/class/tool.tcl ================================================================== --- modules/practcl/build/class/tool.tcl +++ modules/practcl/build/class/tool.tcl @@ -4,12 +4,12 @@ set ::practcl::MAIN ::practcl::LOCAL # Defer the creation of the ::practcl::LOCAL object until it is called # in order to allow packages to set ::auto_index(::practcl::LOCAL) { ::practcl::project create ::practcl::LOCAL - ::practcl::LOCAL config set [::practcl::local_os] - ::practcl::LOCAL config set LOCAL 1 + ::practcl::LOCAL define set [::practcl::local_os] + ::practcl::LOCAL define set LOCAL 1 # Until something better comes along, use ::practcl::LOCAL # as our main project # Add tclconfig as a project of record ::practcl::LOCAL add_tool tclconfig { @@ -34,12 +34,12 @@ method env-bootstrap {} { package require critcl::app } method env-install {} { my unpack - set prefix [my <project> config get prefix [file join [file normalize ~] tcl]] - set srcdir [my Config_get srcdir] + set prefix [my <project> define get prefix [file join [file normalize ~] tcl]] + set srcdir [my define get srcdir] ::practcl::dotclexec [file join $srcdir build.tcl] install [file join $prefix lib] } } ::practcl::LOCAL add_tool odie { tag trunk class subproject.source Index: modules/practcl/build/class/toolset/baseclass.tcl ================================================================== --- modules/practcl/build/class/toolset/baseclass.tcl +++ modules/practcl/build/class/toolset/baseclass.tcl @@ -11,19 +11,19 @@ return [my read_configuration] } # Compute the location where the product will be built method BuildDir {PWD} { - set name [my Config_get name] - set debug [my Config_get debug 0] - if {[my <project> config get LOCAL 0]} { - return [my Config_get builddir [file join $PWD local $name]] + set name [my define get name] + set debug [my define get debug 0] + if {[my <project> define get LOCAL 0]} { + return [my define get builddir [file join $PWD local $name]] } if {$debug} { - return [my Config_get builddir [file join $PWD debug $name]] + return [my define get builddir [file join $PWD debug $name]] } else { - return [my Config_get builddir [file join $PWD pkg $name]] + return [my define get builddir [file join $PWD pkg $name]] } } # Return where the Makefile is located relative to [emph srcdir]. # For this implementation the MakeDir is always srcdir. @@ -42,15 +42,15 @@ my variable conf_result if {[info exists conf_result]} { return $conf_result } set result {} - set name [my Config_get name] + set name [my define get name] set PWD $::CWD - set builddir [my Config_get builddir] + set builddir [my define get builddir] my unpack - set srcdir [my Config_get srcdir] + set srcdir [my define get srcdir] if {![file exists $builddir]} { my Configure } set filename [file join $builddir config.tcl] # Project uses the practcl template. Use the leavings from autoconf @@ -111,13 +111,13 @@ # defs - C flags passed to the compiler # includedir - A list of paths to feed to the compiler for finding headers # method build-cflags {PROJECT DEFS namevar versionvar defsvar} { upvar 1 $namevar name $versionvar version NAME NAME $defsvar defs - set name [string tolower [${PROJECT} config get name [${PROJECT} config get pkg_name]]] + set name [string tolower [${PROJECT} define get name [${PROJECT} define get pkg_name]]] set NAME [string toupper $name] - set version [${PROJECT} config get version [${PROJECT} config get pkg_vers]] + set version [${PROJECT} define get version [${PROJECT} define get pkg_vers]] if {$version eq {}} { set version 0.1a } set defs $DEFS foreach flag { @@ -140,11 +140,11 @@ # Invoke critcl in an external process method critcl args { if {![info exists critcl]} { ::practcl::LOCAL tool critcl env-load - set critcl [file join [::practcl::LOCAL tool critcl config get srcdir] main.tcl + set critcl [file join [::practcl::LOCAL tool critcl define get srcdir] main.tcl } set srcdir [my SourceRoot] set PWD [pwd] cd $srcdir ::practcl::dotclexec $critcl {*}$args @@ -157,13 +157,13 @@ method select object { ### # Select the toolset to use for this project ### if {[$object define exists toolset]} { - return [$object config get toolset] + return [$object define get toolset] } - set class [$object config get toolset] + set class [$object define get toolset] if {$class ne {}} { $object clay mixinmap toolset $class } else { if {[info exists ::env(VisualStudioVersion)]} { $object clay mixinmap toolset ::practcl::toolset.msvc Index: modules/practcl/build/class/toolset/gcc.tcl ================================================================== --- modules/practcl/build/class/toolset/gcc.tcl +++ modules/practcl/build/class/toolset/gcc.tcl @@ -6,11 +6,11 @@ ### # Re-run autoconf for this project # Not a good idea in practice... but in the right hands it can be useful ### set pwd [pwd] - set srcdir [file normalize [my Config_get srcdir]] + set srcdir [file normalize [my define get srcdir]] set localsrcdir [my MakeDir $srcdir] cd $localsrcdir foreach template {configure.ac configure.in} { set input [file join $srcdir $template] if {[file exists $input]} { @@ -20,94 +20,94 @@ } cd $pwd } method BuildDir {PWD} { - set name [my Config_get name] - set debug [my Config_get debug 0] - if {[my <project> config get LOCAL 0]} { - return [my Config_get builddir [file join $PWD local $name]] + set name [my define get name] + set debug [my define get debug 0] + if {[my <project> define get LOCAL 0]} { + return [my define get builddir [file join $PWD local $name]] } if {$debug} { - return [my Config_get builddir [file join $PWD debug $name]] + return [my define get builddir [file join $PWD debug $name]] } else { - return [my Config_get builddir [file join $PWD pkg $name]] + return [my define get builddir [file join $PWD pkg $name]] } } method ConfigureOpts {} { set opts {} - set builddir [my Config_get builddir] + set builddir [my define get builddir] - if {[my Config_get broken_destroot 0]} { - set PREFIX [my <project> config get prefix_broken_destdir] + if {[my define get broken_destroot 0]} { + set PREFIX [my <project> define get prefix_broken_destdir] } else { - set PREFIX [my <project> config get prefix] + set PREFIX [my <project> define get prefix] } - switch [my Config_get name] { + switch [my define get name] { tcl { - set opts [::practcl::platform::tcl_core_options [my <project> config get TEACUP_OS]] + set opts [::practcl::platform::tcl_core_options [my <project> define get TEACUP_OS]] } tk { - set opts [::practcl::platform::tk_core_options [my <project> config get TEACUP_OS]] + set opts [::practcl::platform::tk_core_options [my <project> define get TEACUP_OS]] } } - if {[my <project> config get CONFIG_SITE] != {}} { - lappend opts --host=[my <project> config get HOST] + if {[my <project> define get CONFIG_SITE] != {}} { + lappend opts --host=[my <project> define get HOST] } - set inside_msys [string is true -strict [my <project> config get MSYS_ENV 0]] + set inside_msys [string is true -strict [my <project> define get MSYS_ENV 0]] lappend opts --with-tclsh=[info nameofexecutable] - if {[my Config_get tk 0]} { - if {![my <project> config get LOCAL 0]} { + if {[my define get tk 0]} { + if {![my <project> define get LOCAL 0]} { set obj [my <project> tclcore] if {$obj ne {}} { if {$inside_msys} { - lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] + lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj define get builddir]] } else { - lappend opts --with-tcl=[file normalize [$obj config get builddir]] + lappend opts --with-tcl=[file normalize [$obj define get builddir]] } } set obj [my <project> tkcore] if {$obj ne {}} { if {$inside_msys} { - lappend opts --with-tk=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] + lappend opts --with-tk=[::practcl::file_relative [file normalize $builddir] [$obj define get builddir]] } else { - lappend opts --with-tk=[file normalize [$obj config get builddir]] + lappend opts --with-tk=[file normalize [$obj define get builddir]] } } } else { lappend opts --with-tcl=[file join $PREFIX lib] lappend opts --with-tk=[file join $PREFIX lib] } } else { - if {![my <project> config get LOCAL 0]} { + if {![my <project> define get LOCAL 0]} { set obj [my <project> tclcore] if {$obj ne {}} { if {$inside_msys} { - lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] + lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj define get builddir]] } else { - lappend opts --with-tcl=[file normalize [$obj config get builddir]] + lappend opts --with-tcl=[file normalize [$obj define get builddir]] } } } else { lappend opts --with-tcl=[file join $PREFIX lib] } } - lappend opts {*}[my Config_get config_opts] + lappend opts {*}[my define get config_opts] if {![regexp -- "--prefix" $opts]} { lappend opts --prefix=$PREFIX --exec-prefix=$PREFIX } - if {[my Config_get debug 0]} { + if {[my define get debug 0]} { lappend opts --enable-symbols=true } #--exec_prefix=$PREFIX #if {$::tcl_platform(platform) eq "windows"} { # lappend opts --disable-64bit #} - if {[my Config_get static 1]} { + if {[my define get static 1]} { lappend opts --disable-shared #--disable-stubs # } else { lappend opts --enable-shared @@ -117,17 +117,17 @@ # Detect what directory contains the Makefile template method MakeDir {srcdir} { set localsrcdir $srcdir if {[file exists [file join $srcdir generic]]} { - my Config_add include_dir [file join $srcdir generic] + my define add include_dir [file join $srcdir generic] } - set os [my <project> config get TEACUP_OS] + set os [my <project> define get TEACUP_OS] switch $os { windows { if {[file exists [file join $srcdir win]]} { - my Config_add include_dir [file join $srcdir win] + my define add include_dir [file join $srcdir win] } if {[file exists [file join $srcdir win Makefile.in]]} { set localsrcdir [file join $srcdir win] } } @@ -136,14 +136,14 @@ set localsrcdir [file join $srcdir unix] } } default { if {[file exists [file join $srcdir $os]]} { - my Config_add include_dir [file join $srcdir $os] + my define add include_dir [file join $srcdir $os] } if {[file exists [file join $srcdir unix]]} { - my Config_add include_dir [file join $srcdir unix] + my define add include_dir [file join $srcdir unix] } if {[file exists [file join $srcdir $os Makefile.in]]} { set localsrcdir [file join $srcdir $os] } elseif {[file exists [file join $srcdir unix Makefile.in]]} { set localsrcdir [file join $srcdir unix] @@ -152,11 +152,11 @@ } return $localsrcdir } Ensemble make::autodetect {} { - set srcdir [my Config_get srcdir] + set srcdir [my define get srcdir] set localsrcdir [my MakeDir $srcdir] if {$localsrcdir eq {}} { set localsrcdir $srcdir } if {$srcdir eq $localsrcdir} { @@ -166,20 +166,20 @@ if {[file exists [file join $srcdir .. tclconfig install-sh]]} { set teapath [file join $srcdir .. tclconfig] } else { set tclConfigObj [::practcl::LOCAL tool tclconfig] $tclConfigObj load - set teapath [$tclConfigObj config get srcdir] + set teapath [$tclConfigObj define get srcdir] } set teapath [file normalize $teapath] #file mkdir [file join $srcdir tclconfig] if {[catch {file link -symbolic [file join $srcdir tclconfig] $teapath}]} { ::practcl::copyDir [file join $teapath] [file join $srcdir tclconfig] } } } - set builddir [my Config_get builddir] + set builddir [my define get builddir] file mkdir $builddir if {![file exists [file join $localsrcdir configure]]} { if {[file exists [file join $localsrcdir autogen.sh]]} { cd $localsrcdir catch {exec sh autogen.sh >>& [file join $builddir autoconf.log]} @@ -188,41 +188,41 @@ } set opts [my ConfigureOpts] if {[file exists [file join $builddir autoconf.log]]} { file delete [file join $builddir autoconf.log] } - ::practcl::debug [list PKG [my Config_get name] CONFIGURE {*}$opts] + ::practcl::debug [list PKG [my define get name] CONFIGURE {*}$opts] ::practcl::log [file join $builddir autoconf.log] [list CONFIGURE {*}$opts] cd $builddir - if {[my <project> config get CONFIG_SITE] ne {}} { - set ::env(CONFIG_SITE) [my <project> config get CONFIG_SITE] + if {[my <project> define get CONFIG_SITE] ne {}} { + set ::env(CONFIG_SITE) [my <project> define get CONFIG_SITE] } catch {exec sh [file join $localsrcdir configure] {*}$opts >>& [file join $builddir autoconf.log]} cd $::CWD } Ensemble make::clean {} { - set builddir [file normalize [my Config_get builddir]] + set builddir [file normalize [my define get builddir]] catch {::practcl::domake $builddir clean} } Ensemble make::compile {} { - set name [my Config_get name] - set srcdir [my Config_get srcdir] - if {[my Config_get static 1]} { + set name [my define get name] + set srcdir [my define get srcdir] + if {[my define get static 1]} { puts "BUILDING Static $name $srcdir" } else { puts "BUILDING Dynamic $name $srcdir" } cd $::CWD - set builddir [file normalize [my Config_get builddir]] + set builddir [file normalize [my define get builddir]] file mkdir $builddir if {![file exists [file join $builddir Makefile]]} { my Configure } if {[file exists [file join $builddir make.tcl]]} { - if {[my Config_get debug 0]} { + if {[my define get debug 0]} { ::practcl::domake.tcl $builddir debug all } else { ::practcl::domake.tcl $builddir all } } else { @@ -230,34 +230,34 @@ } } Ensemble make::install DEST { set PWD [pwd] - set builddir [my Config_get builddir] - if {[my <project> config get LOCAL 0] || $DEST eq {}} { + set builddir [my define get builddir] + if {[my <project> define get LOCAL 0] || $DEST eq {}} { if {[file exists [file join $builddir make.tcl]]} { puts "[self] Local INSTALL (Practcl)" ::practcl::domake.tcl $builddir install - } elseif {[my Config_get broken_destroot 0] == 0} { + } elseif {[my define get broken_destroot 0] == 0} { puts "[self] Local INSTALL (TEA)" ::practcl::domake $builddir install } } else { if {[file exists [file join $builddir make.tcl]]} { # Practcl builds can inject right to where we need them puts "[self] VFS INSTALL $DEST (Practcl)" ::practcl::domake.tcl $builddir install-package $DEST - } elseif {[my Config_get broken_destroot 0] == 0} { + } elseif {[my define get broken_destroot 0] == 0} { # Most modern TEA projects understand DESTROOT in the makefile puts "[self] VFS INSTALL $DEST (TEA)" ::practcl::domake $builddir install DESTDIR=[::practcl::file_relative $builddir $DEST] } else { # But some require us to do an install into a fictitious filesystem # and then extract the gooey parts within. # (*cough*) TkImg - set PREFIX [my <project> config get prefix] - set BROKENROOT [::practcl::msys_to_tclpath [my <project> config get prefix_broken_destdir]] + set PREFIX [my <project> define get prefix] + set BROKENROOT [::practcl::msys_to_tclpath [my <project> define get prefix_broken_destdir]] file delete -force $BROKENROOT file mkdir $BROKENROOT ::practcl::domake $builddir $install ::practcl::copyDir $BROKENROOT [file join $DEST [string trimleft $PREFIX /]] file delete -force $BROKENROOT @@ -265,17 +265,17 @@ } cd $PWD } method build-compile-sources {PROJECT COMPILE CPPCOMPILE INCLUDES} { - set objext [my Config_get OBJEXT o] + set objext [my define get OBJEXT o] set EXTERN_OBJS {} set OBJECTS {} set result {} - set builddir [$PROJECT config get builddir] + set builddir [$PROJECT define get builddir] file mkdir [file join $builddir objs] - set debug [$PROJECT config get debug 0] + set debug [$PROJECT define get debug 0] set task {} ### # Compile the C sources ### @@ -362,15 +362,15 @@ } return $result } method build-Makefile {path PROJECT} { - array set proj [$PROJECT config dump] + array set proj [$PROJECT define dump] set path $proj(builddir) cd $path set includedir . - set objext [my Config_get OBJEXT o] + set objext [my define get OBJEXT o] #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)] lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]] lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]] foreach include [$PROJECT toolset-include-directory] { @@ -417,72 +417,72 @@ set map {} lappend map %LIBRARY_NAME% $proj(name) lappend map %LIBRARY_VERSION% $proj(version) lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)] - lappend map %LIBRARY_PREFIX% [$PROJECT config get libprefix] + lappend map %LIBRARY_PREFIX% [$PROJECT define getnull libprefix] - if {[string is true [$PROJECT config get SHARED_BUILD]]} { - set outfile [$PROJECT config get libfile] + if {[string is true [$PROJECT define get SHARED_BUILD]]} { + set outfile [$PROJECT define get libfile] } else { set outfile [$PROJECT shared_library] } - $PROJECT config set shared_library $outfile + $PROJECT define set shared_library $outfile ::practcl::cputs result " ${NAME}_SHLIB = $outfile ${NAME}_OBJS = [dict keys $products] " #lappend map %OUTFILE% {\[$]@} lappend map %OUTFILE% $outfile lappend map %LIBRARY_OBJECTS% "\$(${NAME}_OBJS)" ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" - ::practcl::cputs result "\t[string map $map [$PROJECT config get PRACTCL_SHARED_LIB]]" - if {[$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { - ::practcl::cputs result "\t[string map $map [$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL]]" + ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_SHARED_LIB]]" + if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { + ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]]" } ::practcl::cputs result {} - if {[string is true [$PROJECT config get SHARED_BUILD]]} { + if {[string is true [$PROJECT define get SHARED_BUILD]]} { #set outfile [$PROJECT static_library] set outfile $proj(name).a } else { - set outfile [$PROJECT config get libfile] + set outfile [$PROJECT define get libfile] } - $PROJECT config set static_library $outfile + $PROJECT define set static_library $outfile dict set map %OUTFILE% $outfile ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" - ::practcl::cputs result "\t[string map $map [$PROJECT config get PRACTCL_STATIC_LIB]]" + ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_STATIC_LIB]]" ::practcl::cputs result {} return $result } ### # Produce a static or dynamic library ### method build-library {outfile PROJECT} { - array set proj [$PROJECT config dump] + array set proj [$PROJECT define dump] set path $proj(builddir) cd $path set includedir . #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)] lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]] - if {[$PROJECT config get TEA_PRIVATE_TCL_HEADERS 0]} { - if {[$PROJECT config get TEA_PLATFORM] eq "windows"} { + if {[$PROJECT define get TEA_PRIVATE_TCL_HEADERS 0]} { + if {[$PROJECT define get TEA_PLATFORM] eq "windows"} { lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) win]]] } else { lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) unix]]] } } lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]] - if {[$PROJECT config get tk 0]} { + if {[$PROJECT define get tk 0]} { lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) generic]]] lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) ttk]]] lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) xlib]]] - if {[$PROJECT config get TEA_PRIVATE_TK_HEADERS 0]} { - if {[$PROJECT config get TEA_PLATFORM] eq "windows"} { + if {[$PROJECT define get TEA_PRIVATE_TK_HEADERS 0]} { + if {[$PROJECT define get TEA_PLATFORM] eq "windows"} { lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) win]]] } else { lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) unix]]] } } @@ -494,12 +494,12 @@ lappend includedir $cpath } } my build-cflags $PROJECT $proj(DEFS) name version defs set NAME [string toupper $name] - set debug [$PROJECT config get debug 0] - set os [$PROJECT config get TEACUP_OS] + set debug [$PROJECT define get debug 0] + set os [$PROJECT define get TEACUP_OS] set INCLUDES "-I[join $includedir " -I"]" if {$debug} { set COMPILE "$proj(CC) $proj(CFLAGS_DEBUG) -ggdb \ $proj(CFLAGS_WARNING) $INCLUDES $defs" @@ -528,65 +528,65 @@ lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)] lappend map %OUTFILE% $outfile lappend map %LIBRARY_OBJECTS% $products lappend map {${CFLAGS}} "$proj(CFLAGS_DEFAULT) $proj(CFLAGS_WARNING)" - if {[string is true [$PROJECT config get SHARED_BUILD 1]]} { - set cmd [$PROJECT config get PRACTCL_SHARED_LIB] - append cmd " [$PROJECT config get PRACTCL_LIBS]" + if {[string is true [$PROJECT define get SHARED_BUILD 1]]} { + set cmd [$PROJECT define get PRACTCL_SHARED_LIB] + append cmd " [$PROJECT define get PRACTCL_LIBS]" set cmd [string map $map $cmd] puts $cmd exec {*}$cmd >&@ stdout - if {[$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { - set cmd [string map $map [$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL]] + if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { + set cmd [string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]] puts $cmd exec {*}$cmd >&@ stdout } } else { - set cmd [string map $map [$PROJECT config get PRACTCL_STATIC_LIB]] + set cmd [string map $map [$PROJECT define get PRACTCL_STATIC_LIB]] puts $cmd exec {*}$cmd >&@ stdout } - set ranlib [$PROJECT config get RANLIB] + set ranlib [$PROJECT define get RANLIB] if {$ranlib ni {{} :}} { catch {exec $ranlib $outfile} } } ### # Produce a static executable ### method build-tclsh {outfile PROJECT {path {auto}}} { - if {[my Config_get tk 0] && [my Config_get static_tk 0]} { + if {[my define get tk 0] && [my define get static_tk 0]} { puts " BUILDING STATIC TCL/TK EXE $PROJECT" set TKOBJ [$PROJECT tkcore] if {[info command $TKOBJ] eq {}} { set TKOBJ ::noop - $PROJECT config set static_tk 0 + $PROJECT define set static_tk 0 } else { ::practcl::toolset select $TKOBJ array set TK [$TKOBJ read_configuration] - set do_tk [$TKOBJ config get static] - $PROJECT config set static_tk $do_tk - $PROJECT config set tk $do_tk - set TKSRCDIR [$TKOBJ config get srcdir] + set do_tk [$TKOBJ define get static] + $PROJECT define set static_tk $do_tk + $PROJECT define set tk $do_tk + set TKSRCDIR [$TKOBJ define get srcdir] } } else { puts " BUILDING STATIC TCL EXE $PROJECT" set TKOBJ ::noop - my Config_set static_tk 0 + my define set static_tk 0 } set TCLOBJ [$PROJECT tclcore] ::practcl::toolset select $TCLOBJ set PKG_OBJS {} foreach item [$PROJECT link list core.library] { - if {[string is true [$item config get static]]} { + if {[string is true [$item define get static]]} { lappend PKG_OBJS $item } } foreach item [$PROJECT link list package] { - if {[string is true [$item config get static]]} { + if {[string is true [$item define get static]]} { lappend PKG_OBJS $item } } array set TCL [$TCLOBJ read_configuration] if {$path in {{} auto}} { @@ -601,11 +601,11 @@ # with the same DEFS flags as the tcl core was compiled with. # The DEFS produced by a TEA extension aren't intended to operate # with the internals of a staticly linked Tcl ### my build-cflags $PROJECT $TCL(defs) name version defs - set debug [$PROJECT config get debug 0] + set debug [$PROJECT define get debug 0] set NAME [string toupper $name] set result {} set libraries {} set thisline {} set OBJECTS {} @@ -612,22 +612,22 @@ set EXTERN_OBJS {} foreach obj $PKG_OBJS { $obj compile set config($obj) [$obj read_configuration] } - set os [$PROJECT config get TEACUP_OS] - set TCLSRCDIR [$TCLOBJ config get srcdir] + set os [$PROJECT define get TEACUP_OS] + set TCLSRCDIR [$TCLOBJ define get srcdir] set includedir . foreach include [$TCLOBJ toolset-include-directory] { set cpath [::practcl::file_relative $path [file normalize $include]] if {$cpath ni $includedir} { lappend includedir $cpath } } lappend includedir [::practcl::file_relative $path [file normalize ../tcl/compat/zlib]] - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { lappend includedir [::practcl::file_relative $path [file normalize [file join $TKSRCDIR generic]]] lappend includedir [::practcl::file_relative $path [file normalize [file join $TKSRCDIR ttk]]] lappend includedir [::practcl::file_relative $path [file normalize [file join $TKSRCDIR xlib]]] lappend includedir [::practcl::file_relative $path [file normalize $TKSRCDIR]] } @@ -650,24 +650,24 @@ append COMPILE " " $defs lappend OBJECTS {*}[my build-compile-sources $PROJECT $COMPILE $COMPILE $INCLUDES] set TCLSRC [file normalize $TCLSRCDIR] - if {[${PROJECT} config get TEACUP_OS] eq "windows"} { - set windres [$PROJECT config get RC windres] + if {[${PROJECT} define get TEACUP_OS] eq "windows"} { + set windres [$PROJECT define get RC windres] set RSOBJ [file join $path objs tclkit.res.o] - set RCSRC [${PROJECT} config get kit_resource_file] - set RCMAN [${PROJECT} config get kit_manifest_file] - set RCICO [${PROJECT} config get kit_icon_file] + set RCSRC [${PROJECT} define get kit_resource_file] + set RCMAN [${PROJECT} define get kit_manifest_file] + set RCICO [${PROJECT} define get kit_icon_file] set cmd [list $windres -o $RSOBJ -DSTATIC_BUILD --include [::practcl::file_relative $path [file join $TCLSRC generic]]] - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { if {$RCSRC eq {} || ![file exists $RCSRC]} { set RCSRC [file join $TKSRCDIR win rc wish.rc] } if {$RCMAN eq {} || ![file exists $RCMAN]} { - set RCMAN [file join [$TKOBJ config get builddir] wish.exe.manifest] + set RCMAN [file join [$TKOBJ define get builddir] wish.exe.manifest] } if {$RCICO eq {} || ![file exists $RCICO]} { set RCICO [file join $TKSRCDIR win rc wish.ico] } set TKSRC [file normalize $TKSRCDIR] @@ -677,17 +677,17 @@ } else { if {$RCSRC eq {} || ![file exists $RCSRC]} { set RCSRC [file join $TCLSRCDIR win tclsh.rc] } if {$RCMAN eq {} || ![file exists $RCMAN]} { - set RCMAN [file join [$TCLOBJ config get builddir] tclsh.exe.manifest] + set RCMAN [file join [$TCLOBJ define get builddir] tclsh.exe.manifest] } if {$RCICO eq {} || ![file exists $RCICO]} { set RCICO [file join $TCLSRCDIR win tclsh.ico] } } - foreach item [${PROJECT} config get resource_include] { + foreach item [${PROJECT} define get resource_include] { lappend cmd --include [::practcl::file_relative $path [file normalize $item]] } lappend cmd [file tail $RCSRC] if {![file exists [file join $path [file tail $RCSRC]]]} { file copy -force $RCSRC [file join $path [file tail $RCSRC]] @@ -721,16 +721,16 @@ ### # There is bug in the core's autoconf and the value for # tcl_build_lib_spec does not have the 'g' suffix ### append cmd " -L[file dirname $TCL(build_stub_lib_path)] -ltcl86g" - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { append cmd " -L[file dirname $TK(build_stub_lib_path)] -ltk86g" } } else { append cmd " $TCL(build_lib_spec)" - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { append cmd " $TK(build_lib_spec)" } } foreach obj $PKG_OBJS { append cmd " [$obj linker-products $config($obj)]" @@ -738,11 +738,11 @@ set LIBS {} foreach item $TCL(libs) { if {[string range $item 0 1] eq "-l" && $item in $LIBS } continue lappend LIBS $item } - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { foreach item $TK(libs) { if {[string range $item 0 1] eq "-l" && $item in $LIBS } continue lappend LIBS $item } } @@ -767,16 +767,16 @@ append cmd $item } } if {$debug && $os eq "windows"} { append cmd " -L[file dirname $TCL(build_stub_lib_path)] ${TCL(stub_lib_flag)}" - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { append cmd " -L[file dirname $TK(build_stub_lib_path)] ${TK(stub_lib_flag)}" } } else { append cmd " $TCL(build_stub_lib_spec)" - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { append cmd " $TK(build_stub_lib_spec)" } } if {[info exists TCL(cc_search_flags)]} { append cmd " $TCL(cc_search_flags)" Index: modules/practcl/build/class/toolset/msvc.tcl ================================================================== --- modules/practcl/build/class/toolset/msvc.tcl +++ modules/practcl/build/class/toolset/msvc.tcl @@ -1,11 +1,11 @@ ::clay::define ::practcl::toolset.msvc { superclass ::practcl::toolset # MSVC always builds in the source directory method BuildDir {PWD} { - set srcdir [my Config_get srcdir] + set srcdir [my define get srcdir] return $srcdir } # Do nothing @@ -12,50 +12,50 @@ Ensemble make::autodetect {} { } Ensemble make::clean {} { set PWD [pwd] - set srcdir [my Config_get srcdir] + set srcdir [my define get srcdir] cd $srcdir catch {::practcl::doexec nmake -f makefile.vc clean} cd $PWD } Ensemble make::compile {} { - set srcdir [my Config_get srcdir] - if {[my Config_get static 1]} { + set srcdir [my define get srcdir] + if {[my define get static 1]} { puts "BUILDING Static $name $srcdir" } else { puts "BUILDING Dynamic $name $srcdir" } cd $srcdir if {[file exists [file join $srcdir make.tcl]]} { - if {[my Config_get debug 0]} { + if {[my define get debug 0]} { ::practcl::domake.tcl $srcdir debug all } else { ::practcl::domake.tcl $srcdir all } } else { if {[file exists [file join $srcdir makefile.vc]]} { - ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> config get installdir] {*}[my NmakeOpts] release + ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> define get installdir] {*}[my NmakeOpts] release } elseif {[file exists [file join $srcdir win makefile.vc]]} { cd [file join $srcdir win] - ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> config get installdir] {*}[my NmakeOpts] release + ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> define get installdir] {*}[my NmakeOpts] release } else { error "No make.tcl or makefile.vc found for project $name" } } } Ensemble make::install DEST { set PWD [pwd] - set srcdir [my Config_get srcdir] + set srcdir [my define get srcdir] cd $srcdir if {$DEST eq {}} { error "No destination given" } - if {[my <project> config get LOCAL 0] || $DEST eq {}} { + if {[my <project> define get LOCAL 0] || $DEST eq {}} { if {[file exists [file join $srcdir make.tcl]]} { # Practcl builds can inject right to where we need them puts "[self] Local Install (Practcl)" ::practcl::domake.tcl $srcdir install } else { @@ -77,39 +77,39 @@ # Detect what directory contains the Makefile template method MakeDir {srcdir} { set localsrcdir $srcdir if {[file exists [file join $srcdir generic]]} { - my Config_add include_dir [file join $srcdir generic] + my define add include_dir [file join $srcdir generic] } if {[file exists [file join $srcdir win]]} { - my Config_add include_dir [file join $srcdir win] + my define add include_dir [file join $srcdir win] } if {[file exists [file join $srcdir makefile.vc]]} { set localsrcdir [file join $srcdir win] } return $localsrcdir } method NmakeOpts {} { set opts {} - set builddir [file normalize [my Config_get builddir]] + set builddir [file normalize [my define get builddir]] if {[my <project> define exists tclsrcdir]} { ### # On Windows we are probably running under MSYS, which doesn't deal with # spaces in filename well ### - set TCLSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> config get tclsrcdir] ..]]] - set TCLGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> config get tclsrcdir] .. generic]]] + set TCLSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tclsrcdir] ..]]] + set TCLGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tclsrcdir] .. generic]]] lappend opts TCLDIR=[file normalize $TCLSRCDIR] #--with-tclinclude=$TCLGENERIC } if {[my <project> define exists tksrcdir]} { - set TKSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> config get tksrcdir] ..]]] - set TKGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> config get tksrcdir] .. generic]]] + set TKSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tksrcdir] ..]]] + set TKGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tksrcdir] .. generic]]] #lappend opts --with-tk=$TKSRCDIR --with-tkinclude=$TKGENERIC lappend opts TKDIR=[file normalize $TKSRCDIR] } return $opts } } Index: modules/practcl/build/makeutil.tcl ================================================================== --- modules/practcl/build/makeutil.tcl +++ modules/practcl/build/makeutil.tcl @@ -30,10 +30,10 @@ # a value in the global [variable target] array. ### proc ::practcl::target {name info {action {}}} { set obj [::practcl::LOCAL make task $name $info $action] set ::make($name) 0 - set filename [$obj config get filename] + set filename [$obj define get filename] if {$filename ne {}} { set ::target($name) $filename } } Index: scripts/practcl.tcl ================================================================== --- scripts/practcl.tcl +++ scripts/practcl.tcl @@ -2,11 +2,11 @@ # Amalgamated package for practcl # Do not edit directly, tweak the source in src/ and rerun # build.tcl ### package require Tcl 8.6 -package provide practcl 0.17 +package provide practcl 0.16.3 namespace eval ::practcl {} ### # START: httpwget/wget.tcl ### @@ -2032,319 +2032,10 @@ } ### # END: clay/clay.tcl ### -### -# START: clay-yggdrasil/clay-yggdrasil.tcl -### -package provide clay-yggdrasil 0.1 -namespace eval ::clay-yggdrasil { -} -set ::clay-yggdrasil::version 0.1 -namespace eval ::clay::yggdrasil { -} -clay::define ::clay::yggdrasil { - method child {method args} { - tailcall my Child_${method} {*}$args - } - method Child_clear_all {} { - my variable children - foreach child $children { - catch { - $child child clear_all - $child clay refcount_decr - } - } - set children {} - } - method Child_count {} { - my variable children - if {![info exists children]} { - return {} - } - return [llength $children] - } - method Child_remove {args} { - my variable children - if {![info exists children]} { - return {} - } - set oldlist $children - set children {} - foreach item $oldlist { - if {$item in $args} continue - if {[info commands $item] eq {}} continue - lappend childrent $item - } - } - method Child_index {childidx args} { - my variable children - if {![info exists children]} { - return {} - } - set rowobj [lindex $children $childidx] - if {[llength $args] == 0} { - return $rowobj - } - return [$rowobj child index {*}$args] - } - method Child_last {} { - my variable children - return [lindex [my children] end] - } - method Child_list {} { - my variable children - if {![info exists children]} { - return {} - } - return $children - } - method config {method args} { - tailcall my Config_${method} {*}$args - } - method Config_Default field { - set info [my meta getnull option $field] - set getcmd [dict getnull $info default-command:] - if {$getcmd ne {}} { - return [{*}[string map [list %field% $field %self% [namespace which my]] $getcmd]] - } else { - return [dict getnull $info default:] - } - } - method Config_add {field args} { - my variable config - set value [dict getnull $config $field] - foreach item $args { - if {$item ni $value} { - lappend value $item - } - } - dict set config $field $value - } - method Config_exists field { - my variable config - return [dict exists $config $field] - } - method Config_get {field args} { - my variable config option_canonical option_getcmd css - set field [string trimleft $field -] - if {[info exists option_canonical($field)]} { - set field $option_canonical($field) - } - if {[info exists option_getcmd($field)]} { - return [eval $option_getcmd($field)] - } - if {[dict exists $config $field]} { - return [dict get $config $field] - } - if {[llength $args]} { - return [lindex $args 0] - } - return [my clay get option $field default] - } - method Config_id args { - my variable config - if {[llength $args]} { - my Config_set id [lindex $args 0] - } - if {![dict exists $config id] || [dict get $config id] eq {}} { - dict set config id [::clay::uuid::short] - } - return [dict get $config id] - } - method Config_initialize args { - set mixinmap {} - dict for {opt optinfo} [my clay get option] { - if {[dict getnull $optinfo class] != "mixin"} continue - dict set mixinmap $opt [my Config_Mixin $opt [dict get $optinfo default]] - } - - if {[dict size $mixinmap]} { - my clay mixinmap {*}$mixinmap - } - } - method Config_merge dictargs { - my variable config option_canonical - set rawlist $dictargs - set dictargs {} - set mixinmap {} - foreach {field val} $rawlist { - set field [string trim $field -:/] - if {[info exists option_canonical($field)]} { - set field $option_canonical($field) - } - if {$field eq "mixinmap"} { - my clay mixinmap {*}$val - } elseif {$field eq "delegate"} { - my clay delegate {*}$val - } else { - dict set dictargs $field $val - } - } - foreach {field val} $dictargs { - if {[my clay get option $field class] eq "mixin"} { - my clay mixinmap $field [my Config_Mixin $field $val] - } - } - #if {[dict size $mixinmap]} { - # my clay mixinmap {*}$mixinmap - #} - ### - # Validate all inputs - ### - foreach {field val} $dictargs { - set script [my clay get option $field validate-command] - if {$script ne {}} { - dict set dictargs $field [eval [string map [list %field% [list $field] %value% [list $val] %self% [namespace which my]] $script]] - } - } - ### - # Apply all inputs with special rules - ### - foreach {field val} $dictargs { - set script [my clay get option $field set-command] - dict set config $field $val - if {$script ne {}} { - {*}[string map [list %field% [list $field] %value% [list $val] %self% [namespace which my]] $script] - } - } - return $dictargs - } - method Config_Mixin {field value} { - set pattern [my clay get option $field pattern] - set default [my clay get option $field default] - if {$value eq {}} { - return "${pattern}.${default}" - } - if {[string index $value 0] eq ":" && [info commands $value] ne {}} { - return $value - } - foreach trial { - {${pattern}.$value} - {${pattern}::$value} - {${pattern}::${field}.$value} - {${pattern}::${field}.${default}.$value} - {::clay::tk::${field}.$value} - {::clay::tk::$value} - } { - set str [subst $trial] - if {[info commands $str] ne {}} { - return $str - } - } - return "${pattern}.${default}" - } - method Config_remove {field args} { - my variable config - if {![dict exists $config field]} return - set olist [dict get $config $field] - set nlist {} - foreach arg $olist { - if {$arg in $args} continue - lappend nlist $arg - } - dict set config $field $nlist - return $nlist - } - method Config_set args { - set dictargs [::clay::args_to_options {*}$args] - set dat [my Config_merge $dictargs] - my Config_triggers $dat - } - method Config_triggers dictargs { - foreach {field val} $dictargs { - set script [my clay get option $field post-command] - if {$script ne {}} { - {*}[string map [list %field% [list $field] %value% [list $val] %self% [namespace which my]] $script] - } - } - } - method css {method args} { - tailcall my CSS_${method} {*}$args - } - method CSS_class args { - if {[llength $args]} { - my Config_set class [lindex $args 0] - } - return [my Config_get class] - } - method CSS_exists field { - my variable css - return [dict exists $css $field] - } - method CSS_get field { - my variable css - if {[dict exists $css $field]} { - return [dict get $css $field] - } - return [my clay get css $field] - } - method CSS_set args { - my variable css - dict for {f v} $args { - dict set css $f $v - } - } - method eval args { - eval {*}$args - } - method link {method args} { - tailcall my Link_$method {*}$args - } - method Link_add {linktype object} { - my variable links - if {[info exists links($linktype)] && $object in $links($linktype)} { - return - } - lappend links($linktype) $object - } - method Link_dump {} { - return [array get links] - } - method Link_list {{linktype *}} { - if {$linktype eq "*"} { - return [array get links] - } - if {![info exists links($linktype)]} { - return {} - } - return $links($linktype) - } - method Link_object args { - my variable links - foreach obj $args { - foreach linktype [$obj linktype] { - my link add $linktype $obj - } - } - } - method Link_remove {object {linktype *}} { - foreach {linktype elements} [array get links $linktype] { - if {$object in $elements} { - set nlist {} - foreach e $elements { - if { $object ne $e } { lappend nlist $e } - } - set links($linktype) $nlist - } - } - } - method source args { - source {*}$args - } - method uuid {} { - tailcall my Config_id - } -} -namespace eval ::clay-yggdrasil { - namespace export * -} - -### -# END: clay-yggdrasil/clay-yggdrasil.tcl -### ### # START: setup.tcl ### package require TclOO set tcllib_path {} @@ -3052,11 +2743,11 @@ } set ::fosdat($dir) $result return $result } proc ::practcl::os {} { - return [${::practcl::MAIN} config get TEACUP_OS] + return [${::practcl::MAIN} define get TEACUP_OS] } proc ::practcl::mkzip {exename barekit vfspath} { ::practcl::tcllib_require zipfile::mkzip ::zipfile::mkzip::mkzip $exename -runtime $barekit -directory $vfspath } @@ -4122,11 +3813,11 @@ ::practcl::LOCAL make depends {*}$args } proc ::practcl::target {name info {action {}}} { set obj [::practcl::LOCAL make task $name $info $action] set ::make($name) 0 - set filename [$obj config get filename] + set filename [$obj define get filename] if {$filename ne {}} { set ::target($name) $filename } } @@ -4135,24 +3826,133 @@ ### ### # START: class metaclass.tcl ### ::clay::define ::practcl::metaclass { - superclass ::clay::yggdrasil method _MorphPatterns {} { return {{@name@} {::practcl::@name@} {::practcl::*@name@} {::practcl::*@name@*}} } - method Child_define {} { - return {} - } - method define {method args} { - tailcall my Config_$method {*}$args + method define {submethod args} { + my variable define + switch $submethod { + dump { + return [array get define] + } + add { + set field [lindex $args 0] + if {![info exists define($field)]} { + set define($field) {} + } + foreach arg [lrange $args 1 end] { + if {$arg ni $define($field)} { + lappend define($field) $arg + } + } + return $define($field) + } + remove { + set field [lindex $args 0] + if {![info exists define($field)]} { + return + } + set rlist [lrange $args 1 end] + set olist $define($field) + set nlist {} + foreach arg $olist { + if {$arg in $rlist} continue + lappend nlist $arg + } + set define($field) $nlist + return $nlist + } + exists { + set field [lindex $args 0] + return [info exists define($field)] + } + getnull - + get - + cget { + set field [lindex $args 0] + if {[info exists define($field)]} { + return $define($field) + } + return [lindex $args 1] + } + set { + if {[llength $args]==1} { + set arglist [lindex $args 0] + } else { + set arglist $args + } + array set define $arglist + if {[dict exists $arglist class]} { + my select + } + } + default { + array $submethod define {*}$args + } + } } method graft args { return [my clay delegate {*}$args] } method initialize {} {} + method link {command args} { + my variable links + switch $command { + object { + foreach obj $args { + foreach linktype [$obj linktype] { + my link add $linktype $obj + } + } + } + add { + ### + # Add a link to an object that was externally created + ### + if {[llength $args] ne 2} { error "Usage: link add LINKTYPE OBJECT"} + lassign $args linktype object + if {[info exists links($linktype)] && $object in $links($linktype)} { + return + } + lappend links($linktype) $object + } + remove { + set object [lindex $args 0] + if {[llength $args]==1} { + set ltype * + } else { + set ltype [lindex $args 1] + } + foreach {linktype elements} [array get links $ltype] { + if {$object in $elements} { + set nlist {} + foreach e $elements { + if { $object ne $e } { lappend nlist $e } + } + set links($linktype) $nlist + } + } + } + list { + if {[llength $args]==0} { + return [array get links] + } + if {[llength $args] != 1} { error "Usage: link list LINKTYPE"} + set linktype [lindex $args 0] + if {![info exists links($linktype)]} { + return {} + } + return $links($linktype) + } + dump { + return [array get links] + } + } + } method morph classname { my variable define if {$classname ne {}} { set map [list @name@ $classname] foreach pattern [string map $map [my _MorphPatterns]] { @@ -4177,11 +3977,11 @@ my clay mixinmap $mixinslot $class } elseif {[info command $class] ne {}} { if {[info object class [self]] ne $class} { ::oo::objdefine [self] class $class ::practcl::debug [self] morph $class - my Config_set class $class + my define set class $class } } else { error "[self] Could not detect class for $classname" } } @@ -4218,19 +4018,19 @@ ::clay::define ::practcl::toolset { method config.sh {} { return [my read_configuration] } method BuildDir {PWD} { - set name [my Config_get name] - set debug [my Config_get debug 0] - if {[my <project> config get LOCAL 0]} { - return [my Config_get builddir [file join $PWD local $name]] + set name [my define get name] + set debug [my define get debug 0] + if {[my <project> define get LOCAL 0]} { + return [my define get builddir [file join $PWD local $name]] } if {$debug} { - return [my Config_get builddir [file join $PWD debug $name]] + return [my define get builddir [file join $PWD debug $name]] } else { - return [my Config_get builddir [file join $PWD pkg $name]] + return [my define get builddir [file join $PWD pkg $name]] } } method MakeDir {srcdir} { return $srcdir } @@ -4238,15 +4038,15 @@ my variable conf_result if {[info exists conf_result]} { return $conf_result } set result {} - set name [my Config_get name] + set name [my define get name] set PWD $::CWD - set builddir [my Config_get builddir] + set builddir [my define get builddir] my unpack - set srcdir [my Config_get srcdir] + set srcdir [my define get srcdir] if {![file exists $builddir]} { my Configure } set filename [file join $builddir config.tcl] # Project uses the practcl template. Use the leavings from autoconf @@ -4299,13 +4099,13 @@ cd $PWD return $result } method build-cflags {PROJECT DEFS namevar versionvar defsvar} { upvar 1 $namevar name $versionvar version NAME NAME $defsvar defs - set name [string tolower [${PROJECT} config get name [${PROJECT} config get pkg_name]]] + set name [string tolower [${PROJECT} define get name [${PROJECT} define get pkg_name]]] set NAME [string toupper $name] - set version [${PROJECT} config get version [${PROJECT} config get pkg_vers]] + set version [${PROJECT} define get version [${PROJECT} define get pkg_vers]] if {$version eq {}} { set version 0.1a } set defs $DEFS foreach flag { @@ -4326,11 +4126,11 @@ return $defs } method critcl args { if {![info exists critcl]} { ::practcl::LOCAL tool critcl env-load - set critcl [file join [::practcl::LOCAL tool critcl config get srcdir] main.tcl + set critcl [file join [::practcl::LOCAL tool critcl define get srcdir] main.tcl } set srcdir [my SourceRoot] set PWD [pwd] cd $srcdir ::practcl::dotclexec $critcl {*}$args @@ -4342,13 +4142,13 @@ method select object { ### # Select the toolset to use for this project ### if {[$object define exists toolset]} { - return [$object config get toolset] + return [$object define get toolset] } - set class [$object config get toolset] + set class [$object define get toolset] if {$class ne {}} { $object clay mixinmap toolset $class } else { if {[info exists ::env(VisualStudioVersion)]} { $object clay mixinmap toolset ::practcl::toolset.msvc @@ -4371,11 +4171,11 @@ ### # Re-run autoconf for this project # Not a good idea in practice... but in the right hands it can be useful ### set pwd [pwd] - set srcdir [file normalize [my Config_get srcdir]] + set srcdir [file normalize [my define get srcdir]] set localsrcdir [my MakeDir $srcdir] cd $localsrcdir foreach template {configure.ac configure.in} { set input [file join $srcdir $template] if {[file exists $input]} { @@ -4384,93 +4184,93 @@ } } cd $pwd } method BuildDir {PWD} { - set name [my Config_get name] - set debug [my Config_get debug 0] - if {[my <project> config get LOCAL 0]} { - return [my Config_get builddir [file join $PWD local $name]] + set name [my define get name] + set debug [my define get debug 0] + if {[my <project> define get LOCAL 0]} { + return [my define get builddir [file join $PWD local $name]] } if {$debug} { - return [my Config_get builddir [file join $PWD debug $name]] + return [my define get builddir [file join $PWD debug $name]] } else { - return [my Config_get builddir [file join $PWD pkg $name]] + return [my define get builddir [file join $PWD pkg $name]] } } method ConfigureOpts {} { set opts {} - set builddir [my Config_get builddir] + set builddir [my define get builddir] - if {[my Config_get broken_destroot 0]} { - set PREFIX [my <project> config get prefix_broken_destdir] + if {[my define get broken_destroot 0]} { + set PREFIX [my <project> define get prefix_broken_destdir] } else { - set PREFIX [my <project> config get prefix] + set PREFIX [my <project> define get prefix] } - switch [my Config_get name] { + switch [my define get name] { tcl { - set opts [::practcl::platform::tcl_core_options [my <project> config get TEACUP_OS]] + set opts [::practcl::platform::tcl_core_options [my <project> define get TEACUP_OS]] } tk { - set opts [::practcl::platform::tk_core_options [my <project> config get TEACUP_OS]] + set opts [::practcl::platform::tk_core_options [my <project> define get TEACUP_OS]] } } - if {[my <project> config get CONFIG_SITE] != {}} { - lappend opts --host=[my <project> config get HOST] + if {[my <project> define get CONFIG_SITE] != {}} { + lappend opts --host=[my <project> define get HOST] } - set inside_msys [string is true -strict [my <project> config get MSYS_ENV 0]] + set inside_msys [string is true -strict [my <project> define get MSYS_ENV 0]] lappend opts --with-tclsh=[info nameofexecutable] - if {[my Config_get tk 0]} { - if {![my <project> config get LOCAL 0]} { + if {[my define get tk 0]} { + if {![my <project> define get LOCAL 0]} { set obj [my <project> tclcore] if {$obj ne {}} { if {$inside_msys} { - lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] + lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj define get builddir]] } else { - lappend opts --with-tcl=[file normalize [$obj config get builddir]] + lappend opts --with-tcl=[file normalize [$obj define get builddir]] } } set obj [my <project> tkcore] if {$obj ne {}} { if {$inside_msys} { - lappend opts --with-tk=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] + lappend opts --with-tk=[::practcl::file_relative [file normalize $builddir] [$obj define get builddir]] } else { - lappend opts --with-tk=[file normalize [$obj config get builddir]] + lappend opts --with-tk=[file normalize [$obj define get builddir]] } } } else { lappend opts --with-tcl=[file join $PREFIX lib] lappend opts --with-tk=[file join $PREFIX lib] } } else { - if {![my <project> config get LOCAL 0]} { + if {![my <project> define get LOCAL 0]} { set obj [my <project> tclcore] if {$obj ne {}} { if {$inside_msys} { - lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] + lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj define get builddir]] } else { - lappend opts --with-tcl=[file normalize [$obj config get builddir]] + lappend opts --with-tcl=[file normalize [$obj define get builddir]] } } } else { lappend opts --with-tcl=[file join $PREFIX lib] } } - lappend opts {*}[my Config_get config_opts] + lappend opts {*}[my define get config_opts] if {![regexp -- "--prefix" $opts]} { lappend opts --prefix=$PREFIX --exec-prefix=$PREFIX } - if {[my Config_get debug 0]} { + if {[my define get debug 0]} { lappend opts --enable-symbols=true } #--exec_prefix=$PREFIX #if {$::tcl_platform(platform) eq "windows"} { # lappend opts --disable-64bit #} - if {[my Config_get static 1]} { + if {[my define get static 1]} { lappend opts --disable-shared #--disable-stubs # } else { lappend opts --enable-shared @@ -4478,17 +4278,17 @@ return $opts } method MakeDir {srcdir} { set localsrcdir $srcdir if {[file exists [file join $srcdir generic]]} { - my Config_add include_dir [file join $srcdir generic] + my define add include_dir [file join $srcdir generic] } - set os [my <project> config get TEACUP_OS] + set os [my <project> define get TEACUP_OS] switch $os { windows { if {[file exists [file join $srcdir win]]} { - my Config_add include_dir [file join $srcdir win] + my define add include_dir [file join $srcdir win] } if {[file exists [file join $srcdir win Makefile.in]]} { set localsrcdir [file join $srcdir win] } } @@ -4497,14 +4297,14 @@ set localsrcdir [file join $srcdir unix] } } default { if {[file exists [file join $srcdir $os]]} { - my Config_add include_dir [file join $srcdir $os] + my define add include_dir [file join $srcdir $os] } if {[file exists [file join $srcdir unix]]} { - my Config_add include_dir [file join $srcdir unix] + my define add include_dir [file join $srcdir unix] } if {[file exists [file join $srcdir $os Makefile.in]]} { set localsrcdir [file join $srcdir $os] } elseif {[file exists [file join $srcdir unix Makefile.in]]} { set localsrcdir [file join $srcdir unix] @@ -4512,11 +4312,11 @@ } } return $localsrcdir } Ensemble make::autodetect {} { - set srcdir [my Config_get srcdir] + set srcdir [my define get srcdir] set localsrcdir [my MakeDir $srcdir] if {$localsrcdir eq {}} { set localsrcdir $srcdir } if {$srcdir eq $localsrcdir} { @@ -4526,20 +4326,20 @@ if {[file exists [file join $srcdir .. tclconfig install-sh]]} { set teapath [file join $srcdir .. tclconfig] } else { set tclConfigObj [::practcl::LOCAL tool tclconfig] $tclConfigObj load - set teapath [$tclConfigObj config get srcdir] + set teapath [$tclConfigObj define get srcdir] } set teapath [file normalize $teapath] #file mkdir [file join $srcdir tclconfig] if {[catch {file link -symbolic [file join $srcdir tclconfig] $teapath}]} { ::practcl::copyDir [file join $teapath] [file join $srcdir tclconfig] } } } - set builddir [my Config_get builddir] + set builddir [my define get builddir] file mkdir $builddir if {![file exists [file join $localsrcdir configure]]} { if {[file exists [file join $localsrcdir autogen.sh]]} { cd $localsrcdir catch {exec sh autogen.sh >>& [file join $builddir autoconf.log]} @@ -4548,39 +4348,39 @@ } set opts [my ConfigureOpts] if {[file exists [file join $builddir autoconf.log]]} { file delete [file join $builddir autoconf.log] } - ::practcl::debug [list PKG [my Config_get name] CONFIGURE {*}$opts] + ::practcl::debug [list PKG [my define get name] CONFIGURE {*}$opts] ::practcl::log [file join $builddir autoconf.log] [list CONFIGURE {*}$opts] cd $builddir - if {[my <project> config get CONFIG_SITE] ne {}} { - set ::env(CONFIG_SITE) [my <project> config get CONFIG_SITE] + if {[my <project> define get CONFIG_SITE] ne {}} { + set ::env(CONFIG_SITE) [my <project> define get CONFIG_SITE] } catch {exec sh [file join $localsrcdir configure] {*}$opts >>& [file join $builddir autoconf.log]} cd $::CWD } Ensemble make::clean {} { - set builddir [file normalize [my Config_get builddir]] + set builddir [file normalize [my define get builddir]] catch {::practcl::domake $builddir clean} } Ensemble make::compile {} { - set name [my Config_get name] - set srcdir [my Config_get srcdir] - if {[my Config_get static 1]} { + set name [my define get name] + set srcdir [my define get srcdir] + if {[my define get static 1]} { puts "BUILDING Static $name $srcdir" } else { puts "BUILDING Dynamic $name $srcdir" } cd $::CWD - set builddir [file normalize [my Config_get builddir]] + set builddir [file normalize [my define get builddir]] file mkdir $builddir if {![file exists [file join $builddir Makefile]]} { my Configure } if {[file exists [file join $builddir make.tcl]]} { - if {[my Config_get debug 0]} { + if {[my define get debug 0]} { ::practcl::domake.tcl $builddir debug all } else { ::practcl::domake.tcl $builddir all } } else { @@ -4587,34 +4387,34 @@ ::practcl::domake $builddir all } } Ensemble make::install DEST { set PWD [pwd] - set builddir [my Config_get builddir] - if {[my <project> config get LOCAL 0] || $DEST eq {}} { + set builddir [my define get builddir] + if {[my <project> define get LOCAL 0] || $DEST eq {}} { if {[file exists [file join $builddir make.tcl]]} { puts "[self] Local INSTALL (Practcl)" ::practcl::domake.tcl $builddir install - } elseif {[my Config_get broken_destroot 0] == 0} { + } elseif {[my define get broken_destroot 0] == 0} { puts "[self] Local INSTALL (TEA)" ::practcl::domake $builddir install } } else { if {[file exists [file join $builddir make.tcl]]} { # Practcl builds can inject right to where we need them puts "[self] VFS INSTALL $DEST (Practcl)" ::practcl::domake.tcl $builddir install-package $DEST - } elseif {[my Config_get broken_destroot 0] == 0} { + } elseif {[my define get broken_destroot 0] == 0} { # Most modern TEA projects understand DESTROOT in the makefile puts "[self] VFS INSTALL $DEST (TEA)" ::practcl::domake $builddir install DESTDIR=[::practcl::file_relative $builddir $DEST] } else { # But some require us to do an install into a fictitious filesystem # and then extract the gooey parts within. # (*cough*) TkImg - set PREFIX [my <project> config get prefix] - set BROKENROOT [::practcl::msys_to_tclpath [my <project> config get prefix_broken_destdir]] + set PREFIX [my <project> define get prefix] + set BROKENROOT [::practcl::msys_to_tclpath [my <project> define get prefix_broken_destdir]] file delete -force $BROKENROOT file mkdir $BROKENROOT ::practcl::domake $builddir $install ::practcl::copyDir $BROKENROOT [file join $DEST [string trimleft $PREFIX /]] file delete -force $BROKENROOT @@ -4621,17 +4421,17 @@ } } cd $PWD } method build-compile-sources {PROJECT COMPILE CPPCOMPILE INCLUDES} { - set objext [my Config_get OBJEXT o] + set objext [my define get OBJEXT o] set EXTERN_OBJS {} set OBJECTS {} set result {} - set builddir [$PROJECT config get builddir] + set builddir [$PROJECT define get builddir] file mkdir [file join $builddir objs] - set debug [$PROJECT config get debug 0] + set debug [$PROJECT define get debug 0] set task {} ### # Compile the C sources ### @@ -4717,15 +4517,15 @@ } } return $result } method build-Makefile {path PROJECT} { - array set proj [$PROJECT config dump] + array set proj [$PROJECT define dump] set path $proj(builddir) cd $path set includedir . - set objext [my Config_get OBJEXT o] + set objext [my define get OBJEXT o] #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)] lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]] lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]] foreach include [$PROJECT toolset-include-directory] { @@ -4772,68 +4572,68 @@ set map {} lappend map %LIBRARY_NAME% $proj(name) lappend map %LIBRARY_VERSION% $proj(version) lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)] - lappend map %LIBRARY_PREFIX% [$PROJECT config get libprefix] + lappend map %LIBRARY_PREFIX% [$PROJECT define getnull libprefix] - if {[string is true [$PROJECT config get SHARED_BUILD]]} { - set outfile [$PROJECT config get libfile] + if {[string is true [$PROJECT define get SHARED_BUILD]]} { + set outfile [$PROJECT define get libfile] } else { set outfile [$PROJECT shared_library] } - $PROJECT config set shared_library $outfile + $PROJECT define set shared_library $outfile ::practcl::cputs result " ${NAME}_SHLIB = $outfile ${NAME}_OBJS = [dict keys $products] " #lappend map %OUTFILE% {\[$]@} lappend map %OUTFILE% $outfile lappend map %LIBRARY_OBJECTS% "\$(${NAME}_OBJS)" ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" - ::practcl::cputs result "\t[string map $map [$PROJECT config get PRACTCL_SHARED_LIB]]" - if {[$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { - ::practcl::cputs result "\t[string map $map [$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL]]" + ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_SHARED_LIB]]" + if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { + ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]]" } ::practcl::cputs result {} - if {[string is true [$PROJECT config get SHARED_BUILD]]} { + if {[string is true [$PROJECT define get SHARED_BUILD]]} { #set outfile [$PROJECT static_library] set outfile $proj(name).a } else { - set outfile [$PROJECT config get libfile] + set outfile [$PROJECT define get libfile] } - $PROJECT config set static_library $outfile + $PROJECT define set static_library $outfile dict set map %OUTFILE% $outfile ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" - ::practcl::cputs result "\t[string map $map [$PROJECT config get PRACTCL_STATIC_LIB]]" + ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_STATIC_LIB]]" ::practcl::cputs result {} return $result } method build-library {outfile PROJECT} { - array set proj [$PROJECT config dump] + array set proj [$PROJECT define dump] set path $proj(builddir) cd $path set includedir . #lappend includedir [::practcl::file_relative $path $proj(TCL_INCLUDES)] lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) generic]]] - if {[$PROJECT config get TEA_PRIVATE_TCL_HEADERS 0]} { - if {[$PROJECT config get TEA_PLATFORM] eq "windows"} { + if {[$PROJECT define get TEA_PRIVATE_TCL_HEADERS 0]} { + if {[$PROJECT define get TEA_PLATFORM] eq "windows"} { lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) win]]] } else { lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TCL_SRC_DIR) unix]]] } } lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(srcdir) generic]]] - if {[$PROJECT config get tk 0]} { + if {[$PROJECT define get tk 0]} { lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) generic]]] lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) ttk]]] lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) xlib]]] - if {[$PROJECT config get TEA_PRIVATE_TK_HEADERS 0]} { - if {[$PROJECT config get TEA_PLATFORM] eq "windows"} { + if {[$PROJECT define get TEA_PRIVATE_TK_HEADERS 0]} { + if {[$PROJECT define get TEA_PLATFORM] eq "windows"} { lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) win]]] } else { lappend includedir [::practcl::file_relative $path [file normalize [file join $proj(TK_SRC_DIR) unix]]] } } @@ -4845,12 +4645,12 @@ lappend includedir $cpath } } my build-cflags $PROJECT $proj(DEFS) name version defs set NAME [string toupper $name] - set debug [$PROJECT config get debug 0] - set os [$PROJECT config get TEACUP_OS] + set debug [$PROJECT define get debug 0] + set os [$PROJECT define get TEACUP_OS] set INCLUDES "-I[join $includedir " -I"]" if {$debug} { set COMPILE "$proj(CC) $proj(CFLAGS_DEBUG) -ggdb \ $proj(CFLAGS_WARNING) $INCLUDES $defs" @@ -4879,61 +4679,61 @@ lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $proj(version)] lappend map %OUTFILE% $outfile lappend map %LIBRARY_OBJECTS% $products lappend map {${CFLAGS}} "$proj(CFLAGS_DEFAULT) $proj(CFLAGS_WARNING)" - if {[string is true [$PROJECT config get SHARED_BUILD 1]]} { - set cmd [$PROJECT config get PRACTCL_SHARED_LIB] - append cmd " [$PROJECT config get PRACTCL_LIBS]" + if {[string is true [$PROJECT define get SHARED_BUILD 1]]} { + set cmd [$PROJECT define get PRACTCL_SHARED_LIB] + append cmd " [$PROJECT define get PRACTCL_LIBS]" set cmd [string map $map $cmd] puts $cmd exec {*}$cmd >&@ stdout - if {[$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { - set cmd [string map $map [$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL]] + if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { + set cmd [string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]] puts $cmd exec {*}$cmd >&@ stdout } } else { - set cmd [string map $map [$PROJECT config get PRACTCL_STATIC_LIB]] + set cmd [string map $map [$PROJECT define get PRACTCL_STATIC_LIB]] puts $cmd exec {*}$cmd >&@ stdout } - set ranlib [$PROJECT config get RANLIB] + set ranlib [$PROJECT define get RANLIB] if {$ranlib ni {{} :}} { catch {exec $ranlib $outfile} } } method build-tclsh {outfile PROJECT {path {auto}}} { - if {[my Config_get tk 0] && [my Config_get static_tk 0]} { + if {[my define get tk 0] && [my define get static_tk 0]} { puts " BUILDING STATIC TCL/TK EXE $PROJECT" set TKOBJ [$PROJECT tkcore] if {[info command $TKOBJ] eq {}} { set TKOBJ ::noop - $PROJECT config set static_tk 0 + $PROJECT define set static_tk 0 } else { ::practcl::toolset select $TKOBJ array set TK [$TKOBJ read_configuration] - set do_tk [$TKOBJ config get static] - $PROJECT config set static_tk $do_tk - $PROJECT config set tk $do_tk - set TKSRCDIR [$TKOBJ config get srcdir] + set do_tk [$TKOBJ define get static] + $PROJECT define set static_tk $do_tk + $PROJECT define set tk $do_tk + set TKSRCDIR [$TKOBJ define get srcdir] } } else { puts " BUILDING STATIC TCL EXE $PROJECT" set TKOBJ ::noop - my Config_set static_tk 0 + my define set static_tk 0 } set TCLOBJ [$PROJECT tclcore] ::practcl::toolset select $TCLOBJ set PKG_OBJS {} foreach item [$PROJECT link list core.library] { - if {[string is true [$item config get static]]} { + if {[string is true [$item define get static]]} { lappend PKG_OBJS $item } } foreach item [$PROJECT link list package] { - if {[string is true [$item config get static]]} { + if {[string is true [$item define get static]]} { lappend PKG_OBJS $item } } array set TCL [$TCLOBJ read_configuration] if {$path in {{} auto}} { @@ -4948,11 +4748,11 @@ # with the same DEFS flags as the tcl core was compiled with. # The DEFS produced by a TEA extension aren't intended to operate # with the internals of a staticly linked Tcl ### my build-cflags $PROJECT $TCL(defs) name version defs - set debug [$PROJECT config get debug 0] + set debug [$PROJECT define get debug 0] set NAME [string toupper $name] set result {} set libraries {} set thisline {} set OBJECTS {} @@ -4959,22 +4759,22 @@ set EXTERN_OBJS {} foreach obj $PKG_OBJS { $obj compile set config($obj) [$obj read_configuration] } - set os [$PROJECT config get TEACUP_OS] - set TCLSRCDIR [$TCLOBJ config get srcdir] + set os [$PROJECT define get TEACUP_OS] + set TCLSRCDIR [$TCLOBJ define get srcdir] set includedir . foreach include [$TCLOBJ toolset-include-directory] { set cpath [::practcl::file_relative $path [file normalize $include]] if {$cpath ni $includedir} { lappend includedir $cpath } } lappend includedir [::practcl::file_relative $path [file normalize ../tcl/compat/zlib]] - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { lappend includedir [::practcl::file_relative $path [file normalize [file join $TKSRCDIR generic]]] lappend includedir [::practcl::file_relative $path [file normalize [file join $TKSRCDIR ttk]]] lappend includedir [::practcl::file_relative $path [file normalize [file join $TKSRCDIR xlib]]] lappend includedir [::practcl::file_relative $path [file normalize $TKSRCDIR]] } @@ -4997,24 +4797,24 @@ append COMPILE " " $defs lappend OBJECTS {*}[my build-compile-sources $PROJECT $COMPILE $COMPILE $INCLUDES] set TCLSRC [file normalize $TCLSRCDIR] - if {[${PROJECT} config get TEACUP_OS] eq "windows"} { - set windres [$PROJECT config get RC windres] + if {[${PROJECT} define get TEACUP_OS] eq "windows"} { + set windres [$PROJECT define get RC windres] set RSOBJ [file join $path objs tclkit.res.o] - set RCSRC [${PROJECT} config get kit_resource_file] - set RCMAN [${PROJECT} config get kit_manifest_file] - set RCICO [${PROJECT} config get kit_icon_file] + set RCSRC [${PROJECT} define get kit_resource_file] + set RCMAN [${PROJECT} define get kit_manifest_file] + set RCICO [${PROJECT} define get kit_icon_file] set cmd [list $windres -o $RSOBJ -DSTATIC_BUILD --include [::practcl::file_relative $path [file join $TCLSRC generic]]] - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { if {$RCSRC eq {} || ![file exists $RCSRC]} { set RCSRC [file join $TKSRCDIR win rc wish.rc] } if {$RCMAN eq {} || ![file exists $RCMAN]} { - set RCMAN [file join [$TKOBJ config get builddir] wish.exe.manifest] + set RCMAN [file join [$TKOBJ define get builddir] wish.exe.manifest] } if {$RCICO eq {} || ![file exists $RCICO]} { set RCICO [file join $TKSRCDIR win rc wish.ico] } set TKSRC [file normalize $TKSRCDIR] @@ -5024,17 +4824,17 @@ } else { if {$RCSRC eq {} || ![file exists $RCSRC]} { set RCSRC [file join $TCLSRCDIR win tclsh.rc] } if {$RCMAN eq {} || ![file exists $RCMAN]} { - set RCMAN [file join [$TCLOBJ config get builddir] tclsh.exe.manifest] + set RCMAN [file join [$TCLOBJ define get builddir] tclsh.exe.manifest] } if {$RCICO eq {} || ![file exists $RCICO]} { set RCICO [file join $TCLSRCDIR win tclsh.ico] } } - foreach item [${PROJECT} config get resource_include] { + foreach item [${PROJECT} define get resource_include] { lappend cmd --include [::practcl::file_relative $path [file normalize $item]] } lappend cmd [file tail $RCSRC] if {![file exists [file join $path [file tail $RCSRC]]]} { file copy -force $RCSRC [file join $path [file tail $RCSRC]] @@ -5068,16 +4868,16 @@ ### # There is bug in the core's autoconf and the value for # tcl_build_lib_spec does not have the 'g' suffix ### append cmd " -L[file dirname $TCL(build_stub_lib_path)] -ltcl86g" - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { append cmd " -L[file dirname $TK(build_stub_lib_path)] -ltk86g" } } else { append cmd " $TCL(build_lib_spec)" - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { append cmd " $TK(build_lib_spec)" } } foreach obj $PKG_OBJS { append cmd " [$obj linker-products $config($obj)]" @@ -5085,11 +4885,11 @@ set LIBS {} foreach item $TCL(libs) { if {[string range $item 0 1] eq "-l" && $item in $LIBS } continue lappend LIBS $item } - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { foreach item $TK(libs) { if {[string range $item 0 1] eq "-l" && $item in $LIBS } continue lappend LIBS $item } } @@ -5114,16 +4914,16 @@ append cmd $item } } if {$debug && $os eq "windows"} { append cmd " -L[file dirname $TCL(build_stub_lib_path)] ${TCL(stub_lib_flag)}" - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { append cmd " -L[file dirname $TK(build_stub_lib_path)] ${TK(stub_lib_flag)}" } } else { append cmd " $TCL(build_stub_lib_spec)" - if {[$PROJECT config get static_tk]} { + if {[$PROJECT define get static_tk]} { append cmd " $TK(build_stub_lib_spec)" } } if {[info exists TCL(cc_search_flags)]} { append cmd " $TCL(cc_search_flags)" @@ -5146,55 +4946,55 @@ # START: class toolset msvc.tcl ### ::clay::define ::practcl::toolset.msvc { superclass ::practcl::toolset method BuildDir {PWD} { - set srcdir [my Config_get srcdir] + set srcdir [my define get srcdir] return $srcdir } Ensemble make::autodetect {} { } Ensemble make::clean {} { set PWD [pwd] - set srcdir [my Config_get srcdir] + set srcdir [my define get srcdir] cd $srcdir catch {::practcl::doexec nmake -f makefile.vc clean} cd $PWD } Ensemble make::compile {} { - set srcdir [my Config_get srcdir] - if {[my Config_get static 1]} { + set srcdir [my define get srcdir] + if {[my define get static 1]} { puts "BUILDING Static $name $srcdir" } else { puts "BUILDING Dynamic $name $srcdir" } cd $srcdir if {[file exists [file join $srcdir make.tcl]]} { - if {[my Config_get debug 0]} { + if {[my define get debug 0]} { ::practcl::domake.tcl $srcdir debug all } else { ::practcl::domake.tcl $srcdir all } } else { if {[file exists [file join $srcdir makefile.vc]]} { - ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> config get installdir] {*}[my NmakeOpts] release + ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> define get installdir] {*}[my NmakeOpts] release } elseif {[file exists [file join $srcdir win makefile.vc]]} { cd [file join $srcdir win] - ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> config get installdir] {*}[my NmakeOpts] release + ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> define get installdir] {*}[my NmakeOpts] release } else { error "No make.tcl or makefile.vc found for project $name" } } } Ensemble make::install DEST { set PWD [pwd] - set srcdir [my Config_get srcdir] + set srcdir [my define get srcdir] cd $srcdir if {$DEST eq {}} { error "No destination given" } - if {[my <project> config get LOCAL 0] || $DEST eq {}} { + if {[my <project> define get LOCAL 0] || $DEST eq {}} { if {[file exists [file join $srcdir make.tcl]]} { # Practcl builds can inject right to where we need them puts "[self] Local Install (Practcl)" ::practcl::domake.tcl $srcdir install } else { @@ -5214,37 +5014,37 @@ cd $PWD } method MakeDir {srcdir} { set localsrcdir $srcdir if {[file exists [file join $srcdir generic]]} { - my Config_add include_dir [file join $srcdir generic] + my define add include_dir [file join $srcdir generic] } if {[file exists [file join $srcdir win]]} { - my Config_add include_dir [file join $srcdir win] + my define add include_dir [file join $srcdir win] } if {[file exists [file join $srcdir makefile.vc]]} { set localsrcdir [file join $srcdir win] } return $localsrcdir } method NmakeOpts {} { set opts {} - set builddir [file normalize [my Config_get builddir]] + set builddir [file normalize [my define get builddir]] if {[my <project> define exists tclsrcdir]} { ### # On Windows we are probably running under MSYS, which doesn't deal with # spaces in filename well ### - set TCLSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> config get tclsrcdir] ..]]] - set TCLGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> config get tclsrcdir] .. generic]]] + set TCLSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tclsrcdir] ..]]] + set TCLGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tclsrcdir] .. generic]]] lappend opts TCLDIR=[file normalize $TCLSRCDIR] #--with-tclinclude=$TCLGENERIC } if {[my <project> define exists tksrcdir]} { - set TKSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> config get tksrcdir] ..]]] - set TKGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> config get tksrcdir] .. generic]]] + set TKSRCDIR [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tksrcdir] ..]]] + set TKGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tksrcdir] .. generic]]] #lappend opts --with-tk=$TKSRCDIR --with-tkinclude=$TKGENERIC lappend opts TKDIR=[file normalize $TKSRCDIR] } return $opts } @@ -5260,19 +5060,20 @@ superclass ::practcl::metaclass constructor {module_object name info {action_body {}}} { my variable define triggered domake set triggered 0 set domake 0 - my Config_set name $name action {} - my Config_merge $info + set define(name) $name + set define(action) {} + array set define $info my select my initialize foreach {stub obj} [$module_object child organs] { my graft $stub $obj } if {$action_body ne {}} { - my Config_set action $action_body + set define(action) $action_body } } method do {} { my variable domake return $domake @@ -5285,11 +5086,11 @@ if {[info exists needs_make]} { return $needs_make } set make_objects [my <module> make objects] set needs_make 0 - foreach item [my Config_get depends] { + foreach item [my define get depends] { if {![dict exists $make_objects $item]} continue set depobj [dict get $make_objects $item] if {$depobj eq [self]} { puts "WARNING [self] depends on itself" continue @@ -5307,15 +5108,15 @@ } return $needs_make } method output {} { set result {} - set filename [my Config_get filename] + set filename [my define get filename] if {$filename ne {}} { lappend result $filename } - foreach filename [my Config_get files] { + foreach filename [my define get files] { if {$filename ne {}} { lappend result $filename } } return $result @@ -5332,11 +5133,11 @@ return $domake } set triggered 1 set make_objects [my <module> make objects] - foreach item [my Config_get depends] { + foreach item [my define get depends] { if {![dict exists $make_objects $item]} continue set depobj [dict get $make_objects $item] if {$depobj eq [self]} { puts "WARNING [self] triggers itself" continue @@ -5346,11 +5147,11 @@ $depobj triggers } } } set domake 1 - my <module> make trigger {*}[my Config_get triggers] + my <module> make trigger {*}[my define get triggers] } } ### # END: class target.tcl @@ -5359,38 +5160,35 @@ # START: class object.tcl ### ::clay::define ::practcl::object { superclass ::practcl::metaclass constructor {parent args} { - my variable links + my variable links define set organs [$parent child organs] my clay delegate {*}$organs - my Config_merge $organs - my Config_merge [$parent child define] + array set define $organs + array set define [$parent child define] array set links {} if {[llength $args]==1 && [file exists [lindex $args 0]]} { - my Config_set filename [lindex $args 0] + my define set filename [lindex $args 0] ::practcl::product select [self] } elseif {[llength $args] == 1} { set data [uplevel 1 [list subst [lindex $args 0]]] - my Config_merge $data + array set define $data my select } else { - my Config_merge [uplevel 1 [list subst $args]] + array set define [uplevel 1 [list subst $args]] my select } my initialize } - method Child_delegate {} { - return {} - } - method Child_organs {} { + method child {method} { return {} } method go {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable links foreach {linktype objs} [array get links] { foreach obj $objs { $obj go } @@ -5415,17 +5213,17 @@ if {![dict exists $cstruct $name public]} { dict set cstruct $name public 1 } } method include header { - my Config_add include $header + my define add include $header } method include_dir args { - my Config_add include_dir {*}$args + my define add include_dir {*}$args } method include_directory args { - my Config_add include_dir {*}$args + my define add include_dir {*}$args } method c_header body { my variable code ::practcl::cputs code(header) $body } @@ -5550,33 +5348,33 @@ my c_function [string map [list @FNAME@ $fname] $template] [string map $map $body] dict set tcltype $name $func $fname } } method project-compile-products {} { - set filename [my Config_get output_c] + set filename [my define get output_c] set result {} if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my Config_get ofile] + set ofile [my define get ofile] } else { set ofile [my Ofile $filename] - my Config_set ofile $ofile + my define set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] } else { - set filename [my Config_get cfile] + set filename [my define get cfile] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my Config_get ofile] + set ofile [my define get ofile] } else { set ofile [my Ofile $filename] - my Config_set ofile $ofile + my define set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] } } foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } @@ -5583,49 +5381,49 @@ return $result } method implement path { my go my Collate_Source $path - if {[my Config_get output_c] eq {}} return - set filename [file join $path [my Config_get output_c]] - ::practcl::debug [self] [my Config_get filename] WANTS TO GENERATE $filename - my Config_set cfile $filename + if {[my define get output_c] eq {}} return + set filename [file join $path [my define get output_c]] + ::practcl::debug [self] [my define get filename] WANTS TO GENERATE $filename + my define set cfile $filename set fout [open $filename w] puts $fout [my generate-c] - if {[my Config_get initfunc] ne {}} { - puts $fout "extern int DLLEXPORT [my Config_get initfunc]( Tcl_Interp *interp ) \x7B" + if {[my define get initfunc] ne {}} { + puts $fout "extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \x7B" puts $fout [my generate-loader-module] - if {[my Config_get pkg_name] ne {}} { - puts $fout " Tcl_PkgProvide(interp, \"[my Config_get pkg_name]\", \"[my Config_get pkg_vers]\");" + if {[my define get pkg_name] ne {}} { + puts $fout " Tcl_PkgProvide(interp, \"[my define get pkg_name]\", \"[my define get pkg_vers]\");" } puts $fout " return TCL_OK\;" puts $fout "\x7D" } close $fout } method initialize {} { - set filename [my Config_get filename] + set filename [my define get filename] if {$filename eq {}} { return } - if {[my Config_get name] eq {}} { - my Config_set name [file tail [file rootname $filename]] + if {[my define get name] eq {}} { + my define set name [file tail [file rootname $filename]] } - if {[my Config_get localpath] eq {}} { - my Config_set localpath [my <module> config get localpath]_[my Config_get name] + if {[my define get localpath] eq {}} { + my define set localpath [my <module> define get localpath]_[my define get name] } ::source $filename } method linktype {} { return {subordinate product dynamic} } method generate-cfile-constant {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} my variable code cstruct methods tcltype if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my Config_get filename] CONSTANT */" + ::practcl::cputs result "/* [my define get filename] CONSTANT */" ::practcl::cputs result $code(constant) } if {[info exists cstruct]} { foreach {name info} $cstruct { set map {} @@ -5695,17 +5493,17 @@ dict set methods $name methodtype $methodtype } } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue ::practcl::cputs result [$obj generate-cfile-constant] } return $result } method generate-cfile-header {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cfunct cstruct methods tcltype tclprocs set result {} if {[info exists code(header)]} { ::practcl::cputs result $code(header) } @@ -5722,13 +5520,13 @@ if {[dict exists $info header]} { ::practcl::cputs result "[dict get $info header]\;" } } } - ::practcl::debug [list methods [info exists methods] [my Config_get cclass]] + ::practcl::debug [list methods [info exists methods] [my define get cclass]] if {[info exists methods]} { - set thisclass [my Config_get cclass] + set thisclass [my define get cclass] foreach {name info} $methods { if {[dict exists $info header]} { ::practcl::cputs result "[dict get $info header]\;" } } @@ -5735,22 +5533,22 @@ # Add the initializer wrapper for the class ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp)\;" } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue set dat [$obj generate-cfile-header] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-header */" + ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-header */" + ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */" } } return $result } method generate-cfile-tclapi {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code methods tclprocs set result {} if {[info exists code(method)]} { ::practcl::cputs result $code(method) } @@ -5766,11 +5564,11 @@ } } if {[info exists methods]} { - set thisclass [my Config_get cclass] + set thisclass [my define get cclass] foreach {name info} $methods { if {![dict exists $info body]} continue set callproc [dict get $info callproc] set header [dict get $info header] set body [dict get $info body] @@ -5778,11 +5576,11 @@ ::practcl::cputs result "${header} \{${body}\}" } # Build the OO_Init function ::practcl::cputs result "/* Loader for $thisclass */" ::practcl::cputs result "static int ${thisclass}_OO_Init(Tcl_Interp *interp) \{" - ::practcl::cputs result [string map [list @CCLASS@ $thisclass @TCLCLASS@ [my Config_get class]] { + ::practcl::cputs result [string map [list @CCLASS@ $thisclass @TCLCLASS@ [my define get class]] { /* ** Build the "@TCLCLASS@" class */ Tcl_Obj* nameObj; /* Name of a class or method being looked up */ Tcl_Object curClassObject; /* Tcl_Object representing the current class */ @@ -5829,17 +5627,17 @@ } ::practcl::cputs result " return TCL_OK\;\n\}\n" } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue ::practcl::cputs result [$obj generate-cfile-tclapi] } return $result } method generate-loader-module {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} my variable code methods tclprocs if {[info exists code(nspace)]} { ::practcl::cputs result " \{\n Tcl_Namespace *modPtr;" foreach nspace $code(nspace) { @@ -5885,14 +5683,14 @@ Tcl_Export(interp, modPtr, "[a-z]*", 1); }] } ::practcl::cputs result " \}" } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} { + if {[$obj define get output_c] ne {}} { ::practcl::cputs result [$obj generate-loader-external] } else { ::practcl::cputs result [$obj generate-loader-module] } } @@ -5899,12 +5697,12 @@ return $result } method Collate_Source CWD { my variable methods code cstruct tclprocs if {[info exists methods]} { - ::practcl::debug [self] methods [my Config_get cclass] - set thisclass [my Config_get cclass] + ::practcl::debug [self] methods [my define get cclass] + set thisclass [my define get cclass] foreach {name info} $methods { # Provide a callproc if {![dict exists $info callproc]} { set callproc [string map {____ _ ___ _ __ _} [string map {{ } _ : _} OOMethod_${thisclass}_${name}]] dict set methods $name callproc $callproc @@ -5921,11 +5719,11 @@ } if {![info exists code(initfuncts)] || "${thisclass}_OO_Init" ni $code(initfuncts)} { lappend code(initfuncts) "${thisclass}_OO_Init" } } - set thisnspace [my Config_get nspace] + set thisnspace [my define get nspace] if {[info exists tclprocs]} { ::practcl::debug [self] tclprocs [dict keys $tclprocs] foreach {name info} $tclprocs { if {![dict exists $info callproc]} { @@ -5956,104 +5754,104 @@ } method Collate_Source CWD {} method project-compile-products {} { set result {} noop { - set filename [my Config_get filename] + set filename [my define get filename] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my Config_get ofile] + set ofile [my define get ofile] } else { set ofile [my Ofile $filename] - my Config_set ofile $ofile + my define set ofile $ofile } - lappend result $ofile [list cfile $filename include [my Config_get include] extra [my Config_get extra] external [string is true -strict [my Config_get external]] object [self]] + 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]] } } foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } return $result } method generate-debug {{spaces {}}} { set result {} - ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my Config_get filename]] links [my link list]]" + ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my define get filename]] links [my link list]]" foreach item [my link list subordinate] { practcl::cputs result [$item generate-debug "$spaces "] } return $result } method generate-cfile-constant {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} my variable code cstruct methods tcltype if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my Config_get filename] CONSTANT */" + ::practcl::cputs result "/* [my define get filename] CONSTANT */" ::practcl::cputs result $code(constant) } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue ::practcl::cputs result [$obj generate-cfile-constant] } return $result } method generate-cfile-public-structure {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cstruct methods tcltype set result {} if {[info exists code(struct)]} { ::practcl::cputs result $code(struct) } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue ::practcl::cputs result [$obj generate-cfile-public-structure] } return $result } method generate-cfile-header {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cfunct cstruct methods tcltype tclprocs set result {} if {[info exists code(header)]} { ::practcl::cputs result $code(header) } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue set dat [$obj generate-cfile-header] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-header */" + ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-header */" + ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */" } } return $result } method generate-cfile-global {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cfunct cstruct methods tcltype tclprocs set result {} if {[info exists code(global)]} { ::practcl::cputs result $code(global) } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue set dat [$obj generate-cfile-global] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-global */" + ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-global */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-global */" + ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-global */" } } return $result } method generate-cfile-private-typedef {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(private-typedef)]} { ::practcl::cputs result $code(private-typedef) } @@ -6067,18 +5865,18 @@ ::practcl::cputs result "typedef struct $name ${n}\;" } } } } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-cfile-private-typedef] } return $result } method generate-cfile-private-structure {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(private-structure)]} { ::practcl::cputs result $code(private-structure) } @@ -6089,18 +5887,18 @@ ::practcl::cputs result [dict get $info comment] } ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" } } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-cfile-private-structure] } return $result } method generate-cfile-functions {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cfunct set result {} if {[info exists code(funct)]} { ::practcl::cputs result $code(funct) } @@ -6114,59 +5912,59 @@ } } } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} { + if {[$obj define get output_c] ne {}} { continue } ::practcl::cputs result [$obj generate-cfile-functions] } return $result } method generate-cfile-tclapi {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code methods tclprocs set result {} if {[info exists code(method)]} { ::practcl::cputs result $code(method) } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj config get output_c] ne {}} continue + if {[$obj define get output_c] ne {}} continue ::practcl::cputs result [$obj generate-cfile-tclapi] } return $result } method generate-hfile-public-define {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code set result {} if {[info exists code(public-define)]} { ::practcl::cputs result $code(public-define) } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-hfile-public-define] } return $result } method generate-hfile-public-macro {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code set result {} if {[info exists code(public-macro)]} { ::practcl::cputs result $code(public-macro) } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-hfile-public-macro] } return $result } method generate-hfile-public-typedef {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(public-typedef)]} { ::practcl::cputs result $code(public-typedef) } @@ -6180,18 +5978,18 @@ ::practcl::cputs result "typedef struct $name ${n}\;" } } } } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-hfile-public-typedef] } return $result } method generate-hfile-public-structure {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(public-structure)]} { ::practcl::cputs result $code(public-structure) } @@ -6202,18 +6000,18 @@ ::practcl::cputs result [dict get $info comment] } ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" } } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-hfile-public-structure] } return $result } method generate-hfile-public-headers {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code tcltype set result {} if {[info exists code(public-header)]} { ::practcl::cputs result $code(public-header) } @@ -6229,40 +6027,40 @@ } } if {[info exists code(public)]} { ::practcl::cputs result $code(public) } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-hfile-public-headers] } return $result } method generate-hfile-public-function {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cfunct tcltype set result {} - if {[my Config_get initfunc] ne {}} { - ::practcl::cputs result "int [my Config_get initfunc](Tcl_Interp *interp);" + if {[my define get initfunc] ne {}} { + ::practcl::cputs result "int [my define get initfunc](Tcl_Interp *interp);" } if {[info exists cfunct]} { foreach {funcname info} $cfunct { if {![dict get $info public]} continue ::practcl::cputs result "[dict get $info header]\;" } } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach mod [my link list product] { ::practcl::cputs result [$mod generate-hfile-public-function] } return $result } method generate-hfile-public-includes {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set includes {} - foreach item [my Config_get public-include] { + foreach item [my define get public-include] { if {$item ni $includes} { lappend includes $item } } foreach mod [my link list product] { @@ -6273,13 +6071,13 @@ } } return $includes } method generate-hfile-public-verbatim {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set includes {} - foreach item [my Config_get public-verbatim] { + foreach item [my define get public-verbatim] { if {$item ni $includes} { lappend includes $item } } foreach mod [my link list subordinate] { @@ -6290,37 +6088,37 @@ } } return $includes } method generate-loader-external {} { - if {[my Config_get initfunc] eq {}} { - return "/* [my Config_get filename] declared not initfunc */" + if {[my define get initfunc] eq {}} { + return "/* [my define get filename] declared not initfunc */" } - return " if([my Config_get initfunc](interp)) return TCL_ERROR\;" + return " if([my define get initfunc](interp)) return TCL_ERROR\;" } method generate-loader-module {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code set result {} if {[info exists code(cinit)]} { ::practcl::cputs result $code(cinit) } - if {[my Config_get initfunc] ne {}} { - ::practcl::cputs result " if([my Config_get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" + if {[my define get initfunc] ne {}} { + ::practcl::cputs result " if([my define get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" } - set result [::practcl::_tagblock $result c [my Config_get filename]] + set result [::practcl::_tagblock $result c [my define get filename]] foreach item [my link list product] { - if {[$item config get output_c] ne {}} { + if {[$item define get output_c] ne {}} { ::practcl::cputs result [$item generate-loader-external] } else { ::practcl::cputs result [$item generate-loader-module] } } return $result } method generate-stub-function {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] my variable code cfunct tcltype set result {} foreach mod [my link list product] { foreach {funct def} [$mod generate-stub-function] { dict set result $funct $def @@ -6345,15 +6143,15 @@ } } } method generate-tcl-loader {} { set result {} - set PKGINIT [my Config_get pkginit] - set PKG_NAME [my Config_get name [my Config_get pkg_name]] - set PKG_VERSION [my Config_get pkg_vers [my Config_get version]] - if {[string is true [my Config_get SHARED_BUILD 0]]} { - set LIBFILE [my Config_get libfile] + set PKGINIT [my define get pkginit] + set PKG_NAME [my define get name [my define get pkg_name]] + set PKG_VERSION [my define get pkg_vers [my define get version]] + if {[string is true [my define get SHARED_BUILD 0]]} { + set LIBFILE [my define get libfile] ::practcl::cputs result [string map \ [list @LIBFILE@ $LIBFILE @PKGINIT@ $PKGINIT @PKG_NAME@ $PKG_NAME @PKG_VERSION@ $PKG_VERSION] { # Shared Library Style load [file join [file dirname [file join [pwd] [info script]]] @LIBFILE@] @PKGINIT@ package provide @PKG_NAME@ @PKG_VERSION@ @@ -6367,30 +6165,30 @@ }] } return $result } method generate-tcl-pre {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} my variable code if {[info exists code(tcl)]} { - set result [::practcl::_tagblock $code(tcl) tcl [my Config_get filename]] + set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] } if {[info exists code(tcl-pre)]} { - set result [::practcl::_tagblock $code(tcl) tcl [my Config_get filename]] + set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] } foreach mod [my link list product] { ::practcl::cputs result [$mod generate-tcl-pre] } return $result } method generate-tcl-post {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} my variable code if {[info exists code(tcl-post)]} { - set result [::practcl::_tagblock $code(tcl-post) tcl [my Config_get filename]] + set result [::practcl::_tagblock $code(tcl-post) tcl [my define get filename]] } foreach mod [my link list product] { ::practcl::cputs result [$mod generate-tcl-post] } return $result @@ -6397,25 +6195,25 @@ } method linktype {} { return {subordinate product} } method Ofile filename { - set lpath [my <module> config get localpath] + set lpath [my <module> define get localpath] if {$lpath eq {}} { - set lpath [my <module> config get name] + set lpath [my <module> define get name] } return ${lpath}_[file rootname [file tail $filename]] } method project-static-packages {} { - set result [my Config_get static_packages] - set initfunc [my Config_get initfunc] + set result [my define get static_packages] + set initfunc [my define get initfunc] if {$initfunc ne {}} { - set pkg_name [my Config_get pkg_name] + set pkg_name [my define get pkg_name] if {$pkg_name ne {}} { dict set result $pkg_name initfunc $initfunc - dict set result $pkg_name version [my Config_get version [my Config_get pkg_vers]] - dict set result $pkg_name autoload [my Config_get autoload 0] + dict set result $pkg_name version [my define get version [my define get pkg_vers]] + dict set result $pkg_name autoload [my define get autoload 0] } } foreach item [my link list subordinate] { foreach {pkg info} [$item project-static-packages] { dict set result $pkg $info @@ -6422,12 +6220,12 @@ } } return $result } method toolset-include-directory {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] - set result [my Config_get include_dir] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set result [my define get include_dir] foreach obj [my link list product] { foreach path [$obj toolset-include-directory] { lappend result $path } } @@ -6440,14 +6238,14 @@ } } oo::objdefine ::practcl::product { method select {object} { - set class [$object config get class] - set mixin [$object config get product] + set class [$object define get class] + set mixin [$object define get product] if {$class eq {} && $mixin eq {}} { - set filename [$object config get filename] + set filename [$object define get filename] if {$filename ne {} && [file exists $filename]} { switch [file extension $filename] { .tcl { set mixin ::practcl::product.dynamic } @@ -6491,20 +6289,20 @@ } ::clay::define ::practcl::product.csource { superclass ::practcl::product method project-compile-products {} { set result {} - set filename [my Config_get filename] + set filename [my define get filename] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my Config_get ofile] + set ofile [my define get ofile] } else { set ofile [my Ofile $filename] - my Config_set ofile $ofile + my define set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]] object [self]] + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]] object [self]] } foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } return $result @@ -6511,34 +6309,34 @@ } } ::clay::define ::practcl::product.clibrary { superclass ::practcl::product method linker-products {configdict} { - return [my Config_get filename] + return [my define get filename] } } ::clay::define ::practcl::product.dynamic { superclass ::practcl::dynamic ::practcl::product method initialize {} { - set filename [my Config_get filename] + set filename [my define get filename] if {$filename eq {}} { return } - if {[my Config_get name] eq {}} { - my Config_set name [file tail [file rootname $filename]] + if {[my define get name] eq {}} { + my define set name [file tail [file rootname $filename]] } - if {[my Config_get localpath] eq {}} { - my Config_set localpath [my <module> config get localpath]_[my Config_get name] + if {[my define get localpath] eq {}} { + my define set localpath [my <module> define get localpath]_[my define get name] } # Future Development: # Scan source file to see if it is encoded in criticl or practcl notation #set thisline {} #foreach line [split [::practcl::cat $filename] \n] { # #} ::source $filename - if {[my Config_get output_c] ne {}} { + if {[my define get output_c] ne {}} { # Turn into a module if we have an output_c file my morph ::practcl::module } } } @@ -6577,11 +6375,11 @@ ### # Build local variables needed for install ### package require platform set result {} - set dat [my Config_dump] + set dat [my define dump] set PKG_DIR [dict get $dat name][dict get $dat version] dict set result PKG_DIR $PKG_DIR dict with dat {} if {![info exists DESTDIR]} { set DESTDIR {} @@ -6651,11 +6449,11 @@ } } } Ensemble make::filename name { if {[dict exists $make_object $name]} { - return [[dict get $make_object $name] config get filename] + return [[dict get $make_object $name] define get filename] } } Ensemble make::target {name Info body} { set info [uplevel #0 [list subst $Info]] set nspace [namespace current] @@ -6687,22 +6485,24 @@ } Ensemble make::do {} { global CWD SRCDIR project SANDBOX foreach {name obj} $make_object { if {[$obj do]} { - eval [$obj config get action] + eval [$obj define get action] + } + } + } + method child which { + switch $which { + delegate - + organs { + return [list project [my define get project] module [self]] } } } - method Child_delegate {} { - return [list project [my Config_get project] module [self]] - } - method Child_organs {} { - return [list project [my Config_get project] module [self]] - } method generate-c {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result { /* This file was generated by practcl */ } set includes {} @@ -6711,20 +6511,20 @@ $mod go } set headers {} my IncludeAdd headers <tcl.h> <tclOO.h> - if {[my Config_get tk 0]} { + if {[my define get tk 0]} { my IncludeAdd headers <tk.h> } - if {[my Config_get output_h] ne {}} { - my IncludeAdd headers [my Config_get output_h] + if {[my define get output_h] ne {}} { + my IncludeAdd headers [my define get output_h] } - my IncludeAdd headers {*}[my Config_get include] + my IncludeAdd headers {*}[my define get include] foreach mod [my link list dynamic] { - my IncludeAdd headers {*}[$mod config get include] + my IncludeAdd headers {*}[$mod define get include] } foreach inc $headers { ::practcl::cputs result "#include $inc" } foreach {method} { @@ -6737,20 +6537,20 @@ generate-cfile-functions generate-cfile-tclapi } { set dat [my $method] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN $method [my Config_get filename] */" + ::practcl::cputs result "/* BEGIN $method [my define get filename] */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END $method [my Config_get filename] */" + ::practcl::cputs result "/* END $method [my define get filename] */" } } - ::practcl::debug [list /[self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] return $result } method generate-h {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} foreach method { generate-hfile-public-define generate-hfile-public-macro } { @@ -6790,22 +6590,22 @@ ::practcl::cputs result "/* END SECTION $method */" } return $result } method generate-loader {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set result {} - if {[my Config_get initfunc] eq {}} return + if {[my define get initfunc] eq {}} return ::practcl::cputs result " -extern int DLLEXPORT [my Config_get initfunc]( Tcl_Interp *interp ) \{" +extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \{" ::practcl::cputs result { /* Initialise the stubs tables. */ #ifdef USE_TCL_STUBS if (Tcl_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR; if (TclOOInitializeStubs(interp, "1.0") == NULL) return TCL_ERROR; } - if {[my Config_get tk 0]} { + if {[my define get tk 0]} { ::practcl::cputs result { if (Tk_InitStubs(interp, "8.6", 0)==NULL) return TCL_ERROR;} } ::practcl::cputs result { #endif} set TCLINIT [my generate-tcl-pre] if {[string length [string trim $TCLINIT]]} { @@ -6816,25 +6616,25 @@ set TCLINIT [my generate-tcl-post] if {[string length [string trim $TCLINIT]]} { ::practcl::cputs result " if(interp) {\nif(Tcl_Eval(interp,[::practcl::tcl_to_c $TCLINIT])) return TCL_ERROR;\n }" } if {[my define exists pkg_name]} { - ::practcl::cputs result " if (Tcl_PkgProvide(interp, \"[my Config_get pkg_name [my Config_get name]]\" , \"[my Config_get pkg_vers [my Config_get version]]\" )) return TCL_ERROR\;" + ::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\;" } ::practcl::cputs result " return TCL_OK\;\n\}\n" return $result } method initialize {} { - set filename [my Config_get filename] + set filename [my define get filename] if {$filename eq {}} { return } - if {[my Config_get name] eq {}} { - my Config_set name [file tail [file dirname $filename]] + if {[my define get name] eq {}} { + my define set name [file tail [file dirname $filename]] } - if {[my Config_get localpath] eq {}} { - my Config_set localpath [my <project> config get name]_[my Config_get name] + if {[my define get localpath] eq {}} { + my define set localpath [my <project> define get name]_[my define get name] } my graft module [self] ::practcl::debug [self] SOURCE $filename my source $filename } @@ -6842,21 +6642,21 @@ my go my Collate_Source $path set errs {} foreach item [my link list dynamic] { if {[catch {$item implement $path} err errdat]} { - lappend errs "Skipped $item: [$item config get filename] $err" + lappend errs "Skipped $item: [$item define get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } } } foreach item [my link list module] { if {[catch {$item implement $path} err errdat]} { - lappend errs "Skipped $item: [$item config get filename] $err" + lappend errs "Skipped $item: [$item define get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } @@ -6872,12 +6672,12 @@ ::practcl::log $logfile "*** DEBUG INFO ***" ::practcl::log $logfile $::DEBUG_INFO puts stderr "Errors saved to $logfile" exit 1 } - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] - set filename [my Config_get output_c] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set filename [my define get output_c] if {$filename eq {}} { ::practcl::debug [list /[self] [self method] [self class]] return } set cout [open [file join $path [file rootname $filename].c] w] @@ -6931,100 +6731,104 @@ if {[dict exists $rawcontents $field]} { dict set contents $field [dict get $rawcontents $field] } } my graft module [self] - my Config_merge $contents + array set define $contents ::practcl::toolset select [self] my initialize } method add_object object { my link object $object } method add_project {pkg info {oodefine {}}} { ::practcl::debug [self] add_project $pkg $info - set os [my Config_get TEACUP_OS] + set os [my define get TEACUP_OS] if {$os eq {}} { set os [::practcl::os] - my Config_set os $os + my define set os $os } - set fossilinfo [list download [my Config_get download] tag trunk sandbox [my Config_get sandbox]] + set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]] if {[dict exists $info os] && ($os ni [dict get $info os])} return # Select which tag to use here. # For production builds: tag-release - set profile [my Config_get profile release]: + set profile [my define get profile release]: if {[dict exists $info profile $profile]} { dict set info tag [dict get $info profile $profile] } - dict set info USEMSVC [my Config_get USEMSVC 0] - dict set info debug [my Config_get debug 0] + dict set info USEMSVC [my define get USEMSVC 0] + dict set info debug [my define get debug 0] set obj [namespace current]::PROJECT.$pkg if {[info command $obj] eq {}} { set obj [::practcl::subproject create $obj [self] [dict merge $fossilinfo [list name $pkg pkg_name $pkg static 0 class subproject.binary] $info]] } my link object $obj oo::objdefine $obj $oodefine - $obj config set masterpath $::CWD + $obj define set masterpath $::CWD $obj go return $obj } method add_tool {pkg info {oodefine {}}} { ::practcl::debug [self] add_tool $pkg $info set info [dict merge [::practcl::local_os] $info] set os [dict get $info TEACUP_OS] - set fossilinfo [list download [my Config_get download] tag trunk sandbox [my Config_get sandbox]] + set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]] if {[dict exists $info os] && ($os ni [dict get $info os])} return # Select which tag to use here. # For production builds: tag-release - set profile [my Config_get profile release]: + set profile [my define get profile release]: if {[dict exists $info profile $profile]} { dict set info tag [dict get $info profile $profile] } set obj ::practcl::OBJECT::TOOL.$pkg if {[info command $obj] eq {}} { set obj [::practcl::subproject create $obj [self] [dict merge $fossilinfo [list name $pkg pkg_name $pkg static 0] $info]] } my link add tool $obj oo::objdefine $obj $oodefine - $obj config set masterpath $::CWD + $obj define set masterpath $::CWD $obj go return $obj } method build-tclcore {} { - set os [my Config_get TEACUP_OS] + set os [my define get TEACUP_OS] set tcl_config_opts [::practcl::platform::tcl_core_options $os] set tk_config_opts [::practcl::platform::tk_core_options $os] - lappend tcl_config_opts --prefix [my Config_get prefix] --exec-prefix [my Config_get prefix] + lappend tcl_config_opts --prefix [my define get prefix] --exec-prefix [my define get prefix] set tclobj [my tclcore] - if {[my Config_get debug 0]} { - $tclobj config set debug 1 + if {[my define get debug 0]} { + $tclobj define set debug 1 lappend tcl_config_opts --enable-symbols=true } - $tclobj config set config_opts $tcl_config_opts + $tclobj define set config_opts $tcl_config_opts $tclobj go $tclobj compile - set _TclSrcDir [$tclobj config get localsrcdir] - my Config_set tclsrcdir $_TclSrcDir - if {[my Config_get tk 0]} { + set _TclSrcDir [$tclobj define get localsrcdir] + my define set tclsrcdir $_TclSrcDir + if {[my define get tk 0]} { set tkobj [my tkcore] - lappend tk_config_opts --with-tcl=[::practcl::file_relative [$tkobj config get builddir] [$tclobj config get builddir]] - if {[my Config_get debug 0]} { - $tkobj config set debug 1 + lappend tk_config_opts --with-tcl=[::practcl::file_relative [$tkobj define get builddir] [$tclobj define get builddir]] + if {[my define get debug 0]} { + $tkobj define set debug 1 lappend tk_config_opts --enable-symbols=true } - $tkobj config set config_opts $tk_config_opts + $tkobj define set config_opts $tk_config_opts $tkobj compile } } - method Child_delegate {} { - return [list project [self] module [self]] - } - method Child_organs {} { - return [list project [self] module [self]] + method child which { + switch $which { + delegate - + organs { + # A library can be a project, it can be a module. Any + # subordinate modules will indicate their existance + return [list project [self] module [self]] + } + } } method linktype {} { return project } method project {pkg args} { @@ -7094,11 +6898,11 @@ # START: class project library.tcl ### ::clay::define ::practcl::library { superclass ::practcl::project method clean {PATH} { - set objext [my Config_get OBJEXT o] + set objext [my define get OBJEXT o] foreach {ofile info} [my project-compile-products] { if {[file exists [file join $PATH objs $ofile].${objext}]} { file delete [file join $PATH objs $ofile].${objext} } } @@ -7106,11 +6910,11 @@ file delete $ofile } foreach ofile [glob -nocomplain [file join $PATH objs *]] { file delete $ofile } - set libfile [my Config_get libfile] + set libfile [my define get libfile] if {[file exists [file join $PATH $libfile]]} { file delete [file join $PATH $libfile] } my implement $PATH } @@ -7117,68 +6921,68 @@ method project-compile-products {} { set result {} foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } - set filename [my Config_get output_c] + set filename [my define get output_c] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename set ofile [file rootname [file tail $filename]]_main - lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] + lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] } return $result } method go {} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] - set name [my Config_get name] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + set name [my define getnull name] if {$name eq {}} { set name generic my define name generic } - if {[my Config_get tk] eq {@TEA_TK_EXTENSION@}} { - my Config_set tk 0 + if {[my define get tk] eq {@TEA_TK_EXTENSION@}} { + my define set tk 0 } - set output_c [my Config_get output_c] + set output_c [my define getnull output_c] if {$output_c eq {}} { set output_c [file rootname $name].c - my Config_set output_c $output_c + my define set output_c $output_c } - set output_h [my Config_get output_h] + set output_h [my define getnull output_h] if {$output_h eq {}} { set output_h [file rootname $output_c].h - my Config_set output_h $output_h + my define set output_h $output_h } - set output_tcl [my Config_get output_tcl] + set output_tcl [my define getnull output_tcl] #if {$output_tcl eq {}} { # set output_tcl [file rootname $output_c].tcl - # my Config_set output_tcl $output_tcl + # my define set output_tcl $output_tcl #} - #set output_mk [my Config_get output_mk] + #set output_mk [my define getnull output_mk] #if {$output_mk eq {}} { # set output_mk [file rootname $output_c].mk - # my Config_set output_mk $output_mk + # my define set output_mk $output_mk #} - set initfunc [my Config_get initfunc] + set initfunc [my define getnull initfunc] if {$initfunc eq {}} { set initfunc [string totitle $name]_Init - my Config_set initfunc $initfunc + my define set initfunc $initfunc } - set output_decls [my Config_get output_decls] + set output_decls [my define getnull output_decls] if {$output_decls eq {}} { set output_decls [file rootname $output_c].decls - my Config_set output_decls $output_decls + my define set output_decls $output_decls } my variable links foreach {linktype objs} [array get links] { foreach obj $objs { $obj go } } - ::practcl::debug [list /[self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] } method generate-decls {pkgname path} { - ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] set outfile [file join $path/$pkgname.decls] ### # Build the decls file ## # @@ -7200,12 +7004,12 @@ set thisline {} set functcount 0 foreach {func header} $stubfuncts { puts $fout [list declare [incr functcount] $header] } - puts $fout [list export "int [my Config_get initfunc](Tcl_Inter *interp)"] - puts $fout [list export "char *[string totitle [my Config_get name]]_InitStubs(Tcl_Inter *interp, char *version, int exact)"] + puts $fout [list export "int [my define get initfunc](Tcl_Inter *interp)"] + puts $fout [list export "char *[string totitle [my define get name]]_InitStubs(Tcl_Inter *interp, char *version, int exact)"] close $fout ### # Build [package]Decls.h @@ -7272,21 +7076,21 @@ my go my Collate_Source $path set errs {} foreach item [my link list dynamic] { if {[catch {$item implement $path} err errdat]} { - lappend errs "Skipped $item: [$item config get filename] $err" + lappend errs "Skipped $item: [$item define get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } } } foreach item [my link list module] { if {[catch {$item implement $path} err errdat]} { - lappend errs "Skipped $item: [$item config get filename] $err" + lappend errs "Skipped $item: [$item define get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } @@ -7302,21 +7106,21 @@ ::practcl::log $logfile "*** DEBUG INFO ***" ::practcl::log $logfile $::DEBUG_INFO puts stderr "Errors saved to $logfile" exit 1 } - set cout [open [file join $path [my Config_get output_c]] w] + set cout [open [file join $path [my define get output_c]] w] puts $cout [subst {/* ** This file is generated by the [info script] script ** any changes will be overwritten the next time it is run */}] puts $cout [my generate-c] puts $cout [my generate-loader] close $cout - set macro HAVE_[string toupper [file rootname [my Config_get output_h]]]_H - set hout [open [file join $path [my Config_get output_h]] w] + set macro HAVE_[string toupper [file rootname [my define get output_h]]]_H + set hout [open [file join $path [my define get output_h]] w] puts $hout [subst {/* ** This file is generated by the [info script] script ** any changes will be overwritten the next time it is run */}] puts $hout "#ifndef ${macro}" @@ -7323,13 +7127,13 @@ puts $hout "#define ${macro} 1" puts $hout [my generate-h] puts $hout "#endif" close $hout - set output_tcl [my Config_get output_tcl] + set output_tcl [my define get output_tcl] if {$output_tcl ne {}} { - set tclout [open [file join $path [my Config_get output_tcl]] w] + set tclout [open [file join $path [my define get output_tcl]] w] puts $tclout "### # This file is generated by the [info script] script # any changes will be overwritten the next time it is run ###" puts $tclout [my generate-tcl-pre] @@ -7344,20 +7148,20 @@ method linktype {} { return library } method package-ifneeded {args} { set result {} - set name [my Config_get pkg_name [my Config_get name]] - set version [my Config_get pkg_vers [my Config_get version]] + set name [my define get pkg_name [my define get name]] + set version [my define get pkg_vers [my define get version]] if {$version eq {}} { set version 0.1a } - set output_tcl [my Config_get output_tcl] + set output_tcl [my define get output_tcl] if {$output_tcl ne {}} { set script "\[list source \[file join \$dir $output_tcl\]\]" - } elseif {[my Config_get SHARED_BUILD 0]} { - set script "\[list load \[file join \$dir [my Config_get libfile]\] $name\]" + } elseif {[my define get SHARED_BUILD 0]} { + set script "\[list load \[file join \$dir [my define get libfile]\] $name\]" } else { # Provide a null passthrough set script "\[list package provide $name $version\]" } set result "package ifneeded [list $name] [list $version] $script" @@ -7366,31 +7170,31 @@ append result \n\n [list package ifneeded $alias $version $script] } return $result } method shared_library {{filename {}}} { - set name [string tolower [my Config_get name [my Config_get pkg_name]]] + set name [string tolower [my define get name [my define get pkg_name]]] set NAME [string toupper $name] - set version [my Config_get version [my Config_get pkg_vers]] + set version [my define get version [my define get pkg_vers]] set map {} lappend map %LIBRARY_NAME% $name lappend map %LIBRARY_VERSION% $version lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $version] - lappend map %LIBRARY_PREFIX% [my Config_get libprefix] - set outfile [string map $map [my Config_get PRACTCL_NAME_LIBRARY]][my Config_get SHLIB_SUFFIX] + lappend map %LIBRARY_PREFIX% [my define getnull libprefix] + set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]][my define get SHLIB_SUFFIX] return $outfile } method static_library {{filename {}}} { - set name [string tolower [my Config_get name [my Config_get pkg_name]]] + set name [string tolower [my define get name [my define get pkg_name]]] set NAME [string toupper $name] - set version [my Config_get version [my Config_get pkg_vers]] + set version [my define get version [my define get pkg_vers]] set map {} lappend map %LIBRARY_NAME% $name lappend map %LIBRARY_VERSION% $version lappend map %LIBRARY_VERSION_NODOTS% [string map {. {}} $version] - lappend map %LIBRARY_PREFIX% [my Config_get libprefix] - set outfile [string map $map [my Config_get PRACTCL_NAME_LIBRARY]].a + lappend map %LIBRARY_PREFIX% [my define getnull libprefix] + set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]].a return $outfile } } ### @@ -7454,14 +7258,14 @@ } # Build an area of the file for #define directives and # function declarations set define {} - set mainhook [$PROJECT config get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] - set mainfunc [$PROJECT config get TCL_LOCAL_APPINIT Tclkit_AppInit] - set mainscript [$PROJECT config get main.tcl main.tcl] - set vfsroot [$PROJECT config get vfsroot "[$PROJECT config get ZIPFS_VOLUME]app"] + set mainhook [$PROJECT define get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] + set mainfunc [$PROJECT define get TCL_LOCAL_APPINIT Tclkit_AppInit] + set mainscript [$PROJECT define get main.tcl main.tcl] + set vfsroot [$PROJECT define get vfsroot "[$PROJECT define get ZIPFS_VOLUME]app"] set vfs_main "${vfsroot}/${mainscript}" set map {} foreach var { vfsroot mainhook mainfunc vfs_main @@ -7504,11 +7308,11 @@ append main_init_script \n {if {[file exists [file join $::starkit::topdir pkgIndex.tcl]]} { #In a wrapped exe, we don't go out to the environment set dir $::starkit::topdir source [file join $::starkit::topdir pkgIndex.tcl] }} - append main_init_script \n [list set tcl_rcFileName [$PROJECT config get tcl_rcFileName ~/.tclshrc]] + append main_init_script \n [list set tcl_rcFileName [$PROJECT define get tcl_rcFileName ~/.tclshrc]] append preinitscript \n [list set ::starkit::thread_init $thread_init_script] append preinitscript \n {eval $::starkit::thread_init} set zvfsboot { /* * %mainhook% -- @@ -7521,11 +7325,11 @@ archive=Tcl_GetNameOfExecutable(); } # We have to initialize the virtual filesystem before calling # Tcl_Init(). Otherwise, Tcl_Init() will not be able to find # its startup script files. - if {![$PROJECT config get tip_430 0]} { + if {![$PROJECT define get tip_430 0]} { # Add declarations of functions that tip430 puts in the stub files $PROJECT code public-header { int TclZipfs_Init(Tcl_Interp *interp); int TclZipfs_Mount( Tcl_Interp *interp, @@ -7573,11 +7377,11 @@ } }])\;" ::practcl::cputs zvfsboot " \x7D" ::practcl::cputs zvfsboot " return TCL_OK;" - if {[$PROJECT config get TEACUP_OS] eq "windows"} { + if {[$PROJECT define get TEACUP_OS] eq "windows"} { set header {int %mainhook%(int *argc, TCHAR ***argv)} } else { set header {int %mainhook%(int *argc, char ***argv)} } $PROJECT c_function [string map $map $header] [string map $map $zvfsboot] @@ -7590,11 +7394,11 @@ if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } } - if {![$PROJECT config get tip_430 0]} { + if {![$PROJECT define get tip_430 0]} { ::practcl::cputs appinit { TclZipfs_Init(interp);} } foreach {statpkg info} $statpkglist { set initfunc {} if {[dict exists $info initfunc]} { @@ -7621,57 +7425,57 @@ practcl::cputs appinit { return TCL_OK;} $PROJECT c_function [string map $map "int %mainfunc%(Tcl_Interp *interp)"] [string map $map $appinit] } method Collate_Source CWD { next $CWD - set name [my Config_get name] + set name [my define get name] # Assume a static shell if {[my define exists SHARED_BUILD]} { - my Config_set SHARED_BUILD 0 + my define set SHARED_BUILD 0 } if {![my define exists TCL_LOCAL_APPINIT]} { - my Config_set TCL_LOCAL_APPINIT Tclkit_AppInit + my define set TCL_LOCAL_APPINIT Tclkit_AppInit } if {![my define exists TCL_LOCAL_MAIN_HOOK]} { - my Config_set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook + my define set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook } set PROJECT [self] - set os [$PROJECT config get TEACUP_OS] - if {[my Config_get SHARED_BUILD 0]} { + set os [$PROJECT define get TEACUP_OS] + if {[my define get SHARED_BUILD 0]} { puts [list BUILDING TCLSH FOR OS $os] } else { puts [list BUILDING KIT FOR OS $os] } set TCLOBJ [$PROJECT tclcore] ::practcl::toolset select $TCLOBJ - set TCLSRCDIR [$TCLOBJ config get srcdir] + set TCLSRCDIR [$TCLOBJ define get srcdir] set PKG_OBJS {} foreach item [$PROJECT link list core.library] { - if {[string is true [$item config get static]]} { + if {[string is true [$item define get static]]} { lappend PKG_OBJS $item } } foreach item [$PROJECT link list package] { - if {[string is true [$item config get static]]} { + if {[string is true [$item define get static]]} { lappend PKG_OBJS $item } } # Arrange to build an main.c that utilizes TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK if {$os eq "windows"} { set PLATFORM_SRC_DIR win - if {![my Config_get SHARED_BUILD 0]} { + if {![my define get SHARED_BUILD 0]} { my add class csource filename [file join $TCLSRCDIR win tclWinReg.c] initfunc Registry_Init pkg_name registry pkg_vers 1.3.1 autoload 1 my add class csource filename [file join $TCLSRCDIR win tclWinDde.c] initfunc Dde_Init pkg_name dde pkg_vers 1.4.0 autoload 1 } - my add class csource ofile [my Config_get name]_appinit.o filename [file join $TCLSRCDIR win tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my Config_get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my Config_get TCL_LOCAL_APPINIT Tclkit_AppInit]] + 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]] } else { set PLATFORM_SRC_DIR unix - my add class csource ofile [my Config_get name]_appinit.o filename [file join $TCLSRCDIR unix tclAppInit.c] extra [list -DTCL_LOCAL_MAIN_HOOK=[my Config_get TCL_LOCAL_MAIN_HOOK Tclkit_MainHook] -DTCL_LOCAL_APPINIT=[my Config_get TCL_LOCAL_APPINIT Tclkit_AppInit]] + 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]] } - if {![my Config_get SHARED_BUILD 0]} { + if {![my define get SHARED_BUILD 0]} { ### # Add local static Zlib implementation ### set cdir [file join $TCLSRCDIR compat zlib] foreach file { @@ -7687,57 +7491,57 @@ # Pre 8.7, Tcl doesn't include a Zipfs implementation # in the core. Grab the one from odielib ### set zipfs [file join $TCLSRCDIR generic tclZipfs.c] if {![$PROJECT define exists ZIPFS_VOLUME]} { - $PROJECT config set ZIPFS_VOLUME "zipfs:/" + $PROJECT define set ZIPFS_VOLUME "zipfs:/" } - $PROJECT code header "#define ZIPFS_VOLUME \"[$PROJECT config get ZIPFS_VOLUME]\"" + $PROJECT code header "#define ZIPFS_VOLUME \"[$PROJECT define get ZIPFS_VOLUME]\"" if {[file exists $zipfs]} { - $TCLOBJ config set tip_430 1 - my Config_set tip_430 1 + $TCLOBJ define set tip_430 1 + my define set tip_430 1 } else { # The Tclconfig project maintains a mirror of the version # released with the Tcl core - my Config_set tip_430 0 - set tclzipfs_c [my Config_get tclzipfs_c] + my define set tip_430 0 + set tclzipfs_c [my define get tclzipfs_c] if {![file exists $tclzipfs_c]} { ::practcl::LOCAL tool tclconfig unpack - set COMPATSRCROOT [::practcl::LOCAL tool tclconfig config get srcdir] + set COMPATSRCROOT [::practcl::LOCAL tool tclconfig define get srcdir] set tclzipfs_c [file join $COMPATSRCROOT compat tclZipfs.c] } my add class csource ofile tclZipfs.o filename $tclzipfs_c \ extra -I[::practcl::file_relative $CWD [file join $TCLSRCDIR compat zlib contrib minizip]] } - my Config_add include_dir [file join $TCLSRCDIR generic] - my Config_add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR] + my define add include_dir [file join $TCLSRCDIR generic] + my define add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR] # This file will implement TCL_LOCAL_APPINIT and TCL_LOCAL_MAIN_HOOK my build-tclkit_main $PROJECT $PKG_OBJS } method wrap {PWD exename vfspath args} { cd $PWD if {![file exists $vfspath]} { file mkdir $vfspath } foreach item [my link list core.library] { - set name [$item config get name] - set libsrcdir [$item config get srcdir] + set name [$item define get name] + set libsrcdir [$item define get srcdir] if {[file exists [file join $libsrcdir library]]} { ::practcl::copyDir [file join $libsrcdir library] [file join $vfspath ${name}_library] } } # Assume the user will populate the VFS path - #if {[my Config_get installdir] ne {}} { - # ::practcl::copyDir [file join [my Config_get installdir] [string trimleft [my Config_get prefix] /] lib] [file join $vfspath lib] + #if {[my define get installdir] ne {}} { + # ::practcl::copyDir [file join [my define get installdir] [string trimleft [my define get prefix] /] lib] [file join $vfspath lib] #} foreach arg $args { ::practcl::copyDir $arg $vfspath } set fout [open [file join $vfspath pkgIndex.tcl] w] - puts $fout [string map [list %platform% [my Config_get TEACUP_PROFILE]] {set ::tcl_teapot_profile {%platform%}}] + puts $fout [string map [list %platform% [my define get TEACUP_PROFILE]] {set ::tcl_teapot_profile {%platform%}}] puts $fout { namespace eval ::starkit {} set ::PKGIDXFILE [info script] set dir [file dirname $::PKGIDXFILE] if {$::tcl_platform(platform) eq "windows"} { @@ -7769,14 +7573,14 @@ } } } close $fout - set EXEEXT [my Config_get EXEEXT] - set tclkit_bare [my Config_get tclkit_bare] + set EXEEXT [my define get EXEEXT] + set tclkit_bare [my define get tclkit_bare] ::practcl::mkzip ${exename}${EXEEXT} $tclkit_bare $vfspath - if { [my Config_get TEACUP_OS] ne "windows" } { + if { [my define get TEACUP_OS] ne "windows" } { file attributes ${exename}${EXEEXT} -permissions a+x } } } @@ -7795,35 +7599,35 @@ tags {} isodate {} } } method DistroMixIn {} { - my Config_set scm none + my define set scm none } method Sandbox {} { if {[my define exists sandbox]} { - return [my Config_get sandbox] + return [my define get sandbox] } if {[my clay delegate project] ni {::noop {}}} { - set sandbox [my <project> config get sandbox] + set sandbox [my <project> define get sandbox] if {$sandbox ne {}} { - my Config_set sandbox $sandbox + my define set sandbox $sandbox return $sandbox } } set sandbox [file normalize [file join $::CWD ..]] - my Config_set sandbox $sandbox + my define set sandbox $sandbox return $sandbox } method SrcDir {} { - set pkg [my Config_get name] + set pkg [my define get name] if {[my define exists srcdir]} { - return [my Config_get srcdir] + return [my define get srcdir] } set sandbox [my Sandbox] set srcdir [file join [my Sandbox] $pkg] - my Config_set srcdir $srcdir + my define set srcdir $srcdir return $srcdir } method ScmTag {} {} method ScmClone {} {} method ScmUnpack {} {} @@ -7831,14 +7635,14 @@ method Unpack {} { set srcdir [my SrcDir] if {[file exists $srcdir]} { return } - set pkg [my Config_get name] + set pkg [my define get name] if {[my define exists download]} { # Utilize a staged download - set download [my Config_get download] + set download [my define get download] if {[file exists [file join $download $pkg.zip]]} { ::practcl::tcllib_require zipfile::decode ::zipfile::decode::unzipfile [file join $download $pkg.zip] $srcdir return } @@ -7847,61 +7651,61 @@ } } oo::objdefine ::practcl::distribution { method Sandbox {object} { if {[$object define exists sandbox]} { - return [$object config get sandbox] + return [$object define get sandbox] } if {[$object clay delegate project] ni {::noop {}}} { - set sandbox [$object <project> config get sandbox] + set sandbox [$object <project> define get sandbox] if {$sandbox ne {}} { - $object config set sandbox $sandbox + $object define set sandbox $sandbox return $sandbox } } - set pkg [$object config get name] + set pkg [$object define get name] set sandbox [file normalize [file join $::CWD ..]] - $object config set sandbox $sandbox + $object define set sandbox $sandbox return $sandbox } method select object { if {[$object define exists scm]} { - return [$object config get scm] + return [$object define get scm] } - set pkg [$object config get name] - if {[$object config get srcdir] ne {}} { - set srcdir [$object config get srcdir] + set pkg [$object define get name] + if {[$object define get srcdir] ne {}} { + set srcdir [$object define get srcdir] } else { set srcdir [file join [my Sandbox $object] $pkg] - $object config set srcdir $srcdir + $object define set srcdir $srcdir } set classprefix ::practcl::distribution. if {[file exists $srcdir]} { foreach class [::info commands ${classprefix}*] { if {[$class claim_path $srcdir]} { $object clay mixinmap distribution $class set name [$class claim_option] - $object config set scm $name + $object define set scm $name return $name } } } foreach class [::info commands ${classprefix}*] { if {[$class claim_object $object]} { $object clay mixinmap distribution $class set name [$class claim_option] - $object config set scm $name + $object define set scm $name return $name } } - if {[$object config get scm] eq {} && [$object define exists file_url]} { + if {[$object define get scm] eq {} && [$object define exists file_url]} { set class ::practcl::distribution.snapshot set name [$class claim_option] - $object config set scm $name + $object define set scm $name $object clay mixinmap distribution $class return $name } error "Cannot determine source distribution method" } @@ -7930,12 +7734,12 @@ method ScmUnpack {} { set srcdir [my SrcDir] if {[file exists [file join $srcdir .download]]} { return 0 } - set dpath [::practcl::LOCAL config get download] - set url [my Config_get file_url] + set dpath [::practcl::LOCAL define get download] + set url [my define get file_url] set fname [file tail $url] set archive [file join $dpath $fname] if {![file exists $archive]} { ::http::wget $url $archive } @@ -7992,11 +7796,11 @@ ::clay::define ::practcl::distribution.fossil { superclass ::practcl::distribution method scm_info {} { set info [next] dict set info scm fossil - foreach {field value} [::practcl::fossil_status [my Config_get srcdir]] { + foreach {field value} [::practcl::fossil_status [my define get srcdir]] { dict set info $field $value } return $info } method ScmClone {} { @@ -8009,19 +7813,19 @@ } if {![::info exists ::practcl::fossil_dbs]} { # Get a list of local fossil databases set ::practcl::fossil_dbs [exec fossil all list] } - set pkg [my Config_get name] + set pkg [my define get name] # Return an already downloaded fossil repo foreach line [split $::practcl::fossil_dbs \n] { set line [string trim $line] if {[file rootname [file tail $line]] eq $pkg} { return $line } } - set download [::practcl::LOCAL config get download] + set download [::practcl::LOCAL define get download] set fosdb [file join $download $pkg.fos] if {[file exists $fosdb]} { return $fosdb } @@ -8032,23 +7836,23 @@ } set cloned 0 # Attempt to clone from a local network mirror if {[::practcl::LOCAL define exists fossil_mirror]} { - set localmirror [::practcl::LOCAL config get fossil_mirror] + set localmirror [::practcl::LOCAL define get fossil_mirror] catch { ::practcl::doexec fossil clone $localmirror/$pkg $fosdb set cloned 1 } if {$cloned} { return $fosdb } } # Attempt to clone from the canonical source - if {[my Config_get fossil_url] ne {}} { + if {[my define get fossil_url] ne {}} { catch { - ::practcl::doexec fossil clone [my Config_get fossil_url] $fosdb + ::practcl::doexec fossil clone [my define get fossil_url] $fosdb set cloned 1 } if {$cloned} { return $fosdb } @@ -8057,18 +7861,18 @@ ::practcl::doexec fossil clone http://fossil.etoyoc.com/fossil/$pkg $fosdb return $fosdb } method ScmTag {} { if {[my define exists scm_tag]} { - return [my Config_get scm_tag] + return [my define get scm_tag] } if {[my define exists tag]} { - set tag [my Config_get tag] + set tag [my define get tag] } else { set tag trunk } - my Config_set scm_tag $tag + my define set scm_tag $tag return $tag } method ScmUnpack {} { set srcdir [my SrcDir] if {[file exists [file join $srcdir .fslckout]]} { @@ -8095,15 +7899,15 @@ } oo::objdefine ::practcl::distribution.fossil { # Check for markers in the metadata method claim_object obj { - set path [$obj config get srcdir] + set path [$obj define get srcdir] if {[my claim_path $path]} { return true } - if {[$obj config get fossil_url] ne {}} { + if {[$obj define get fossil_url] ne {}} { return true } return false } @@ -8131,30 +7935,30 @@ ### ::clay::define ::practcl::distribution.git { superclass ::practcl::distribution method ScmTag {} { if {[my define exists scm_tag]} { - return [my Config_get scm_tag] + return [my define get scm_tag] } if {[my define exists tag]} { - set tag [my Config_get tag] + set tag [my define get tag] } else { set tag master } - my Config_set scm_tag $tag + my define set scm_tag $tag return $tag } method ScmUnpack {} { set srcdir [my SrcDir] if {[file exists [file join $srcdir .git]]} { return 0 } set CWD [pwd] set tag [my ScmTag] - set pkg [my Config_get name] + set pkg [my define get name] if {[my define exists git_url]} { - ::practcl::doexec git clone --branch $tag [my Config_get git_url] $srcdir + ::practcl::doexec git clone --branch $tag [my define get git_url] $srcdir } else { ::practcl::doexec git clone --branch $tag https://github.com/eviltwinskippy/$pkg $srcdir } return 1 } @@ -8170,15 +7974,15 @@ } } oo::objdefine ::practcl::distribution.git { method claim_object obj { - set path [$obj config get srcdir] + set path [$obj define get srcdir] if {[my claim_path $path]} { return true } - if {[$obj config get git_url] ne {}} { + if {[$obj define get git_url] ne {}} { return true } return false } @@ -8204,24 +8008,28 @@ superclass ::practcl::module method _MorphPatterns {} { return {{::practcl::subproject.@name@} {::practcl::@name@} {@name@} {::practcl::subproject}} } method BuildDir {PWD} { - return [my Config_get srcdir] + return [my define get srcdir] } - method Child_delegate {} { - return [list project [self] module [self]] - } - method Child_organs {} { - return [list project [self] module [self]] + method child which { + switch $which { + delegate - + organs { + # A library can be a project, it can be a module. Any + # subordinate modules will indicate their existance + return [list project [self] module [self]] + } + } } method compile {} {} method go {} { ::practcl::distribution select [self] - set name [my Config_get name] - my Config_set builddir [my BuildDir [my Config_get masterpath]] - my Config_set builddir [my BuildDir [my Config_get masterpath]] + set name [my define get name] + my define set builddir [my BuildDir [my define get masterpath]] + my define set builddir [my BuildDir [my define get masterpath]] my sources } method install args {} method linktype {} { return {subordinate package} @@ -8240,11 +8048,11 @@ return [dict get $configdict PRACTCL_LINKER_EXTRA] } return {} } method env-bootstrap {} { - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] package require $pkg } method env-exec {} {} method env-install {} { my unpack @@ -8259,11 +8067,11 @@ } my env-bootstrap set loaded 1 } method env-present {} { - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] if {[catch [list package require $pkg]]} { return 0 } return 1 } @@ -8280,49 +8088,49 @@ } } ::clay::define ::practcl::subproject.source { superclass ::practcl::subproject ::practcl::library method env-bootstrap {} { - set LibraryRoot [file join [my Config_get srcdir] [my Config_get module_root modules]] + set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] if {[file exists $LibraryRoot] && $LibraryRoot ni $::auto_path} { set ::auto_path [linsert $::auto_path 0 $LibraryRoot] } } method env-present {} { - set path [my Config_get srcdir] + set path [my define get srcdir] return [file exists $path] } method linktype {} { return {subordinate package source} } } ::clay::define ::practcl::subproject.teapot { superclass ::practcl::subproject method env-bootstrap {} { - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] package require $pkg } method env-install {} { - set pkg [my Config_get pkg_name [my Config_get name]] - set download [my <project> config get download] + set pkg [my define get pkg_name [my define get name]] + set download [my <project> define get download] my unpack - set prefix [string trimleft [my <project> config get prefix] /] + set prefix [string trimleft [my <project> define get prefix] /] ::practcl::tcllib_require zipfile::decode ::zipfile::decode::unzipfile [file join $download $pkg.zip] [file join $prefix lib $pkg] } method env-present {} { - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] if {[catch [list package require $pkg]]} { return 0 } return 1 } method install DEST { - set pkg [my Config_get pkg_name [my Config_get name]] - set download [my <project> config get download] + set pkg [my define get pkg_name [my define get name]] + set download [my <project> define get download] my unpack - set prefix [string trimleft [my <project> config get prefix] /] + set prefix [string trimleft [my <project> define get prefix] /] ::practcl::tcllib_require zipfile::decode ::zipfile::decode::unzipfile [file join $download $pkg.zip] [file join $DEST $prefix lib $pkg] } } ::clay::define ::practcl::subproject.kettle { @@ -8329,11 +8137,11 @@ superclass ::practcl::subproject method kettle {path args} { my variable kettle if {![info exists kettle]} { ::practcl::LOCAL tool kettle env-load - set kettle [file join [::practcl::LOCAL tool kettle config get srcdir] kettle] + set kettle [file join [::practcl::LOCAL tool kettle define get srcdir] kettle] } set srcdir [my SourceRoot] ::practcl::dotclexec $kettle -f [file join $srcdir build.tcl] {*}$args } method install DEST { @@ -8341,58 +8149,58 @@ } } ::clay::define ::practcl::subproject.critcl { superclass ::practcl::subproject method install DEST { - my critcl -pkg [my Config_get name] + my critcl -pkg [my define get name] set srcdir [my SourceRoot] - ::practcl::copyDir [file join $srcdir [my Config_get name]] [file join $DEST lib [my Config_get name]] + ::practcl::copyDir [file join $srcdir [my define get name]] [file join $DEST lib [my define get name]] } } ::clay::define ::practcl::subproject.sak { superclass ::practcl::subproject method env-bootstrap {} { - set LibraryRoot [file join [my Config_get srcdir] [my Config_get module_root modules]] + set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] if {[file exists $LibraryRoot] && $LibraryRoot ni $::auto_path} { set ::auto_path [linsert $::auto_path 0 $LibraryRoot] } } method env-install {} { ### # Handle teapot installs ### - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] my unpack - set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] - set srcdir [my Config_get srcdir] + set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] + set srcdir [my define get srcdir] ::practcl::dotclexec [file join $srcdir installer.tcl] \ -apps -app-path [file join $prefix apps] \ -html -html-path [file join $prefix doc html $pkg] \ -pkg-path [file join $prefix lib $pkg] \ -no-nroff -no-wait -no-gui } method env-present {} { - set path [my Config_get srcdir] + set path [my define get srcdir] return [file exists $path] } method install DEST { ### # Handle teapot installs ### - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] my unpack - set prefix [string trimleft [my <project> config get prefix] /] - set srcdir [my Config_get srcdir] + set prefix [string trimleft [my <project> define get prefix] /] + set srcdir [my define get srcdir] ::practcl::dotclexec [file join $srcdir installer.tcl] \ -pkg-path [file join $DEST $prefix lib $pkg] \ -no-examples -no-html -no-nroff \ -no-wait -no-gui -no-apps } method install-module {DEST args} { - set srcdir [my Config_get srcdir] + set srcdir [my define get srcdir] if {[llength $args]==1 && [lindex $args 0] in {* all}} { - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] ::practcl::dotclexec [file join $srcdir installer.tcl] \ -pkg-path [file join $DEST $pkg] \ -no-examples -no-html -no-nroff \ -no-wait -no-gui -no-apps } else { @@ -8403,39 +8211,39 @@ } } ::clay::define ::practcl::subproject.practcl { superclass ::practcl::subproject method env-bootstrap {} { - set LibraryRoot [file join [my Config_get srcdir] [my Config_get module_root modules]] + set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] if {[file exists $LibraryRoot] && $LibraryRoot ni $::auto_path} { set ::auto_path [linsert $::auto_path 0 $LibraryRoot] } } method env-install {} { ### # Handle teapot installs ### - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] my unpack - set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] - set srcdir [my Config_get srcdir] + set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] + set srcdir [my define get srcdir] ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $prefix lib $pkg] } method install DEST { ### # Handle teapot installs ### - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] my unpack - set prefix [string trimleft [my <project> config get prefix] /] - set srcdir [my Config_get srcdir] - puts [list INSTALLING [my Config_get name] to [file join $DEST $prefix lib $pkg]] + set prefix [string trimleft [my <project> define get prefix] /] + set srcdir [my define get srcdir] + puts [list INSTALLING [my define get name] to [file join $DEST $prefix lib $pkg]] ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $DEST $prefix lib $pkg] } method install-module {DEST args} { - set pkg [my Config_get pkg_name [my Config_get name]] - set srcdir [my Config_get srcdir] + set pkg [my define get pkg_name [my define get name]] + set srcdir [my define get srcdir] ::practcl::dotclexec [file join $srcdir make.tcl] install-module $DEST {*}$args } } ### @@ -8445,11 +8253,11 @@ # START: class subproject binary.tcl ### ::clay::define ::practcl::subproject.binary { superclass ::practcl::subproject method clean {} { - set builddir [file normalize [my Config_get builddir]] + set builddir [file normalize [my define get builddir]] if {![file exists $builddir]} return if {[file exists [file join $builddir make.tcl]]} { ::practcl::domake.tcl $builddir clean } else { catch {::practcl::domake $builddir clean} @@ -8457,44 +8265,44 @@ } method env-install {} { ### # Handle tea installs ### - set pkg [my Config_get pkg_name [my Config_get name]] + set pkg [my define get pkg_name [my define get name]] set os [::practcl::local_os] - my Config_set os $os + my define set os $os my unpack - set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] - set srcdir [my Config_get srcdir] + set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] + set srcdir [my define get srcdir] lappend options --prefix $prefix --exec-prefix $prefix - my Config_set config_opts $options + my define set config_opts $options my go my clean my compile my make install {} } method project-compile-products {} {} method ComputeInstall {} { if {[my define exists install]} { - switch [my Config_get install] { + switch [my define get install] { static { - my Config_set static 1 - my Config_set autoload 0 + my define set static 1 + my define set autoload 0 } static-autoload { - my Config_set static 1 - my Config_set autoload 1 + my define set static 1 + my define set autoload 1 } vfs { - my Config_set static 0 - my Config_set autoload 0 - my Config_set vfsinstall 1 + my define set static 0 + my define set autoload 0 + my define set vfsinstall 1 } null { - my Config_set static 0 - my Config_set autoload 0 - my Config_set vfsinstall 0 + my define set static 0 + my define set autoload 0 + my define set vfsinstall 0 } default { } } @@ -8502,46 +8310,46 @@ } method go {} { next ::practcl::distribution select [self] my ComputeInstall - my Config_set builddir [my BuildDir [my Config_get masterpath]] + my define set builddir [my BuildDir [my define get masterpath]] } method linker-products {configdict} { - if {![my Config_get static 0]} { + if {![my define get static 0]} { return {} } - set srcdir [my Config_get builddir] + set srcdir [my define get builddir] if {[dict exists $configdict libfile]} { return " [file join $srcdir [dict get $configdict libfile]]" } } method project-static-packages {} { - if {![my Config_get static 0]} { + if {![my define get static 0]} { return {} } - set result [my Config_get static_packages] - set statpkg [my Config_get static_pkg] - set initfunc [my Config_get initfunc] + set result [my define get static_packages] + set statpkg [my define get static_pkg] + set initfunc [my define get initfunc] if {$initfunc ne {}} { - set pkg_name [my Config_get pkg_name] + set pkg_name [my define get pkg_name] if {$pkg_name ne {}} { dict set result $pkg_name initfunc $initfunc - set version [my Config_get version] + set version [my define get version] if {$version eq {}} { my unpack set info [my read_configuration] set version [dict get $info version] set pl {} if {[dict exists $info patch_level]} { set pl [dict get $info patch_level] append version $pl } - my Config_set version $version + my define set version $version } dict set result $pkg_name version $version - dict set result $pkg_name autoload [my Config_get autoload 0] + dict set result $pkg_name autoload [my define get autoload 0] } } foreach item [my link list subordinate] { foreach {pkg info} [$item project-static-packages] { dict set result $pkg $info @@ -8548,35 +8356,35 @@ } } return $result } method BuildDir {PWD} { - set name [my Config_get name] - set debug [my Config_get debug 0] - if {[my <project> config get LOCAL 0]} { - return [my Config_get builddir [file join $PWD local $name]] + set name [my define get name] + set debug [my define get debug 0] + if {[my <project> define get LOCAL 0]} { + return [my define get builddir [file join $PWD local $name]] } if {$debug} { - return [my Config_get builddir [file join $PWD debug $name]] + return [my define get builddir [file join $PWD debug $name]] } else { - return [my Config_get builddir [file join $PWD pkg $name]] + return [my define get builddir [file join $PWD pkg $name]] } } method compile {} { - set name [my Config_get name] + set name [my define get name] set PWD $::CWD cd $PWD my unpack set srcdir [file normalize [my SrcDir]] set localsrcdir [my MakeDir $srcdir] - my Config_set localsrcdir $localsrcdir + my define set localsrcdir $localsrcdir my Collate_Source $PWD ### # Build a starter VFS for both Tcl and wish ### - set srcdir [my Config_get srcdir] - if {[my Config_get static 1]} { + set srcdir [my define get srcdir] + if {[my define get static 1]} { puts "BUILDING Static $name $srcdir" } else { puts "BUILDING Dynamic $name $srcdir" } my make compile @@ -8584,26 +8392,26 @@ } method Configure {} { cd $::CWD my unpack ::practcl::toolset select [self] - set srcdir [file normalize [my Config_get srcdir]] - set builddir [file normalize [my Config_get builddir]] + set srcdir [file normalize [my define get srcdir]] + set builddir [file normalize [my define get builddir]] file mkdir $builddir my make autodetect } method install DEST { set PWD [pwd] - set PREFIX [my <project> config get prefix] + set PREFIX [my <project> define get prefix] ### # Handle teapot installs ### - set pkg [my Config_get pkg_name [my Config_get name]] - if {[my <project> config get teapot] ne {}} { - set TEAPOT [my <project> config get teapot] + set pkg [my define get pkg_name [my define get name]] + if {[my <project> define get teapot] ne {}} { + set TEAPOT [my <project> define get teapot] set found 0 - foreach ver [my Config_get pkg_vers [my Config_get version]] { + foreach ver [my define get pkg_vers [my define get version]] { set teapath [file join $TEAPOT $pkg$ver] if {[file exists $teapath]} { set dest [file join $DEST [string trimleft $PREFIX /] lib [file tail $teapath]] ::practcl::copyDir $teapath $dest return @@ -8639,29 +8447,29 @@ ### ::clay::define ::practcl::subproject.core { superclass ::practcl::subproject.binary method env-bootstrap {} {} method env-present {} { - set PREFIX [my <project> config get prefix] - set name [my Config_get name] + set PREFIX [my <project> define get prefix] + set name [my define get name] set fname [file join $PREFIX lib ${name}Config.sh] return [file exists $fname] } method env-install {} { my unpack set os [::practcl::local_os] - set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] lappend options --prefix $prefix --exec-prefix $prefix - my Config_set config_opts $options + my define set config_opts $options puts [list [self] OS [dict get $os TEACUP_OS] options $options] my go my compile my make install {} } method go {} { - my Config_set core_binary 1 + my define set core_binary 1 next } method linktype {} { return {subordinate core.library} } @@ -8674,12 +8482,12 @@ # START: class tool.tcl ### set ::practcl::MAIN ::practcl::LOCAL set ::auto_index(::practcl::LOCAL) { ::practcl::project create ::practcl::LOCAL - ::practcl::LOCAL config set [::practcl::local_os] - ::practcl::LOCAL config set LOCAL 1 + ::practcl::LOCAL define set [::practcl::local_os] + ::practcl::LOCAL define set LOCAL 1 # Until something better comes along, use ::practcl::LOCAL # as our main project # Add tclconfig as a project of record ::practcl::LOCAL add_tool tclconfig { @@ -8704,12 +8512,12 @@ method env-bootstrap {} { package require critcl::app } method env-install {} { my unpack - set prefix [my <project> config get prefix [file join [file normalize ~] tcl]] - set srcdir [my Config_get srcdir] + set prefix [my <project> define get prefix [file join [file normalize ~] tcl]] + set srcdir [my define get srcdir] ::practcl::dotclexec [file join $srcdir build.tcl] install [file join $prefix lib] } } ::practcl::LOCAL add_tool odie { tag trunk class subproject.source