[my <head> tag title] - my <head> tag meta charset [my html 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 html 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 html get title] + my <title> content [my config get title] } } ::clay::define ::gilgamesh::core/avatar { Index: make.tcl ================================================================== --- make.tcl +++ make.tcl @@ -12,11 +12,11 @@ ::practcl::library create PROJECT { name clay version 0.1 } -[::practcl::LOCAL tool tcllib] define set tag hypnotoad +[::practcl::LOCAL tool tcllib] config set tag hypnotoad ::practcl::LOCAL add_tool clay { tag trunk class subproject.sak install vfs fossil_url http://fossil.etoyoc.com/clay @@ -138,65 +138,65 @@ } } { set obj [::practcl::LOCAL tool $project] $obj unpack $obj update - set lsrcdir [$obj define get srcdir] + set lsrcdir [$obj config get srcdir] foreach module $modules { installModule [file join $lsrcdir modules $module] $DEST } } } claykit { set dat [::practcl::config.tcl $CWD] set object TCLKIT ::practcl::tclkit create $object $dat - $object define set name claykit - $object define set sandbox $::SANDBOX - $object define set srcdir $::SRCDIR + $object config set name claykit + $object config set sandbox $::SANDBOX + $object config set srcdir $::SRCDIR $object source [file join $::SRCDIR claykit.ini] - set INSTALLDIR [$object define get installdir] - if {![file exists [$object define get tclkit_bare]]} { + set INSTALLDIR [$object config get installdir] + if {![file exists [$object config get tclkit_bare]]} { $object build-tclcore $object implement $CWD foreach item [$object link list package] { - if {![string is true [$item define get static 0]]} continue - puts [list GENERATING $item [$item define get srcdir]] + if {![string is true [$item config get static 0]]} continue + puts [list GENERATING $item [$item config get srcdir]] $item compile } - $object build-tclsh [$object define get tclkit_bare] $object + $object build-tclsh [$object config get tclkit_bare] $object } - set VFS [file join $CWD [$object define get vfs]] + set VFS [file join $CWD [$object config get vfs]] file mkdir $VFS foreach item [$object link list package] { - set modlist [$item define get module_list] - puts [list PACKAGE INSTALL [$item define get name] MODLIST $modlist] + set modlist [$item config get module_list] + puts [list PACKAGE INSTALL [$item config get name] MODLIST $modlist] if {[llength $modlist]} { if {[catch {$item install-module [file join ${VFS} modules] {*}$modlist} error errdat]} { puts stderr "BUILD FAILURE $item" puts "FAILED TO INSTALL package $item" puts [dict get $errdat -errorinfo] exit 1 } - } elseif {[string is true [$item define get vfsinstall 1]]} { - puts [list GENERATING $item [$item define get srcdir]] + } elseif {[string is true [$item config get vfsinstall 1]]} { + puts [list GENERATING $item [$item config get srcdir]] if {[catch {$item install $INSTALLDIR} error errdat]} { puts stderr "BUILD FAILURE $item" puts "FAILED TO INSTALL package $item" puts [dict get $errdat -errorinfo] exit 1 } } } # Copy in our "secret squirrel" code - #set SCMCOPY [list ::exec [WISHKIT define get tclkit_bare] [file join $::SRCDIR scripts scm-copy.tcl]] + #set SCMCOPY [list ::exec [WISHKIT config get tclkit_bare] [file join $::SRCDIR scripts scm-copy.tcl]] #set SCMCOPY ::practcl::copyDir #{*}$SCMCOPY [file join $::SRCDIR src] ${VFS} - if {[$object define get debug 0]} { - $object wrap $CWD [$object define get exe] $VFS [file join $CWD PKGROOT] + if {[$object config get debug 0]} { + $object wrap $CWD [$object config get exe] $VFS [file join $CWD PKGROOT] } else { - $object wrap $CWD [$object define get exe] $VFS [file join $CWD PKGROOT] + $object wrap $CWD [$object config get exe] $VFS [file join $CWD PKGROOT] } } modules { set modules [modules] puts $modules Index: modules/clay-tk-console/build/core.tcl ================================================================== --- modules/clay-tk-console/build/core.tcl +++ modules/clay-tk-console/build/core.tcl @@ -6,19 +6,19 @@ ### namespace eval ::clay::tk::console {} ::clay::define ::clay::tk::hull.console { Variable ismain 0 - clay set option language { + Option language { default tcl class mixin pattern ::clay::tk::console } - clay set option title { + Option title { default {} } - clay set option prompt { + Option prompt { default {tcl% } } set has_consolas [expr {"Consolas" in [font families]}] if {$has_consolas} { set font {Consolas 10} @@ -36,11 +36,11 @@ windows { set font {systemfixed 9} } } } - clay set option font [list \ + Option font [list \ widget font \ description {Font used on console widgets} \ default $font ] clay set signal focus { Index: modules/clay-tk-console/build/sqlshell.tcl ================================================================== --- modules/clay-tk-console/build/sqlshell.tcl +++ modules/clay-tk-console/build/sqlshell.tcl @@ -16,15 +16,15 @@ ### # Implement an interactive command line interface to an Sqlite database ### ::clay::define ::clay::tk::console::language.sqlite { - clay set option db {class organ} - clay set option prompt {default {sqlite-> }} - clay set option title {default {SQLite Console}} - clay set option header {datatype boolean default 1} - clay set option mode {widget select default column values {line list column csv multicolumn}} + Option db {class organ} + Option prompt {default {sqlite-> }} + Option title {default {SQLite Console}} + Option header {datatype boolean default 1} + Option mode {widget select default column values {line list column csv multicolumn}} ### # topic: 43e235cf3b612e95c590e5de400d4bcc39d622a4 # description: @@ -42,18 +42,18 @@ if {$word==".tcl"} { my tcl_console return {} } elseif {$word==".mode"} { regexp {^.[a-z]+ +([a-z]+)} $cmd all newvalue - my config set [list mode $newvalue] + my Config_set [list mode $newvalue] return {} } elseif {$word==".exit"} { my destroy return {} } elseif {$word==".header"} { regexp {^.[a-z]+ +([a-z]+)} $cmd all newvalue - my config set [list header $newvalue] + my Config_set [list header $newvalue] return {} } elseif {$word==".tables"} { set mode multicolumn set cmd {SELECT name FROM sqlite_master WHERE type='table' UNION ALL Index: modules/clay-tk/build/core.tcl ================================================================== --- modules/clay-tk/build/core.tcl +++ modules/clay-tk/build/core.tcl @@ -1,6 +1,8 @@ namespace eval ::clay::tk {} + +package require clay-yggdrasil set ::clay::tk::winsys [tk windowingsystem] if {$::tcl_platform(platform) eq "windows"} { set ::clay::tk::platform windows catch {::ttk::style theme use xpnative} @@ -13,10 +15,11 @@ catch {::ttk::style theme use clam} } ::clay::define ::clay::tk::megawidget { + superclass ::clay::yggdrasil constructor {tkpath args} { my Config_initialize $args my Config_merge $args my Hull_Construct $tkpath @@ -25,118 +28,10 @@ destructor { my Hull_Destroy } - Ensemble config::get args { - return [my Config_get {*}$args] - } - Ensemble config::merge args { - return [my Config_merge {*}$args] - } - Ensemble config::set args { - my Config_set {*}$args - } - - 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 MegaMixin $opt [dict get $optinfo default]] - } - - if {[dict size $mixinmap]} { - my clay mixinmap {*}$mixinmap - } - } - method Config_get {field args} { - my variable config option_canonical option_getcmd - 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] - } - - ### - # topic: dc9fba12ec23a3ad000c66aea17135a5 - ### - 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 MegaMixin $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_set args { - set dictargs [::clay::args_to_options {*}$args] - set dat [my Config_merge $dictargs] - my Config_triggers $dat - } - - ### - # React to configuration changes - ### - 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 content {} {} method event {submethod args} { ::clay::event::$submethod [self] {*}$args } @@ -172,45 +67,10 @@ set tkpath [my clay delegate hull] if {![winfo exists $tkpath]} return bind $tkpath <Destroy> {} } - method MegaMixin {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 Option_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 signal args {} # Renames the tcl command that represents the widget to # one that resides in the object's namespace. It then renames # the object to catch calls to the tk path. Index: modules/clay-tk/build/hull.tcl ================================================================== --- modules/clay-tk/build/hull.tcl +++ modules/clay-tk/build/hull.tcl @@ -81,11 +81,11 @@ update idletasks try { set w [winfo parent $h] set t [winfo toplevel $h] set width [expr {[winfo width $w]-[winfo width $h.cy]-8}] - set minwidth [my config get minwidth] + set minwidth [my Config_get minwidth] if {$width < $minwidth} { set width $minwidth } set oheight [winfo height $h.cx] incr oheight 1 @@ -94,11 +94,11 @@ if {![winfo ismapped $child]} return if {$child eq $h} continue puts [list $child [winfo height $child]] incr oheight [winfo height $child] } - set minheight [my config get minheight] + set minheight [my Config_get minheight] set height [expr {[winfo height $w] - $oheight}] if {$height < $minheight} { set height $minheight } puts [list [self] width $width height $height] Index: modules/clay-tktable/build/core.tcl ================================================================== --- modules/clay-tktable/build/core.tcl +++ modules/clay-tktable/build/core.tcl @@ -2,53 +2,53 @@ package require Tktable clay::define ::clay::tk::hull.tkable { Array Data - clay set option titlerows { + Option titlerows { default {1} native -titlerows } - clay set option titlecols { + Option titlecols { default {1} native -titlecols } - clay set option cols { + Option cols { default 0 native -cols } - clay set option rows { + Option rows { default 0 native -rows } - clay set option height { + Option height { default {} native -height } - clay set option width { + Option width { default {} native -width } - clay set option maxheight { + Option maxheight { default {} native -maxheight } - clay set option maxwidth { + Option maxwidth { default {} native -maxwidth } - clay set option multiline { + Option multiline { default 1 native -multiline } - clay set option selectmode { + Option selectmode { default browse type select values {single browse multiple extended} native -selectmode } - clay set option colstretchmode { + Option colstretchmode { default none type select values {none unset all last} native -colstretchmode description { @@ -64,11 +64,11 @@ allocated to the table. This mode can interfere with interactive border resizing which tries to force column width.last The last column will be stretched to fill the window space allocated to the table. } } - clay set option rowstretchmode { + Option rowstretchmode { default none type select values {none unset all last fill} native -rowstretchmode description { @@ -88,11 +88,11 @@ fill The table will get more or less columns according to the window space allocated to the table. This mode has numerous quirks and may disappear in the future. } } - clay set option multiline { + Option multiline { native -multiline default 1 type boolean } Index: modules/clay-tktable/build/spreadsheet.tcl ================================================================== --- modules/clay-tktable/build/spreadsheet.tcl +++ modules/clay-tktable/build/spreadsheet.tcl @@ -2,11 +2,11 @@ # Mimic the likes of Microsoft Excel(tm) ### clay::define ::clay::tk::hull.spreadsheet { superclass ::clay::tk::hull.tkable - clay set option keycolumn { + Option keycolumn { default 0 } method browse {row col} { my variable prior Data Index: modules/clay-ui/build/baseclass.tcl ================================================================== --- modules/clay-ui/build/baseclass.tcl +++ modules/clay-ui/build/baseclass.tcl @@ -160,11 +160,11 @@ Ensemble action::revert_to_default {} { set field [my clay get field] set default [my clay get default] if {$default in {{} default}} { - set default [my <form> private Option_Default $field] + set default [my <form> private Config_Default $field] } my Value_Store $default } method ApplySelectedValue newvalue { ADDED modules/clay-yggdrasil/build/build.tcl Index: modules/clay-yggdrasil/build/build.tcl ================================================================== --- modules/clay-yggdrasil/build/build.tcl +++ modules/clay-yggdrasil/build/build.tcl @@ -0,0 +1,71 @@ +set here [file dirname [file normalize [file join [pwd] [info script]]]] + +set version 0.1 +set modpath [file dirname $here] +set module clay-yggdrasil +set filename [file tail $modpath] + +set fout [open [file join $modpath ${filename}.tcl] w] +dict set map %module% $module +dict set map %version% $version + +puts $fout [string map $map {### +# Amalgamated package for %module% +# Do not edit directly, tweak the source in src/ and rerun +# build.tcl +### +package provide %module% %version% +namespace eval ::%module% {} +set ::%module%::version %version% +}] + +# Track what files we have included so far +set loaded {build.tcl} +# These files must be loaded in a particular order +foreach file { + core.tcl +} { + lappend loaded $file + set fin [open [file join $here $file] r] + puts $fout "###\n# START: [file tail $file]\n###" + puts $fout [read $fin] + close $fin + puts $fout "###\n# END: [file tail $file]\n###" +} +# These files can be loaded in any order +foreach file [glob [file join $here *.tcl]] { + if {[file tail $file] in $loaded} continue + lappend loaded $file + set fin [open [file join $here $file] r] + puts $fout "###\n# START: [file tail $file]\n###" + puts $fout [read $fin] + close $fin + puts $fout "###\n# END: [file tail $file]\n###" +} + +# Provide some cleanup and our final package provide +puts $fout [string map $map { +namespace eval ::%module% { + namespace export * +} +}] +close $fout + +### +# Build our pkgIndex.tcl file +### +#if {![package vsatisfies [package provide Tcl] 8.6]} {return} + +set fout [open [file join $modpath pkgIndex.tcl] w] +puts $fout [string map $map {# Tcl package index file, version 1.1 +# This file is generated by practcl +# and sourced either when an application starts up or +# by a "package unknown" script. It invokes the +# "package ifneeded" command to set up package-related +# information so that packages will be loaded automatically +# in response to "package require" commands. When this +# script is sourced, the variable $dir must contain the +# full path name of this file's directory. +package ifneeded %module% %version% [list source [file join $dir %module%.tcl]] +}] +close $fout ADDED modules/clay-yggdrasil/build/core.tcl Index: modules/clay-yggdrasil/build/core.tcl ================================================================== --- modules/clay-yggdrasil/build/core.tcl +++ modules/clay-yggdrasil/build/core.tcl @@ -0,0 +1,353 @@ + +namespace eval ::clay::yggdrasil {} + +clay::define ::clay::yggdrasil { + Dict css {} + clay branch css + + 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_config {} { + return {} + } + + method Child_delegate {} { + return [list parent [self]] + } + + 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] + } + + ### + # Data that tracks with the node itself + ### + 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 + } + } + + ### + # topic: dc9fba12ec23a3ad000c66aea17135a5 + ### + 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 + } + + ### + # React to configuration changes + ### + 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 + } + + ### + # Content Style Sheet Data + # Moves in parallel with configuration data + ### + 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 + } +} Index: modules/cuneiform/build/core.tcl ================================================================== --- modules/cuneiform/build/core.tcl +++ modules/cuneiform/build/core.tcl @@ -1,6 +1,8 @@ namespace eval cuneiform {} + +package require clay-yggdrasil proc ::cuneiform::markdown real_filename { set fin [open $real_filename r] while {[gets $fin line]>=0} { if {[string range $line 0 2] eq "---" && [string range $line end-2 end] eq "---"} { @@ -26,10 +28,12 @@ } return $record } clay::define ::cuneiform::object { + superclass ::clay::yggdrasil + Variable cuneiform_content {} Variable children {} Variable tag_namespace {} destructor { @@ -40,76 +44,10 @@ ### # Build basic layout ### method cuneiform_structure {} {} - Ensemble child::clear_all {} { - my variable children - foreach child $children { - catch { - $child child clear_all - $child clay refcount_decr - } - } - set children {} - } - - Ensemble child::count {} { - my variable children - if {![info exists children]} { - return {} - } - return [llength $children] - } - - Ensemble 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 - } - } - - Ensemble 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] - } - - Ensemble child::last {} { - my variable children - return [lindex [my children] end] - } - - Ensemble child::list {} { - my variable children - if {![info exists children]} { - return {} - } - return $children - } - - method eval args { - eval {*}$args - } - - method source args { - source {*}$args - } - method tag {type args} { my variable children set output {} if {[llength $args]==1} { set args [list content [lindex $args 0]] @@ -143,16 +81,10 @@ } } clay::define ::cuneiform::element { superclass object - - Dict css {} - Dict xml {} - - clay branch css - clay set xml_tag "" clay set xml_paired 1 Variable xml_element {} @@ -199,20 +131,20 @@ switch $f { parent { my clay delegate parent $v } id { - my xml set id $v + my Config_id $v } css_class - class { - my xml set class $v + my CSS_class $v } css - css_style - style { - my css set {*}$v + my CSS_set {*}$v } tk - html - html_option - html_options - @@ -219,63 +151,30 @@ xml - xml_option - xml_options - options - option { - my xml set {*}$v + my Config_set {*}$v } namespace { my variable tag_namespace set tag_namespace $v } content { my content $v } default { - if {[string range $f 0 4] eq "xml:"} { - # If the user explicitly tells us this is xml, this is xml - my xml set [string range $f 5 end] $v - } elseif {[string range $f 0 3] eq "css:"} { - my css set [string range $f 4 end] $v - } else { - # Otherwise assume its an xml option - my xml set $f $v - } - } - } - } - } - - Ensemble css::class args { - my xml set class [lindex $args 0] - return [my xml get class] - } - Ensemble css::get field { - my variable css - if {[dict exists $css $field]} { - return [dict get $css $field] - } - return [my clay get css $field] - } - Ensemble css::set args { - my variable css - dict for {f v} $args { - dict set css $f $v - } - } - - Ensemble xml::get field { - my variable xml - if {[dict exists $xml $field]} { - return [dict get $xml $field] - } - return [my clay get xml $field] - } - Ensemble xml::set args { - my variable xml - dict for {f v} $args { - dict set xml $f $v - } - } - + if {[string range $f 0 4] eq "html:"} { + # If the user explicitly tells us this is xml, this is xml + my Config_set [string range $f 5 end] $v + } elseif {[string range $f 0 3] eq "css:"} { + my CSS_set [string range $f 4 end] $v + } else { + # Otherwise assume its an xml option + my Config_set $f $v + } + } + } + } + } } Index: modules/cuneiform/build/html.tcl ================================================================== --- modules/cuneiform/build/html.tcl +++ modules/cuneiform/build/html.tcl @@ -115,11 +115,11 @@ namespace { my variable tag_namespace set tag_namespace $v } default { - my xml set $f $v + my config set $f $v } } } } } @@ -188,12 +188,12 @@ my tag LI content $content {*}$args } } clay::define ::cuneiform::html::a { clay set xml_tag "A" - clay set xml href {} - clay set xml target {} + Option href {} + Option target {} } # Tk names that will confuse the parser clay::define ::cuneiform::html::label { clay set xml_tag LABEL @@ -201,65 +201,65 @@ clay::define ::cuneiform::html::text { clay set xml_tag TEXT } clay::define ::cuneiform::html::button { clay set xml_tag "BUTTON" - clay set xml href {} - clay set xml target {} - clay set xml type {} - clay set xml name {} - clay set xml value {} + Option href {} + Option target {} + Option type {} + Option name {} + Option value {} } clay::define ::cuneiform::html::img { superclass nonpaired clay set xml_paired 0 clay set xml_tag "IMG" - clay set xml src {} - clay set xml alt {} - clay set xml width {} - clay set xml height {} + Option src {} + Option alt {} + Option width {} + Option height {} } clay::define ::cuneiform::html::image { superclass nonpaired clay set xml_paired 0 clay set xml_tag "IMG" - clay set xml src {} - clay set xml alt {} - clay set xml width {} - clay set xml height {} + Option src {} + Option alt {} + Option width {} + Option height {} } clay::define ::cuneiform::html::form { clay set xml_tag "FORM" - clay set xml action {} - clay set xml method POST + Option action {} + Option method {default POST} } clay::define ::cuneiform::html::label { clay set xml_tag "LABEL" - clay set xml for {} + Option for {} } clay::define ::cuneiform::html::option { clay set xml_tag "OPTION" - clay set xml value {} + Option value {} clay set xml_flag disabled 0 clay set xml_flag selected 0 } clay::define ::cuneiform::html::input { clay set xml_tag "INPUT" - clay set xml type {} - clay set xml name {} - clay set xml value {} + Option type {} + Option name {} + Option value {} } clay::define ::cuneiform::html::table { clay set xml_tag "TABLE" @@ -288,11 +288,11 @@ method listrow {opts args} { set rowojb [my tag tr] set result {} foreach value $args { - lappend result [$rowojb tag {*}$opts content $value] + lappend result [$rowojb tag td {*}$opts content $value] } return $result } method row args { @@ -317,20 +317,20 @@ } } clay::define ::cuneiform::html::th { clay set xml_tag "TH" - clay set xml colspan {} - clay set xml rowspan {} - clay set xml headers {} + Option colspan {} + Option rowspan {} + Option headers {} } clay::define ::cuneiform::html::td { clay set xml_tag "TD" - clay set xml colspan {} - clay set xml rowspan {} - clay set xml headers {} + Option colspan {} + Option rowspan {} + Option headers {} } clay::define ::cuneiform::html::page_break { superclass para clay set css style { @@ -418,17 +418,17 @@ clay::define ::cuneiform::document.html { superclass ::cuneiform::buffer.html ::cuneiform::html::nocss clay set stylesheet {} clay set xml_tag "HTML" - clay set xml title {Default} - clay set xml charset UTF-8 + Option title {} + Option charset {default UTF-8} method cuneiform_syntax {} { next proc stylesheet url { - my <stylesheet> xml set href $url + my <stylesheet> config set href $url } proc title string { my <title> content $string } @@ -440,11 +440,11 @@ set xml {} set css {} my clay delegate <head> [my Tag head] my clay delegate <title> [my <head> tag title] - my <head> tag meta charset [my xml get charset] + my <head> tag meta charset [my config get charset] set sheethref [my clay get xml stylesheet] if {$sheethref eq {}} { set sheethref /style.css } my clay delegate <stylesheet> [my <head> tag link rel stylesheet type text/css href $sheethref] @@ -451,12 +451,12 @@ set styleobj [my <head> tag style] my clay delegate <style> $styleobj my clay delegate <style:screen> $styleobj my clay delegate <style:print> [my <head> tag style] - my <style> xml set media screen type text/css - my <style:print> xml set media print type text/css + my <style> config set media screen type text/css + my <style:print> config set media print type text/css set bodyobj [my Tag body] my clay delegate <body> $bodyobj my clay delegate <header> [$bodyobj tag header id header] my clay delegate <top> [$bodyobj tag div id top] Index: modules/cuneiform/build/svg.tcl ================================================================== --- modules/cuneiform/build/svg.tcl +++ modules/cuneiform/build/svg.tcl @@ -5,28 +5,28 @@ ### # SVG Tags ### clay::define ::cuneiform::svg { clay set xml_tag "SVG" - clay set xml colspan {} - clay set xml viewBox {} - clay set xml xmlns {} - clay set xml width {} - clay set xml height {} + Option colspan {} + Option viewBox {} + Option xmlns {} + Option width {} + Option height {} } clay::define ::cuneiform::svg::g { clay set xml_tag "G" - clay set xml id {} + Option id {} } clay::define ::cuneiform::svg::text { clay set xml_tag "TEXT" - clay set xml x {} - clay set xml y {} - clay set xml fill {} - clay set xml font-size {} + Option x {} + Option y {} + Option fill {} + Option font-size {} } clay::define ::cuneiform::svg::polygon { superclass nonpaired clay set xml_tag "POLYGON" - clay set xml points {} + Option points {} } Index: modules/cuneiform/build/tk.tcl ================================================================== --- modules/cuneiform/build/tk.tcl +++ modules/cuneiform/build/tk.tcl @@ -130,15 +130,15 @@ ::clay::define ::cuneiform::tk::label { method Cuneiform_Tk_Hull {window args} { set w $window.uuid[my uuid] puts [list [self] [self class] [self method] $window $w] set opts {} - if {[my xml get text] ne {}} { - lappend opts -text [my xml get text] + if {[my config get text] ne {}} { + lappend opts -text [my config get text] } - if {[my xml get variable] ne {}} { - lappend opts -textvariable [my xml get text] + if {[my config get variable] ne {}} { + lappend opts -textvariable [my config get text] } puts [list ttk::label $w {*}$opts] ttk::label $w {*}$opts return $w } @@ -146,18 +146,18 @@ ::clay::define ::cuneiform::tk::button { method Cuneiform_Tk_Hull {window args} { set w $window.uuid[my uuid] puts [list [self] [self class] [self method] $window $w] set opts {} - if {[my xml get text] ne {}} { - lappend opts -text [my xml get text] - } - if {[my xml get variable] ne {}} { - lappend opts -textvariable [my xml get text] - } - if {[my xml get command] ne {}} { - lappend opts -command [my xml get command] + if {[my config get text] ne {}} { + lappend opts -text [my config get text] + } + if {[my config get variable] ne {}} { + lappend opts -textvariable [my config get text] + } + if {[my config get command] ne {}} { + lappend opts -command [my config get command] } puts [list ttk::button $w {*}$opts] ttk::button $w {*}$opts return $w } Index: modules/cuneiform/build/xml.tcl ================================================================== --- modules/cuneiform/build/xml.tcl +++ modules/cuneiform/build/xml.tcl @@ -98,11 +98,11 @@ switch $f { parent { my clay delegate parent $v } default { - my xml set $f $v + my config set $f $v } } } } } @@ -204,19 +204,19 @@ clay::define ::cuneiform::document.xml { superclass ::cuneiform::buffer.xml ::cuneiform::xml::nocss clay set stylesheet {} clay set xml_tag "xml" - clay set xml title {Default} - clay set xml encoding UTF-8 - clay set xml version 1.0 - clay set xml headerline 1 + Option title {} + Option encoding {default UTF-8} + Option version {default 1.0} + Option headerline {type boolean default 1} method cuneiform_syntax {} { next proc stylesheet url { - my <stylesheet> xml set href $url + my <stylesheet> config set href $url } proc title string { my <title> content $string } @@ -236,16 +236,16 @@ my <footer> append {*}$args } method xml_output {} { set output {} - if {[my xml get headerline]} { - append output "<?xml version=\"[my xml get version]\" encoding=\"[my xml get encoding]\" standalone=\"yes\" ?>" \n + if {[my config get headerline]} { + append output "<?xml version=\"[my config get version]\" encoding=\"[my config get encoding]\" standalone=\"yes\" ?>" \n } append output [my xml_format_content] return $output } } namespace eval ::cuneiform::xml { namespace export * } Index: modules/cuneiform/cuneiform-tk.test ================================================================== --- modules/cuneiform/cuneiform-tk.test +++ modules/cuneiform/cuneiform-tk.test @@ -1,8 +1,10 @@ set here [file dirname [file normalize [info script]]] source [file join $here .. clay clay.tcl] +source [file join $here .. clay-yggdrasil clay-yggdrasil.tcl] + exec tclsh [file join $here build build.tcl] source [file join $here cuneiform.tcl] package require Tk Index: modules/cuneiform/cuneiform.test ================================================================== --- modules/cuneiform/cuneiform.test +++ modules/cuneiform/cuneiform.test @@ -1,17 +1,19 @@ set here [file dirname [file normalize [info script]]] source [file join $here .. clay clay.tcl] +source [file join $here .. clay-yggdrasil clay-yggdrasil.tcl] + exec tclsh [file join $here build build.tcl] source [file join $here cuneiform.tcl] ::cuneiform::document.html create HTML html title {Hello World!} stylesheet /style.css clay::define test_html { method content {} { my <title> content {What a lovely day} - my tag H1 content {Hello World} - set t [my tag TABLE] + my tag H1 {Hello World} + set t [my tag table] $t listrow {} {Test} Right set obj [$t child index 0 0] $obj css set border 1 set r [$t tag TR] $r tag TD content {Test 2} @@ -21,11 +23,11 @@ } ### # Inject content ### -HTML tag h1 [HTML html get title] +HTML tag h1 [HTML config get title] ### # Mixin a behavior hand have that behavior inject content ### HTML clay mixinmap content test_html HTML content 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.16.3 +set version 0.17 set tclversion 8.6 set module [file tail $moddir] set filename $module set fout [open [file join $moddir $filename.tcl] w] @@ -35,10 +35,11 @@ # 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} define get TEACUP_OS] + return [${::practcl::MAIN} config 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 define set scm none + my Config_set scm none } method Sandbox {} { if {[my define exists sandbox]} { - return [my define get sandbox] + return [my Config_get sandbox] } if {[my clay delegate project] ni {::noop {}}} { - set sandbox [my <project> define get sandbox] + set sandbox [my <project> config get sandbox] if {$sandbox ne {}} { - my define set sandbox $sandbox + my Config_set sandbox $sandbox return $sandbox } } set sandbox [file normalize [file join $::CWD ..]] - my define set sandbox $sandbox + my Config_set sandbox $sandbox return $sandbox } method SrcDir {} { - set pkg [my define get name] + set pkg [my Config_get name] if {[my define exists srcdir]} { - return [my define get srcdir] + return [my Config_get srcdir] } set sandbox [my Sandbox] set srcdir [file join [my Sandbox] $pkg] - my define set srcdir $srcdir + my Config_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 define get name] + set pkg [my Config_get name] if {[my define exists download]} { # Utilize a staged download - set download [my define get download] + set download [my Config_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 define get sandbox] + return [$object config get sandbox] } if {[$object clay delegate project] ni {::noop {}}} { - set sandbox [$object <project> define get sandbox] + set sandbox [$object <project> config get sandbox] if {$sandbox ne {}} { - $object define set sandbox $sandbox + $object config set sandbox $sandbox return $sandbox } } - set pkg [$object define get name] + set pkg [$object config get name] set sandbox [file normalize [file join $::CWD ..]] - $object define set sandbox $sandbox + $object config set sandbox $sandbox return $sandbox } method select object { if {[$object define exists scm]} { - return [$object define get scm] + return [$object config get scm] } - set pkg [$object define get name] - if {[$object define get srcdir] ne {}} { - set srcdir [$object define get srcdir] + set pkg [$object config get name] + if {[$object config get srcdir] ne {}} { + set srcdir [$object config get srcdir] } else { set srcdir [file join [my Sandbox $object] $pkg] - $object define set srcdir $srcdir + $object config 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 define set scm $name + $object config 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 define set scm $name + $object config set scm $name return $name } } - if {[$object define get scm] eq {} && [$object define exists file_url]} { + if {[$object config get scm] eq {} && [$object define exists file_url]} { set class ::practcl::distribution.snapshot set name [$class claim_option] - $object define set scm $name + $object config 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 define get srcdir]] { + foreach {field value} [::practcl::fossil_status [my Config_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 define get name] + set pkg [my Config_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 define get download] + set download [::practcl::LOCAL config 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 define get fossil_mirror] + set localmirror [::practcl::LOCAL config 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 define get fossil_url] ne {}} { + if {[my Config_get fossil_url] ne {}} { catch { - ::practcl::doexec fossil clone [my define get fossil_url] $fosdb + ::practcl::doexec fossil clone [my Config_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 define get scm_tag] + return [my Config_get scm_tag] } if {[my define exists tag]} { - set tag [my define get tag] + set tag [my Config_get tag] } else { set tag trunk } - my define set scm_tag $tag + my Config_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 define get srcdir] + set path [$obj config get srcdir] if {[my claim_path $path]} { return true } - if {[$obj define get fossil_url] ne {}} { + if {[$obj config 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 define get scm_tag] + return [my Config_get scm_tag] } if {[my define exists tag]} { - set tag [my define get tag] + set tag [my Config_get tag] } else { set tag master } - my define set scm_tag $tag + my Config_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 define get name] + set pkg [my Config_get name] if {[my define exists git_url]} { - ::practcl::doexec git clone --branch $tag [my define get git_url] $srcdir + ::practcl::doexec git clone --branch $tag [my Config_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 define get srcdir] + set path [$obj config get srcdir] if {[my claim_path $path]} { return true } - if {[$obj define get git_url] ne {}} { + if {[$obj config 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 define get download] - set url [my define get file_url] + set dpath [::practcl::LOCAL config get download] + set url [my Config_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 define add include $header + my Config_add include $header } method include_dir args { - my define add include_dir {*}$args + my Config_add include_dir {*}$args } method include_directory args { - my define add include_dir {*}$args + my Config_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 define get output_c] + set filename [my Config_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 define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] } else { - set filename [my define get cfile] + set filename [my Config_get cfile] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_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 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 + 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 set fout [open $filename w] puts $fout [my generate-c] - if {[my define get initfunc] ne {}} { - puts $fout "extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \x7B" + if {[my Config_get initfunc] ne {}} { + puts $fout "extern int DLLEXPORT [my Config_get initfunc]( Tcl_Interp *interp ) \x7B" puts $fout [my generate-loader-module] - if {[my define get pkg_name] ne {}} { - puts $fout " Tcl_PkgProvide(interp, \"[my define get pkg_name]\", \"[my define get pkg_vers]\");" + if {[my Config_get pkg_name] ne {}} { + puts $fout " Tcl_PkgProvide(interp, \"[my Config_get pkg_name]\", \"[my Config_get pkg_vers]\");" } puts $fout " return TCL_OK\;" puts $fout "\x7D" } close $fout @@ -228,33 +228,33 @@ ### # Practcl internals ### method initialize {} { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename eq {}} { return } - if {[my define get name] eq {}} { - my define set name [file tail [file rootname $filename]] + if {[my Config_get name] eq {}} { + my Config_set name [file tail [file rootname $filename]] } - if {[my define get localpath] eq {}} { - my define set localpath [my <module> define get localpath]_[my define get name] + if {[my Config_get localpath] eq {}} { + my Config_set localpath [my <module> config get localpath]_[my Config_get name] } ::source $filename } method linktype {} { return {subordinate product dynamic} } method generate-cfile-constant {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} my variable code cstruct methods tcltype if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my define get filename] CONSTANT */" + ::practcl::cputs result "/* [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get cclass]] + ::practcl::debug [list methods [info exists methods] [my Config_get cclass]] if {[info exists methods]} { - set thisclass [my define get cclass] + set thisclass [my Config_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 define get output_c] ne {}} continue + if {[$obj config get output_c] ne {}} continue set dat [$obj generate-cfile-header] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-header */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* END [$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get cclass] + set thisclass [my Config_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 define get class]] { + ::practcl::cputs result [string map [list @CCLASS@ $thisclass @TCLCLASS@ [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_get filename]] foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} { + if {[$obj config 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 define get cclass] - set thisclass [my define get cclass] + ::practcl::debug [self] methods [my Config_get cclass] + set thisclass [my Config_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 define get nspace] + set thisnspace [my Config_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,139 +1,29 @@ ### # The metaclass for all practcl objects ### ::clay::define ::practcl::metaclass { + superclass ::clay::yggdrasil method _MorphPatterns {} { return {{@name@} {::practcl::@name@} {::practcl::*@name@} {::practcl::*@name@*}} } - 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 Child_define {} { + return {} + } + + method define {method args} { + tailcall my Config_$method {*}$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]] { @@ -158,11 +48,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 define set class $class + my Config_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 define dump] + set dat [my Config_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] define get filename] + return [[dict get $make_object $name] config get filename] } } Ensemble make::target {name Info body} { set info [uplevel #0 [list subst $Info]] @@ -164,30 +164,28 @@ # 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 define get action] + eval [$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result { /* This file was generated by practcl */ } set includes {} @@ -196,20 +194,20 @@ $mod go } set headers {} my IncludeAdd headers <tcl.h> <tclOO.h> - if {[my define get tk 0]} { + if {[my Config_get tk 0]} { my IncludeAdd headers <tk.h> } - if {[my define get output_h] ne {}} { - my IncludeAdd headers [my define get output_h] + if {[my Config_get output_h] ne {}} { + my IncludeAdd headers [my Config_get output_h] } - my IncludeAdd headers {*}[my define get include] + my IncludeAdd headers {*}[my Config_get include] foreach mod [my link list dynamic] { - my IncludeAdd headers {*}[$mod define get include] + my IncludeAdd headers {*}[$mod config get include] } foreach inc $headers { ::practcl::cputs result "#include $inc" } foreach {method} { @@ -222,26 +220,26 @@ generate-cfile-functions generate-cfile-tclapi } { set dat [my $method] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN $method [my define get filename] */" + ::practcl::cputs result "/* BEGIN $method [my Config_get filename] */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END $method [my define get filename] */" + ::practcl::cputs result "/* END $method [my Config_get filename] */" } } - ::practcl::debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list /[self] [self method] [self class] -- [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} foreach method { generate-hfile-public-define generate-hfile-public-macro } { @@ -282,22 +280,22 @@ } return $result } method generate-loader {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} - if {[my define get initfunc] eq {}} return + if {[my Config_get initfunc] eq {}} return ::practcl::cputs result " -extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \{" +extern int DLLEXPORT [my Config_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 define get tk 0]} { + if {[my Config_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]]} { @@ -308,25 +306,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 define get pkg_name [my define get name]]\" , \"[my define get pkg_vers [my define get version]]\" )) return TCL_ERROR\;" + ::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 " return TCL_OK\;\n\}\n" return $result } method initialize {} { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename eq {}} { return } - if {[my define get name] eq {}} { - my define set name [file tail [file dirname $filename]] + if {[my Config_get name] eq {}} { + my Config_set name [file tail [file dirname $filename]] } - if {[my define get localpath] eq {}} { - my define set localpath [my <project> define get name]_[my define get name] + if {[my Config_get localpath] eq {}} { + my Config_set localpath [my <project> config get name]_[my Config_get name] } my graft module [self] ::practcl::debug [self] SOURCE $filename my source $filename } @@ -335,21 +333,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 define get filename] $err" + lappend errs "Skipped $item: [$item config 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 define get filename] $err" + lappend errs "Skipped $item: [$item config get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } @@ -365,12 +363,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 define get filename] [info object class [self]]] - set filename [my define get output_c] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + set filename [my Config_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,41 +3,44 @@ ### ::clay::define ::practcl::object { superclass ::practcl::metaclass constructor {parent args} { - my variable links define + my variable links set organs [$parent child organs] my clay delegate {*}$organs - array set define $organs - array set define [$parent child define] + my Config_merge $organs + my Config_merge [$parent child define] array set links {} if {[llength $args]==1 && [file exists [lindex $args 0]]} { - my define set filename [lindex $args 0] + my Config_set filename [lindex $args 0] ::practcl::product select [self] } elseif {[llength $args] == 1} { set data [uplevel 1 [list subst [lindex $args 0]]] - array set define $data + my Config_merge $data my select } else { - array set define [uplevel 1 [list subst $args]] + my Config_merge [uplevel 1 [list subst $args]] my select } my initialize } - method child {method} { + method Child_delegate {} { + return {} + } + method Child_organs {} { return {} } method go {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable links foreach {linktype objs} [array get links] { foreach obj $objs { $obj go } } ::practcl::debug [list /[self] [self method] [self class]] } } 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 define get filename] + set filename [my Config_get filename] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - 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]] + 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]] } } 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 define get filename]] links [my link list]]" + ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} my variable code cstruct methods tcltype if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my define get filename] CONSTANT */" + ::practcl::cputs result "/* [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config get output_c] ne {}} continue set dat [$obj generate-cfile-header] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-header */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-header */" } } return $result } method generate-cfile-global {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config get output_c] ne {}} continue set dat [$obj generate-cfile-global] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-global */" + ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-global */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-global */" + ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-global */" } } return $result } method generate-cfile-private-typedef {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} { + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cfunct tcltype set result {} - if {[my define get initfunc] ne {}} { - ::practcl::cputs result "int [my define get initfunc](Tcl_Interp *interp);" + if {[my Config_get initfunc] ne {}} { + ::practcl::cputs result "int [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set includes {} - foreach item [my define get public-include] { + foreach item [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set includes {} - foreach item [my define get public-verbatim] { + foreach item [my Config_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 define get initfunc] eq {}} { - return "/* [my define get filename] declared not initfunc */" + if {[my Config_get initfunc] eq {}} { + return "/* [my Config_get filename] declared not initfunc */" } - return " if([my define get initfunc](interp)) return TCL_ERROR\;" + return " if([my Config_get initfunc](interp)) return TCL_ERROR\;" } method generate-loader-module {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code set result {} if {[info exists code(cinit)]} { ::practcl::cputs result $code(cinit) } - if {[my define get initfunc] ne {}} { - ::practcl::cputs result " if([my define get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" + if {[my Config_get initfunc] ne {}} { + ::practcl::cputs result " if([my Config_get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_get filename]] foreach item [my link list product] { - if {[$item define get output_c] ne {}} { + if {[$item config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 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] + 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] ::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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} my variable code if {[info exists code(tcl)]} { - set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] + set result [::practcl::_tagblock $code(tcl) tcl [my Config_get filename]] } if {[info exists code(tcl-pre)]} { - set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] + set result [::practcl::_tagblock $code(tcl) tcl [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $code(tcl-post) tcl [my Config_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> define get localpath] + set lpath [my <module> config get localpath] if {$lpath eq {}} { - set lpath [my <module> define get name] + set lpath [my <module> config get name] } return ${lpath}_[file rootname [file tail $filename]] } ### # Methods called by the master project ### method project-static-packages {} { - set result [my define get static_packages] - set initfunc [my define get initfunc] + set result [my Config_get static_packages] + set initfunc [my Config_get initfunc] if {$initfunc ne {}} { - set pkg_name [my define get pkg_name] + set pkg_name [my Config_get pkg_name] if {$pkg_name ne {}} { dict set result $pkg_name initfunc $initfunc - 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] + 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] } } 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 define get filename] [info object class [self]]] - set result [my define get include_dir] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + set result [my Config_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 define get class] - set mixin [$object define get product] + set class [$object config get class] + set mixin [$object config get product] if {$class eq {} && $mixin eq {}} { - set filename [$object define get filename] + set filename [$object config 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 define get filename] + set filename [my Config_get filename] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]] object [self]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_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 define get filename] + return [my Config_get filename] } } ### @@ -655,28 +655,28 @@ ### ::clay::define ::practcl::product.dynamic { superclass ::practcl::dynamic ::practcl::product method initialize {} { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename eq {}} { return } - if {[my define get name] eq {}} { - my define set name [file tail [file rootname $filename]] + if {[my Config_get name] eq {}} { + my Config_set name [file tail [file rootname $filename]] } - if {[my define get localpath] eq {}} { - my define set localpath [my <module> define get localpath]_[my define get name] + if {[my Config_get localpath] eq {}} { + my Config_set localpath [my <module> config get localpath]_[my Config_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 define get output_c] ne {}} { + if {[my Config_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] - array set define $contents + my Config_merge $contents ::practcl::toolset select [self] my initialize } method add_object object { @@ -44,102 +44,100 @@ my link object $object } method add_project {pkg info {oodefine {}}} { ::practcl::debug [self] add_project $pkg $info - set os [my define get TEACUP_OS] + set os [my Config_get TEACUP_OS] if {$os eq {}} { set os [::practcl::os] - my define set os $os + my Config_set os $os } - set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]] + set fossilinfo [list download [my Config_get download] tag trunk sandbox [my Config_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 define get profile release]: + set profile [my Config_get profile release]: if {[dict exists $info profile $profile]} { dict set info tag [dict get $info profile $profile] } - dict set info USEMSVC [my define get USEMSVC 0] - dict set info debug [my define get debug 0] + dict set info USEMSVC [my Config_get USEMSVC 0] + dict set info debug [my Config_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 define set masterpath $::CWD + $obj config 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 define get download] tag trunk sandbox [my define get sandbox]] + set fossilinfo [list download [my Config_get download] tag trunk sandbox [my Config_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 define get profile release]: + set profile [my Config_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 define set masterpath $::CWD + $obj config 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 define get TEACUP_OS] + set os [my Config_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 define get prefix] --exec-prefix [my define get prefix] + lappend tcl_config_opts --prefix [my Config_get prefix] --exec-prefix [my Config_get prefix] set tclobj [my tclcore] - if {[my define get debug 0]} { - $tclobj define set debug 1 + if {[my Config_get debug 0]} { + $tclobj config set debug 1 lappend tcl_config_opts --enable-symbols=true } - $tclobj define set config_opts $tcl_config_opts + $tclobj config set config_opts $tcl_config_opts $tclobj go $tclobj compile - set _TclSrcDir [$tclobj define get localsrcdir] - my define set tclsrcdir $_TclSrcDir - if {[my define get tk 0]} { + set _TclSrcDir [$tclobj config get localsrcdir] + my Config_set tclsrcdir $_TclSrcDir + if {[my Config_get tk 0]} { set tkobj [my tkcore] - 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 --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 --enable-symbols=true } - $tkobj define set config_opts $tk_config_opts + $tkobj config 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 - return [list project [self] module [self]] - } - } + method Child_delegate {} { + return [list project [self] module [self]] + } + method Child_organs {} { + 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 define get OBJEXT o] + set objext [my Config_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 define get libfile] + set libfile [my Config_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 define get output_c] + set filename [my Config_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 define get extra] external [string is true -strict [my define get external]]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] } return $result } method go {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set name [my define getnull name] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + set name [my Config_get name] if {$name eq {}} { set name generic my define name generic } - if {[my define get tk] eq {@TEA_TK_EXTENSION@}} { - my define set tk 0 + if {[my Config_get tk] eq {@TEA_TK_EXTENSION@}} { + my Config_set tk 0 } - set output_c [my define getnull output_c] + set output_c [my Config_get output_c] if {$output_c eq {}} { set output_c [file rootname $name].c - my define set output_c $output_c + my Config_set output_c $output_c } - set output_h [my define getnull output_h] + set output_h [my Config_get output_h] if {$output_h eq {}} { set output_h [file rootname $output_c].h - my define set output_h $output_h + my Config_set output_h $output_h } - set output_tcl [my define getnull output_tcl] + set output_tcl [my Config_get output_tcl] #if {$output_tcl eq {}} { # set output_tcl [file rootname $output_c].tcl - # my define set output_tcl $output_tcl + # my Config_set output_tcl $output_tcl #} - #set output_mk [my define getnull output_mk] + #set output_mk [my Config_get output_mk] #if {$output_mk eq {}} { # set output_mk [file rootname $output_c].mk - # my define set output_mk $output_mk + # my Config_set output_mk $output_mk #} - set initfunc [my define getnull initfunc] + set initfunc [my Config_get initfunc] if {$initfunc eq {}} { set initfunc [string totitle $name]_Init - my define set initfunc $initfunc + my Config_set initfunc $initfunc } - set output_decls [my define getnull output_decls] + set output_decls [my Config_get output_decls] if {$output_decls eq {}} { set output_decls [file rootname $output_c].decls - my define set output_decls $output_decls + my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list /[self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] } method generate-decls {pkgname path} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 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)"] + 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)"] 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 define get filename] $err" + lappend errs "Skipped $item: [$item config 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 define get filename] $err" + lappend errs "Skipped $item: [$item config 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 define get output_c]] w] + set cout [open [file join $path [my Config_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 define get output_h]]]_H - set hout [open [file join $path [my define get output_h]] w] + 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] 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 define get output_tcl] + set output_tcl [my Config_get output_tcl] if {$output_tcl ne {}} { - set tclout [open [file join $path [my define get output_tcl]] w] + set tclout [open [file join $path [my Config_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 define get pkg_name [my define get name]] - set version [my define get pkg_vers [my define get version]] + set name [my Config_get pkg_name [my Config_get name]] + set version [my Config_get pkg_vers [my Config_get version]] if {$version eq {}} { set version 0.1a } - set output_tcl [my define get output_tcl] + set output_tcl [my Config_get output_tcl] if {$output_tcl ne {}} { set script "\[list source \[file join \$dir $output_tcl\]\]" - } elseif {[my define get SHARED_BUILD 0]} { - set script "\[list load \[file join \$dir [my define get libfile]\] $name\]" + } elseif {[my Config_get SHARED_BUILD 0]} { + set script "\[list load \[file join \$dir [my Config_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 define get name [my define get pkg_name]]] + set name [string tolower [my Config_get name [my Config_get pkg_name]]] set NAME [string toupper $name] - set version [my define get version [my define get pkg_vers]] + set version [my Config_get version [my Config_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 define getnull libprefix] - set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]][my define get SHLIB_SUFFIX] + lappend map %LIBRARY_PREFIX% [my Config_get libprefix] + set outfile [string map $map [my Config_get PRACTCL_NAME_LIBRARY]][my Config_get SHLIB_SUFFIX] return $outfile } method static_library {{filename {}}} { - set name [string tolower [my define get name [my define get pkg_name]]] + set name [string tolower [my Config_get name [my Config_get pkg_name]]] set NAME [string toupper $name] - set version [my define get version [my define get pkg_vers]] + set version [my Config_get version [my Config_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 define getnull libprefix] - set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]].a + lappend map %LIBRARY_PREFIX% [my Config_get libprefix] + set outfile [string map $map [my Config_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 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 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 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 define get tcl_rcFileName ~/.tclshrc]] + append main_init_script \n [list set tcl_rcFileName [$PROJECT config 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 define get tip_430 0]} { + if {![$PROJECT config 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 define get TEACUP_OS] eq "windows"} { + if {[$PROJECT config 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 define get tip_430 0]} { + if {![$PROJECT config 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 define get name] + set name [my Config_get name] # Assume a static shell if {[my define exists SHARED_BUILD]} { - my define set SHARED_BUILD 0 + my Config_set SHARED_BUILD 0 } if {![my define exists TCL_LOCAL_APPINIT]} { - my define set TCL_LOCAL_APPINIT Tclkit_AppInit + my Config_set TCL_LOCAL_APPINIT Tclkit_AppInit } if {![my define exists TCL_LOCAL_MAIN_HOOK]} { - my define set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook + my Config_set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook } set PROJECT [self] - set os [$PROJECT define get TEACUP_OS] - if {[my define get SHARED_BUILD 0]} { + set os [$PROJECT config get TEACUP_OS] + if {[my Config_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 define get srcdir] + set TCLSRCDIR [$TCLOBJ config get srcdir] set PKG_OBJS {} foreach item [$PROJECT link list core.library] { - if {[string is true [$item define get static]]} { + if {[string is true [$item config get static]]} { lappend PKG_OBJS $item } } foreach item [$PROJECT link list package] { - if {[string is true [$item define get static]]} { + if {[string is true [$item config 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 define get SHARED_BUILD 0]} { + if {![my Config_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 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]] + 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]] } else { set PLATFORM_SRC_DIR unix - 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]] + 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]] } - if {![my define get SHARED_BUILD 0]} { + if {![my Config_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 define set ZIPFS_VOLUME "zipfs:/" + $PROJECT config set ZIPFS_VOLUME "zipfs:/" } - $PROJECT code header "#define ZIPFS_VOLUME \"[$PROJECT define get ZIPFS_VOLUME]\"" + $PROJECT code header "#define ZIPFS_VOLUME \"[$PROJECT config get ZIPFS_VOLUME]\"" if {[file exists $zipfs]} { - $TCLOBJ define set tip_430 1 - my define set tip_430 1 + $TCLOBJ config set tip_430 1 + my Config_set tip_430 1 } else { # The Tclconfig project maintains a mirror of the version # released with the Tcl core - my define set tip_430 0 - set tclzipfs_c [my define get tclzipfs_c] + my Config_set tip_430 0 + set tclzipfs_c [my Config_get tclzipfs_c] if {![file exists $tclzipfs_c]} { ::practcl::LOCAL tool tclconfig unpack - set COMPATSRCROOT [::practcl::LOCAL tool tclconfig define get srcdir] + set COMPATSRCROOT [::practcl::LOCAL tool tclconfig config 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 define add include_dir [file join $TCLSRCDIR generic] - my define add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR] + my Config_add include_dir [file join $TCLSRCDIR generic] + my Config_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 define get name] - set libsrcdir [$item define get srcdir] + set name [$item config get name] + set libsrcdir [$item config 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 define get installdir] ne {}} { - # ::practcl::copyDir [file join [my define get installdir] [string trimleft [my define get prefix] /] lib] [file join $vfspath lib] + #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] #} foreach arg $args { ::practcl::copyDir $arg $vfspath } set fout [open [file join $vfspath pkgIndex.tcl] w] - puts $fout [string map [list %platform% [my define get TEACUP_PROFILE]] {set ::tcl_teapot_profile {%platform%}}] + puts $fout [string map [list %platform% [my Config_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 define get EXEEXT] - set tclkit_bare [my define get tclkit_bare] + set EXEEXT [my Config_get EXEEXT] + set tclkit_bare [my Config_get tclkit_bare] ::practcl::mkzip ${exename}${EXEEXT} $tclkit_bare $vfspath - if { [my define get TEACUP_OS] ne "windows" } { + if { [my Config_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,32 +8,30 @@ return {{::practcl::subproject.@name@} {::practcl::@name@} {@name@} {::practcl::subproject}} } method BuildDir {PWD} { - return [my define get srcdir] + return [my Config_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 - return [list project [self] module [self]] - } - } + method Child_delegate {} { + return [list project [self] module [self]] + } + method Child_organs {} { + return [list project [self] module [self]] } method compile {} {} method go {} { ::practcl::distribution select [self] - 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]] + 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]] my sources } # Install project into the local build system method install args {} @@ -68,11 +66,11 @@ ### # Load the facility into the interpreter ### method env-bootstrap {} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] package require $pkg } ### # Return a file path that exec can call @@ -104,11 +102,11 @@ ### # Check if tool is available for load/already loaded ### method env-present {} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] if {[catch [list package require $pkg]]} { return 0 } return 1 } @@ -139,18 +137,18 @@ ### ::clay::define ::practcl::subproject.source { superclass ::practcl::subproject ::practcl::library method env-bootstrap {} { - set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] + set LibraryRoot [file join [my Config_get srcdir] [my Config_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 define get srcdir] + set path [my Config_get srcdir] return [file exists $path] } method linktype {} { return {subordinate package source} @@ -161,36 +159,36 @@ # a copy from the teapot ::clay::define ::practcl::subproject.teapot { superclass ::practcl::subproject method env-bootstrap {} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] package require $pkg } method env-install {} { - set pkg [my define get pkg_name [my define get name]] - set download [my <project> define get download] + set pkg [my Config_get pkg_name [my Config_get name]] + set download [my <project> config get download] my unpack - set prefix [string trimleft [my <project> define get prefix] /] + set prefix [string trimleft [my <project> config 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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] if {[catch [list package require $pkg]]} { return 0 } return 1 } method install DEST { - set pkg [my define get pkg_name [my define get name]] - set download [my <project> define get download] + set pkg [my Config_get pkg_name [my Config_get name]] + set download [my <project> config get download] my unpack - set prefix [string trimleft [my <project> define get prefix] /] + set prefix [string trimleft [my <project> config get prefix] /] ::practcl::tcllib_require zipfile::decode ::zipfile::decode::unzipfile [file join $download $pkg.zip] [file join $DEST $prefix lib $pkg] } } @@ -199,11 +197,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 define get srcdir] kettle] + set kettle [file join [::practcl::LOCAL tool kettle config get srcdir] kettle] } set srcdir [my SourceRoot] ::practcl::dotclexec $kettle -f [file join $srcdir build.tcl] {*}$args } @@ -214,64 +212,64 @@ ::clay::define ::practcl::subproject.critcl { superclass ::practcl::subproject method install DEST { - my critcl -pkg [my define get name] + my critcl -pkg [my Config_get name] set srcdir [my SourceRoot] - ::practcl::copyDir [file join $srcdir [my define get name]] [file join $DEST lib [my define get name]] + ::practcl::copyDir [file join $srcdir [my Config_get name]] [file join $DEST lib [my Config_get name]] } } ::clay::define ::practcl::subproject.sak { superclass ::practcl::subproject method env-bootstrap {} { - set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] + set LibraryRoot [file join [my Config_get srcdir] [my Config_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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set srcdir [my Config_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 define get srcdir] + set path [my Config_get srcdir] return [file exists $path] } method install DEST { ### # Handle teapot installs ### - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - set prefix [string trimleft [my <project> define get prefix] /] - set srcdir [my define get srcdir] + set prefix [string trimleft [my <project> config get prefix] /] + set srcdir [my Config_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 define get srcdir] + set srcdir [my Config_get srcdir] if {[llength $args]==1 && [lindex $args 0] in {* all}} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_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 { @@ -285,42 +283,42 @@ ::clay::define ::practcl::subproject.practcl { superclass ::practcl::subproject method env-bootstrap {} { - set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] + set LibraryRoot [file join [my Config_get srcdir] [my Config_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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set srcdir [my Config_get srcdir] ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $prefix lib $pkg] } method install DEST { ### # Handle teapot installs ### - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - 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]] + 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]] ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $DEST $prefix lib $pkg] } method install-module {DEST args} { - set pkg [my define get pkg_name [my define get name]] - set srcdir [my define get srcdir] + set pkg [my Config_get pkg_name [my Config_get name]] + set srcdir [my Config_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 define get builddir]] + set builddir [file normalize [my Config_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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] set os [::practcl::local_os] - my define set os $os + my Config_set os $os my unpack - set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set srcdir [my Config_get srcdir] lappend options --prefix $prefix --exec-prefix $prefix - my define set config_opts $options + my Config_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 define get install] { + switch [my Config_get install] { static { - my define set static 1 - my define set autoload 0 + my Config_set static 1 + my Config_set autoload 0 } static-autoload { - my define set static 1 - my define set autoload 1 + my Config_set static 1 + my Config_set autoload 1 } vfs { - my define set static 0 - my define set autoload 0 - my define set vfsinstall 1 + my Config_set static 0 + my Config_set autoload 0 + my Config_set vfsinstall 1 } null { - my define set static 0 - my define set autoload 0 - my define set vfsinstall 0 + my Config_set static 0 + my Config_set autoload 0 + my Config_set vfsinstall 0 } default { } } @@ -64,48 +64,48 @@ method go {} { next ::practcl::distribution select [self] my ComputeInstall - my define set builddir [my BuildDir [my define get masterpath]] + my Config_set builddir [my BuildDir [my Config_get masterpath]] } method linker-products {configdict} { - if {![my define get static 0]} { + if {![my Config_get static 0]} { return {} } - set srcdir [my define get builddir] + set srcdir [my Config_get builddir] if {[dict exists $configdict libfile]} { return " [file join $srcdir [dict get $configdict libfile]]" } } method project-static-packages {} { - if {![my define get static 0]} { + if {![my Config_get static 0]} { return {} } - set result [my define get static_packages] - set statpkg [my define get static_pkg] - set initfunc [my define get initfunc] + set result [my Config_get static_packages] + set statpkg [my Config_get static_pkg] + set initfunc [my Config_get initfunc] if {$initfunc ne {}} { - set pkg_name [my define get pkg_name] + set pkg_name [my Config_get pkg_name] if {$pkg_name ne {}} { dict set result $pkg_name initfunc $initfunc - set version [my define get version] + set version [my Config_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 define set version $version + my Config_set version $version } dict set result $pkg_name version $version - dict set result $pkg_name autoload [my define get autoload 0] + dict set result $pkg_name autoload [my Config_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 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]] + 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]] } if {$debug} { - return [my define get builddir [file join $PWD debug $name]] + return [my Config_get builddir [file join $PWD debug $name]] } else { - return [my define get builddir [file join $PWD pkg $name]] + return [my Config_get builddir [file join $PWD pkg $name]] } } method compile {} { - set name [my define get name] + set name [my Config_get name] set PWD $::CWD cd $PWD my unpack set srcdir [file normalize [my SrcDir]] set localsrcdir [my MakeDir $srcdir] - my define set localsrcdir $localsrcdir + my Config_set localsrcdir $localsrcdir my Collate_Source $PWD ### # Build a starter VFS for both Tcl and wish ### - set srcdir [my define get srcdir] - if {[my define get static 1]} { + set srcdir [my Config_get srcdir] + if {[my Config_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 define get srcdir]] - set builddir [file normalize [my define get builddir]] + set srcdir [file normalize [my Config_get srcdir]] + set builddir [file normalize [my Config_get builddir]] file mkdir $builddir my make autodetect } method install DEST { set PWD [pwd] - set PREFIX [my <project> define get prefix] + set PREFIX [my <project> config get prefix] ### # Handle teapot installs ### - 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 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 found 0 - foreach ver [my define get pkg_vers [my define get version]] { + foreach ver [my Config_get pkg_vers [my Config_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,33 +3,33 @@ superclass ::practcl::subproject.binary method env-bootstrap {} {} method env-present {} { - set PREFIX [my <project> define get prefix] - set name [my define get name] + set PREFIX [my <project> config get prefix] + set name [my Config_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> define get prefix [file normalize [file join ~ tcl]]] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] lappend options --prefix $prefix --exec-prefix $prefix - my define set config_opts $options + my Config_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 define set core_binary 1 + my Config_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,20 +7,19 @@ constructor {module_object name info {action_body {}}} { my variable define triggered domake set triggered 0 set domake 0 - set define(name) $name - set define(action) {} - array set define $info + my Config_set name $name action {} + my Config_merge $info my select my initialize foreach {stub obj} [$module_object child organs] { my graft $stub $obj } if {$action_body ne {}} { - set define(action) $action_body + my Config_set action $action_body } } method do {} { my variable domake @@ -35,11 +34,11 @@ if {[info exists needs_make]} { return $needs_make } set make_objects [my <module> make objects] set needs_make 0 - foreach item [my define get depends] { + foreach item [my Config_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 @@ -58,15 +57,15 @@ return $needs_make } method output {} { set result {} - set filename [my define get filename] + set filename [my Config_get filename] if {$filename ne {}} { lappend result $filename } - foreach filename [my define get files] { + foreach filename [my Config_get files] { if {$filename ne {}} { lappend result $filename } } return $result @@ -85,11 +84,11 @@ return $domake } set triggered 1 set make_objects [my <module> make objects] - foreach item [my define get depends] { + foreach item [my Config_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 @@ -99,8 +98,8 @@ $depobj triggers } } } set domake 1 - my <module> make trigger {*}[my define get triggers] + my <module> make trigger {*}[my Config_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 define set [::practcl::local_os] - ::practcl::LOCAL define set LOCAL 1 + ::practcl::LOCAL config set [::practcl::local_os] + ::practcl::LOCAL config 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> define get prefix [file join [file normalize ~] tcl]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file join [file normalize ~] tcl]] + set srcdir [my Config_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 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]] + 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]] } if {$debug} { - return [my define get builddir [file join $PWD debug $name]] + return [my Config_get builddir [file join $PWD debug $name]] } else { - return [my define get builddir [file join $PWD pkg $name]] + return [my Config_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 define get name] + set name [my Config_get name] set PWD $::CWD - set builddir [my define get builddir] + set builddir [my Config_get builddir] my unpack - set srcdir [my define get srcdir] + set srcdir [my Config_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} define get name [${PROJECT} define get pkg_name]]] + set name [string tolower [${PROJECT} config get name [${PROJECT} config get pkg_name]]] set NAME [string toupper $name] - set version [${PROJECT} define get version [${PROJECT} define get pkg_vers]] + set version [${PROJECT} config get version [${PROJECT} config 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 define get srcdir] main.tcl + set critcl [file join [::practcl::LOCAL tool critcl config 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 define get toolset] + return [$object config get toolset] } - set class [$object define get toolset] + set class [$object config 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 define get srcdir]] + set srcdir [file normalize [my Config_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 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]] + 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]] } if {$debug} { - return [my define get builddir [file join $PWD debug $name]] + return [my Config_get builddir [file join $PWD debug $name]] } else { - return [my define get builddir [file join $PWD pkg $name]] + return [my Config_get builddir [file join $PWD pkg $name]] } } method ConfigureOpts {} { set opts {} - set builddir [my define get builddir] + set builddir [my Config_get builddir] - if {[my define get broken_destroot 0]} { - set PREFIX [my <project> define get prefix_broken_destdir] + if {[my Config_get broken_destroot 0]} { + set PREFIX [my <project> config get prefix_broken_destdir] } else { - set PREFIX [my <project> define get prefix] + set PREFIX [my <project> config get prefix] } - switch [my define get name] { + switch [my Config_get name] { tcl { - set opts [::practcl::platform::tcl_core_options [my <project> define get TEACUP_OS]] + set opts [::practcl::platform::tcl_core_options [my <project> config get TEACUP_OS]] } tk { - set opts [::practcl::platform::tk_core_options [my <project> define get TEACUP_OS]] + set opts [::practcl::platform::tk_core_options [my <project> config get TEACUP_OS]] } } - if {[my <project> define get CONFIG_SITE] != {}} { - lappend opts --host=[my <project> define get HOST] + if {[my <project> config get CONFIG_SITE] != {}} { + lappend opts --host=[my <project> config get HOST] } - set inside_msys [string is true -strict [my <project> define get MSYS_ENV 0]] + set inside_msys [string is true -strict [my <project> config get MSYS_ENV 0]] lappend opts --with-tclsh=[info nameofexecutable] - if {[my define get tk 0]} { - if {![my <project> define get LOCAL 0]} { + if {[my Config_get tk 0]} { + if {![my <project> config 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 define get builddir]] + lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] } else { - lappend opts --with-tcl=[file normalize [$obj define get builddir]] + lappend opts --with-tcl=[file normalize [$obj config get builddir]] } } set obj [my <project> tkcore] if {$obj ne {}} { if {$inside_msys} { - lappend opts --with-tk=[::practcl::file_relative [file normalize $builddir] [$obj define get builddir]] + lappend opts --with-tk=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] } else { - lappend opts --with-tk=[file normalize [$obj define get builddir]] + lappend opts --with-tk=[file normalize [$obj config get builddir]] } } } else { lappend opts --with-tcl=[file join $PREFIX lib] lappend opts --with-tk=[file join $PREFIX lib] } } else { - if {![my <project> define get LOCAL 0]} { + if {![my <project> config 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 define get builddir]] + lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] } else { - lappend opts --with-tcl=[file normalize [$obj define get builddir]] + lappend opts --with-tcl=[file normalize [$obj config get builddir]] } } } else { lappend opts --with-tcl=[file join $PREFIX lib] } } - lappend opts {*}[my define get config_opts] + lappend opts {*}[my Config_get config_opts] if {![regexp -- "--prefix" $opts]} { lappend opts --prefix=$PREFIX --exec-prefix=$PREFIX } - if {[my define get debug 0]} { + if {[my Config_get debug 0]} { lappend opts --enable-symbols=true } #--exec_prefix=$PREFIX #if {$::tcl_platform(platform) eq "windows"} { # lappend opts --disable-64bit #} - if {[my define get static 1]} { + if {[my Config_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 define add include_dir [file join $srcdir generic] + my Config_add include_dir [file join $srcdir generic] } - set os [my <project> define get TEACUP_OS] + set os [my <project> config get TEACUP_OS] switch $os { windows { if {[file exists [file join $srcdir win]]} { - my define add include_dir [file join $srcdir win] + my Config_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 define add include_dir [file join $srcdir $os] + my Config_add include_dir [file join $srcdir $os] } if {[file exists [file join $srcdir unix]]} { - my define add include_dir [file join $srcdir unix] + my Config_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 define get srcdir] + set srcdir [my Config_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 define get srcdir] + set teapath [$tclConfigObj config 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 define get builddir] + set builddir [my Config_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 define get name] CONFIGURE {*}$opts] + ::practcl::debug [list PKG [my Config_get name] CONFIGURE {*}$opts] ::practcl::log [file join $builddir autoconf.log] [list CONFIGURE {*}$opts] cd $builddir - if {[my <project> define get CONFIG_SITE] ne {}} { - set ::env(CONFIG_SITE) [my <project> define get CONFIG_SITE] + if {[my <project> config get CONFIG_SITE] ne {}} { + set ::env(CONFIG_SITE) [my <project> config 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 define get builddir]] + set builddir [file normalize [my Config_get builddir]] catch {::practcl::domake $builddir clean} } Ensemble make::compile {} { - set name [my define get name] - set srcdir [my define get srcdir] - if {[my define get static 1]} { + set name [my Config_get name] + set srcdir [my Config_get srcdir] + if {[my Config_get static 1]} { puts "BUILDING Static $name $srcdir" } else { puts "BUILDING Dynamic $name $srcdir" } cd $::CWD - set builddir [file normalize [my define get builddir]] + set builddir [file normalize [my Config_get builddir]] file mkdir $builddir if {![file exists [file join $builddir Makefile]]} { my Configure } if {[file exists [file join $builddir make.tcl]]} { - if {[my define get debug 0]} { + if {[my Config_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 define get builddir] - if {[my <project> define get LOCAL 0] || $DEST eq {}} { + set builddir [my Config_get builddir] + if {[my <project> config 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 define get broken_destroot 0] == 0} { + } elseif {[my Config_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 define get broken_destroot 0] == 0} { + } elseif {[my Config_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> define get prefix] - set BROKENROOT [::practcl::msys_to_tclpath [my <project> define get prefix_broken_destdir]] + set PREFIX [my <project> config get prefix] + set BROKENROOT [::practcl::msys_to_tclpath [my <project> config 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 define get OBJEXT o] + set objext [my Config_get OBJEXT o] set EXTERN_OBJS {} set OBJECTS {} set result {} - set builddir [$PROJECT define get builddir] + set builddir [$PROJECT config get builddir] file mkdir [file join $builddir objs] - set debug [$PROJECT define get debug 0] + set debug [$PROJECT config get debug 0] set task {} ### # Compile the C sources ### @@ -362,15 +362,15 @@ } return $result } method build-Makefile {path PROJECT} { - array set proj [$PROJECT define dump] + array set proj [$PROJECT config dump] set path $proj(builddir) cd $path set includedir . - set objext [my define get OBJEXT o] + set objext [my Config_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 define getnull libprefix] + lappend map %LIBRARY_PREFIX% [$PROJECT config get libprefix] - if {[string is true [$PROJECT define get SHARED_BUILD]]} { - set outfile [$PROJECT define get libfile] + if {[string is true [$PROJECT config get SHARED_BUILD]]} { + set outfile [$PROJECT config get libfile] } else { set outfile [$PROJECT shared_library] } - $PROJECT define set shared_library $outfile + $PROJECT config 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 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 "\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 {} - if {[string is true [$PROJECT define get SHARED_BUILD]]} { + if {[string is true [$PROJECT config get SHARED_BUILD]]} { #set outfile [$PROJECT static_library] set outfile $proj(name).a } else { - set outfile [$PROJECT define get libfile] + set outfile [$PROJECT config get libfile] } - $PROJECT define set static_library $outfile + $PROJECT config set static_library $outfile dict set map %OUTFILE% $outfile ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" - ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_STATIC_LIB]]" + ::practcl::cputs result "\t[string map $map [$PROJECT config get PRACTCL_STATIC_LIB]]" ::practcl::cputs result {} return $result } ### # Produce a static or dynamic library ### method build-library {outfile PROJECT} { - array set proj [$PROJECT define dump] + array set proj [$PROJECT config 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 define get TEA_PRIVATE_TCL_HEADERS 0]} { - if {[$PROJECT define get TEA_PLATFORM] eq "windows"} { + if {[$PROJECT config get TEA_PRIVATE_TCL_HEADERS 0]} { + if {[$PROJECT config 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 define get tk 0]} { + if {[$PROJECT config 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 define get TEA_PRIVATE_TK_HEADERS 0]} { - if {[$PROJECT define get TEA_PLATFORM] eq "windows"} { + if {[$PROJECT config get TEA_PRIVATE_TK_HEADERS 0]} { + if {[$PROJECT config 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 define get debug 0] - set os [$PROJECT define get TEACUP_OS] + set debug [$PROJECT config get debug 0] + set os [$PROJECT config 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 define get SHARED_BUILD 1]]} { - set cmd [$PROJECT define get PRACTCL_SHARED_LIB] - append cmd " [$PROJECT define get PRACTCL_LIBS]" + 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]" set cmd [string map $map $cmd] puts $cmd exec {*}$cmd >&@ stdout - if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { - set cmd [string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]] + if {[$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { + set cmd [string map $map [$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL]] puts $cmd exec {*}$cmd >&@ stdout } } else { - set cmd [string map $map [$PROJECT define get PRACTCL_STATIC_LIB]] + set cmd [string map $map [$PROJECT config get PRACTCL_STATIC_LIB]] puts $cmd exec {*}$cmd >&@ stdout } - set ranlib [$PROJECT define get RANLIB] + set ranlib [$PROJECT config get RANLIB] if {$ranlib ni {{} :}} { catch {exec $ranlib $outfile} } } ### # Produce a static executable ### method build-tclsh {outfile PROJECT {path {auto}}} { - if {[my define get tk 0] && [my define get static_tk 0]} { + if {[my Config_get tk 0] && [my Config_get static_tk 0]} { puts " BUILDING STATIC TCL/TK EXE $PROJECT" set TKOBJ [$PROJECT tkcore] if {[info command $TKOBJ] eq {}} { set TKOBJ ::noop - $PROJECT define set static_tk 0 + $PROJECT config set static_tk 0 } else { ::practcl::toolset select $TKOBJ array set TK [$TKOBJ read_configuration] - 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] + 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] } } else { puts " BUILDING STATIC TCL EXE $PROJECT" set TKOBJ ::noop - my define set static_tk 0 + my Config_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 define get static]]} { + if {[string is true [$item config get static]]} { lappend PKG_OBJS $item } } foreach item [$PROJECT link list package] { - if {[string is true [$item define get static]]} { + if {[string is true [$item config 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 define get debug 0] + set debug [$PROJECT config 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 define get TEACUP_OS] - set TCLSRCDIR [$TCLOBJ define get srcdir] + set os [$PROJECT config get TEACUP_OS] + set TCLSRCDIR [$TCLOBJ config 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 define get static_tk]} { + if {[$PROJECT config 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} define get TEACUP_OS] eq "windows"} { - set windres [$PROJECT define get RC windres] + if {[${PROJECT} config get TEACUP_OS] eq "windows"} { + set windres [$PROJECT config get RC windres] set RSOBJ [file join $path objs tclkit.res.o] - 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 RCSRC [${PROJECT} config get kit_resource_file] + set RCMAN [${PROJECT} config get kit_manifest_file] + set RCICO [${PROJECT} config get kit_icon_file] set cmd [list $windres -o $RSOBJ -DSTATIC_BUILD --include [::practcl::file_relative $path [file join $TCLSRC generic]]] - if {[$PROJECT define get static_tk]} { + if {[$PROJECT config 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 define get builddir] wish.exe.manifest] + set RCMAN [file join [$TKOBJ config 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 define get builddir] tclsh.exe.manifest] + set RCMAN [file join [$TCLOBJ config get builddir] tclsh.exe.manifest] } if {$RCICO eq {} || ![file exists $RCICO]} { set RCICO [file join $TCLSRCDIR win tclsh.ico] } } - foreach item [${PROJECT} define get resource_include] { + foreach item [${PROJECT} config 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 define get static_tk]} { + if {[$PROJECT config get static_tk]} { append cmd " -L[file dirname $TK(build_stub_lib_path)] -ltk86g" } } else { append cmd " $TCL(build_lib_spec)" - if {[$PROJECT define get static_tk]} { + if {[$PROJECT config 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 define get static_tk]} { + if {[$PROJECT config 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 define get static_tk]} { + if {[$PROJECT config 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 define get static_tk]} { + if {[$PROJECT config 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 define get srcdir] + set srcdir [my Config_get srcdir] return $srcdir } # Do nothing @@ -12,50 +12,50 @@ Ensemble make::autodetect {} { } Ensemble make::clean {} { set PWD [pwd] - set srcdir [my define get srcdir] + set srcdir [my Config_get srcdir] cd $srcdir catch {::practcl::doexec nmake -f makefile.vc clean} cd $PWD } Ensemble make::compile {} { - set srcdir [my define get srcdir] - if {[my define get static 1]} { + set srcdir [my Config_get srcdir] + if {[my Config_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 define get debug 0]} { + if {[my Config_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> define get installdir] {*}[my NmakeOpts] release + ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> config 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> define get installdir] {*}[my NmakeOpts] release + ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> config 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 define get srcdir] + set srcdir [my Config_get srcdir] cd $srcdir if {$DEST eq {}} { error "No destination given" } - if {[my <project> define get LOCAL 0] || $DEST eq {}} { + if {[my <project> config 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 define add include_dir [file join $srcdir generic] + my Config_add include_dir [file join $srcdir generic] } if {[file exists [file join $srcdir win]]} { - my define add include_dir [file join $srcdir win] + my Config_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 define get builddir]] + set builddir [file normalize [my Config_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> define get tclsrcdir] ..]]] - set TCLGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tclsrcdir] .. generic]]] + 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]]] 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> define get tksrcdir] ..]]] - set TKGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tksrcdir] .. generic]]] + 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]]] #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 define get filename] + set filename [$obj config 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.16.3 +package provide practcl 0.17 namespace eval ::practcl {} ### # START: httpwget/wget.tcl ### @@ -15,11 +15,11 @@ # END: httpwget/wget.tcl ### ### # START: clay/clay.tcl ### -package provide clay 0.8 +package provide clay 0.8.1 namespace eval ::clay { } namespace eval ::clay { } set ::clay::trace 0 @@ -1314,10 +1314,15 @@ set path [::clay::tree::storage $args] if {![dict exists $clay {*}$path .]} { dict set clay {*}$path . {} } } + cache { + set path [lindex $args 0] + set value [lindex $args 1] + dict set claycache $path $value + } cget { # Leaf searches return one data field at a time # Search in our local dict if {[llength $args]==1} { set field [string trim [lindex $args 0] -:/] @@ -1398,11 +1403,10 @@ ::clay::tree::dictmerge result $clay return $result } ensemble_map { set ensemble [lindex $args 0] - my variable claycache set mensemble [string trim $ensemble :/] if {[dict exists $claycache method_ensemble $mensemble]} { return [clay::tree::sanitize [dict get $claycache method_ensemble $mensemble]] } set emap [my clay dget method_ensemble $mensemble] @@ -1477,31 +1481,29 @@ ::clay::tree::dictmerge result [$class clay dump] } ::clay::tree::dictmerge result $clay return $result } - # Search in our local cache - if {[dict exists $claycache {*}$path .]} { - return [dict get $claycache {*}$path] - } - if {[dict exists $claycache {*}$path]} { - return [dict get $claycache {*}$path] - } if {[dict exists $clay {*}$path] && ![dict exists $clay {*}$path .]} { # Path is a leaf return [dict get $clay {*}$path] } + # Search in our local cache + if {[my clay search $path value isleaf]} { + return $value + } + set found 0 set branch [dict exists $clay {*}$path .] foreach class $clayorder { if {[$class clay exists {*}$path .]} { set found 1 break } if {!$branch && [$class clay exists {*}$path]} { set result [$class clay dget {*}$path] - dict set claycache {*}$path $result + my clay cache $path $result return $result } } # Path is a branch set result [dict getnull $clay {*}$path] @@ -1510,11 +1512,11 @@ ::clay::tree::dictmerge result [$class clay dget {*}$path] } #if {[dict exists $clay {*}$path .]} { # ::clay::tree::dictmerge result #} - dict set claycache {*}$path $result + my clay cache $path $result return $result } getnull - get { set path [::clay::tree::storage $args] @@ -1526,20 +1528,21 @@ ::clay::tree::dictmerge result [$class clay dump] } ::clay::tree::dictmerge result $clay return [::clay::tree::sanitize $result] } - # Search in our local cache - if {[dict exists $claycache {*}$path .]} { - return [::clay::tree::sanitize [dict get $claycache {*}$path]] - } - if {[dict exists $claycache {*}$path]} { - return [dict get $claycache {*}$path] - } if {[dict exists $clay {*}$path] && ![dict exists $clay {*}$path .]} { # Path is a leaf return [dict get $clay {*}$path] + } + # Search in our local cache + if {[my clay search $path value isleaf]} { + if {!$isleaf} { + return [clay::tree::sanitize $value] + } else { + return $value + } } set found 0 set branch [dict exists $clay {*}$path .] foreach class $clayorder { if {[$class clay exists {*}$path .]} { @@ -1546,11 +1549,11 @@ set found 1 break } if {!$branch && [$class clay exists {*}$path]} { set result [$class clay dget {*}$path] - dict set claycache {*}$path $result + my clay cache $path $result return $result } } # Path is a branch set result [dict getnull $clay {*}$path] @@ -1563,11 +1566,11 @@ ::clay::tree::dictmerge result [$class clay dget {*}$path] } #if {[dict exists $clay {*}$path .]} { # ::clay::tree::dictmerge result [dict get $clay {*}$path] #} - dict set claycache {*}$path $result + my clay cache $path $result return [clay::tree::sanitize $result] } leaf { # Leaf searches return one data field at a time # Search in our local dict @@ -1577,21 +1580,22 @@ } if {[dict exists $clay {*}$path]} { return [dict get $clay {*}$path] } # Search in our local cache - if {[dict exists $claycache {*}$path .]} { - return [clay::tree::sanitize [dict get $claycache {*}$path]] - } - if {[dict exists $claycache {*}$path]} { - return [dict get $claycache {*}$path] + if {[my clay search $path value isleaf]} { + if {!$isleaf} { + return [clay::tree::sanitize $value] + } else { + return $value + } } # Search in the in our list of classes for an answer foreach class $clayorder { if {[$class clay exists {*}$path]} { set value [$class clay get {*}$path] - dict set claycache {*}$path $value + my clay cache $path $value return $value } } } merge { @@ -1601,10 +1605,11 @@ } mixin { ### # Mix in the class ### + my clay flush set prior [info object mixins [self]] set newmixin {} foreach item $args { lappend newmixin ::[string trimleft $item :] } @@ -1644,11 +1649,10 @@ break } } } mixinmap { - my variable clay if {![dict exists $clay .mixin]} { dict set clay .mixin {} } if {[llength $args]==0} { return [dict get $clay .mixin] @@ -1697,16 +1701,25 @@ } } replace { set clay [lindex $args 0] } + search { + set path [lindex $args 0] + upvar 1 [lindex $args 1] value [lindex $args 2] isleaf + set isleaf [expr {![dict exists $claycache $path .]}] + if {[dict exists $claycache $path]} { + set value [dict get $claycache $path] + return 1 + } + return 0 + } source { source [lindex $args 0] } set { #puts [list [self] clay SET {*}$args] - set claycache {} ::clay::tree::dictset clay {*}$args } default { dict $submethod clay {*}$args } @@ -1777,11 +1790,10 @@ set setcmd [dict getnull $info set-command] if {$setcmd ne {}} { {*}[string map [list %field% [list $field] %value% [list $value] %self% [namespace which my]] $setcmd] } } - my variable clayorder clay claycache if {[info exists clay]} { set emap [dict getnull $clay method_ensemble] } else { set emap {} } @@ -1830,17 +1842,20 @@ proc ::cron::object_destroy args {} } ::namespace eval ::clay::event { } proc ::clay::cleanup {} { + set count 0 if {![info exists ::clay::idle_destroy]} return - foreach obj $::clay::idle_destroy { - if {[info commands $obj] ne {}} { - catch {$obj destroy} - } - } + set objlist $::clay::idle_destroy set ::clay::idle_destroy {} + foreach obj $objlist { + if {![catch {$obj destroy}]} { + incr count + } + } + return $count } proc ::clay::object_create {objname {class {}}} { #if {$::clay::trace>0} { # puts [list $objname CREATE] #} @@ -2017,10 +2032,319 @@ } ### # 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 {} @@ -2728,11 +3052,11 @@ } set ::fosdat($dir) $result return $result } proc ::practcl::os {} { - return [${::practcl::MAIN} define get TEACUP_OS] + return [${::practcl::MAIN} config get TEACUP_OS] } proc ::practcl::mkzip {exename barekit vfspath} { ::practcl::tcllib_require zipfile::mkzip ::zipfile::mkzip::mkzip $exename -runtime $barekit -directory $vfspath } @@ -3798,11 +4122,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 define get filename] + set filename [$obj config get filename] if {$filename ne {}} { set ::target($name) $filename } } @@ -3811,133 +4135,24 @@ ### ### # START: class metaclass.tcl ### ::clay::define ::practcl::metaclass { + superclass ::clay::yggdrasil method _MorphPatterns {} { return {{@name@} {::practcl::@name@} {::practcl::*@name@} {::practcl::*@name@*}} } - 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 Child_define {} { + return {} + } + method define {method args} { + tailcall my Config_$method {*}$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]] { @@ -3962,11 +4177,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 define set class $class + my Config_set class $class } } else { error "[self] Could not detect class for $classname" } } @@ -4003,19 +4218,19 @@ ::clay::define ::practcl::toolset { method config.sh {} { return [my read_configuration] } method BuildDir {PWD} { - 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]] + 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]] } if {$debug} { - return [my define get builddir [file join $PWD debug $name]] + return [my Config_get builddir [file join $PWD debug $name]] } else { - return [my define get builddir [file join $PWD pkg $name]] + return [my Config_get builddir [file join $PWD pkg $name]] } } method MakeDir {srcdir} { return $srcdir } @@ -4023,15 +4238,15 @@ my variable conf_result if {[info exists conf_result]} { return $conf_result } set result {} - set name [my define get name] + set name [my Config_get name] set PWD $::CWD - set builddir [my define get builddir] + set builddir [my Config_get builddir] my unpack - set srcdir [my define get srcdir] + set srcdir [my Config_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 @@ -4084,13 +4299,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} define get name [${PROJECT} define get pkg_name]]] + set name [string tolower [${PROJECT} config get name [${PROJECT} config get pkg_name]]] set NAME [string toupper $name] - set version [${PROJECT} define get version [${PROJECT} define get pkg_vers]] + set version [${PROJECT} config get version [${PROJECT} config get pkg_vers]] if {$version eq {}} { set version 0.1a } set defs $DEFS foreach flag { @@ -4111,11 +4326,11 @@ return $defs } method critcl args { if {![info exists critcl]} { ::practcl::LOCAL tool critcl env-load - set critcl [file join [::practcl::LOCAL tool critcl define get srcdir] main.tcl + set critcl [file join [::practcl::LOCAL tool critcl config get srcdir] main.tcl } set srcdir [my SourceRoot] set PWD [pwd] cd $srcdir ::practcl::dotclexec $critcl {*}$args @@ -4127,13 +4342,13 @@ method select object { ### # Select the toolset to use for this project ### if {[$object define exists toolset]} { - return [$object define get toolset] + return [$object config get toolset] } - set class [$object define get toolset] + set class [$object config get toolset] if {$class ne {}} { $object clay mixinmap toolset $class } else { if {[info exists ::env(VisualStudioVersion)]} { $object clay mixinmap toolset ::practcl::toolset.msvc @@ -4156,11 +4371,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 define get srcdir]] + set srcdir [file normalize [my Config_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]} { @@ -4169,93 +4384,93 @@ } } cd $pwd } method BuildDir {PWD} { - 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]] + 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]] } if {$debug} { - return [my define get builddir [file join $PWD debug $name]] + return [my Config_get builddir [file join $PWD debug $name]] } else { - return [my define get builddir [file join $PWD pkg $name]] + return [my Config_get builddir [file join $PWD pkg $name]] } } method ConfigureOpts {} { set opts {} - set builddir [my define get builddir] + set builddir [my Config_get builddir] - if {[my define get broken_destroot 0]} { - set PREFIX [my <project> define get prefix_broken_destdir] + if {[my Config_get broken_destroot 0]} { + set PREFIX [my <project> config get prefix_broken_destdir] } else { - set PREFIX [my <project> define get prefix] + set PREFIX [my <project> config get prefix] } - switch [my define get name] { + switch [my Config_get name] { tcl { - set opts [::practcl::platform::tcl_core_options [my <project> define get TEACUP_OS]] + set opts [::practcl::platform::tcl_core_options [my <project> config get TEACUP_OS]] } tk { - set opts [::practcl::platform::tk_core_options [my <project> define get TEACUP_OS]] + set opts [::practcl::platform::tk_core_options [my <project> config get TEACUP_OS]] } } - if {[my <project> define get CONFIG_SITE] != {}} { - lappend opts --host=[my <project> define get HOST] + if {[my <project> config get CONFIG_SITE] != {}} { + lappend opts --host=[my <project> config get HOST] } - set inside_msys [string is true -strict [my <project> define get MSYS_ENV 0]] + set inside_msys [string is true -strict [my <project> config get MSYS_ENV 0]] lappend opts --with-tclsh=[info nameofexecutable] - if {[my define get tk 0]} { - if {![my <project> define get LOCAL 0]} { + if {[my Config_get tk 0]} { + if {![my <project> config 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 define get builddir]] + lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] } else { - lappend opts --with-tcl=[file normalize [$obj define get builddir]] + lappend opts --with-tcl=[file normalize [$obj config get builddir]] } } set obj [my <project> tkcore] if {$obj ne {}} { if {$inside_msys} { - lappend opts --with-tk=[::practcl::file_relative [file normalize $builddir] [$obj define get builddir]] + lappend opts --with-tk=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] } else { - lappend opts --with-tk=[file normalize [$obj define get builddir]] + lappend opts --with-tk=[file normalize [$obj config get builddir]] } } } else { lappend opts --with-tcl=[file join $PREFIX lib] lappend opts --with-tk=[file join $PREFIX lib] } } else { - if {![my <project> define get LOCAL 0]} { + if {![my <project> config 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 define get builddir]] + lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] } else { - lappend opts --with-tcl=[file normalize [$obj define get builddir]] + lappend opts --with-tcl=[file normalize [$obj config get builddir]] } } } else { lappend opts --with-tcl=[file join $PREFIX lib] } } - lappend opts {*}[my define get config_opts] + lappend opts {*}[my Config_get config_opts] if {![regexp -- "--prefix" $opts]} { lappend opts --prefix=$PREFIX --exec-prefix=$PREFIX } - if {[my define get debug 0]} { + if {[my Config_get debug 0]} { lappend opts --enable-symbols=true } #--exec_prefix=$PREFIX #if {$::tcl_platform(platform) eq "windows"} { # lappend opts --disable-64bit #} - if {[my define get static 1]} { + if {[my Config_get static 1]} { lappend opts --disable-shared #--disable-stubs # } else { lappend opts --enable-shared @@ -4263,17 +4478,17 @@ return $opts } method MakeDir {srcdir} { set localsrcdir $srcdir if {[file exists [file join $srcdir generic]]} { - my define add include_dir [file join $srcdir generic] + my Config_add include_dir [file join $srcdir generic] } - set os [my <project> define get TEACUP_OS] + set os [my <project> config get TEACUP_OS] switch $os { windows { if {[file exists [file join $srcdir win]]} { - my define add include_dir [file join $srcdir win] + my Config_add include_dir [file join $srcdir win] } if {[file exists [file join $srcdir win Makefile.in]]} { set localsrcdir [file join $srcdir win] } } @@ -4282,14 +4497,14 @@ set localsrcdir [file join $srcdir unix] } } default { if {[file exists [file join $srcdir $os]]} { - my define add include_dir [file join $srcdir $os] + my Config_add include_dir [file join $srcdir $os] } if {[file exists [file join $srcdir unix]]} { - my define add include_dir [file join $srcdir unix] + my Config_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] @@ -4297,11 +4512,11 @@ } } return $localsrcdir } Ensemble make::autodetect {} { - set srcdir [my define get srcdir] + set srcdir [my Config_get srcdir] set localsrcdir [my MakeDir $srcdir] if {$localsrcdir eq {}} { set localsrcdir $srcdir } if {$srcdir eq $localsrcdir} { @@ -4311,20 +4526,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 define get srcdir] + set teapath [$tclConfigObj config 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 define get builddir] + set builddir [my Config_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]} @@ -4333,39 +4548,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 define get name] CONFIGURE {*}$opts] + ::practcl::debug [list PKG [my Config_get name] CONFIGURE {*}$opts] ::practcl::log [file join $builddir autoconf.log] [list CONFIGURE {*}$opts] cd $builddir - if {[my <project> define get CONFIG_SITE] ne {}} { - set ::env(CONFIG_SITE) [my <project> define get CONFIG_SITE] + if {[my <project> config get CONFIG_SITE] ne {}} { + set ::env(CONFIG_SITE) [my <project> config 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 define get builddir]] + set builddir [file normalize [my Config_get builddir]] catch {::practcl::domake $builddir clean} } Ensemble make::compile {} { - set name [my define get name] - set srcdir [my define get srcdir] - if {[my define get static 1]} { + set name [my Config_get name] + set srcdir [my Config_get srcdir] + if {[my Config_get static 1]} { puts "BUILDING Static $name $srcdir" } else { puts "BUILDING Dynamic $name $srcdir" } cd $::CWD - set builddir [file normalize [my define get builddir]] + set builddir [file normalize [my Config_get builddir]] file mkdir $builddir if {![file exists [file join $builddir Makefile]]} { my Configure } if {[file exists [file join $builddir make.tcl]]} { - if {[my define get debug 0]} { + if {[my Config_get debug 0]} { ::practcl::domake.tcl $builddir debug all } else { ::practcl::domake.tcl $builddir all } } else { @@ -4372,34 +4587,34 @@ ::practcl::domake $builddir all } } Ensemble make::install DEST { set PWD [pwd] - set builddir [my define get builddir] - if {[my <project> define get LOCAL 0] || $DEST eq {}} { + set builddir [my Config_get builddir] + if {[my <project> config 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 define get broken_destroot 0] == 0} { + } elseif {[my Config_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 define get broken_destroot 0] == 0} { + } elseif {[my Config_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> define get prefix] - set BROKENROOT [::practcl::msys_to_tclpath [my <project> define get prefix_broken_destdir]] + set PREFIX [my <project> config get prefix] + set BROKENROOT [::practcl::msys_to_tclpath [my <project> config 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 @@ -4406,17 +4621,17 @@ } } cd $PWD } method build-compile-sources {PROJECT COMPILE CPPCOMPILE INCLUDES} { - set objext [my define get OBJEXT o] + set objext [my Config_get OBJEXT o] set EXTERN_OBJS {} set OBJECTS {} set result {} - set builddir [$PROJECT define get builddir] + set builddir [$PROJECT config get builddir] file mkdir [file join $builddir objs] - set debug [$PROJECT define get debug 0] + set debug [$PROJECT config get debug 0] set task {} ### # Compile the C sources ### @@ -4502,15 +4717,15 @@ } } return $result } method build-Makefile {path PROJECT} { - array set proj [$PROJECT define dump] + array set proj [$PROJECT config dump] set path $proj(builddir) cd $path set includedir . - set objext [my define get OBJEXT o] + set objext [my Config_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] { @@ -4557,68 +4772,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 define getnull libprefix] + lappend map %LIBRARY_PREFIX% [$PROJECT config get libprefix] - if {[string is true [$PROJECT define get SHARED_BUILD]]} { - set outfile [$PROJECT define get libfile] + if {[string is true [$PROJECT config get SHARED_BUILD]]} { + set outfile [$PROJECT config get libfile] } else { set outfile [$PROJECT shared_library] } - $PROJECT define set shared_library $outfile + $PROJECT config 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 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 "\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 {} - if {[string is true [$PROJECT define get SHARED_BUILD]]} { + if {[string is true [$PROJECT config get SHARED_BUILD]]} { #set outfile [$PROJECT static_library] set outfile $proj(name).a } else { - set outfile [$PROJECT define get libfile] + set outfile [$PROJECT config get libfile] } - $PROJECT define set static_library $outfile + $PROJECT config set static_library $outfile dict set map %OUTFILE% $outfile ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" - ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_STATIC_LIB]]" + ::practcl::cputs result "\t[string map $map [$PROJECT config get PRACTCL_STATIC_LIB]]" ::practcl::cputs result {} return $result } method build-library {outfile PROJECT} { - array set proj [$PROJECT define dump] + array set proj [$PROJECT config 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 define get TEA_PRIVATE_TCL_HEADERS 0]} { - if {[$PROJECT define get TEA_PLATFORM] eq "windows"} { + if {[$PROJECT config get TEA_PRIVATE_TCL_HEADERS 0]} { + if {[$PROJECT config 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 define get tk 0]} { + if {[$PROJECT config 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 define get TEA_PRIVATE_TK_HEADERS 0]} { - if {[$PROJECT define get TEA_PLATFORM] eq "windows"} { + if {[$PROJECT config get TEA_PRIVATE_TK_HEADERS 0]} { + if {[$PROJECT config 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]]] } } @@ -4630,12 +4845,12 @@ lappend includedir $cpath } } my build-cflags $PROJECT $proj(DEFS) name version defs set NAME [string toupper $name] - set debug [$PROJECT define get debug 0] - set os [$PROJECT define get TEACUP_OS] + set debug [$PROJECT config get debug 0] + set os [$PROJECT config get TEACUP_OS] set INCLUDES "-I[join $includedir " -I"]" if {$debug} { set COMPILE "$proj(CC) $proj(CFLAGS_DEBUG) -ggdb \ $proj(CFLAGS_WARNING) $INCLUDES $defs" @@ -4664,61 +4879,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 define get SHARED_BUILD 1]]} { - set cmd [$PROJECT define get PRACTCL_SHARED_LIB] - append cmd " [$PROJECT define get PRACTCL_LIBS]" + 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]" set cmd [string map $map $cmd] puts $cmd exec {*}$cmd >&@ stdout - if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { - set cmd [string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]] + if {[$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { + set cmd [string map $map [$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL]] puts $cmd exec {*}$cmd >&@ stdout } } else { - set cmd [string map $map [$PROJECT define get PRACTCL_STATIC_LIB]] + set cmd [string map $map [$PROJECT config get PRACTCL_STATIC_LIB]] puts $cmd exec {*}$cmd >&@ stdout } - set ranlib [$PROJECT define get RANLIB] + set ranlib [$PROJECT config get RANLIB] if {$ranlib ni {{} :}} { catch {exec $ranlib $outfile} } } method build-tclsh {outfile PROJECT {path {auto}}} { - if {[my define get tk 0] && [my define get static_tk 0]} { + if {[my Config_get tk 0] && [my Config_get static_tk 0]} { puts " BUILDING STATIC TCL/TK EXE $PROJECT" set TKOBJ [$PROJECT tkcore] if {[info command $TKOBJ] eq {}} { set TKOBJ ::noop - $PROJECT define set static_tk 0 + $PROJECT config set static_tk 0 } else { ::practcl::toolset select $TKOBJ array set TK [$TKOBJ read_configuration] - 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] + 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] } } else { puts " BUILDING STATIC TCL EXE $PROJECT" set TKOBJ ::noop - my define set static_tk 0 + my Config_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 define get static]]} { + if {[string is true [$item config get static]]} { lappend PKG_OBJS $item } } foreach item [$PROJECT link list package] { - if {[string is true [$item define get static]]} { + if {[string is true [$item config get static]]} { lappend PKG_OBJS $item } } array set TCL [$TCLOBJ read_configuration] if {$path in {{} auto}} { @@ -4733,11 +4948,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 define get debug 0] + set debug [$PROJECT config get debug 0] set NAME [string toupper $name] set result {} set libraries {} set thisline {} set OBJECTS {} @@ -4744,22 +4959,22 @@ set EXTERN_OBJS {} foreach obj $PKG_OBJS { $obj compile set config($obj) [$obj read_configuration] } - set os [$PROJECT define get TEACUP_OS] - set TCLSRCDIR [$TCLOBJ define get srcdir] + set os [$PROJECT config get TEACUP_OS] + set TCLSRCDIR [$TCLOBJ config 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 define get static_tk]} { + if {[$PROJECT config 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]] } @@ -4782,24 +4997,24 @@ append COMPILE " " $defs lappend OBJECTS {*}[my build-compile-sources $PROJECT $COMPILE $COMPILE $INCLUDES] set TCLSRC [file normalize $TCLSRCDIR] - if {[${PROJECT} define get TEACUP_OS] eq "windows"} { - set windres [$PROJECT define get RC windres] + if {[${PROJECT} config get TEACUP_OS] eq "windows"} { + set windres [$PROJECT config get RC windres] set RSOBJ [file join $path objs tclkit.res.o] - 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 RCSRC [${PROJECT} config get kit_resource_file] + set RCMAN [${PROJECT} config get kit_manifest_file] + set RCICO [${PROJECT} config get kit_icon_file] set cmd [list $windres -o $RSOBJ -DSTATIC_BUILD --include [::practcl::file_relative $path [file join $TCLSRC generic]]] - if {[$PROJECT define get static_tk]} { + if {[$PROJECT config 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 define get builddir] wish.exe.manifest] + set RCMAN [file join [$TKOBJ config 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] @@ -4809,17 +5024,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 define get builddir] tclsh.exe.manifest] + set RCMAN [file join [$TCLOBJ config get builddir] tclsh.exe.manifest] } if {$RCICO eq {} || ![file exists $RCICO]} { set RCICO [file join $TCLSRCDIR win tclsh.ico] } } - foreach item [${PROJECT} define get resource_include] { + foreach item [${PROJECT} config 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]] @@ -4853,16 +5068,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 define get static_tk]} { + if {[$PROJECT config get static_tk]} { append cmd " -L[file dirname $TK(build_stub_lib_path)] -ltk86g" } } else { append cmd " $TCL(build_lib_spec)" - if {[$PROJECT define get static_tk]} { + if {[$PROJECT config get static_tk]} { append cmd " $TK(build_lib_spec)" } } foreach obj $PKG_OBJS { append cmd " [$obj linker-products $config($obj)]" @@ -4870,11 +5085,11 @@ set LIBS {} foreach item $TCL(libs) { if {[string range $item 0 1] eq "-l" && $item in $LIBS } continue lappend LIBS $item } - if {[$PROJECT define get static_tk]} { + if {[$PROJECT config get static_tk]} { foreach item $TK(libs) { if {[string range $item 0 1] eq "-l" && $item in $LIBS } continue lappend LIBS $item } } @@ -4899,16 +5114,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 define get static_tk]} { + if {[$PROJECT config 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 define get static_tk]} { + if {[$PROJECT config get static_tk]} { append cmd " $TK(build_stub_lib_spec)" } } if {[info exists TCL(cc_search_flags)]} { append cmd " $TCL(cc_search_flags)" @@ -4931,55 +5146,55 @@ # START: class toolset msvc.tcl ### ::clay::define ::practcl::toolset.msvc { superclass ::practcl::toolset method BuildDir {PWD} { - set srcdir [my define get srcdir] + set srcdir [my Config_get srcdir] return $srcdir } Ensemble make::autodetect {} { } Ensemble make::clean {} { set PWD [pwd] - set srcdir [my define get srcdir] + set srcdir [my Config_get srcdir] cd $srcdir catch {::practcl::doexec nmake -f makefile.vc clean} cd $PWD } Ensemble make::compile {} { - set srcdir [my define get srcdir] - if {[my define get static 1]} { + set srcdir [my Config_get srcdir] + if {[my Config_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 define get debug 0]} { + if {[my Config_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> define get installdir] {*}[my NmakeOpts] release + ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> config 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> define get installdir] {*}[my NmakeOpts] release + ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> config 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 define get srcdir] + set srcdir [my Config_get srcdir] cd $srcdir if {$DEST eq {}} { error "No destination given" } - if {[my <project> define get LOCAL 0] || $DEST eq {}} { + if {[my <project> config 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 { @@ -4999,37 +5214,37 @@ cd $PWD } method MakeDir {srcdir} { set localsrcdir $srcdir if {[file exists [file join $srcdir generic]]} { - my define add include_dir [file join $srcdir generic] + my Config_add include_dir [file join $srcdir generic] } if {[file exists [file join $srcdir win]]} { - my define add include_dir [file join $srcdir win] + my Config_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 define get builddir]] + set builddir [file normalize [my Config_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> define get tclsrcdir] ..]]] - set TCLGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tclsrcdir] .. generic]]] + 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]]] 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> define get tksrcdir] ..]]] - set TKGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tksrcdir] .. generic]]] + 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]]] #lappend opts --with-tk=$TKSRCDIR --with-tkinclude=$TKGENERIC lappend opts TKDIR=[file normalize $TKSRCDIR] } return $opts } @@ -5045,20 +5260,19 @@ superclass ::practcl::metaclass constructor {module_object name info {action_body {}}} { my variable define triggered domake set triggered 0 set domake 0 - set define(name) $name - set define(action) {} - array set define $info + my Config_set name $name action {} + my Config_merge $info my select my initialize foreach {stub obj} [$module_object child organs] { my graft $stub $obj } if {$action_body ne {}} { - set define(action) $action_body + my Config_set action $action_body } } method do {} { my variable domake return $domake @@ -5071,11 +5285,11 @@ if {[info exists needs_make]} { return $needs_make } set make_objects [my <module> make objects] set needs_make 0 - foreach item [my define get depends] { + foreach item [my Config_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 @@ -5093,15 +5307,15 @@ } return $needs_make } method output {} { set result {} - set filename [my define get filename] + set filename [my Config_get filename] if {$filename ne {}} { lappend result $filename } - foreach filename [my define get files] { + foreach filename [my Config_get files] { if {$filename ne {}} { lappend result $filename } } return $result @@ -5118,11 +5332,11 @@ return $domake } set triggered 1 set make_objects [my <module> make objects] - foreach item [my define get depends] { + foreach item [my Config_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 @@ -5132,11 +5346,11 @@ $depobj triggers } } } set domake 1 - my <module> make trigger {*}[my define get triggers] + my <module> make trigger {*}[my Config_get triggers] } } ### # END: class target.tcl @@ -5145,35 +5359,38 @@ # START: class object.tcl ### ::clay::define ::practcl::object { superclass ::practcl::metaclass constructor {parent args} { - my variable links define + my variable links set organs [$parent child organs] my clay delegate {*}$organs - array set define $organs - array set define [$parent child define] + my Config_merge $organs + my Config_merge [$parent child define] array set links {} if {[llength $args]==1 && [file exists [lindex $args 0]]} { - my define set filename [lindex $args 0] + my Config_set filename [lindex $args 0] ::practcl::product select [self] } elseif {[llength $args] == 1} { set data [uplevel 1 [list subst [lindex $args 0]]] - array set define $data + my Config_merge $data my select } else { - array set define [uplevel 1 [list subst $args]] + my Config_merge [uplevel 1 [list subst $args]] my select } my initialize } - method child {method} { + method Child_delegate {} { + return {} + } + method Child_organs {} { return {} } method go {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable links foreach {linktype objs} [array get links] { foreach obj $objs { $obj go } @@ -5198,17 +5415,17 @@ if {![dict exists $cstruct $name public]} { dict set cstruct $name public 1 } } method include header { - my define add include $header + my Config_add include $header } method include_dir args { - my define add include_dir {*}$args + my Config_add include_dir {*}$args } method include_directory args { - my define add include_dir {*}$args + my Config_add include_dir {*}$args } method c_header body { my variable code ::practcl::cputs code(header) $body } @@ -5333,33 +5550,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 define get output_c] + set filename [my Config_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 define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] } else { - set filename [my define get cfile] + set filename [my Config_get cfile] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] } } foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } @@ -5366,49 +5583,49 @@ return $result } method implement path { my go my Collate_Source $path - 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 + 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 set fout [open $filename w] puts $fout [my generate-c] - if {[my define get initfunc] ne {}} { - puts $fout "extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \x7B" + if {[my Config_get initfunc] ne {}} { + puts $fout "extern int DLLEXPORT [my Config_get initfunc]( Tcl_Interp *interp ) \x7B" puts $fout [my generate-loader-module] - if {[my define get pkg_name] ne {}} { - puts $fout " Tcl_PkgProvide(interp, \"[my define get pkg_name]\", \"[my define get pkg_vers]\");" + if {[my Config_get pkg_name] ne {}} { + puts $fout " Tcl_PkgProvide(interp, \"[my Config_get pkg_name]\", \"[my Config_get pkg_vers]\");" } puts $fout " return TCL_OK\;" puts $fout "\x7D" } close $fout } method initialize {} { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename eq {}} { return } - if {[my define get name] eq {}} { - my define set name [file tail [file rootname $filename]] + if {[my Config_get name] eq {}} { + my Config_set name [file tail [file rootname $filename]] } - if {[my define get localpath] eq {}} { - my define set localpath [my <module> define get localpath]_[my define get name] + if {[my Config_get localpath] eq {}} { + my Config_set localpath [my <module> config get localpath]_[my Config_get name] } ::source $filename } method linktype {} { return {subordinate product dynamic} } method generate-cfile-constant {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} my variable code cstruct methods tcltype if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my define get filename] CONSTANT */" + ::practcl::cputs result "/* [my Config_get filename] CONSTANT */" ::practcl::cputs result $code(constant) } if {[info exists cstruct]} { foreach {name info} $cstruct { set map {} @@ -5478,17 +5695,17 @@ dict set methods $name methodtype $methodtype } } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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) } @@ -5505,13 +5722,13 @@ if {[dict exists $info header]} { ::practcl::cputs result "[dict get $info header]\;" } } } - ::practcl::debug [list methods [info exists methods] [my define get cclass]] + ::practcl::debug [list methods [info exists methods] [my Config_get cclass]] if {[info exists methods]} { - set thisclass [my define get cclass] + set thisclass [my Config_get cclass] foreach {name info} $methods { if {[dict exists $info header]} { ::practcl::cputs result "[dict get $info header]\;" } } @@ -5518,22 +5735,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 define get output_c] ne {}} continue + if {[$obj config get output_c] ne {}} continue set dat [$obj generate-cfile-header] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-header */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-header */" } } return $result } method generate-cfile-tclapi {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code methods tclprocs set result {} if {[info exists code(method)]} { ::practcl::cputs result $code(method) } @@ -5549,11 +5766,11 @@ } } if {[info exists methods]} { - set thisclass [my define get cclass] + set thisclass [my Config_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] @@ -5561,11 +5778,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 define get class]] { + ::practcl::cputs result [string map [list @CCLASS@ $thisclass @TCLCLASS@ [my Config_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 */ @@ -5612,17 +5829,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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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) { @@ -5668,14 +5885,14 @@ Tcl_Export(interp, modPtr, "[a-z]*", 1); }] } ::practcl::cputs result " \}" } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_get filename]] foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} { + if {[$obj config get output_c] ne {}} { ::practcl::cputs result [$obj generate-loader-external] } else { ::practcl::cputs result [$obj generate-loader-module] } } @@ -5682,12 +5899,12 @@ return $result } method Collate_Source CWD { my variable methods code cstruct tclprocs if {[info exists methods]} { - ::practcl::debug [self] methods [my define get cclass] - set thisclass [my define get cclass] + ::practcl::debug [self] methods [my Config_get cclass] + set thisclass [my Config_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 @@ -5704,11 +5921,11 @@ } if {![info exists code(initfuncts)] || "${thisclass}_OO_Init" ni $code(initfuncts)} { lappend code(initfuncts) "${thisclass}_OO_Init" } } - set thisnspace [my define get nspace] + set thisnspace [my Config_get nspace] if {[info exists tclprocs]} { ::practcl::debug [self] tclprocs [dict keys $tclprocs] foreach {name info} $tclprocs { if {![dict exists $info callproc]} { @@ -5739,104 +5956,104 @@ } method Collate_Source CWD {} method project-compile-products {} { set result {} noop { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - 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]] + 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]] } } 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 define get filename]] links [my link list]]" + ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} my variable code cstruct methods tcltype if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my define get filename] CONSTANT */" + ::practcl::cputs result "/* [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config get output_c] ne {}} continue set dat [$obj generate-cfile-header] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-header */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-header */" } } return $result } method generate-cfile-global {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config get output_c] ne {}} continue set dat [$obj generate-cfile-global] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-global */" + ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-global */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-global */" + ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-global */" } } return $result } method generate-cfile-private-typedef {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(private-typedef)]} { ::practcl::cputs result $code(private-typedef) } @@ -5850,18 +6067,18 @@ ::practcl::cputs result "typedef struct $name ${n}\;" } } } } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(private-structure)]} { ::practcl::cputs result $code(private-structure) } @@ -5872,18 +6089,18 @@ ::practcl::cputs result [dict get $info comment] } ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" } } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cfunct set result {} if {[info exists code(funct)]} { ::practcl::cputs result $code(funct) } @@ -5897,59 +6114,59 @@ } } } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} { + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(public-typedef)]} { ::practcl::cputs result $code(public-typedef) } @@ -5963,18 +6180,18 @@ ::practcl::cputs result "typedef struct $name ${n}\;" } } } } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(public-structure)]} { ::practcl::cputs result $code(public-structure) } @@ -5985,18 +6202,18 @@ ::practcl::cputs result [dict get $info comment] } ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" } } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code tcltype set result {} if {[info exists code(public-header)]} { ::practcl::cputs result $code(public-header) } @@ -6012,40 +6229,40 @@ } } if {[info exists code(public)]} { ::practcl::cputs result $code(public) } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cfunct tcltype set result {} - if {[my define get initfunc] ne {}} { - ::practcl::cputs result "int [my define get initfunc](Tcl_Interp *interp);" + if {[my Config_get initfunc] ne {}} { + ::practcl::cputs result "int [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set includes {} - foreach item [my define get public-include] { + foreach item [my Config_get public-include] { if {$item ni $includes} { lappend includes $item } } foreach mod [my link list product] { @@ -6056,13 +6273,13 @@ } } return $includes } method generate-hfile-public-verbatim {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set includes {} - foreach item [my define get public-verbatim] { + foreach item [my Config_get public-verbatim] { if {$item ni $includes} { lappend includes $item } } foreach mod [my link list subordinate] { @@ -6073,37 +6290,37 @@ } } return $includes } method generate-loader-external {} { - if {[my define get initfunc] eq {}} { - return "/* [my define get filename] declared not initfunc */" + if {[my Config_get initfunc] eq {}} { + return "/* [my Config_get filename] declared not initfunc */" } - return " if([my define get initfunc](interp)) return TCL_ERROR\;" + return " if([my Config_get initfunc](interp)) return TCL_ERROR\;" } method generate-loader-module {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code set result {} if {[info exists code(cinit)]} { ::practcl::cputs result $code(cinit) } - if {[my define get initfunc] ne {}} { - ::practcl::cputs result " if([my define get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" + if {[my Config_get initfunc] ne {}} { + ::practcl::cputs result " if([my Config_get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_get filename]] foreach item [my link list product] { - if {[$item define get output_c] ne {}} { + if {[$item config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 @@ -6128,15 +6345,15 @@ } } } method generate-tcl-loader {} { set result {} - 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] + 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] ::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@ @@ -6150,30 +6367,30 @@ }] } return $result } method generate-tcl-pre {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} my variable code if {[info exists code(tcl)]} { - set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] + set result [::practcl::_tagblock $code(tcl) tcl [my Config_get filename]] } if {[info exists code(tcl-pre)]} { - set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] + set result [::practcl::_tagblock $code(tcl) tcl [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $code(tcl-post) tcl [my Config_get filename]] } foreach mod [my link list product] { ::practcl::cputs result [$mod generate-tcl-post] } return $result @@ -6180,25 +6397,25 @@ } method linktype {} { return {subordinate product} } method Ofile filename { - set lpath [my <module> define get localpath] + set lpath [my <module> config get localpath] if {$lpath eq {}} { - set lpath [my <module> define get name] + set lpath [my <module> config get name] } return ${lpath}_[file rootname [file tail $filename]] } method project-static-packages {} { - set result [my define get static_packages] - set initfunc [my define get initfunc] + set result [my Config_get static_packages] + set initfunc [my Config_get initfunc] if {$initfunc ne {}} { - set pkg_name [my define get pkg_name] + set pkg_name [my Config_get pkg_name] if {$pkg_name ne {}} { dict set result $pkg_name initfunc $initfunc - 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] + 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] } } foreach item [my link list subordinate] { foreach {pkg info} [$item project-static-packages] { dict set result $pkg $info @@ -6205,12 +6422,12 @@ } } return $result } method toolset-include-directory {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result [my define get include_dir] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + set result [my Config_get include_dir] foreach obj [my link list product] { foreach path [$obj toolset-include-directory] { lappend result $path } } @@ -6223,14 +6440,14 @@ } } oo::objdefine ::practcl::product { method select {object} { - set class [$object define get class] - set mixin [$object define get product] + set class [$object config get class] + set mixin [$object config get product] if {$class eq {} && $mixin eq {}} { - set filename [$object define get filename] + set filename [$object config get filename] if {$filename ne {} && [file exists $filename]} { switch [file extension $filename] { .tcl { set mixin ::practcl::product.dynamic } @@ -6274,20 +6491,20 @@ } ::clay::define ::practcl::product.csource { superclass ::practcl::product method project-compile-products {} { set result {} - set filename [my define get filename] + set filename [my Config_get filename] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]] object [self]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]] object [self]] } foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } return $result @@ -6294,34 +6511,34 @@ } } ::clay::define ::practcl::product.clibrary { superclass ::practcl::product method linker-products {configdict} { - return [my define get filename] + return [my Config_get filename] } } ::clay::define ::practcl::product.dynamic { superclass ::practcl::dynamic ::practcl::product method initialize {} { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename eq {}} { return } - if {[my define get name] eq {}} { - my define set name [file tail [file rootname $filename]] + if {[my Config_get name] eq {}} { + my Config_set name [file tail [file rootname $filename]] } - if {[my define get localpath] eq {}} { - my define set localpath [my <module> define get localpath]_[my define get name] + if {[my Config_get localpath] eq {}} { + my Config_set localpath [my <module> config get localpath]_[my Config_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 define get output_c] ne {}} { + if {[my Config_get output_c] ne {}} { # Turn into a module if we have an output_c file my morph ::practcl::module } } } @@ -6360,11 +6577,11 @@ ### # Build local variables needed for install ### package require platform set result {} - set dat [my define dump] + set dat [my Config_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 {} @@ -6434,11 +6651,11 @@ } } } Ensemble make::filename name { if {[dict exists $make_object $name]} { - return [[dict get $make_object $name] define get filename] + return [[dict get $make_object $name] config get filename] } } Ensemble make::target {name Info body} { set info [uplevel #0 [list subst $Info]] set nspace [namespace current] @@ -6470,24 +6687,22 @@ } Ensemble make::do {} { global CWD SRCDIR project SANDBOX foreach {name obj} $make_object { if {[$obj do]} { - eval [$obj define get action] + eval [$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result { /* This file was generated by practcl */ } set includes {} @@ -6496,20 +6711,20 @@ $mod go } set headers {} my IncludeAdd headers <tcl.h> <tclOO.h> - if {[my define get tk 0]} { + if {[my Config_get tk 0]} { my IncludeAdd headers <tk.h> } - if {[my define get output_h] ne {}} { - my IncludeAdd headers [my define get output_h] + if {[my Config_get output_h] ne {}} { + my IncludeAdd headers [my Config_get output_h] } - my IncludeAdd headers {*}[my define get include] + my IncludeAdd headers {*}[my Config_get include] foreach mod [my link list dynamic] { - my IncludeAdd headers {*}[$mod define get include] + my IncludeAdd headers {*}[$mod config get include] } foreach inc $headers { ::practcl::cputs result "#include $inc" } foreach {method} { @@ -6522,20 +6737,20 @@ generate-cfile-functions generate-cfile-tclapi } { set dat [my $method] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN $method [my define get filename] */" + ::practcl::cputs result "/* BEGIN $method [my Config_get filename] */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END $method [my define get filename] */" + ::practcl::cputs result "/* END $method [my Config_get filename] */" } } - ::practcl::debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list /[self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] return $result } method generate-h {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} foreach method { generate-hfile-public-define generate-hfile-public-macro } { @@ -6575,22 +6790,22 @@ ::practcl::cputs result "/* END SECTION $method */" } return $result } method generate-loader {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} - if {[my define get initfunc] eq {}} return + if {[my Config_get initfunc] eq {}} return ::practcl::cputs result " -extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \{" +extern int DLLEXPORT [my Config_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 define get tk 0]} { + if {[my Config_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]]} { @@ -6601,25 +6816,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 define get pkg_name [my define get name]]\" , \"[my define get pkg_vers [my define get version]]\" )) return TCL_ERROR\;" + ::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 " return TCL_OK\;\n\}\n" return $result } method initialize {} { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename eq {}} { return } - if {[my define get name] eq {}} { - my define set name [file tail [file dirname $filename]] + if {[my Config_get name] eq {}} { + my Config_set name [file tail [file dirname $filename]] } - if {[my define get localpath] eq {}} { - my define set localpath [my <project> define get name]_[my define get name] + if {[my Config_get localpath] eq {}} { + my Config_set localpath [my <project> config get name]_[my Config_get name] } my graft module [self] ::practcl::debug [self] SOURCE $filename my source $filename } @@ -6627,21 +6842,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 define get filename] $err" + lappend errs "Skipped $item: [$item config 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 define get filename] $err" + lappend errs "Skipped $item: [$item config get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } @@ -6657,12 +6872,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 define get filename] [info object class [self]]] - set filename [my define get output_c] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + set filename [my Config_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] @@ -6716,104 +6931,100 @@ if {[dict exists $rawcontents $field]} { dict set contents $field [dict get $rawcontents $field] } } my graft module [self] - array set define $contents + my Config_merge $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 define get TEACUP_OS] + set os [my Config_get TEACUP_OS] if {$os eq {}} { set os [::practcl::os] - my define set os $os + my Config_set os $os } - set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]] + set fossilinfo [list download [my Config_get download] tag trunk sandbox [my Config_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 define get profile release]: + set profile [my Config_get profile release]: if {[dict exists $info profile $profile]} { dict set info tag [dict get $info profile $profile] } - dict set info USEMSVC [my define get USEMSVC 0] - dict set info debug [my define get debug 0] + dict set info USEMSVC [my Config_get USEMSVC 0] + dict set info debug [my Config_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 define set masterpath $::CWD + $obj config 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 define get download] tag trunk sandbox [my define get sandbox]] + set fossilinfo [list download [my Config_get download] tag trunk sandbox [my Config_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 define get profile release]: + set profile [my Config_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 define set masterpath $::CWD + $obj config set masterpath $::CWD $obj go return $obj } method build-tclcore {} { - set os [my define get TEACUP_OS] + set os [my Config_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 define get prefix] --exec-prefix [my define get prefix] + lappend tcl_config_opts --prefix [my Config_get prefix] --exec-prefix [my Config_get prefix] set tclobj [my tclcore] - if {[my define get debug 0]} { - $tclobj define set debug 1 + if {[my Config_get debug 0]} { + $tclobj config set debug 1 lappend tcl_config_opts --enable-symbols=true } - $tclobj define set config_opts $tcl_config_opts + $tclobj config set config_opts $tcl_config_opts $tclobj go $tclobj compile - set _TclSrcDir [$tclobj define get localsrcdir] - my define set tclsrcdir $_TclSrcDir - if {[my define get tk 0]} { + set _TclSrcDir [$tclobj config get localsrcdir] + my Config_set tclsrcdir $_TclSrcDir + if {[my Config_get tk 0]} { set tkobj [my tkcore] - 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 --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 --enable-symbols=true } - $tkobj define set config_opts $tk_config_opts + $tkobj config 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 - return [list project [self] module [self]] - } - } + method Child_delegate {} { + return [list project [self] module [self]] + } + method Child_organs {} { + return [list project [self] module [self]] } method linktype {} { return project } method project {pkg args} { @@ -6883,11 +7094,11 @@ # START: class project library.tcl ### ::clay::define ::practcl::library { superclass ::practcl::project method clean {PATH} { - set objext [my define get OBJEXT o] + set objext [my Config_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} } } @@ -6895,11 +7106,11 @@ file delete $ofile } foreach ofile [glob -nocomplain [file join $PATH objs *]] { file delete $ofile } - set libfile [my define get libfile] + set libfile [my Config_get libfile] if {[file exists [file join $PATH $libfile]]} { file delete [file join $PATH $libfile] } my implement $PATH } @@ -6906,68 +7117,68 @@ method project-compile-products {} { set result {} foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } - set filename [my define get output_c] + set filename [my Config_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 define get extra] external [string is true -strict [my define get external]]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] } return $result } method go {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set name [my define getnull name] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + set name [my Config_get name] if {$name eq {}} { set name generic my define name generic } - if {[my define get tk] eq {@TEA_TK_EXTENSION@}} { - my define set tk 0 + if {[my Config_get tk] eq {@TEA_TK_EXTENSION@}} { + my Config_set tk 0 } - set output_c [my define getnull output_c] + set output_c [my Config_get output_c] if {$output_c eq {}} { set output_c [file rootname $name].c - my define set output_c $output_c + my Config_set output_c $output_c } - set output_h [my define getnull output_h] + set output_h [my Config_get output_h] if {$output_h eq {}} { set output_h [file rootname $output_c].h - my define set output_h $output_h + my Config_set output_h $output_h } - set output_tcl [my define getnull output_tcl] + set output_tcl [my Config_get output_tcl] #if {$output_tcl eq {}} { # set output_tcl [file rootname $output_c].tcl - # my define set output_tcl $output_tcl + # my Config_set output_tcl $output_tcl #} - #set output_mk [my define getnull output_mk] + #set output_mk [my Config_get output_mk] #if {$output_mk eq {}} { # set output_mk [file rootname $output_c].mk - # my define set output_mk $output_mk + # my Config_set output_mk $output_mk #} - set initfunc [my define getnull initfunc] + set initfunc [my Config_get initfunc] if {$initfunc eq {}} { set initfunc [string totitle $name]_Init - my define set initfunc $initfunc + my Config_set initfunc $initfunc } - set output_decls [my define getnull output_decls] + set output_decls [my Config_get output_decls] if {$output_decls eq {}} { set output_decls [file rootname $output_c].decls - my define set output_decls $output_decls + my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list /[self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] } method generate-decls {pkgname path} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set outfile [file join $path/$pkgname.decls] ### # Build the decls file ## # @@ -6989,12 +7200,12 @@ set thisline {} set functcount 0 foreach {func header} $stubfuncts { puts $fout [list declare [incr functcount] $header] } - 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)"] + 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)"] close $fout ### # Build [package]Decls.h @@ -7061,21 +7272,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 define get filename] $err" + lappend errs "Skipped $item: [$item config 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 define get filename] $err" + lappend errs "Skipped $item: [$item config get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } @@ -7091,21 +7302,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 define get output_c]] w] + set cout [open [file join $path [my Config_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 define get output_h]]]_H - set hout [open [file join $path [my define get output_h]] w] + 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] 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}" @@ -7112,13 +7323,13 @@ puts $hout "#define ${macro} 1" puts $hout [my generate-h] puts $hout "#endif" close $hout - set output_tcl [my define get output_tcl] + set output_tcl [my Config_get output_tcl] if {$output_tcl ne {}} { - set tclout [open [file join $path [my define get output_tcl]] w] + set tclout [open [file join $path [my Config_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] @@ -7133,20 +7344,20 @@ method linktype {} { return library } method package-ifneeded {args} { set result {} - set name [my define get pkg_name [my define get name]] - set version [my define get pkg_vers [my define get version]] + set name [my Config_get pkg_name [my Config_get name]] + set version [my Config_get pkg_vers [my Config_get version]] if {$version eq {}} { set version 0.1a } - set output_tcl [my define get output_tcl] + set output_tcl [my Config_get output_tcl] if {$output_tcl ne {}} { set script "\[list source \[file join \$dir $output_tcl\]\]" - } elseif {[my define get SHARED_BUILD 0]} { - set script "\[list load \[file join \$dir [my define get libfile]\] $name\]" + } elseif {[my Config_get SHARED_BUILD 0]} { + set script "\[list load \[file join \$dir [my Config_get libfile]\] $name\]" } else { # Provide a null passthrough set script "\[list package provide $name $version\]" } set result "package ifneeded [list $name] [list $version] $script" @@ -7155,31 +7366,31 @@ append result \n\n [list package ifneeded $alias $version $script] } return $result } method shared_library {{filename {}}} { - set name [string tolower [my define get name [my define get pkg_name]]] + set name [string tolower [my Config_get name [my Config_get pkg_name]]] set NAME [string toupper $name] - set version [my define get version [my define get pkg_vers]] + set version [my Config_get version [my Config_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 define getnull libprefix] - set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]][my define get SHLIB_SUFFIX] + lappend map %LIBRARY_PREFIX% [my Config_get libprefix] + set outfile [string map $map [my Config_get PRACTCL_NAME_LIBRARY]][my Config_get SHLIB_SUFFIX] return $outfile } method static_library {{filename {}}} { - set name [string tolower [my define get name [my define get pkg_name]]] + set name [string tolower [my Config_get name [my Config_get pkg_name]]] set NAME [string toupper $name] - set version [my define get version [my define get pkg_vers]] + set version [my Config_get version [my Config_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 define getnull libprefix] - set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]].a + lappend map %LIBRARY_PREFIX% [my Config_get libprefix] + set outfile [string map $map [my Config_get PRACTCL_NAME_LIBRARY]].a return $outfile } } ### @@ -7243,14 +7454,14 @@ } # Build an area of the file for #define directives and # function declarations set define {} - 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 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 vfs_main "${vfsroot}/${mainscript}" set map {} foreach var { vfsroot mainhook mainfunc vfs_main @@ -7282,23 +7493,22 @@ append preinitscript \n $script if {[dict get $info autoload]} { append main_init_script \n [list ::load {} $statpkg] } } - append preinitscript \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 { # Specify a user-specific startup file to invoke if the application # is run interactively. Typically the startup file is "~/.apprc" # where "app" is the name of the application. If this line is deleted # then no user-specific startup file will be run under any conditions. } - append main_init_script \n [list set tcl_rcFileName [$PROJECT define get tcl_rcFileName ~/.tclshrc]] + 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 preinitscript \n [list set ::starkit::thread_init $thread_init_script] append preinitscript \n {eval $::starkit::thread_init} set zvfsboot { /* * %mainhook% -- @@ -7311,11 +7521,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 define get tip_430 0]} { + if {![$PROJECT config 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, @@ -7363,11 +7573,11 @@ } }])\;" ::practcl::cputs zvfsboot " \x7D" ::practcl::cputs zvfsboot " return TCL_OK;" - if {[$PROJECT define get TEACUP_OS] eq "windows"} { + if {[$PROJECT config 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] @@ -7380,11 +7590,11 @@ if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } } - if {![$PROJECT define get tip_430 0]} { + if {![$PROJECT config get tip_430 0]} { ::practcl::cputs appinit { TclZipfs_Init(interp);} } foreach {statpkg info} $statpkglist { set initfunc {} if {[dict exists $info initfunc]} { @@ -7411,57 +7621,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 define get name] + set name [my Config_get name] # Assume a static shell if {[my define exists SHARED_BUILD]} { - my define set SHARED_BUILD 0 + my Config_set SHARED_BUILD 0 } if {![my define exists TCL_LOCAL_APPINIT]} { - my define set TCL_LOCAL_APPINIT Tclkit_AppInit + my Config_set TCL_LOCAL_APPINIT Tclkit_AppInit } if {![my define exists TCL_LOCAL_MAIN_HOOK]} { - my define set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook + my Config_set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook } set PROJECT [self] - set os [$PROJECT define get TEACUP_OS] - if {[my define get SHARED_BUILD 0]} { + set os [$PROJECT config get TEACUP_OS] + if {[my Config_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 define get srcdir] + set TCLSRCDIR [$TCLOBJ config get srcdir] set PKG_OBJS {} foreach item [$PROJECT link list core.library] { - if {[string is true [$item define get static]]} { + if {[string is true [$item config get static]]} { lappend PKG_OBJS $item } } foreach item [$PROJECT link list package] { - if {[string is true [$item define get static]]} { + if {[string is true [$item config 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 define get SHARED_BUILD 0]} { + if {![my Config_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 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]] + 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]] } else { set PLATFORM_SRC_DIR unix - 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]] + 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]] } - if {![my define get SHARED_BUILD 0]} { + if {![my Config_get SHARED_BUILD 0]} { ### # Add local static Zlib implementation ### set cdir [file join $TCLSRCDIR compat zlib] foreach file { @@ -7477,57 +7687,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 define set ZIPFS_VOLUME "zipfs:/" + $PROJECT config set ZIPFS_VOLUME "zipfs:/" } - $PROJECT code header "#define ZIPFS_VOLUME \"[$PROJECT define get ZIPFS_VOLUME]\"" + $PROJECT code header "#define ZIPFS_VOLUME \"[$PROJECT config get ZIPFS_VOLUME]\"" if {[file exists $zipfs]} { - $TCLOBJ define set tip_430 1 - my define set tip_430 1 + $TCLOBJ config set tip_430 1 + my Config_set tip_430 1 } else { # The Tclconfig project maintains a mirror of the version # released with the Tcl core - my define set tip_430 0 - set tclzipfs_c [my define get tclzipfs_c] + my Config_set tip_430 0 + set tclzipfs_c [my Config_get tclzipfs_c] if {![file exists $tclzipfs_c]} { ::practcl::LOCAL tool tclconfig unpack - set COMPATSRCROOT [::practcl::LOCAL tool tclconfig define get srcdir] + set COMPATSRCROOT [::practcl::LOCAL tool tclconfig config 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 define add include_dir [file join $TCLSRCDIR generic] - my define add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR] + my Config_add include_dir [file join $TCLSRCDIR generic] + my Config_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 define get name] - set libsrcdir [$item define get srcdir] + set name [$item config get name] + set libsrcdir [$item config 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 define get installdir] ne {}} { - # ::practcl::copyDir [file join [my define get installdir] [string trimleft [my define get prefix] /] lib] [file join $vfspath lib] + #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] #} foreach arg $args { ::practcl::copyDir $arg $vfspath } set fout [open [file join $vfspath pkgIndex.tcl] w] - puts $fout [string map [list %platform% [my define get TEACUP_PROFILE]] {set ::tcl_teapot_profile {%platform%}}] + puts $fout [string map [list %platform% [my Config_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"} { @@ -7559,14 +7769,14 @@ } } } close $fout - set EXEEXT [my define get EXEEXT] - set tclkit_bare [my define get tclkit_bare] + set EXEEXT [my Config_get EXEEXT] + set tclkit_bare [my Config_get tclkit_bare] ::practcl::mkzip ${exename}${EXEEXT} $tclkit_bare $vfspath - if { [my define get TEACUP_OS] ne "windows" } { + if { [my Config_get TEACUP_OS] ne "windows" } { file attributes ${exename}${EXEEXT} -permissions a+x } } } @@ -7585,35 +7795,35 @@ tags {} isodate {} } } method DistroMixIn {} { - my define set scm none + my Config_set scm none } method Sandbox {} { if {[my define exists sandbox]} { - return [my define get sandbox] + return [my Config_get sandbox] } if {[my clay delegate project] ni {::noop {}}} { - set sandbox [my <project> define get sandbox] + set sandbox [my <project> config get sandbox] if {$sandbox ne {}} { - my define set sandbox $sandbox + my Config_set sandbox $sandbox return $sandbox } } set sandbox [file normalize [file join $::CWD ..]] - my define set sandbox $sandbox + my Config_set sandbox $sandbox return $sandbox } method SrcDir {} { - set pkg [my define get name] + set pkg [my Config_get name] if {[my define exists srcdir]} { - return [my define get srcdir] + return [my Config_get srcdir] } set sandbox [my Sandbox] set srcdir [file join [my Sandbox] $pkg] - my define set srcdir $srcdir + my Config_set srcdir $srcdir return $srcdir } method ScmTag {} {} method ScmClone {} {} method ScmUnpack {} {} @@ -7621,14 +7831,14 @@ method Unpack {} { set srcdir [my SrcDir] if {[file exists $srcdir]} { return } - set pkg [my define get name] + set pkg [my Config_get name] if {[my define exists download]} { # Utilize a staged download - set download [my define get download] + set download [my Config_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 } @@ -7637,61 +7847,61 @@ } } oo::objdefine ::practcl::distribution { method Sandbox {object} { if {[$object define exists sandbox]} { - return [$object define get sandbox] + return [$object config get sandbox] } if {[$object clay delegate project] ni {::noop {}}} { - set sandbox [$object <project> define get sandbox] + set sandbox [$object <project> config get sandbox] if {$sandbox ne {}} { - $object define set sandbox $sandbox + $object config set sandbox $sandbox return $sandbox } } - set pkg [$object define get name] + set pkg [$object config get name] set sandbox [file normalize [file join $::CWD ..]] - $object define set sandbox $sandbox + $object config set sandbox $sandbox return $sandbox } method select object { if {[$object define exists scm]} { - return [$object define get scm] + return [$object config get scm] } - set pkg [$object define get name] - if {[$object define get srcdir] ne {}} { - set srcdir [$object define get srcdir] + set pkg [$object config get name] + if {[$object config get srcdir] ne {}} { + set srcdir [$object config get srcdir] } else { set srcdir [file join [my Sandbox $object] $pkg] - $object define set srcdir $srcdir + $object config 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 define set scm $name + $object config 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 define set scm $name + $object config set scm $name return $name } } - if {[$object define get scm] eq {} && [$object define exists file_url]} { + if {[$object config get scm] eq {} && [$object define exists file_url]} { set class ::practcl::distribution.snapshot set name [$class claim_option] - $object define set scm $name + $object config set scm $name $object clay mixinmap distribution $class return $name } error "Cannot determine source distribution method" } @@ -7720,12 +7930,12 @@ method ScmUnpack {} { set srcdir [my SrcDir] if {[file exists [file join $srcdir .download]]} { return 0 } - set dpath [::practcl::LOCAL define get download] - set url [my define get file_url] + set dpath [::practcl::LOCAL config get download] + set url [my Config_get file_url] set fname [file tail $url] set archive [file join $dpath $fname] if {![file exists $archive]} { ::http::wget $url $archive } @@ -7782,11 +7992,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 define get srcdir]] { + foreach {field value} [::practcl::fossil_status [my Config_get srcdir]] { dict set info $field $value } return $info } method ScmClone {} { @@ -7799,19 +8009,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 define get name] + set pkg [my Config_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 define get download] + set download [::practcl::LOCAL config get download] set fosdb [file join $download $pkg.fos] if {[file exists $fosdb]} { return $fosdb } @@ -7822,23 +8032,23 @@ } set cloned 0 # Attempt to clone from a local network mirror if {[::practcl::LOCAL define exists fossil_mirror]} { - set localmirror [::practcl::LOCAL define get fossil_mirror] + set localmirror [::practcl::LOCAL config 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 define get fossil_url] ne {}} { + if {[my Config_get fossil_url] ne {}} { catch { - ::practcl::doexec fossil clone [my define get fossil_url] $fosdb + ::practcl::doexec fossil clone [my Config_get fossil_url] $fosdb set cloned 1 } if {$cloned} { return $fosdb } @@ -7847,18 +8057,18 @@ ::practcl::doexec fossil clone http://fossil.etoyoc.com/fossil/$pkg $fosdb return $fosdb } method ScmTag {} { if {[my define exists scm_tag]} { - return [my define get scm_tag] + return [my Config_get scm_tag] } if {[my define exists tag]} { - set tag [my define get tag] + set tag [my Config_get tag] } else { set tag trunk } - my define set scm_tag $tag + my Config_set scm_tag $tag return $tag } method ScmUnpack {} { set srcdir [my SrcDir] if {[file exists [file join $srcdir .fslckout]]} { @@ -7885,15 +8095,15 @@ } oo::objdefine ::practcl::distribution.fossil { # Check for markers in the metadata method claim_object obj { - set path [$obj define get srcdir] + set path [$obj config get srcdir] if {[my claim_path $path]} { return true } - if {[$obj define get fossil_url] ne {}} { + if {[$obj config get fossil_url] ne {}} { return true } return false } @@ -7921,30 +8131,30 @@ ### ::clay::define ::practcl::distribution.git { superclass ::practcl::distribution method ScmTag {} { if {[my define exists scm_tag]} { - return [my define get scm_tag] + return [my Config_get scm_tag] } if {[my define exists tag]} { - set tag [my define get tag] + set tag [my Config_get tag] } else { set tag master } - my define set scm_tag $tag + my Config_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 define get name] + set pkg [my Config_get name] if {[my define exists git_url]} { - ::practcl::doexec git clone --branch $tag [my define get git_url] $srcdir + ::practcl::doexec git clone --branch $tag [my Config_get git_url] $srcdir } else { ::practcl::doexec git clone --branch $tag https://github.com/eviltwinskippy/$pkg $srcdir } return 1 } @@ -7960,15 +8170,15 @@ } } oo::objdefine ::practcl::distribution.git { method claim_object obj { - set path [$obj define get srcdir] + set path [$obj config get srcdir] if {[my claim_path $path]} { return true } - if {[$obj define get git_url] ne {}} { + if {[$obj config get git_url] ne {}} { return true } return false } @@ -7994,28 +8204,24 @@ superclass ::practcl::module method _MorphPatterns {} { return {{::practcl::subproject.@name@} {::practcl::@name@} {@name@} {::practcl::subproject}} } method BuildDir {PWD} { - 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 - return [list project [self] module [self]] - } - } + return [my Config_get srcdir] + } + method Child_delegate {} { + return [list project [self] module [self]] + } + method Child_organs {} { + return [list project [self] module [self]] } method compile {} {} method go {} { ::practcl::distribution select [self] - 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]] + 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]] my sources } method install args {} method linktype {} { return {subordinate package} @@ -8034,11 +8240,11 @@ return [dict get $configdict PRACTCL_LINKER_EXTRA] } return {} } method env-bootstrap {} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] package require $pkg } method env-exec {} {} method env-install {} { my unpack @@ -8053,11 +8259,11 @@ } my env-bootstrap set loaded 1 } method env-present {} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] if {[catch [list package require $pkg]]} { return 0 } return 1 } @@ -8074,49 +8280,49 @@ } } ::clay::define ::practcl::subproject.source { superclass ::practcl::subproject ::practcl::library method env-bootstrap {} { - set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] + set LibraryRoot [file join [my Config_get srcdir] [my Config_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 define get srcdir] + set path [my Config_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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] package require $pkg } method env-install {} { - set pkg [my define get pkg_name [my define get name]] - set download [my <project> define get download] + set pkg [my Config_get pkg_name [my Config_get name]] + set download [my <project> config get download] my unpack - set prefix [string trimleft [my <project> define get prefix] /] + set prefix [string trimleft [my <project> config 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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] if {[catch [list package require $pkg]]} { return 0 } return 1 } method install DEST { - set pkg [my define get pkg_name [my define get name]] - set download [my <project> define get download] + set pkg [my Config_get pkg_name [my Config_get name]] + set download [my <project> config get download] my unpack - set prefix [string trimleft [my <project> define get prefix] /] + set prefix [string trimleft [my <project> config 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 { @@ -8123,11 +8329,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 define get srcdir] kettle] + set kettle [file join [::practcl::LOCAL tool kettle config get srcdir] kettle] } set srcdir [my SourceRoot] ::practcl::dotclexec $kettle -f [file join $srcdir build.tcl] {*}$args } method install DEST { @@ -8135,58 +8341,58 @@ } } ::clay::define ::practcl::subproject.critcl { superclass ::practcl::subproject method install DEST { - my critcl -pkg [my define get name] + my critcl -pkg [my Config_get name] set srcdir [my SourceRoot] - ::practcl::copyDir [file join $srcdir [my define get name]] [file join $DEST lib [my define get name]] + ::practcl::copyDir [file join $srcdir [my Config_get name]] [file join $DEST lib [my Config_get name]] } } ::clay::define ::practcl::subproject.sak { superclass ::practcl::subproject method env-bootstrap {} { - set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] + set LibraryRoot [file join [my Config_get srcdir] [my Config_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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set srcdir [my Config_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 define get srcdir] + set path [my Config_get srcdir] return [file exists $path] } method install DEST { ### # Handle teapot installs ### - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - set prefix [string trimleft [my <project> define get prefix] /] - set srcdir [my define get srcdir] + set prefix [string trimleft [my <project> config get prefix] /] + set srcdir [my Config_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 define get srcdir] + set srcdir [my Config_get srcdir] if {[llength $args]==1 && [lindex $args 0] in {* all}} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_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 { @@ -8197,39 +8403,39 @@ } } ::clay::define ::practcl::subproject.practcl { superclass ::practcl::subproject method env-bootstrap {} { - set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] + set LibraryRoot [file join [my Config_get srcdir] [my Config_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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set srcdir [my Config_get srcdir] ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $prefix lib $pkg] } method install DEST { ### # Handle teapot installs ### - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - 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]] + 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]] ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $DEST $prefix lib $pkg] } method install-module {DEST args} { - set pkg [my define get pkg_name [my define get name]] - set srcdir [my define get srcdir] + set pkg [my Config_get pkg_name [my Config_get name]] + set srcdir [my Config_get srcdir] ::practcl::dotclexec [file join $srcdir make.tcl] install-module $DEST {*}$args } } ### @@ -8239,11 +8445,11 @@ # START: class subproject binary.tcl ### ::clay::define ::practcl::subproject.binary { superclass ::practcl::subproject method clean {} { - set builddir [file normalize [my define get builddir]] + set builddir [file normalize [my Config_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} @@ -8251,44 +8457,44 @@ } method env-install {} { ### # Handle tea installs ### - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] set os [::practcl::local_os] - my define set os $os + my Config_set os $os my unpack - set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set srcdir [my Config_get srcdir] lappend options --prefix $prefix --exec-prefix $prefix - my define set config_opts $options + my Config_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 define get install] { + switch [my Config_get install] { static { - my define set static 1 - my define set autoload 0 + my Config_set static 1 + my Config_set autoload 0 } static-autoload { - my define set static 1 - my define set autoload 1 + my Config_set static 1 + my Config_set autoload 1 } vfs { - my define set static 0 - my define set autoload 0 - my define set vfsinstall 1 + my Config_set static 0 + my Config_set autoload 0 + my Config_set vfsinstall 1 } null { - my define set static 0 - my define set autoload 0 - my define set vfsinstall 0 + my Config_set static 0 + my Config_set autoload 0 + my Config_set vfsinstall 0 } default { } } @@ -8296,46 +8502,46 @@ } method go {} { next ::practcl::distribution select [self] my ComputeInstall - my define set builddir [my BuildDir [my define get masterpath]] + my Config_set builddir [my BuildDir [my Config_get masterpath]] } method linker-products {configdict} { - if {![my define get static 0]} { + if {![my Config_get static 0]} { return {} } - set srcdir [my define get builddir] + set srcdir [my Config_get builddir] if {[dict exists $configdict libfile]} { return " [file join $srcdir [dict get $configdict libfile]]" } } method project-static-packages {} { - if {![my define get static 0]} { + if {![my Config_get static 0]} { return {} } - set result [my define get static_packages] - set statpkg [my define get static_pkg] - set initfunc [my define get initfunc] + set result [my Config_get static_packages] + set statpkg [my Config_get static_pkg] + set initfunc [my Config_get initfunc] if {$initfunc ne {}} { - set pkg_name [my define get pkg_name] + set pkg_name [my Config_get pkg_name] if {$pkg_name ne {}} { dict set result $pkg_name initfunc $initfunc - set version [my define get version] + set version [my Config_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 define set version $version + my Config_set version $version } dict set result $pkg_name version $version - dict set result $pkg_name autoload [my define get autoload 0] + dict set result $pkg_name autoload [my Config_get autoload 0] } } foreach item [my link list subordinate] { foreach {pkg info} [$item project-static-packages] { dict set result $pkg $info @@ -8342,35 +8548,35 @@ } } return $result } method BuildDir {PWD} { - 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]] + 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]] } if {$debug} { - return [my define get builddir [file join $PWD debug $name]] + return [my Config_get builddir [file join $PWD debug $name]] } else { - return [my define get builddir [file join $PWD pkg $name]] + return [my Config_get builddir [file join $PWD pkg $name]] } } method compile {} { - set name [my define get name] + set name [my Config_get name] set PWD $::CWD cd $PWD my unpack set srcdir [file normalize [my SrcDir]] set localsrcdir [my MakeDir $srcdir] - my define set localsrcdir $localsrcdir + my Config_set localsrcdir $localsrcdir my Collate_Source $PWD ### # Build a starter VFS for both Tcl and wish ### - set srcdir [my define get srcdir] - if {[my define get static 1]} { + set srcdir [my Config_get srcdir] + if {[my Config_get static 1]} { puts "BUILDING Static $name $srcdir" } else { puts "BUILDING Dynamic $name $srcdir" } my make compile @@ -8378,26 +8584,26 @@ } method Configure {} { cd $::CWD my unpack ::practcl::toolset select [self] - set srcdir [file normalize [my define get srcdir]] - set builddir [file normalize [my define get builddir]] + set srcdir [file normalize [my Config_get srcdir]] + set builddir [file normalize [my Config_get builddir]] file mkdir $builddir my make autodetect } method install DEST { set PWD [pwd] - set PREFIX [my <project> define get prefix] + set PREFIX [my <project> config get prefix] ### # Handle teapot installs ### - 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 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 found 0 - foreach ver [my define get pkg_vers [my define get version]] { + foreach ver [my Config_get pkg_vers [my Config_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 @@ -8433,29 +8639,29 @@ ### ::clay::define ::practcl::subproject.core { superclass ::practcl::subproject.binary method env-bootstrap {} {} method env-present {} { - set PREFIX [my <project> define get prefix] - set name [my define get name] + set PREFIX [my <project> config get prefix] + set name [my Config_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> define get prefix [file normalize [file join ~ tcl]]] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] lappend options --prefix $prefix --exec-prefix $prefix - my define set config_opts $options + my Config_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 define set core_binary 1 + my Config_set core_binary 1 next } method linktype {} { return {subordinate core.library} } @@ -8468,12 +8674,12 @@ # START: class tool.tcl ### set ::practcl::MAIN ::practcl::LOCAL set ::auto_index(::practcl::LOCAL) { ::practcl::project create ::practcl::LOCAL - ::practcl::LOCAL define set [::practcl::local_os] - ::practcl::LOCAL define set LOCAL 1 + ::practcl::LOCAL config set [::practcl::local_os] + ::practcl::LOCAL config 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 { @@ -8498,12 +8704,12 @@ method env-bootstrap {} { package require critcl::app } method env-install {} { my unpack - set prefix [my <project> define get prefix [file join [file normalize ~] tcl]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file join [file normalize ~] tcl]] + set srcdir [my Config_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: cmodules/kitcrypt.tcl ================================================================== --- cmodules/kitcrypt.tcl +++ cmodules/kitcrypt.tcl @@ -1,26 +1,26 @@ ## # Implementation of an rc4 codec for TCL, adapted for # source code encryption/decryption system ### set here [file dirname [info script]] -my define set pkg_name kitcrypt -my define set pkg_vers 1.0 -my define set initfunc KitCrypt_Init -my define set output_c kitcrypt.c -my define set autoload 1 -my define set static 1 +my Config_set pkg_name kitcrypt +my Config_set pkg_vers 1.0 +my Config_set initfunc KitCrypt_Init +my Config_set output_c kitcrypt.c +my Config_set autoload 1 +my Config_set static 1 my include {} my include {} my include {} my include {} # Retrieve or generate a hard coded password for the crypt_eval function # We write the code here so that a DLL and an EXE built from the same source # checkout will have the same internal password -set pwdfile [file join [my define get builddir] password.txt] +set pwdfile [file join [my Config_get builddir] password.txt] if {![file exists $pwdfile]} { set charset {*+-.0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_} set maxpos [string length $charset] set keylen [expr 8 + int(8 * rand())] set curpwd {} 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 html 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 html 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 html get title] + my <title> content [my config get title] } } ::clay::define ::gilgamesh::core/avatar { Index: make.tcl ================================================================== --- make.tcl +++ make.tcl @@ -12,11 +12,11 @@ ::practcl::library create PROJECT { name clay version 0.1 } -[::practcl::LOCAL tool tcllib] define set tag hypnotoad +[::practcl::LOCAL tool tcllib] config set tag hypnotoad ::practcl::LOCAL add_tool clay { tag trunk class subproject.sak install vfs fossil_url http://fossil.etoyoc.com/clay @@ -138,65 +138,65 @@ } } { set obj [::practcl::LOCAL tool $project] $obj unpack $obj update - set lsrcdir [$obj define get srcdir] + set lsrcdir [$obj config get srcdir] foreach module $modules { installModule [file join $lsrcdir modules $module] $DEST } } } claykit { set dat [::practcl::config.tcl $CWD] set object TCLKIT ::practcl::tclkit create $object $dat - $object define set name claykit - $object define set sandbox $::SANDBOX - $object define set srcdir $::SRCDIR + $object config set name claykit + $object config set sandbox $::SANDBOX + $object config set srcdir $::SRCDIR $object source [file join $::SRCDIR claykit.ini] - set INSTALLDIR [$object define get installdir] - if {![file exists [$object define get tclkit_bare]]} { + set INSTALLDIR [$object config get installdir] + if {![file exists [$object config get tclkit_bare]]} { $object build-tclcore $object implement $CWD foreach item [$object link list package] { - if {![string is true [$item define get static 0]]} continue - puts [list GENERATING $item [$item define get srcdir]] + if {![string is true [$item config get static 0]]} continue + puts [list GENERATING $item [$item config get srcdir]] $item compile } - $object build-tclsh [$object define get tclkit_bare] $object + $object build-tclsh [$object config get tclkit_bare] $object } - set VFS [file join $CWD [$object define get vfs]] + set VFS [file join $CWD [$object config get vfs]] file mkdir $VFS foreach item [$object link list package] { - set modlist [$item define get module_list] - puts [list PACKAGE INSTALL [$item define get name] MODLIST $modlist] + set modlist [$item config get module_list] + puts [list PACKAGE INSTALL [$item config get name] MODLIST $modlist] if {[llength $modlist]} { if {[catch {$item install-module [file join ${VFS} modules] {*}$modlist} error errdat]} { puts stderr "BUILD FAILURE $item" puts "FAILED TO INSTALL package $item" puts [dict get $errdat -errorinfo] exit 1 } - } elseif {[string is true [$item define get vfsinstall 1]]} { - puts [list GENERATING $item [$item define get srcdir]] + } elseif {[string is true [$item config get vfsinstall 1]]} { + puts [list GENERATING $item [$item config get srcdir]] if {[catch {$item install $INSTALLDIR} error errdat]} { puts stderr "BUILD FAILURE $item" puts "FAILED TO INSTALL package $item" puts [dict get $errdat -errorinfo] exit 1 } } } # Copy in our "secret squirrel" code - #set SCMCOPY [list ::exec [WISHKIT define get tclkit_bare] [file join $::SRCDIR scripts scm-copy.tcl]] + #set SCMCOPY [list ::exec [WISHKIT config get tclkit_bare] [file join $::SRCDIR scripts scm-copy.tcl]] #set SCMCOPY ::practcl::copyDir #{*}$SCMCOPY [file join $::SRCDIR src] ${VFS} - if {[$object define get debug 0]} { - $object wrap $CWD [$object define get exe] $VFS [file join $CWD PKGROOT] + if {[$object config get debug 0]} { + $object wrap $CWD [$object config get exe] $VFS [file join $CWD PKGROOT] } else { - $object wrap $CWD [$object define get exe] $VFS [file join $CWD PKGROOT] + $object wrap $CWD [$object config get exe] $VFS [file join $CWD PKGROOT] } } modules { set modules [modules] puts $modules Index: modules/clay-tk-console/build/core.tcl ================================================================== --- modules/clay-tk-console/build/core.tcl +++ modules/clay-tk-console/build/core.tcl @@ -6,19 +6,19 @@ ### namespace eval ::clay::tk::console {} ::clay::define ::clay::tk::hull.console { Variable ismain 0 - clay set option language { + Option language { default tcl class mixin pattern ::clay::tk::console } - clay set option title { + Option title { default {} } - clay set option prompt { + Option prompt { default {tcl% } } set has_consolas [expr {"Consolas" in [font families]}] if {$has_consolas} { set font {Consolas 10} @@ -36,11 +36,11 @@ windows { set font {systemfixed 9} } } } - clay set option font [list \ + Option font [list \ widget font \ description {Font used on console widgets} \ default $font ] clay set signal focus { Index: modules/clay-tk-console/build/sqlshell.tcl ================================================================== --- modules/clay-tk-console/build/sqlshell.tcl +++ modules/clay-tk-console/build/sqlshell.tcl @@ -16,15 +16,15 @@ ### # Implement an interactive command line interface to an Sqlite database ### ::clay::define ::clay::tk::console::language.sqlite { - clay set option db {class organ} - clay set option prompt {default {sqlite-> }} - clay set option title {default {SQLite Console}} - clay set option header {datatype boolean default 1} - clay set option mode {widget select default column values {line list column csv multicolumn}} + Option db {class organ} + Option prompt {default {sqlite-> }} + Option title {default {SQLite Console}} + Option header {datatype boolean default 1} + Option mode {widget select default column values {line list column csv multicolumn}} ### # topic: 43e235cf3b612e95c590e5de400d4bcc39d622a4 # description: @@ -42,18 +42,18 @@ if {$word==".tcl"} { my tcl_console return {} } elseif {$word==".mode"} { regexp {^.[a-z]+ +([a-z]+)} $cmd all newvalue - my config set [list mode $newvalue] + my Config_set [list mode $newvalue] return {} } elseif {$word==".exit"} { my destroy return {} } elseif {$word==".header"} { regexp {^.[a-z]+ +([a-z]+)} $cmd all newvalue - my config set [list header $newvalue] + my Config_set [list header $newvalue] return {} } elseif {$word==".tables"} { set mode multicolumn set cmd {SELECT name FROM sqlite_master WHERE type='table' UNION ALL Index: modules/clay-tk/build/core.tcl ================================================================== --- modules/clay-tk/build/core.tcl +++ modules/clay-tk/build/core.tcl @@ -1,6 +1,8 @@ namespace eval ::clay::tk {} + +package require clay-yggdrasil set ::clay::tk::winsys [tk windowingsystem] if {$::tcl_platform(platform) eq "windows"} { set ::clay::tk::platform windows catch {::ttk::style theme use xpnative} @@ -13,10 +15,11 @@ catch {::ttk::style theme use clam} } ::clay::define ::clay::tk::megawidget { + superclass ::clay::yggdrasil constructor {tkpath args} { my Config_initialize $args my Config_merge $args my Hull_Construct $tkpath @@ -25,118 +28,10 @@ destructor { my Hull_Destroy } - Ensemble config::get args { - return [my Config_get {*}$args] - } - Ensemble config::merge args { - return [my Config_merge {*}$args] - } - Ensemble config::set args { - my Config_set {*}$args - } - - 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 MegaMixin $opt [dict get $optinfo default]] - } - - if {[dict size $mixinmap]} { - my clay mixinmap {*}$mixinmap - } - } - method Config_get {field args} { - my variable config option_canonical option_getcmd - 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] - } - - ### - # topic: dc9fba12ec23a3ad000c66aea17135a5 - ### - 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 MegaMixin $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_set args { - set dictargs [::clay::args_to_options {*}$args] - set dat [my Config_merge $dictargs] - my Config_triggers $dat - } - - ### - # React to configuration changes - ### - 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 content {} {} method event {submethod args} { ::clay::event::$submethod [self] {*}$args } @@ -172,45 +67,10 @@ set tkpath [my clay delegate hull] if {![winfo exists $tkpath]} return bind $tkpath <Destroy> {} } - method MegaMixin {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 Option_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 signal args {} # Renames the tcl command that represents the widget to # one that resides in the object's namespace. It then renames # the object to catch calls to the tk path. Index: modules/clay-tk/build/hull.tcl ================================================================== --- modules/clay-tk/build/hull.tcl +++ modules/clay-tk/build/hull.tcl @@ -81,11 +81,11 @@ update idletasks try { set w [winfo parent $h] set t [winfo toplevel $h] set width [expr {[winfo width $w]-[winfo width $h.cy]-8}] - set minwidth [my config get minwidth] + set minwidth [my Config_get minwidth] if {$width < $minwidth} { set width $minwidth } set oheight [winfo height $h.cx] incr oheight 1 @@ -94,11 +94,11 @@ if {![winfo ismapped $child]} return if {$child eq $h} continue puts [list $child [winfo height $child]] incr oheight [winfo height $child] } - set minheight [my config get minheight] + set minheight [my Config_get minheight] set height [expr {[winfo height $w] - $oheight}] if {$height < $minheight} { set height $minheight } puts [list [self] width $width height $height] Index: modules/clay-tktable/build/core.tcl ================================================================== --- modules/clay-tktable/build/core.tcl +++ modules/clay-tktable/build/core.tcl @@ -2,53 +2,53 @@ package require Tktable clay::define ::clay::tk::hull.tkable { Array Data - clay set option titlerows { + Option titlerows { default {1} native -titlerows } - clay set option titlecols { + Option titlecols { default {1} native -titlecols } - clay set option cols { + Option cols { default 0 native -cols } - clay set option rows { + Option rows { default 0 native -rows } - clay set option height { + Option height { default {} native -height } - clay set option width { + Option width { default {} native -width } - clay set option maxheight { + Option maxheight { default {} native -maxheight } - clay set option maxwidth { + Option maxwidth { default {} native -maxwidth } - clay set option multiline { + Option multiline { default 1 native -multiline } - clay set option selectmode { + Option selectmode { default browse type select values {single browse multiple extended} native -selectmode } - clay set option colstretchmode { + Option colstretchmode { default none type select values {none unset all last} native -colstretchmode description { @@ -64,11 +64,11 @@ allocated to the table. This mode can interfere with interactive border resizing which tries to force column width.last The last column will be stretched to fill the window space allocated to the table. } } - clay set option rowstretchmode { + Option rowstretchmode { default none type select values {none unset all last fill} native -rowstretchmode description { @@ -88,11 +88,11 @@ fill The table will get more or less columns according to the window space allocated to the table. This mode has numerous quirks and may disappear in the future. } } - clay set option multiline { + Option multiline { native -multiline default 1 type boolean } Index: modules/clay-tktable/build/spreadsheet.tcl ================================================================== --- modules/clay-tktable/build/spreadsheet.tcl +++ modules/clay-tktable/build/spreadsheet.tcl @@ -2,11 +2,11 @@ # Mimic the likes of Microsoft Excel(tm) ### clay::define ::clay::tk::hull.spreadsheet { superclass ::clay::tk::hull.tkable - clay set option keycolumn { + Option keycolumn { default 0 } method browse {row col} { my variable prior Data Index: modules/clay-ui/build/baseclass.tcl ================================================================== --- modules/clay-ui/build/baseclass.tcl +++ modules/clay-ui/build/baseclass.tcl @@ -160,11 +160,11 @@ Ensemble action::revert_to_default {} { set field [my clay get field] set default [my clay get default] if {$default in {{} default}} { - set default [my <form> private Option_Default $field] + set default [my <form> private Config_Default $field] } my Value_Store $default } method ApplySelectedValue newvalue { ADDED modules/clay-yggdrasil/build/build.tcl Index: modules/clay-yggdrasil/build/build.tcl ================================================================== --- modules/clay-yggdrasil/build/build.tcl +++ modules/clay-yggdrasil/build/build.tcl @@ -0,0 +1,71 @@ +set here [file dirname [file normalize [file join [pwd] [info script]]]] + +set version 0.1 +set modpath [file dirname $here] +set module clay-yggdrasil +set filename [file tail $modpath] + +set fout [open [file join $modpath ${filename}.tcl] w] +dict set map %module% $module +dict set map %version% $version + +puts $fout [string map $map {### +# Amalgamated package for %module% +# Do not edit directly, tweak the source in src/ and rerun +# build.tcl +### +package provide %module% %version% +namespace eval ::%module% {} +set ::%module%::version %version% +}] + +# Track what files we have included so far +set loaded {build.tcl} +# These files must be loaded in a particular order +foreach file { + core.tcl +} { + lappend loaded $file + set fin [open [file join $here $file] r] + puts $fout "###\n# START: [file tail $file]\n###" + puts $fout [read $fin] + close $fin + puts $fout "###\n# END: [file tail $file]\n###" +} +# These files can be loaded in any order +foreach file [glob [file join $here *.tcl]] { + if {[file tail $file] in $loaded} continue + lappend loaded $file + set fin [open [file join $here $file] r] + puts $fout "###\n# START: [file tail $file]\n###" + puts $fout [read $fin] + close $fin + puts $fout "###\n# END: [file tail $file]\n###" +} + +# Provide some cleanup and our final package provide +puts $fout [string map $map { +namespace eval ::%module% { + namespace export * +} +}] +close $fout + +### +# Build our pkgIndex.tcl file +### +#if {![package vsatisfies [package provide Tcl] 8.6]} {return} + +set fout [open [file join $modpath pkgIndex.tcl] w] +puts $fout [string map $map {# Tcl package index file, version 1.1 +# This file is generated by practcl +# and sourced either when an application starts up or +# by a "package unknown" script. It invokes the +# "package ifneeded" command to set up package-related +# information so that packages will be loaded automatically +# in response to "package require" commands. When this +# script is sourced, the variable $dir must contain the +# full path name of this file's directory. +package ifneeded %module% %version% [list source [file join $dir %module%.tcl]] +}] +close $fout ADDED modules/clay-yggdrasil/build/core.tcl Index: modules/clay-yggdrasil/build/core.tcl ================================================================== --- modules/clay-yggdrasil/build/core.tcl +++ modules/clay-yggdrasil/build/core.tcl @@ -0,0 +1,353 @@ + +namespace eval ::clay::yggdrasil {} + +clay::define ::clay::yggdrasil { + Dict css {} + clay branch css + + 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_config {} { + return {} + } + + method Child_delegate {} { + return [list parent [self]] + } + + 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] + } + + ### + # Data that tracks with the node itself + ### + 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 + } + } + + ### + # topic: dc9fba12ec23a3ad000c66aea17135a5 + ### + 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 + } + + ### + # React to configuration changes + ### + 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 + } + + ### + # Content Style Sheet Data + # Moves in parallel with configuration data + ### + 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 + } +} Index: modules/cuneiform/build/core.tcl ================================================================== --- modules/cuneiform/build/core.tcl +++ modules/cuneiform/build/core.tcl @@ -1,6 +1,8 @@ namespace eval cuneiform {} + +package require clay-yggdrasil proc ::cuneiform::markdown real_filename { set fin [open $real_filename r] while {[gets $fin line]>=0} { if {[string range $line 0 2] eq "---" && [string range $line end-2 end] eq "---"} { @@ -26,10 +28,12 @@ } return $record } clay::define ::cuneiform::object { + superclass ::clay::yggdrasil + Variable cuneiform_content {} Variable children {} Variable tag_namespace {} destructor { @@ -40,76 +44,10 @@ ### # Build basic layout ### method cuneiform_structure {} {} - Ensemble child::clear_all {} { - my variable children - foreach child $children { - catch { - $child child clear_all - $child clay refcount_decr - } - } - set children {} - } - - Ensemble child::count {} { - my variable children - if {![info exists children]} { - return {} - } - return [llength $children] - } - - Ensemble 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 - } - } - - Ensemble 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] - } - - Ensemble child::last {} { - my variable children - return [lindex [my children] end] - } - - Ensemble child::list {} { - my variable children - if {![info exists children]} { - return {} - } - return $children - } - - method eval args { - eval {*}$args - } - - method source args { - source {*}$args - } - method tag {type args} { my variable children set output {} if {[llength $args]==1} { set args [list content [lindex $args 0]] @@ -143,16 +81,10 @@ } } clay::define ::cuneiform::element { superclass object - - Dict css {} - Dict xml {} - - clay branch css - clay set xml_tag "" clay set xml_paired 1 Variable xml_element {} @@ -199,20 +131,20 @@ switch $f { parent { my clay delegate parent $v } id { - my xml set id $v + my Config_id $v } css_class - class { - my xml set class $v + my CSS_class $v } css - css_style - style { - my css set {*}$v + my CSS_set {*}$v } tk - html - html_option - html_options - @@ -219,63 +151,30 @@ xml - xml_option - xml_options - options - option { - my xml set {*}$v + my Config_set {*}$v } namespace { my variable tag_namespace set tag_namespace $v } content { my content $v } default { - if {[string range $f 0 4] eq "xml:"} { - # If the user explicitly tells us this is xml, this is xml - my xml set [string range $f 5 end] $v - } elseif {[string range $f 0 3] eq "css:"} { - my css set [string range $f 4 end] $v - } else { - # Otherwise assume its an xml option - my xml set $f $v - } - } - } - } - } - - Ensemble css::class args { - my xml set class [lindex $args 0] - return [my xml get class] - } - Ensemble css::get field { - my variable css - if {[dict exists $css $field]} { - return [dict get $css $field] - } - return [my clay get css $field] - } - Ensemble css::set args { - my variable css - dict for {f v} $args { - dict set css $f $v - } - } - - Ensemble xml::get field { - my variable xml - if {[dict exists $xml $field]} { - return [dict get $xml $field] - } - return [my clay get xml $field] - } - Ensemble xml::set args { - my variable xml - dict for {f v} $args { - dict set xml $f $v - } - } - + if {[string range $f 0 4] eq "html:"} { + # If the user explicitly tells us this is xml, this is xml + my Config_set [string range $f 5 end] $v + } elseif {[string range $f 0 3] eq "css:"} { + my CSS_set [string range $f 4 end] $v + } else { + # Otherwise assume its an xml option + my Config_set $f $v + } + } + } + } + } } Index: modules/cuneiform/build/html.tcl ================================================================== --- modules/cuneiform/build/html.tcl +++ modules/cuneiform/build/html.tcl @@ -115,11 +115,11 @@ namespace { my variable tag_namespace set tag_namespace $v } default { - my xml set $f $v + my config set $f $v } } } } } @@ -188,12 +188,12 @@ my tag LI content $content {*}$args } } clay::define ::cuneiform::html::a { clay set xml_tag "A" - clay set xml href {} - clay set xml target {} + Option href {} + Option target {} } # Tk names that will confuse the parser clay::define ::cuneiform::html::label { clay set xml_tag LABEL @@ -201,65 +201,65 @@ clay::define ::cuneiform::html::text { clay set xml_tag TEXT } clay::define ::cuneiform::html::button { clay set xml_tag "BUTTON" - clay set xml href {} - clay set xml target {} - clay set xml type {} - clay set xml name {} - clay set xml value {} + Option href {} + Option target {} + Option type {} + Option name {} + Option value {} } clay::define ::cuneiform::html::img { superclass nonpaired clay set xml_paired 0 clay set xml_tag "IMG" - clay set xml src {} - clay set xml alt {} - clay set xml width {} - clay set xml height {} + Option src {} + Option alt {} + Option width {} + Option height {} } clay::define ::cuneiform::html::image { superclass nonpaired clay set xml_paired 0 clay set xml_tag "IMG" - clay set xml src {} - clay set xml alt {} - clay set xml width {} - clay set xml height {} + Option src {} + Option alt {} + Option width {} + Option height {} } clay::define ::cuneiform::html::form { clay set xml_tag "FORM" - clay set xml action {} - clay set xml method POST + Option action {} + Option method {default POST} } clay::define ::cuneiform::html::label { clay set xml_tag "LABEL" - clay set xml for {} + Option for {} } clay::define ::cuneiform::html::option { clay set xml_tag "OPTION" - clay set xml value {} + Option value {} clay set xml_flag disabled 0 clay set xml_flag selected 0 } clay::define ::cuneiform::html::input { clay set xml_tag "INPUT" - clay set xml type {} - clay set xml name {} - clay set xml value {} + Option type {} + Option name {} + Option value {} } clay::define ::cuneiform::html::table { clay set xml_tag "TABLE" @@ -288,11 +288,11 @@ method listrow {opts args} { set rowojb [my tag tr] set result {} foreach value $args { - lappend result [$rowojb tag {*}$opts content $value] + lappend result [$rowojb tag td {*}$opts content $value] } return $result } method row args { @@ -317,20 +317,20 @@ } } clay::define ::cuneiform::html::th { clay set xml_tag "TH" - clay set xml colspan {} - clay set xml rowspan {} - clay set xml headers {} + Option colspan {} + Option rowspan {} + Option headers {} } clay::define ::cuneiform::html::td { clay set xml_tag "TD" - clay set xml colspan {} - clay set xml rowspan {} - clay set xml headers {} + Option colspan {} + Option rowspan {} + Option headers {} } clay::define ::cuneiform::html::page_break { superclass para clay set css style { @@ -418,17 +418,17 @@ clay::define ::cuneiform::document.html { superclass ::cuneiform::buffer.html ::cuneiform::html::nocss clay set stylesheet {} clay set xml_tag "HTML" - clay set xml title {Default} - clay set xml charset UTF-8 + Option title {} + Option charset {default UTF-8} method cuneiform_syntax {} { next proc stylesheet url { - my <stylesheet> xml set href $url + my <stylesheet> config set href $url } proc title string { my <title> content $string } @@ -440,11 +440,11 @@ set xml {} set css {} my clay delegate <head> [my Tag head] my clay delegate <title> [my <head> tag title] - my <head> tag meta charset [my xml get charset] + my <head> tag meta charset [my config get charset] set sheethref [my clay get xml stylesheet] if {$sheethref eq {}} { set sheethref /style.css } my clay delegate <stylesheet> [my <head> tag link rel stylesheet type text/css href $sheethref] @@ -451,12 +451,12 @@ set styleobj [my <head> tag style] my clay delegate <style> $styleobj my clay delegate <style:screen> $styleobj my clay delegate <style:print> [my <head> tag style] - my <style> xml set media screen type text/css - my <style:print> xml set media print type text/css + my <style> config set media screen type text/css + my <style:print> config set media print type text/css set bodyobj [my Tag body] my clay delegate <body> $bodyobj my clay delegate <header> [$bodyobj tag header id header] my clay delegate <top> [$bodyobj tag div id top] Index: modules/cuneiform/build/svg.tcl ================================================================== --- modules/cuneiform/build/svg.tcl +++ modules/cuneiform/build/svg.tcl @@ -5,28 +5,28 @@ ### # SVG Tags ### clay::define ::cuneiform::svg { clay set xml_tag "SVG" - clay set xml colspan {} - clay set xml viewBox {} - clay set xml xmlns {} - clay set xml width {} - clay set xml height {} + Option colspan {} + Option viewBox {} + Option xmlns {} + Option width {} + Option height {} } clay::define ::cuneiform::svg::g { clay set xml_tag "G" - clay set xml id {} + Option id {} } clay::define ::cuneiform::svg::text { clay set xml_tag "TEXT" - clay set xml x {} - clay set xml y {} - clay set xml fill {} - clay set xml font-size {} + Option x {} + Option y {} + Option fill {} + Option font-size {} } clay::define ::cuneiform::svg::polygon { superclass nonpaired clay set xml_tag "POLYGON" - clay set xml points {} + Option points {} } Index: modules/cuneiform/build/tk.tcl ================================================================== --- modules/cuneiform/build/tk.tcl +++ modules/cuneiform/build/tk.tcl @@ -130,15 +130,15 @@ ::clay::define ::cuneiform::tk::label { method Cuneiform_Tk_Hull {window args} { set w $window.uuid[my uuid] puts [list [self] [self class] [self method] $window $w] set opts {} - if {[my xml get text] ne {}} { - lappend opts -text [my xml get text] + if {[my config get text] ne {}} { + lappend opts -text [my config get text] } - if {[my xml get variable] ne {}} { - lappend opts -textvariable [my xml get text] + if {[my config get variable] ne {}} { + lappend opts -textvariable [my config get text] } puts [list ttk::label $w {*}$opts] ttk::label $w {*}$opts return $w } @@ -146,18 +146,18 @@ ::clay::define ::cuneiform::tk::button { method Cuneiform_Tk_Hull {window args} { set w $window.uuid[my uuid] puts [list [self] [self class] [self method] $window $w] set opts {} - if {[my xml get text] ne {}} { - lappend opts -text [my xml get text] - } - if {[my xml get variable] ne {}} { - lappend opts -textvariable [my xml get text] - } - if {[my xml get command] ne {}} { - lappend opts -command [my xml get command] + if {[my config get text] ne {}} { + lappend opts -text [my config get text] + } + if {[my config get variable] ne {}} { + lappend opts -textvariable [my config get text] + } + if {[my config get command] ne {}} { + lappend opts -command [my config get command] } puts [list ttk::button $w {*}$opts] ttk::button $w {*}$opts return $w } Index: modules/cuneiform/build/xml.tcl ================================================================== --- modules/cuneiform/build/xml.tcl +++ modules/cuneiform/build/xml.tcl @@ -98,11 +98,11 @@ switch $f { parent { my clay delegate parent $v } default { - my xml set $f $v + my config set $f $v } } } } } @@ -204,19 +204,19 @@ clay::define ::cuneiform::document.xml { superclass ::cuneiform::buffer.xml ::cuneiform::xml::nocss clay set stylesheet {} clay set xml_tag "xml" - clay set xml title {Default} - clay set xml encoding UTF-8 - clay set xml version 1.0 - clay set xml headerline 1 + Option title {} + Option encoding {default UTF-8} + Option version {default 1.0} + Option headerline {type boolean default 1} method cuneiform_syntax {} { next proc stylesheet url { - my <stylesheet> xml set href $url + my <stylesheet> config set href $url } proc title string { my <title> content $string } @@ -236,16 +236,16 @@ my <footer> append {*}$args } method xml_output {} { set output {} - if {[my xml get headerline]} { - append output "<?xml version=\"[my xml get version]\" encoding=\"[my xml get encoding]\" standalone=\"yes\" ?>" \n + if {[my config get headerline]} { + append output "<?xml version=\"[my config get version]\" encoding=\"[my config get encoding]\" standalone=\"yes\" ?>" \n } append output [my xml_format_content] return $output } } namespace eval ::cuneiform::xml { namespace export * } Index: modules/cuneiform/cuneiform-tk.test ================================================================== --- modules/cuneiform/cuneiform-tk.test +++ modules/cuneiform/cuneiform-tk.test @@ -1,8 +1,10 @@ set here [file dirname [file normalize [info script]]] source [file join $here .. clay clay.tcl] +source [file join $here .. clay-yggdrasil clay-yggdrasil.tcl] + exec tclsh [file join $here build build.tcl] source [file join $here cuneiform.tcl] package require Tk Index: modules/cuneiform/cuneiform.test ================================================================== --- modules/cuneiform/cuneiform.test +++ modules/cuneiform/cuneiform.test @@ -1,17 +1,19 @@ set here [file dirname [file normalize [info script]]] source [file join $here .. clay clay.tcl] +source [file join $here .. clay-yggdrasil clay-yggdrasil.tcl] + exec tclsh [file join $here build build.tcl] source [file join $here cuneiform.tcl] ::cuneiform::document.html create HTML html title {Hello World!} stylesheet /style.css clay::define test_html { method content {} { my <title> content {What a lovely day} - my tag H1 content {Hello World} - set t [my tag TABLE] + my tag H1 {Hello World} + set t [my tag table] $t listrow {} {Test} Right set obj [$t child index 0 0] $obj css set border 1 set r [$t tag TR] $r tag TD content {Test 2} @@ -21,11 +23,11 @@ } ### # Inject content ### -HTML tag h1 [HTML html get title] +HTML tag h1 [HTML config get title] ### # Mixin a behavior hand have that behavior inject content ### HTML clay mixinmap content test_html HTML content 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.16.3 +set version 0.17 set tclversion 8.6 set module [file tail $moddir] set filename $module set fout [open [file join $moddir $filename.tcl] w] @@ -35,10 +35,11 @@ # 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} define get TEACUP_OS] + return [${::practcl::MAIN} config 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 define set scm none + my Config_set scm none } method Sandbox {} { if {[my define exists sandbox]} { - return [my define get sandbox] + return [my Config_get sandbox] } if {[my clay delegate project] ni {::noop {}}} { - set sandbox [my <project> define get sandbox] + set sandbox [my <project> config get sandbox] if {$sandbox ne {}} { - my define set sandbox $sandbox + my Config_set sandbox $sandbox return $sandbox } } set sandbox [file normalize [file join $::CWD ..]] - my define set sandbox $sandbox + my Config_set sandbox $sandbox return $sandbox } method SrcDir {} { - set pkg [my define get name] + set pkg [my Config_get name] if {[my define exists srcdir]} { - return [my define get srcdir] + return [my Config_get srcdir] } set sandbox [my Sandbox] set srcdir [file join [my Sandbox] $pkg] - my define set srcdir $srcdir + my Config_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 define get name] + set pkg [my Config_get name] if {[my define exists download]} { # Utilize a staged download - set download [my define get download] + set download [my Config_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 define get sandbox] + return [$object config get sandbox] } if {[$object clay delegate project] ni {::noop {}}} { - set sandbox [$object <project> define get sandbox] + set sandbox [$object <project> config get sandbox] if {$sandbox ne {}} { - $object define set sandbox $sandbox + $object config set sandbox $sandbox return $sandbox } } - set pkg [$object define get name] + set pkg [$object config get name] set sandbox [file normalize [file join $::CWD ..]] - $object define set sandbox $sandbox + $object config set sandbox $sandbox return $sandbox } method select object { if {[$object define exists scm]} { - return [$object define get scm] + return [$object config get scm] } - set pkg [$object define get name] - if {[$object define get srcdir] ne {}} { - set srcdir [$object define get srcdir] + set pkg [$object config get name] + if {[$object config get srcdir] ne {}} { + set srcdir [$object config get srcdir] } else { set srcdir [file join [my Sandbox $object] $pkg] - $object define set srcdir $srcdir + $object config 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 define set scm $name + $object config 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 define set scm $name + $object config set scm $name return $name } } - if {[$object define get scm] eq {} && [$object define exists file_url]} { + if {[$object config get scm] eq {} && [$object define exists file_url]} { set class ::practcl::distribution.snapshot set name [$class claim_option] - $object define set scm $name + $object config 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 define get srcdir]] { + foreach {field value} [::practcl::fossil_status [my Config_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 define get name] + set pkg [my Config_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 define get download] + set download [::practcl::LOCAL config 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 define get fossil_mirror] + set localmirror [::practcl::LOCAL config 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 define get fossil_url] ne {}} { + if {[my Config_get fossil_url] ne {}} { catch { - ::practcl::doexec fossil clone [my define get fossil_url] $fosdb + ::practcl::doexec fossil clone [my Config_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 define get scm_tag] + return [my Config_get scm_tag] } if {[my define exists tag]} { - set tag [my define get tag] + set tag [my Config_get tag] } else { set tag trunk } - my define set scm_tag $tag + my Config_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 define get srcdir] + set path [$obj config get srcdir] if {[my claim_path $path]} { return true } - if {[$obj define get fossil_url] ne {}} { + if {[$obj config 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 define get scm_tag] + return [my Config_get scm_tag] } if {[my define exists tag]} { - set tag [my define get tag] + set tag [my Config_get tag] } else { set tag master } - my define set scm_tag $tag + my Config_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 define get name] + set pkg [my Config_get name] if {[my define exists git_url]} { - ::practcl::doexec git clone --branch $tag [my define get git_url] $srcdir + ::practcl::doexec git clone --branch $tag [my Config_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 define get srcdir] + set path [$obj config get srcdir] if {[my claim_path $path]} { return true } - if {[$obj define get git_url] ne {}} { + if {[$obj config 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 define get download] - set url [my define get file_url] + set dpath [::practcl::LOCAL config get download] + set url [my Config_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 define add include $header + my Config_add include $header } method include_dir args { - my define add include_dir {*}$args + my Config_add include_dir {*}$args } method include_directory args { - my define add include_dir {*}$args + my Config_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 define get output_c] + set filename [my Config_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 define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] } else { - set filename [my define get cfile] + set filename [my Config_get cfile] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_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 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 + 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 set fout [open $filename w] puts $fout [my generate-c] - if {[my define get initfunc] ne {}} { - puts $fout "extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \x7B" + if {[my Config_get initfunc] ne {}} { + puts $fout "extern int DLLEXPORT [my Config_get initfunc]( Tcl_Interp *interp ) \x7B" puts $fout [my generate-loader-module] - if {[my define get pkg_name] ne {}} { - puts $fout " Tcl_PkgProvide(interp, \"[my define get pkg_name]\", \"[my define get pkg_vers]\");" + if {[my Config_get pkg_name] ne {}} { + puts $fout " Tcl_PkgProvide(interp, \"[my Config_get pkg_name]\", \"[my Config_get pkg_vers]\");" } puts $fout " return TCL_OK\;" puts $fout "\x7D" } close $fout @@ -228,33 +228,33 @@ ### # Practcl internals ### method initialize {} { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename eq {}} { return } - if {[my define get name] eq {}} { - my define set name [file tail [file rootname $filename]] + if {[my Config_get name] eq {}} { + my Config_set name [file tail [file rootname $filename]] } - if {[my define get localpath] eq {}} { - my define set localpath [my <module> define get localpath]_[my define get name] + if {[my Config_get localpath] eq {}} { + my Config_set localpath [my <module> config get localpath]_[my Config_get name] } ::source $filename } method linktype {} { return {subordinate product dynamic} } method generate-cfile-constant {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} my variable code cstruct methods tcltype if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my define get filename] CONSTANT */" + ::practcl::cputs result "/* [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get cclass]] + ::practcl::debug [list methods [info exists methods] [my Config_get cclass]] if {[info exists methods]} { - set thisclass [my define get cclass] + set thisclass [my Config_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 define get output_c] ne {}} continue + if {[$obj config get output_c] ne {}} continue set dat [$obj generate-cfile-header] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-header */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* END [$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get cclass] + set thisclass [my Config_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 define get class]] { + ::practcl::cputs result [string map [list @CCLASS@ $thisclass @TCLCLASS@ [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_get filename]] foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} { + if {[$obj config 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 define get cclass] - set thisclass [my define get cclass] + ::practcl::debug [self] methods [my Config_get cclass] + set thisclass [my Config_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 define get nspace] + set thisnspace [my Config_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,139 +1,29 @@ ### # The metaclass for all practcl objects ### ::clay::define ::practcl::metaclass { + superclass ::clay::yggdrasil method _MorphPatterns {} { return {{@name@} {::practcl::@name@} {::practcl::*@name@} {::practcl::*@name@*}} } - 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 Child_define {} { + return {} + } + + method define {method args} { + tailcall my Config_$method {*}$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]] { @@ -158,11 +48,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 define set class $class + my Config_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 define dump] + set dat [my Config_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] define get filename] + return [[dict get $make_object $name] config get filename] } } Ensemble make::target {name Info body} { set info [uplevel #0 [list subst $Info]] @@ -164,30 +164,28 @@ # 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 define get action] + eval [$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result { /* This file was generated by practcl */ } set includes {} @@ -196,20 +194,20 @@ $mod go } set headers {} my IncludeAdd headers <tcl.h> <tclOO.h> - if {[my define get tk 0]} { + if {[my Config_get tk 0]} { my IncludeAdd headers <tk.h> } - if {[my define get output_h] ne {}} { - my IncludeAdd headers [my define get output_h] + if {[my Config_get output_h] ne {}} { + my IncludeAdd headers [my Config_get output_h] } - my IncludeAdd headers {*}[my define get include] + my IncludeAdd headers {*}[my Config_get include] foreach mod [my link list dynamic] { - my IncludeAdd headers {*}[$mod define get include] + my IncludeAdd headers {*}[$mod config get include] } foreach inc $headers { ::practcl::cputs result "#include $inc" } foreach {method} { @@ -222,26 +220,26 @@ generate-cfile-functions generate-cfile-tclapi } { set dat [my $method] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN $method [my define get filename] */" + ::practcl::cputs result "/* BEGIN $method [my Config_get filename] */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END $method [my define get filename] */" + ::practcl::cputs result "/* END $method [my Config_get filename] */" } } - ::practcl::debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list /[self] [self method] [self class] -- [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} foreach method { generate-hfile-public-define generate-hfile-public-macro } { @@ -282,22 +280,22 @@ } return $result } method generate-loader {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} - if {[my define get initfunc] eq {}} return + if {[my Config_get initfunc] eq {}} return ::practcl::cputs result " -extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \{" +extern int DLLEXPORT [my Config_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 define get tk 0]} { + if {[my Config_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]]} { @@ -308,25 +306,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 define get pkg_name [my define get name]]\" , \"[my define get pkg_vers [my define get version]]\" )) return TCL_ERROR\;" + ::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 " return TCL_OK\;\n\}\n" return $result } method initialize {} { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename eq {}} { return } - if {[my define get name] eq {}} { - my define set name [file tail [file dirname $filename]] + if {[my Config_get name] eq {}} { + my Config_set name [file tail [file dirname $filename]] } - if {[my define get localpath] eq {}} { - my define set localpath [my <project> define get name]_[my define get name] + if {[my Config_get localpath] eq {}} { + my Config_set localpath [my <project> config get name]_[my Config_get name] } my graft module [self] ::practcl::debug [self] SOURCE $filename my source $filename } @@ -335,21 +333,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 define get filename] $err" + lappend errs "Skipped $item: [$item config 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 define get filename] $err" + lappend errs "Skipped $item: [$item config get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } @@ -365,12 +363,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 define get filename] [info object class [self]]] - set filename [my define get output_c] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + set filename [my Config_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,41 +3,44 @@ ### ::clay::define ::practcl::object { superclass ::practcl::metaclass constructor {parent args} { - my variable links define + my variable links set organs [$parent child organs] my clay delegate {*}$organs - array set define $organs - array set define [$parent child define] + my Config_merge $organs + my Config_merge [$parent child define] array set links {} if {[llength $args]==1 && [file exists [lindex $args 0]]} { - my define set filename [lindex $args 0] + my Config_set filename [lindex $args 0] ::practcl::product select [self] } elseif {[llength $args] == 1} { set data [uplevel 1 [list subst [lindex $args 0]]] - array set define $data + my Config_merge $data my select } else { - array set define [uplevel 1 [list subst $args]] + my Config_merge [uplevel 1 [list subst $args]] my select } my initialize } - method child {method} { + method Child_delegate {} { + return {} + } + method Child_organs {} { return {} } method go {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable links foreach {linktype objs} [array get links] { foreach obj $objs { $obj go } } ::practcl::debug [list /[self] [self method] [self class]] } } 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 define get filename] + set filename [my Config_get filename] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - 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]] + 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]] } } 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 define get filename]] links [my link list]]" + ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} my variable code cstruct methods tcltype if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my define get filename] CONSTANT */" + ::practcl::cputs result "/* [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config get output_c] ne {}} continue set dat [$obj generate-cfile-header] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-header */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-header */" } } return $result } method generate-cfile-global {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config get output_c] ne {}} continue set dat [$obj generate-cfile-global] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-global */" + ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-global */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-global */" + ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-global */" } } return $result } method generate-cfile-private-typedef {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} { + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cfunct tcltype set result {} - if {[my define get initfunc] ne {}} { - ::practcl::cputs result "int [my define get initfunc](Tcl_Interp *interp);" + if {[my Config_get initfunc] ne {}} { + ::practcl::cputs result "int [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set includes {} - foreach item [my define get public-include] { + foreach item [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set includes {} - foreach item [my define get public-verbatim] { + foreach item [my Config_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 define get initfunc] eq {}} { - return "/* [my define get filename] declared not initfunc */" + if {[my Config_get initfunc] eq {}} { + return "/* [my Config_get filename] declared not initfunc */" } - return " if([my define get initfunc](interp)) return TCL_ERROR\;" + return " if([my Config_get initfunc](interp)) return TCL_ERROR\;" } method generate-loader-module {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code set result {} if {[info exists code(cinit)]} { ::practcl::cputs result $code(cinit) } - if {[my define get initfunc] ne {}} { - ::practcl::cputs result " if([my define get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" + if {[my Config_get initfunc] ne {}} { + ::practcl::cputs result " if([my Config_get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_get filename]] foreach item [my link list product] { - if {[$item define get output_c] ne {}} { + if {[$item config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 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] + 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] ::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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} my variable code if {[info exists code(tcl)]} { - set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] + set result [::practcl::_tagblock $code(tcl) tcl [my Config_get filename]] } if {[info exists code(tcl-pre)]} { - set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] + set result [::practcl::_tagblock $code(tcl) tcl [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $code(tcl-post) tcl [my Config_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> define get localpath] + set lpath [my <module> config get localpath] if {$lpath eq {}} { - set lpath [my <module> define get name] + set lpath [my <module> config get name] } return ${lpath}_[file rootname [file tail $filename]] } ### # Methods called by the master project ### method project-static-packages {} { - set result [my define get static_packages] - set initfunc [my define get initfunc] + set result [my Config_get static_packages] + set initfunc [my Config_get initfunc] if {$initfunc ne {}} { - set pkg_name [my define get pkg_name] + set pkg_name [my Config_get pkg_name] if {$pkg_name ne {}} { dict set result $pkg_name initfunc $initfunc - 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] + 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] } } 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 define get filename] [info object class [self]]] - set result [my define get include_dir] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + set result [my Config_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 define get class] - set mixin [$object define get product] + set class [$object config get class] + set mixin [$object config get product] if {$class eq {} && $mixin eq {}} { - set filename [$object define get filename] + set filename [$object config 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 define get filename] + set filename [my Config_get filename] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]] object [self]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_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 define get filename] + return [my Config_get filename] } } ### @@ -655,28 +655,28 @@ ### ::clay::define ::practcl::product.dynamic { superclass ::practcl::dynamic ::practcl::product method initialize {} { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename eq {}} { return } - if {[my define get name] eq {}} { - my define set name [file tail [file rootname $filename]] + if {[my Config_get name] eq {}} { + my Config_set name [file tail [file rootname $filename]] } - if {[my define get localpath] eq {}} { - my define set localpath [my <module> define get localpath]_[my define get name] + if {[my Config_get localpath] eq {}} { + my Config_set localpath [my <module> config get localpath]_[my Config_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 define get output_c] ne {}} { + if {[my Config_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] - array set define $contents + my Config_merge $contents ::practcl::toolset select [self] my initialize } method add_object object { @@ -44,102 +44,100 @@ my link object $object } method add_project {pkg info {oodefine {}}} { ::practcl::debug [self] add_project $pkg $info - set os [my define get TEACUP_OS] + set os [my Config_get TEACUP_OS] if {$os eq {}} { set os [::practcl::os] - my define set os $os + my Config_set os $os } - set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]] + set fossilinfo [list download [my Config_get download] tag trunk sandbox [my Config_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 define get profile release]: + set profile [my Config_get profile release]: if {[dict exists $info profile $profile]} { dict set info tag [dict get $info profile $profile] } - dict set info USEMSVC [my define get USEMSVC 0] - dict set info debug [my define get debug 0] + dict set info USEMSVC [my Config_get USEMSVC 0] + dict set info debug [my Config_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 define set masterpath $::CWD + $obj config 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 define get download] tag trunk sandbox [my define get sandbox]] + set fossilinfo [list download [my Config_get download] tag trunk sandbox [my Config_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 define get profile release]: + set profile [my Config_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 define set masterpath $::CWD + $obj config 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 define get TEACUP_OS] + set os [my Config_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 define get prefix] --exec-prefix [my define get prefix] + lappend tcl_config_opts --prefix [my Config_get prefix] --exec-prefix [my Config_get prefix] set tclobj [my tclcore] - if {[my define get debug 0]} { - $tclobj define set debug 1 + if {[my Config_get debug 0]} { + $tclobj config set debug 1 lappend tcl_config_opts --enable-symbols=true } - $tclobj define set config_opts $tcl_config_opts + $tclobj config set config_opts $tcl_config_opts $tclobj go $tclobj compile - set _TclSrcDir [$tclobj define get localsrcdir] - my define set tclsrcdir $_TclSrcDir - if {[my define get tk 0]} { + set _TclSrcDir [$tclobj config get localsrcdir] + my Config_set tclsrcdir $_TclSrcDir + if {[my Config_get tk 0]} { set tkobj [my tkcore] - 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 --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 --enable-symbols=true } - $tkobj define set config_opts $tk_config_opts + $tkobj config 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 - return [list project [self] module [self]] - } - } + method Child_delegate {} { + return [list project [self] module [self]] + } + method Child_organs {} { + 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 define get OBJEXT o] + set objext [my Config_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 define get libfile] + set libfile [my Config_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 define get output_c] + set filename [my Config_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 define get extra] external [string is true -strict [my define get external]]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] } return $result } method go {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set name [my define getnull name] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + set name [my Config_get name] if {$name eq {}} { set name generic my define name generic } - if {[my define get tk] eq {@TEA_TK_EXTENSION@}} { - my define set tk 0 + if {[my Config_get tk] eq {@TEA_TK_EXTENSION@}} { + my Config_set tk 0 } - set output_c [my define getnull output_c] + set output_c [my Config_get output_c] if {$output_c eq {}} { set output_c [file rootname $name].c - my define set output_c $output_c + my Config_set output_c $output_c } - set output_h [my define getnull output_h] + set output_h [my Config_get output_h] if {$output_h eq {}} { set output_h [file rootname $output_c].h - my define set output_h $output_h + my Config_set output_h $output_h } - set output_tcl [my define getnull output_tcl] + set output_tcl [my Config_get output_tcl] #if {$output_tcl eq {}} { # set output_tcl [file rootname $output_c].tcl - # my define set output_tcl $output_tcl + # my Config_set output_tcl $output_tcl #} - #set output_mk [my define getnull output_mk] + #set output_mk [my Config_get output_mk] #if {$output_mk eq {}} { # set output_mk [file rootname $output_c].mk - # my define set output_mk $output_mk + # my Config_set output_mk $output_mk #} - set initfunc [my define getnull initfunc] + set initfunc [my Config_get initfunc] if {$initfunc eq {}} { set initfunc [string totitle $name]_Init - my define set initfunc $initfunc + my Config_set initfunc $initfunc } - set output_decls [my define getnull output_decls] + set output_decls [my Config_get output_decls] if {$output_decls eq {}} { set output_decls [file rootname $output_c].decls - my define set output_decls $output_decls + my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list /[self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] } method generate-decls {pkgname path} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 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)"] + 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)"] 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 define get filename] $err" + lappend errs "Skipped $item: [$item config 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 define get filename] $err" + lappend errs "Skipped $item: [$item config 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 define get output_c]] w] + set cout [open [file join $path [my Config_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 define get output_h]]]_H - set hout [open [file join $path [my define get output_h]] w] + 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] 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 define get output_tcl] + set output_tcl [my Config_get output_tcl] if {$output_tcl ne {}} { - set tclout [open [file join $path [my define get output_tcl]] w] + set tclout [open [file join $path [my Config_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 define get pkg_name [my define get name]] - set version [my define get pkg_vers [my define get version]] + set name [my Config_get pkg_name [my Config_get name]] + set version [my Config_get pkg_vers [my Config_get version]] if {$version eq {}} { set version 0.1a } - set output_tcl [my define get output_tcl] + set output_tcl [my Config_get output_tcl] if {$output_tcl ne {}} { set script "\[list source \[file join \$dir $output_tcl\]\]" - } elseif {[my define get SHARED_BUILD 0]} { - set script "\[list load \[file join \$dir [my define get libfile]\] $name\]" + } elseif {[my Config_get SHARED_BUILD 0]} { + set script "\[list load \[file join \$dir [my Config_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 define get name [my define get pkg_name]]] + set name [string tolower [my Config_get name [my Config_get pkg_name]]] set NAME [string toupper $name] - set version [my define get version [my define get pkg_vers]] + set version [my Config_get version [my Config_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 define getnull libprefix] - set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]][my define get SHLIB_SUFFIX] + lappend map %LIBRARY_PREFIX% [my Config_get libprefix] + set outfile [string map $map [my Config_get PRACTCL_NAME_LIBRARY]][my Config_get SHLIB_SUFFIX] return $outfile } method static_library {{filename {}}} { - set name [string tolower [my define get name [my define get pkg_name]]] + set name [string tolower [my Config_get name [my Config_get pkg_name]]] set NAME [string toupper $name] - set version [my define get version [my define get pkg_vers]] + set version [my Config_get version [my Config_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 define getnull libprefix] - set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]].a + lappend map %LIBRARY_PREFIX% [my Config_get libprefix] + set outfile [string map $map [my Config_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 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 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 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 define get tcl_rcFileName ~/.tclshrc]] + append main_init_script \n [list set tcl_rcFileName [$PROJECT config 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 define get tip_430 0]} { + if {![$PROJECT config 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 define get TEACUP_OS] eq "windows"} { + if {[$PROJECT config 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 define get tip_430 0]} { + if {![$PROJECT config 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 define get name] + set name [my Config_get name] # Assume a static shell if {[my define exists SHARED_BUILD]} { - my define set SHARED_BUILD 0 + my Config_set SHARED_BUILD 0 } if {![my define exists TCL_LOCAL_APPINIT]} { - my define set TCL_LOCAL_APPINIT Tclkit_AppInit + my Config_set TCL_LOCAL_APPINIT Tclkit_AppInit } if {![my define exists TCL_LOCAL_MAIN_HOOK]} { - my define set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook + my Config_set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook } set PROJECT [self] - set os [$PROJECT define get TEACUP_OS] - if {[my define get SHARED_BUILD 0]} { + set os [$PROJECT config get TEACUP_OS] + if {[my Config_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 define get srcdir] + set TCLSRCDIR [$TCLOBJ config get srcdir] set PKG_OBJS {} foreach item [$PROJECT link list core.library] { - if {[string is true [$item define get static]]} { + if {[string is true [$item config get static]]} { lappend PKG_OBJS $item } } foreach item [$PROJECT link list package] { - if {[string is true [$item define get static]]} { + if {[string is true [$item config 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 define get SHARED_BUILD 0]} { + if {![my Config_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 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]] + 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]] } else { set PLATFORM_SRC_DIR unix - 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]] + 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]] } - if {![my define get SHARED_BUILD 0]} { + if {![my Config_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 define set ZIPFS_VOLUME "zipfs:/" + $PROJECT config set ZIPFS_VOLUME "zipfs:/" } - $PROJECT code header "#define ZIPFS_VOLUME \"[$PROJECT define get ZIPFS_VOLUME]\"" + $PROJECT code header "#define ZIPFS_VOLUME \"[$PROJECT config get ZIPFS_VOLUME]\"" if {[file exists $zipfs]} { - $TCLOBJ define set tip_430 1 - my define set tip_430 1 + $TCLOBJ config set tip_430 1 + my Config_set tip_430 1 } else { # The Tclconfig project maintains a mirror of the version # released with the Tcl core - my define set tip_430 0 - set tclzipfs_c [my define get tclzipfs_c] + my Config_set tip_430 0 + set tclzipfs_c [my Config_get tclzipfs_c] if {![file exists $tclzipfs_c]} { ::practcl::LOCAL tool tclconfig unpack - set COMPATSRCROOT [::practcl::LOCAL tool tclconfig define get srcdir] + set COMPATSRCROOT [::practcl::LOCAL tool tclconfig config 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 define add include_dir [file join $TCLSRCDIR generic] - my define add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR] + my Config_add include_dir [file join $TCLSRCDIR generic] + my Config_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 define get name] - set libsrcdir [$item define get srcdir] + set name [$item config get name] + set libsrcdir [$item config 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 define get installdir] ne {}} { - # ::practcl::copyDir [file join [my define get installdir] [string trimleft [my define get prefix] /] lib] [file join $vfspath lib] + #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] #} foreach arg $args { ::practcl::copyDir $arg $vfspath } set fout [open [file join $vfspath pkgIndex.tcl] w] - puts $fout [string map [list %platform% [my define get TEACUP_PROFILE]] {set ::tcl_teapot_profile {%platform%}}] + puts $fout [string map [list %platform% [my Config_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 define get EXEEXT] - set tclkit_bare [my define get tclkit_bare] + set EXEEXT [my Config_get EXEEXT] + set tclkit_bare [my Config_get tclkit_bare] ::practcl::mkzip ${exename}${EXEEXT} $tclkit_bare $vfspath - if { [my define get TEACUP_OS] ne "windows" } { + if { [my Config_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,32 +8,30 @@ return {{::practcl::subproject.@name@} {::practcl::@name@} {@name@} {::practcl::subproject}} } method BuildDir {PWD} { - return [my define get srcdir] + return [my Config_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 - return [list project [self] module [self]] - } - } + method Child_delegate {} { + return [list project [self] module [self]] + } + method Child_organs {} { + return [list project [self] module [self]] } method compile {} {} method go {} { ::practcl::distribution select [self] - 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]] + 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]] my sources } # Install project into the local build system method install args {} @@ -68,11 +66,11 @@ ### # Load the facility into the interpreter ### method env-bootstrap {} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] package require $pkg } ### # Return a file path that exec can call @@ -104,11 +102,11 @@ ### # Check if tool is available for load/already loaded ### method env-present {} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] if {[catch [list package require $pkg]]} { return 0 } return 1 } @@ -139,18 +137,18 @@ ### ::clay::define ::practcl::subproject.source { superclass ::practcl::subproject ::practcl::library method env-bootstrap {} { - set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] + set LibraryRoot [file join [my Config_get srcdir] [my Config_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 define get srcdir] + set path [my Config_get srcdir] return [file exists $path] } method linktype {} { return {subordinate package source} @@ -161,36 +159,36 @@ # a copy from the teapot ::clay::define ::practcl::subproject.teapot { superclass ::practcl::subproject method env-bootstrap {} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] package require $pkg } method env-install {} { - set pkg [my define get pkg_name [my define get name]] - set download [my <project> define get download] + set pkg [my Config_get pkg_name [my Config_get name]] + set download [my <project> config get download] my unpack - set prefix [string trimleft [my <project> define get prefix] /] + set prefix [string trimleft [my <project> config 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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] if {[catch [list package require $pkg]]} { return 0 } return 1 } method install DEST { - set pkg [my define get pkg_name [my define get name]] - set download [my <project> define get download] + set pkg [my Config_get pkg_name [my Config_get name]] + set download [my <project> config get download] my unpack - set prefix [string trimleft [my <project> define get prefix] /] + set prefix [string trimleft [my <project> config get prefix] /] ::practcl::tcllib_require zipfile::decode ::zipfile::decode::unzipfile [file join $download $pkg.zip] [file join $DEST $prefix lib $pkg] } } @@ -199,11 +197,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 define get srcdir] kettle] + set kettle [file join [::practcl::LOCAL tool kettle config get srcdir] kettle] } set srcdir [my SourceRoot] ::practcl::dotclexec $kettle -f [file join $srcdir build.tcl] {*}$args } @@ -214,64 +212,64 @@ ::clay::define ::practcl::subproject.critcl { superclass ::practcl::subproject method install DEST { - my critcl -pkg [my define get name] + my critcl -pkg [my Config_get name] set srcdir [my SourceRoot] - ::practcl::copyDir [file join $srcdir [my define get name]] [file join $DEST lib [my define get name]] + ::practcl::copyDir [file join $srcdir [my Config_get name]] [file join $DEST lib [my Config_get name]] } } ::clay::define ::practcl::subproject.sak { superclass ::practcl::subproject method env-bootstrap {} { - set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] + set LibraryRoot [file join [my Config_get srcdir] [my Config_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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set srcdir [my Config_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 define get srcdir] + set path [my Config_get srcdir] return [file exists $path] } method install DEST { ### # Handle teapot installs ### - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - set prefix [string trimleft [my <project> define get prefix] /] - set srcdir [my define get srcdir] + set prefix [string trimleft [my <project> config get prefix] /] + set srcdir [my Config_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 define get srcdir] + set srcdir [my Config_get srcdir] if {[llength $args]==1 && [lindex $args 0] in {* all}} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_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 { @@ -285,42 +283,42 @@ ::clay::define ::practcl::subproject.practcl { superclass ::practcl::subproject method env-bootstrap {} { - set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] + set LibraryRoot [file join [my Config_get srcdir] [my Config_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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set srcdir [my Config_get srcdir] ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $prefix lib $pkg] } method install DEST { ### # Handle teapot installs ### - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - 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]] + 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]] ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $DEST $prefix lib $pkg] } method install-module {DEST args} { - set pkg [my define get pkg_name [my define get name]] - set srcdir [my define get srcdir] + set pkg [my Config_get pkg_name [my Config_get name]] + set srcdir [my Config_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 define get builddir]] + set builddir [file normalize [my Config_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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] set os [::practcl::local_os] - my define set os $os + my Config_set os $os my unpack - set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set srcdir [my Config_get srcdir] lappend options --prefix $prefix --exec-prefix $prefix - my define set config_opts $options + my Config_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 define get install] { + switch [my Config_get install] { static { - my define set static 1 - my define set autoload 0 + my Config_set static 1 + my Config_set autoload 0 } static-autoload { - my define set static 1 - my define set autoload 1 + my Config_set static 1 + my Config_set autoload 1 } vfs { - my define set static 0 - my define set autoload 0 - my define set vfsinstall 1 + my Config_set static 0 + my Config_set autoload 0 + my Config_set vfsinstall 1 } null { - my define set static 0 - my define set autoload 0 - my define set vfsinstall 0 + my Config_set static 0 + my Config_set autoload 0 + my Config_set vfsinstall 0 } default { } } @@ -64,48 +64,48 @@ method go {} { next ::practcl::distribution select [self] my ComputeInstall - my define set builddir [my BuildDir [my define get masterpath]] + my Config_set builddir [my BuildDir [my Config_get masterpath]] } method linker-products {configdict} { - if {![my define get static 0]} { + if {![my Config_get static 0]} { return {} } - set srcdir [my define get builddir] + set srcdir [my Config_get builddir] if {[dict exists $configdict libfile]} { return " [file join $srcdir [dict get $configdict libfile]]" } } method project-static-packages {} { - if {![my define get static 0]} { + if {![my Config_get static 0]} { return {} } - set result [my define get static_packages] - set statpkg [my define get static_pkg] - set initfunc [my define get initfunc] + set result [my Config_get static_packages] + set statpkg [my Config_get static_pkg] + set initfunc [my Config_get initfunc] if {$initfunc ne {}} { - set pkg_name [my define get pkg_name] + set pkg_name [my Config_get pkg_name] if {$pkg_name ne {}} { dict set result $pkg_name initfunc $initfunc - set version [my define get version] + set version [my Config_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 define set version $version + my Config_set version $version } dict set result $pkg_name version $version - dict set result $pkg_name autoload [my define get autoload 0] + dict set result $pkg_name autoload [my Config_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 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]] + 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]] } if {$debug} { - return [my define get builddir [file join $PWD debug $name]] + return [my Config_get builddir [file join $PWD debug $name]] } else { - return [my define get builddir [file join $PWD pkg $name]] + return [my Config_get builddir [file join $PWD pkg $name]] } } method compile {} { - set name [my define get name] + set name [my Config_get name] set PWD $::CWD cd $PWD my unpack set srcdir [file normalize [my SrcDir]] set localsrcdir [my MakeDir $srcdir] - my define set localsrcdir $localsrcdir + my Config_set localsrcdir $localsrcdir my Collate_Source $PWD ### # Build a starter VFS for both Tcl and wish ### - set srcdir [my define get srcdir] - if {[my define get static 1]} { + set srcdir [my Config_get srcdir] + if {[my Config_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 define get srcdir]] - set builddir [file normalize [my define get builddir]] + set srcdir [file normalize [my Config_get srcdir]] + set builddir [file normalize [my Config_get builddir]] file mkdir $builddir my make autodetect } method install DEST { set PWD [pwd] - set PREFIX [my <project> define get prefix] + set PREFIX [my <project> config get prefix] ### # Handle teapot installs ### - 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 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 found 0 - foreach ver [my define get pkg_vers [my define get version]] { + foreach ver [my Config_get pkg_vers [my Config_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,33 +3,33 @@ superclass ::practcl::subproject.binary method env-bootstrap {} {} method env-present {} { - set PREFIX [my <project> define get prefix] - set name [my define get name] + set PREFIX [my <project> config get prefix] + set name [my Config_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> define get prefix [file normalize [file join ~ tcl]]] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] lappend options --prefix $prefix --exec-prefix $prefix - my define set config_opts $options + my Config_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 define set core_binary 1 + my Config_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,20 +7,19 @@ constructor {module_object name info {action_body {}}} { my variable define triggered domake set triggered 0 set domake 0 - set define(name) $name - set define(action) {} - array set define $info + my Config_set name $name action {} + my Config_merge $info my select my initialize foreach {stub obj} [$module_object child organs] { my graft $stub $obj } if {$action_body ne {}} { - set define(action) $action_body + my Config_set action $action_body } } method do {} { my variable domake @@ -35,11 +34,11 @@ if {[info exists needs_make]} { return $needs_make } set make_objects [my <module> make objects] set needs_make 0 - foreach item [my define get depends] { + foreach item [my Config_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 @@ -58,15 +57,15 @@ return $needs_make } method output {} { set result {} - set filename [my define get filename] + set filename [my Config_get filename] if {$filename ne {}} { lappend result $filename } - foreach filename [my define get files] { + foreach filename [my Config_get files] { if {$filename ne {}} { lappend result $filename } } return $result @@ -85,11 +84,11 @@ return $domake } set triggered 1 set make_objects [my <module> make objects] - foreach item [my define get depends] { + foreach item [my Config_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 @@ -99,8 +98,8 @@ $depobj triggers } } } set domake 1 - my <module> make trigger {*}[my define get triggers] + my <module> make trigger {*}[my Config_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 define set [::practcl::local_os] - ::practcl::LOCAL define set LOCAL 1 + ::practcl::LOCAL config set [::practcl::local_os] + ::practcl::LOCAL config 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> define get prefix [file join [file normalize ~] tcl]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file join [file normalize ~] tcl]] + set srcdir [my Config_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 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]] + 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]] } if {$debug} { - return [my define get builddir [file join $PWD debug $name]] + return [my Config_get builddir [file join $PWD debug $name]] } else { - return [my define get builddir [file join $PWD pkg $name]] + return [my Config_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 define get name] + set name [my Config_get name] set PWD $::CWD - set builddir [my define get builddir] + set builddir [my Config_get builddir] my unpack - set srcdir [my define get srcdir] + set srcdir [my Config_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} define get name [${PROJECT} define get pkg_name]]] + set name [string tolower [${PROJECT} config get name [${PROJECT} config get pkg_name]]] set NAME [string toupper $name] - set version [${PROJECT} define get version [${PROJECT} define get pkg_vers]] + set version [${PROJECT} config get version [${PROJECT} config 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 define get srcdir] main.tcl + set critcl [file join [::practcl::LOCAL tool critcl config 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 define get toolset] + return [$object config get toolset] } - set class [$object define get toolset] + set class [$object config 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 define get srcdir]] + set srcdir [file normalize [my Config_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 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]] + 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]] } if {$debug} { - return [my define get builddir [file join $PWD debug $name]] + return [my Config_get builddir [file join $PWD debug $name]] } else { - return [my define get builddir [file join $PWD pkg $name]] + return [my Config_get builddir [file join $PWD pkg $name]] } } method ConfigureOpts {} { set opts {} - set builddir [my define get builddir] + set builddir [my Config_get builddir] - if {[my define get broken_destroot 0]} { - set PREFIX [my <project> define get prefix_broken_destdir] + if {[my Config_get broken_destroot 0]} { + set PREFIX [my <project> config get prefix_broken_destdir] } else { - set PREFIX [my <project> define get prefix] + set PREFIX [my <project> config get prefix] } - switch [my define get name] { + switch [my Config_get name] { tcl { - set opts [::practcl::platform::tcl_core_options [my <project> define get TEACUP_OS]] + set opts [::practcl::platform::tcl_core_options [my <project> config get TEACUP_OS]] } tk { - set opts [::practcl::platform::tk_core_options [my <project> define get TEACUP_OS]] + set opts [::practcl::platform::tk_core_options [my <project> config get TEACUP_OS]] } } - if {[my <project> define get CONFIG_SITE] != {}} { - lappend opts --host=[my <project> define get HOST] + if {[my <project> config get CONFIG_SITE] != {}} { + lappend opts --host=[my <project> config get HOST] } - set inside_msys [string is true -strict [my <project> define get MSYS_ENV 0]] + set inside_msys [string is true -strict [my <project> config get MSYS_ENV 0]] lappend opts --with-tclsh=[info nameofexecutable] - if {[my define get tk 0]} { - if {![my <project> define get LOCAL 0]} { + if {[my Config_get tk 0]} { + if {![my <project> config 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 define get builddir]] + lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] } else { - lappend opts --with-tcl=[file normalize [$obj define get builddir]] + lappend opts --with-tcl=[file normalize [$obj config get builddir]] } } set obj [my <project> tkcore] if {$obj ne {}} { if {$inside_msys} { - lappend opts --with-tk=[::practcl::file_relative [file normalize $builddir] [$obj define get builddir]] + lappend opts --with-tk=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] } else { - lappend opts --with-tk=[file normalize [$obj define get builddir]] + lappend opts --with-tk=[file normalize [$obj config get builddir]] } } } else { lappend opts --with-tcl=[file join $PREFIX lib] lappend opts --with-tk=[file join $PREFIX lib] } } else { - if {![my <project> define get LOCAL 0]} { + if {![my <project> config 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 define get builddir]] + lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] } else { - lappend opts --with-tcl=[file normalize [$obj define get builddir]] + lappend opts --with-tcl=[file normalize [$obj config get builddir]] } } } else { lappend opts --with-tcl=[file join $PREFIX lib] } } - lappend opts {*}[my define get config_opts] + lappend opts {*}[my Config_get config_opts] if {![regexp -- "--prefix" $opts]} { lappend opts --prefix=$PREFIX --exec-prefix=$PREFIX } - if {[my define get debug 0]} { + if {[my Config_get debug 0]} { lappend opts --enable-symbols=true } #--exec_prefix=$PREFIX #if {$::tcl_platform(platform) eq "windows"} { # lappend opts --disable-64bit #} - if {[my define get static 1]} { + if {[my Config_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 define add include_dir [file join $srcdir generic] + my Config_add include_dir [file join $srcdir generic] } - set os [my <project> define get TEACUP_OS] + set os [my <project> config get TEACUP_OS] switch $os { windows { if {[file exists [file join $srcdir win]]} { - my define add include_dir [file join $srcdir win] + my Config_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 define add include_dir [file join $srcdir $os] + my Config_add include_dir [file join $srcdir $os] } if {[file exists [file join $srcdir unix]]} { - my define add include_dir [file join $srcdir unix] + my Config_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 define get srcdir] + set srcdir [my Config_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 define get srcdir] + set teapath [$tclConfigObj config 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 define get builddir] + set builddir [my Config_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 define get name] CONFIGURE {*}$opts] + ::practcl::debug [list PKG [my Config_get name] CONFIGURE {*}$opts] ::practcl::log [file join $builddir autoconf.log] [list CONFIGURE {*}$opts] cd $builddir - if {[my <project> define get CONFIG_SITE] ne {}} { - set ::env(CONFIG_SITE) [my <project> define get CONFIG_SITE] + if {[my <project> config get CONFIG_SITE] ne {}} { + set ::env(CONFIG_SITE) [my <project> config 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 define get builddir]] + set builddir [file normalize [my Config_get builddir]] catch {::practcl::domake $builddir clean} } Ensemble make::compile {} { - set name [my define get name] - set srcdir [my define get srcdir] - if {[my define get static 1]} { + set name [my Config_get name] + set srcdir [my Config_get srcdir] + if {[my Config_get static 1]} { puts "BUILDING Static $name $srcdir" } else { puts "BUILDING Dynamic $name $srcdir" } cd $::CWD - set builddir [file normalize [my define get builddir]] + set builddir [file normalize [my Config_get builddir]] file mkdir $builddir if {![file exists [file join $builddir Makefile]]} { my Configure } if {[file exists [file join $builddir make.tcl]]} { - if {[my define get debug 0]} { + if {[my Config_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 define get builddir] - if {[my <project> define get LOCAL 0] || $DEST eq {}} { + set builddir [my Config_get builddir] + if {[my <project> config 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 define get broken_destroot 0] == 0} { + } elseif {[my Config_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 define get broken_destroot 0] == 0} { + } elseif {[my Config_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> define get prefix] - set BROKENROOT [::practcl::msys_to_tclpath [my <project> define get prefix_broken_destdir]] + set PREFIX [my <project> config get prefix] + set BROKENROOT [::practcl::msys_to_tclpath [my <project> config 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 define get OBJEXT o] + set objext [my Config_get OBJEXT o] set EXTERN_OBJS {} set OBJECTS {} set result {} - set builddir [$PROJECT define get builddir] + set builddir [$PROJECT config get builddir] file mkdir [file join $builddir objs] - set debug [$PROJECT define get debug 0] + set debug [$PROJECT config get debug 0] set task {} ### # Compile the C sources ### @@ -362,15 +362,15 @@ } return $result } method build-Makefile {path PROJECT} { - array set proj [$PROJECT define dump] + array set proj [$PROJECT config dump] set path $proj(builddir) cd $path set includedir . - set objext [my define get OBJEXT o] + set objext [my Config_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 define getnull libprefix] + lappend map %LIBRARY_PREFIX% [$PROJECT config get libprefix] - if {[string is true [$PROJECT define get SHARED_BUILD]]} { - set outfile [$PROJECT define get libfile] + if {[string is true [$PROJECT config get SHARED_BUILD]]} { + set outfile [$PROJECT config get libfile] } else { set outfile [$PROJECT shared_library] } - $PROJECT define set shared_library $outfile + $PROJECT config 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 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 "\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 {} - if {[string is true [$PROJECT define get SHARED_BUILD]]} { + if {[string is true [$PROJECT config get SHARED_BUILD]]} { #set outfile [$PROJECT static_library] set outfile $proj(name).a } else { - set outfile [$PROJECT define get libfile] + set outfile [$PROJECT config get libfile] } - $PROJECT define set static_library $outfile + $PROJECT config set static_library $outfile dict set map %OUTFILE% $outfile ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" - ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_STATIC_LIB]]" + ::practcl::cputs result "\t[string map $map [$PROJECT config get PRACTCL_STATIC_LIB]]" ::practcl::cputs result {} return $result } ### # Produce a static or dynamic library ### method build-library {outfile PROJECT} { - array set proj [$PROJECT define dump] + array set proj [$PROJECT config 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 define get TEA_PRIVATE_TCL_HEADERS 0]} { - if {[$PROJECT define get TEA_PLATFORM] eq "windows"} { + if {[$PROJECT config get TEA_PRIVATE_TCL_HEADERS 0]} { + if {[$PROJECT config 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 define get tk 0]} { + if {[$PROJECT config 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 define get TEA_PRIVATE_TK_HEADERS 0]} { - if {[$PROJECT define get TEA_PLATFORM] eq "windows"} { + if {[$PROJECT config get TEA_PRIVATE_TK_HEADERS 0]} { + if {[$PROJECT config 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 define get debug 0] - set os [$PROJECT define get TEACUP_OS] + set debug [$PROJECT config get debug 0] + set os [$PROJECT config 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 define get SHARED_BUILD 1]]} { - set cmd [$PROJECT define get PRACTCL_SHARED_LIB] - append cmd " [$PROJECT define get PRACTCL_LIBS]" + 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]" set cmd [string map $map $cmd] puts $cmd exec {*}$cmd >&@ stdout - if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { - set cmd [string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]] + if {[$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { + set cmd [string map $map [$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL]] puts $cmd exec {*}$cmd >&@ stdout } } else { - set cmd [string map $map [$PROJECT define get PRACTCL_STATIC_LIB]] + set cmd [string map $map [$PROJECT config get PRACTCL_STATIC_LIB]] puts $cmd exec {*}$cmd >&@ stdout } - set ranlib [$PROJECT define get RANLIB] + set ranlib [$PROJECT config get RANLIB] if {$ranlib ni {{} :}} { catch {exec $ranlib $outfile} } } ### # Produce a static executable ### method build-tclsh {outfile PROJECT {path {auto}}} { - if {[my define get tk 0] && [my define get static_tk 0]} { + if {[my Config_get tk 0] && [my Config_get static_tk 0]} { puts " BUILDING STATIC TCL/TK EXE $PROJECT" set TKOBJ [$PROJECT tkcore] if {[info command $TKOBJ] eq {}} { set TKOBJ ::noop - $PROJECT define set static_tk 0 + $PROJECT config set static_tk 0 } else { ::practcl::toolset select $TKOBJ array set TK [$TKOBJ read_configuration] - 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] + 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] } } else { puts " BUILDING STATIC TCL EXE $PROJECT" set TKOBJ ::noop - my define set static_tk 0 + my Config_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 define get static]]} { + if {[string is true [$item config get static]]} { lappend PKG_OBJS $item } } foreach item [$PROJECT link list package] { - if {[string is true [$item define get static]]} { + if {[string is true [$item config 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 define get debug 0] + set debug [$PROJECT config 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 define get TEACUP_OS] - set TCLSRCDIR [$TCLOBJ define get srcdir] + set os [$PROJECT config get TEACUP_OS] + set TCLSRCDIR [$TCLOBJ config 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 define get static_tk]} { + if {[$PROJECT config 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} define get TEACUP_OS] eq "windows"} { - set windres [$PROJECT define get RC windres] + if {[${PROJECT} config get TEACUP_OS] eq "windows"} { + set windres [$PROJECT config get RC windres] set RSOBJ [file join $path objs tclkit.res.o] - 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 RCSRC [${PROJECT} config get kit_resource_file] + set RCMAN [${PROJECT} config get kit_manifest_file] + set RCICO [${PROJECT} config get kit_icon_file] set cmd [list $windres -o $RSOBJ -DSTATIC_BUILD --include [::practcl::file_relative $path [file join $TCLSRC generic]]] - if {[$PROJECT define get static_tk]} { + if {[$PROJECT config 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 define get builddir] wish.exe.manifest] + set RCMAN [file join [$TKOBJ config 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 define get builddir] tclsh.exe.manifest] + set RCMAN [file join [$TCLOBJ config get builddir] tclsh.exe.manifest] } if {$RCICO eq {} || ![file exists $RCICO]} { set RCICO [file join $TCLSRCDIR win tclsh.ico] } } - foreach item [${PROJECT} define get resource_include] { + foreach item [${PROJECT} config 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 define get static_tk]} { + if {[$PROJECT config get static_tk]} { append cmd " -L[file dirname $TK(build_stub_lib_path)] -ltk86g" } } else { append cmd " $TCL(build_lib_spec)" - if {[$PROJECT define get static_tk]} { + if {[$PROJECT config 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 define get static_tk]} { + if {[$PROJECT config 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 define get static_tk]} { + if {[$PROJECT config 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 define get static_tk]} { + if {[$PROJECT config 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 define get srcdir] + set srcdir [my Config_get srcdir] return $srcdir } # Do nothing @@ -12,50 +12,50 @@ Ensemble make::autodetect {} { } Ensemble make::clean {} { set PWD [pwd] - set srcdir [my define get srcdir] + set srcdir [my Config_get srcdir] cd $srcdir catch {::practcl::doexec nmake -f makefile.vc clean} cd $PWD } Ensemble make::compile {} { - set srcdir [my define get srcdir] - if {[my define get static 1]} { + set srcdir [my Config_get srcdir] + if {[my Config_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 define get debug 0]} { + if {[my Config_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> define get installdir] {*}[my NmakeOpts] release + ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> config 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> define get installdir] {*}[my NmakeOpts] release + ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> config 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 define get srcdir] + set srcdir [my Config_get srcdir] cd $srcdir if {$DEST eq {}} { error "No destination given" } - if {[my <project> define get LOCAL 0] || $DEST eq {}} { + if {[my <project> config 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 define add include_dir [file join $srcdir generic] + my Config_add include_dir [file join $srcdir generic] } if {[file exists [file join $srcdir win]]} { - my define add include_dir [file join $srcdir win] + my Config_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 define get builddir]] + set builddir [file normalize [my Config_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> define get tclsrcdir] ..]]] - set TCLGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tclsrcdir] .. generic]]] + 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]]] 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> define get tksrcdir] ..]]] - set TKGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tksrcdir] .. generic]]] + 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]]] #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 define get filename] + set filename [$obj config 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.16.3 +package provide practcl 0.17 namespace eval ::practcl {} ### # START: httpwget/wget.tcl ### @@ -15,11 +15,11 @@ # END: httpwget/wget.tcl ### ### # START: clay/clay.tcl ### -package provide clay 0.8 +package provide clay 0.8.1 namespace eval ::clay { } namespace eval ::clay { } set ::clay::trace 0 @@ -1314,10 +1314,15 @@ set path [::clay::tree::storage $args] if {![dict exists $clay {*}$path .]} { dict set clay {*}$path . {} } } + cache { + set path [lindex $args 0] + set value [lindex $args 1] + dict set claycache $path $value + } cget { # Leaf searches return one data field at a time # Search in our local dict if {[llength $args]==1} { set field [string trim [lindex $args 0] -:/] @@ -1398,11 +1403,10 @@ ::clay::tree::dictmerge result $clay return $result } ensemble_map { set ensemble [lindex $args 0] - my variable claycache set mensemble [string trim $ensemble :/] if {[dict exists $claycache method_ensemble $mensemble]} { return [clay::tree::sanitize [dict get $claycache method_ensemble $mensemble]] } set emap [my clay dget method_ensemble $mensemble] @@ -1477,31 +1481,29 @@ ::clay::tree::dictmerge result [$class clay dump] } ::clay::tree::dictmerge result $clay return $result } - # Search in our local cache - if {[dict exists $claycache {*}$path .]} { - return [dict get $claycache {*}$path] - } - if {[dict exists $claycache {*}$path]} { - return [dict get $claycache {*}$path] - } if {[dict exists $clay {*}$path] && ![dict exists $clay {*}$path .]} { # Path is a leaf return [dict get $clay {*}$path] } + # Search in our local cache + if {[my clay search $path value isleaf]} { + return $value + } + set found 0 set branch [dict exists $clay {*}$path .] foreach class $clayorder { if {[$class clay exists {*}$path .]} { set found 1 break } if {!$branch && [$class clay exists {*}$path]} { set result [$class clay dget {*}$path] - dict set claycache {*}$path $result + my clay cache $path $result return $result } } # Path is a branch set result [dict getnull $clay {*}$path] @@ -1510,11 +1512,11 @@ ::clay::tree::dictmerge result [$class clay dget {*}$path] } #if {[dict exists $clay {*}$path .]} { # ::clay::tree::dictmerge result #} - dict set claycache {*}$path $result + my clay cache $path $result return $result } getnull - get { set path [::clay::tree::storage $args] @@ -1526,20 +1528,21 @@ ::clay::tree::dictmerge result [$class clay dump] } ::clay::tree::dictmerge result $clay return [::clay::tree::sanitize $result] } - # Search in our local cache - if {[dict exists $claycache {*}$path .]} { - return [::clay::tree::sanitize [dict get $claycache {*}$path]] - } - if {[dict exists $claycache {*}$path]} { - return [dict get $claycache {*}$path] - } if {[dict exists $clay {*}$path] && ![dict exists $clay {*}$path .]} { # Path is a leaf return [dict get $clay {*}$path] + } + # Search in our local cache + if {[my clay search $path value isleaf]} { + if {!$isleaf} { + return [clay::tree::sanitize $value] + } else { + return $value + } } set found 0 set branch [dict exists $clay {*}$path .] foreach class $clayorder { if {[$class clay exists {*}$path .]} { @@ -1546,11 +1549,11 @@ set found 1 break } if {!$branch && [$class clay exists {*}$path]} { set result [$class clay dget {*}$path] - dict set claycache {*}$path $result + my clay cache $path $result return $result } } # Path is a branch set result [dict getnull $clay {*}$path] @@ -1563,11 +1566,11 @@ ::clay::tree::dictmerge result [$class clay dget {*}$path] } #if {[dict exists $clay {*}$path .]} { # ::clay::tree::dictmerge result [dict get $clay {*}$path] #} - dict set claycache {*}$path $result + my clay cache $path $result return [clay::tree::sanitize $result] } leaf { # Leaf searches return one data field at a time # Search in our local dict @@ -1577,21 +1580,22 @@ } if {[dict exists $clay {*}$path]} { return [dict get $clay {*}$path] } # Search in our local cache - if {[dict exists $claycache {*}$path .]} { - return [clay::tree::sanitize [dict get $claycache {*}$path]] - } - if {[dict exists $claycache {*}$path]} { - return [dict get $claycache {*}$path] + if {[my clay search $path value isleaf]} { + if {!$isleaf} { + return [clay::tree::sanitize $value] + } else { + return $value + } } # Search in the in our list of classes for an answer foreach class $clayorder { if {[$class clay exists {*}$path]} { set value [$class clay get {*}$path] - dict set claycache {*}$path $value + my clay cache $path $value return $value } } } merge { @@ -1601,10 +1605,11 @@ } mixin { ### # Mix in the class ### + my clay flush set prior [info object mixins [self]] set newmixin {} foreach item $args { lappend newmixin ::[string trimleft $item :] } @@ -1644,11 +1649,10 @@ break } } } mixinmap { - my variable clay if {![dict exists $clay .mixin]} { dict set clay .mixin {} } if {[llength $args]==0} { return [dict get $clay .mixin] @@ -1697,16 +1701,25 @@ } } replace { set clay [lindex $args 0] } + search { + set path [lindex $args 0] + upvar 1 [lindex $args 1] value [lindex $args 2] isleaf + set isleaf [expr {![dict exists $claycache $path .]}] + if {[dict exists $claycache $path]} { + set value [dict get $claycache $path] + return 1 + } + return 0 + } source { source [lindex $args 0] } set { #puts [list [self] clay SET {*}$args] - set claycache {} ::clay::tree::dictset clay {*}$args } default { dict $submethod clay {*}$args } @@ -1777,11 +1790,10 @@ set setcmd [dict getnull $info set-command] if {$setcmd ne {}} { {*}[string map [list %field% [list $field] %value% [list $value] %self% [namespace which my]] $setcmd] } } - my variable clayorder clay claycache if {[info exists clay]} { set emap [dict getnull $clay method_ensemble] } else { set emap {} } @@ -1830,17 +1842,20 @@ proc ::cron::object_destroy args {} } ::namespace eval ::clay::event { } proc ::clay::cleanup {} { + set count 0 if {![info exists ::clay::idle_destroy]} return - foreach obj $::clay::idle_destroy { - if {[info commands $obj] ne {}} { - catch {$obj destroy} - } - } + set objlist $::clay::idle_destroy set ::clay::idle_destroy {} + foreach obj $objlist { + if {![catch {$obj destroy}]} { + incr count + } + } + return $count } proc ::clay::object_create {objname {class {}}} { #if {$::clay::trace>0} { # puts [list $objname CREATE] #} @@ -2017,10 +2032,319 @@ } ### # 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 {} @@ -2728,11 +3052,11 @@ } set ::fosdat($dir) $result return $result } proc ::practcl::os {} { - return [${::practcl::MAIN} define get TEACUP_OS] + return [${::practcl::MAIN} config get TEACUP_OS] } proc ::practcl::mkzip {exename barekit vfspath} { ::practcl::tcllib_require zipfile::mkzip ::zipfile::mkzip::mkzip $exename -runtime $barekit -directory $vfspath } @@ -3798,11 +4122,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 define get filename] + set filename [$obj config get filename] if {$filename ne {}} { set ::target($name) $filename } } @@ -3811,133 +4135,24 @@ ### ### # START: class metaclass.tcl ### ::clay::define ::practcl::metaclass { + superclass ::clay::yggdrasil method _MorphPatterns {} { return {{@name@} {::practcl::@name@} {::practcl::*@name@} {::practcl::*@name@*}} } - 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 Child_define {} { + return {} + } + method define {method args} { + tailcall my Config_$method {*}$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]] { @@ -3962,11 +4177,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 define set class $class + my Config_set class $class } } else { error "[self] Could not detect class for $classname" } } @@ -4003,19 +4218,19 @@ ::clay::define ::practcl::toolset { method config.sh {} { return [my read_configuration] } method BuildDir {PWD} { - 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]] + 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]] } if {$debug} { - return [my define get builddir [file join $PWD debug $name]] + return [my Config_get builddir [file join $PWD debug $name]] } else { - return [my define get builddir [file join $PWD pkg $name]] + return [my Config_get builddir [file join $PWD pkg $name]] } } method MakeDir {srcdir} { return $srcdir } @@ -4023,15 +4238,15 @@ my variable conf_result if {[info exists conf_result]} { return $conf_result } set result {} - set name [my define get name] + set name [my Config_get name] set PWD $::CWD - set builddir [my define get builddir] + set builddir [my Config_get builddir] my unpack - set srcdir [my define get srcdir] + set srcdir [my Config_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 @@ -4084,13 +4299,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} define get name [${PROJECT} define get pkg_name]]] + set name [string tolower [${PROJECT} config get name [${PROJECT} config get pkg_name]]] set NAME [string toupper $name] - set version [${PROJECT} define get version [${PROJECT} define get pkg_vers]] + set version [${PROJECT} config get version [${PROJECT} config get pkg_vers]] if {$version eq {}} { set version 0.1a } set defs $DEFS foreach flag { @@ -4111,11 +4326,11 @@ return $defs } method critcl args { if {![info exists critcl]} { ::practcl::LOCAL tool critcl env-load - set critcl [file join [::practcl::LOCAL tool critcl define get srcdir] main.tcl + set critcl [file join [::practcl::LOCAL tool critcl config get srcdir] main.tcl } set srcdir [my SourceRoot] set PWD [pwd] cd $srcdir ::practcl::dotclexec $critcl {*}$args @@ -4127,13 +4342,13 @@ method select object { ### # Select the toolset to use for this project ### if {[$object define exists toolset]} { - return [$object define get toolset] + return [$object config get toolset] } - set class [$object define get toolset] + set class [$object config get toolset] if {$class ne {}} { $object clay mixinmap toolset $class } else { if {[info exists ::env(VisualStudioVersion)]} { $object clay mixinmap toolset ::practcl::toolset.msvc @@ -4156,11 +4371,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 define get srcdir]] + set srcdir [file normalize [my Config_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]} { @@ -4169,93 +4384,93 @@ } } cd $pwd } method BuildDir {PWD} { - 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]] + 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]] } if {$debug} { - return [my define get builddir [file join $PWD debug $name]] + return [my Config_get builddir [file join $PWD debug $name]] } else { - return [my define get builddir [file join $PWD pkg $name]] + return [my Config_get builddir [file join $PWD pkg $name]] } } method ConfigureOpts {} { set opts {} - set builddir [my define get builddir] + set builddir [my Config_get builddir] - if {[my define get broken_destroot 0]} { - set PREFIX [my <project> define get prefix_broken_destdir] + if {[my Config_get broken_destroot 0]} { + set PREFIX [my <project> config get prefix_broken_destdir] } else { - set PREFIX [my <project> define get prefix] + set PREFIX [my <project> config get prefix] } - switch [my define get name] { + switch [my Config_get name] { tcl { - set opts [::practcl::platform::tcl_core_options [my <project> define get TEACUP_OS]] + set opts [::practcl::platform::tcl_core_options [my <project> config get TEACUP_OS]] } tk { - set opts [::practcl::platform::tk_core_options [my <project> define get TEACUP_OS]] + set opts [::practcl::platform::tk_core_options [my <project> config get TEACUP_OS]] } } - if {[my <project> define get CONFIG_SITE] != {}} { - lappend opts --host=[my <project> define get HOST] + if {[my <project> config get CONFIG_SITE] != {}} { + lappend opts --host=[my <project> config get HOST] } - set inside_msys [string is true -strict [my <project> define get MSYS_ENV 0]] + set inside_msys [string is true -strict [my <project> config get MSYS_ENV 0]] lappend opts --with-tclsh=[info nameofexecutable] - if {[my define get tk 0]} { - if {![my <project> define get LOCAL 0]} { + if {[my Config_get tk 0]} { + if {![my <project> config 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 define get builddir]] + lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] } else { - lappend opts --with-tcl=[file normalize [$obj define get builddir]] + lappend opts --with-tcl=[file normalize [$obj config get builddir]] } } set obj [my <project> tkcore] if {$obj ne {}} { if {$inside_msys} { - lappend opts --with-tk=[::practcl::file_relative [file normalize $builddir] [$obj define get builddir]] + lappend opts --with-tk=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] } else { - lappend opts --with-tk=[file normalize [$obj define get builddir]] + lappend opts --with-tk=[file normalize [$obj config get builddir]] } } } else { lappend opts --with-tcl=[file join $PREFIX lib] lappend opts --with-tk=[file join $PREFIX lib] } } else { - if {![my <project> define get LOCAL 0]} { + if {![my <project> config 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 define get builddir]] + lappend opts --with-tcl=[::practcl::file_relative [file normalize $builddir] [$obj config get builddir]] } else { - lappend opts --with-tcl=[file normalize [$obj define get builddir]] + lappend opts --with-tcl=[file normalize [$obj config get builddir]] } } } else { lappend opts --with-tcl=[file join $PREFIX lib] } } - lappend opts {*}[my define get config_opts] + lappend opts {*}[my Config_get config_opts] if {![regexp -- "--prefix" $opts]} { lappend opts --prefix=$PREFIX --exec-prefix=$PREFIX } - if {[my define get debug 0]} { + if {[my Config_get debug 0]} { lappend opts --enable-symbols=true } #--exec_prefix=$PREFIX #if {$::tcl_platform(platform) eq "windows"} { # lappend opts --disable-64bit #} - if {[my define get static 1]} { + if {[my Config_get static 1]} { lappend opts --disable-shared #--disable-stubs # } else { lappend opts --enable-shared @@ -4263,17 +4478,17 @@ return $opts } method MakeDir {srcdir} { set localsrcdir $srcdir if {[file exists [file join $srcdir generic]]} { - my define add include_dir [file join $srcdir generic] + my Config_add include_dir [file join $srcdir generic] } - set os [my <project> define get TEACUP_OS] + set os [my <project> config get TEACUP_OS] switch $os { windows { if {[file exists [file join $srcdir win]]} { - my define add include_dir [file join $srcdir win] + my Config_add include_dir [file join $srcdir win] } if {[file exists [file join $srcdir win Makefile.in]]} { set localsrcdir [file join $srcdir win] } } @@ -4282,14 +4497,14 @@ set localsrcdir [file join $srcdir unix] } } default { if {[file exists [file join $srcdir $os]]} { - my define add include_dir [file join $srcdir $os] + my Config_add include_dir [file join $srcdir $os] } if {[file exists [file join $srcdir unix]]} { - my define add include_dir [file join $srcdir unix] + my Config_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] @@ -4297,11 +4512,11 @@ } } return $localsrcdir } Ensemble make::autodetect {} { - set srcdir [my define get srcdir] + set srcdir [my Config_get srcdir] set localsrcdir [my MakeDir $srcdir] if {$localsrcdir eq {}} { set localsrcdir $srcdir } if {$srcdir eq $localsrcdir} { @@ -4311,20 +4526,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 define get srcdir] + set teapath [$tclConfigObj config 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 define get builddir] + set builddir [my Config_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]} @@ -4333,39 +4548,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 define get name] CONFIGURE {*}$opts] + ::practcl::debug [list PKG [my Config_get name] CONFIGURE {*}$opts] ::practcl::log [file join $builddir autoconf.log] [list CONFIGURE {*}$opts] cd $builddir - if {[my <project> define get CONFIG_SITE] ne {}} { - set ::env(CONFIG_SITE) [my <project> define get CONFIG_SITE] + if {[my <project> config get CONFIG_SITE] ne {}} { + set ::env(CONFIG_SITE) [my <project> config 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 define get builddir]] + set builddir [file normalize [my Config_get builddir]] catch {::practcl::domake $builddir clean} } Ensemble make::compile {} { - set name [my define get name] - set srcdir [my define get srcdir] - if {[my define get static 1]} { + set name [my Config_get name] + set srcdir [my Config_get srcdir] + if {[my Config_get static 1]} { puts "BUILDING Static $name $srcdir" } else { puts "BUILDING Dynamic $name $srcdir" } cd $::CWD - set builddir [file normalize [my define get builddir]] + set builddir [file normalize [my Config_get builddir]] file mkdir $builddir if {![file exists [file join $builddir Makefile]]} { my Configure } if {[file exists [file join $builddir make.tcl]]} { - if {[my define get debug 0]} { + if {[my Config_get debug 0]} { ::practcl::domake.tcl $builddir debug all } else { ::practcl::domake.tcl $builddir all } } else { @@ -4372,34 +4587,34 @@ ::practcl::domake $builddir all } } Ensemble make::install DEST { set PWD [pwd] - set builddir [my define get builddir] - if {[my <project> define get LOCAL 0] || $DEST eq {}} { + set builddir [my Config_get builddir] + if {[my <project> config 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 define get broken_destroot 0] == 0} { + } elseif {[my Config_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 define get broken_destroot 0] == 0} { + } elseif {[my Config_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> define get prefix] - set BROKENROOT [::practcl::msys_to_tclpath [my <project> define get prefix_broken_destdir]] + set PREFIX [my <project> config get prefix] + set BROKENROOT [::practcl::msys_to_tclpath [my <project> config 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 @@ -4406,17 +4621,17 @@ } } cd $PWD } method build-compile-sources {PROJECT COMPILE CPPCOMPILE INCLUDES} { - set objext [my define get OBJEXT o] + set objext [my Config_get OBJEXT o] set EXTERN_OBJS {} set OBJECTS {} set result {} - set builddir [$PROJECT define get builddir] + set builddir [$PROJECT config get builddir] file mkdir [file join $builddir objs] - set debug [$PROJECT define get debug 0] + set debug [$PROJECT config get debug 0] set task {} ### # Compile the C sources ### @@ -4502,15 +4717,15 @@ } } return $result } method build-Makefile {path PROJECT} { - array set proj [$PROJECT define dump] + array set proj [$PROJECT config dump] set path $proj(builddir) cd $path set includedir . - set objext [my define get OBJEXT o] + set objext [my Config_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] { @@ -4557,68 +4772,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 define getnull libprefix] + lappend map %LIBRARY_PREFIX% [$PROJECT config get libprefix] - if {[string is true [$PROJECT define get SHARED_BUILD]]} { - set outfile [$PROJECT define get libfile] + if {[string is true [$PROJECT config get SHARED_BUILD]]} { + set outfile [$PROJECT config get libfile] } else { set outfile [$PROJECT shared_library] } - $PROJECT define set shared_library $outfile + $PROJECT config 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 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 "\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 {} - if {[string is true [$PROJECT define get SHARED_BUILD]]} { + if {[string is true [$PROJECT config get SHARED_BUILD]]} { #set outfile [$PROJECT static_library] set outfile $proj(name).a } else { - set outfile [$PROJECT define get libfile] + set outfile [$PROJECT config get libfile] } - $PROJECT define set static_library $outfile + $PROJECT config set static_library $outfile dict set map %OUTFILE% $outfile ::practcl::cputs result "$outfile: \$(${NAME}_OBJS)" - ::practcl::cputs result "\t[string map $map [$PROJECT define get PRACTCL_STATIC_LIB]]" + ::practcl::cputs result "\t[string map $map [$PROJECT config get PRACTCL_STATIC_LIB]]" ::practcl::cputs result {} return $result } method build-library {outfile PROJECT} { - array set proj [$PROJECT define dump] + array set proj [$PROJECT config 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 define get TEA_PRIVATE_TCL_HEADERS 0]} { - if {[$PROJECT define get TEA_PLATFORM] eq "windows"} { + if {[$PROJECT config get TEA_PRIVATE_TCL_HEADERS 0]} { + if {[$PROJECT config 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 define get tk 0]} { + if {[$PROJECT config 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 define get TEA_PRIVATE_TK_HEADERS 0]} { - if {[$PROJECT define get TEA_PLATFORM] eq "windows"} { + if {[$PROJECT config get TEA_PRIVATE_TK_HEADERS 0]} { + if {[$PROJECT config 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]]] } } @@ -4630,12 +4845,12 @@ lappend includedir $cpath } } my build-cflags $PROJECT $proj(DEFS) name version defs set NAME [string toupper $name] - set debug [$PROJECT define get debug 0] - set os [$PROJECT define get TEACUP_OS] + set debug [$PROJECT config get debug 0] + set os [$PROJECT config get TEACUP_OS] set INCLUDES "-I[join $includedir " -I"]" if {$debug} { set COMPILE "$proj(CC) $proj(CFLAGS_DEBUG) -ggdb \ $proj(CFLAGS_WARNING) $INCLUDES $defs" @@ -4664,61 +4879,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 define get SHARED_BUILD 1]]} { - set cmd [$PROJECT define get PRACTCL_SHARED_LIB] - append cmd " [$PROJECT define get PRACTCL_LIBS]" + 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]" set cmd [string map $map $cmd] puts $cmd exec {*}$cmd >&@ stdout - if {[$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { - set cmd [string map $map [$PROJECT define get PRACTCL_VC_MANIFEST_EMBED_DLL]] + if {[$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL] ni {: {}}} { + set cmd [string map $map [$PROJECT config get PRACTCL_VC_MANIFEST_EMBED_DLL]] puts $cmd exec {*}$cmd >&@ stdout } } else { - set cmd [string map $map [$PROJECT define get PRACTCL_STATIC_LIB]] + set cmd [string map $map [$PROJECT config get PRACTCL_STATIC_LIB]] puts $cmd exec {*}$cmd >&@ stdout } - set ranlib [$PROJECT define get RANLIB] + set ranlib [$PROJECT config get RANLIB] if {$ranlib ni {{} :}} { catch {exec $ranlib $outfile} } } method build-tclsh {outfile PROJECT {path {auto}}} { - if {[my define get tk 0] && [my define get static_tk 0]} { + if {[my Config_get tk 0] && [my Config_get static_tk 0]} { puts " BUILDING STATIC TCL/TK EXE $PROJECT" set TKOBJ [$PROJECT tkcore] if {[info command $TKOBJ] eq {}} { set TKOBJ ::noop - $PROJECT define set static_tk 0 + $PROJECT config set static_tk 0 } else { ::practcl::toolset select $TKOBJ array set TK [$TKOBJ read_configuration] - 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] + 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] } } else { puts " BUILDING STATIC TCL EXE $PROJECT" set TKOBJ ::noop - my define set static_tk 0 + my Config_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 define get static]]} { + if {[string is true [$item config get static]]} { lappend PKG_OBJS $item } } foreach item [$PROJECT link list package] { - if {[string is true [$item define get static]]} { + if {[string is true [$item config get static]]} { lappend PKG_OBJS $item } } array set TCL [$TCLOBJ read_configuration] if {$path in {{} auto}} { @@ -4733,11 +4948,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 define get debug 0] + set debug [$PROJECT config get debug 0] set NAME [string toupper $name] set result {} set libraries {} set thisline {} set OBJECTS {} @@ -4744,22 +4959,22 @@ set EXTERN_OBJS {} foreach obj $PKG_OBJS { $obj compile set config($obj) [$obj read_configuration] } - set os [$PROJECT define get TEACUP_OS] - set TCLSRCDIR [$TCLOBJ define get srcdir] + set os [$PROJECT config get TEACUP_OS] + set TCLSRCDIR [$TCLOBJ config 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 define get static_tk]} { + if {[$PROJECT config 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]] } @@ -4782,24 +4997,24 @@ append COMPILE " " $defs lappend OBJECTS {*}[my build-compile-sources $PROJECT $COMPILE $COMPILE $INCLUDES] set TCLSRC [file normalize $TCLSRCDIR] - if {[${PROJECT} define get TEACUP_OS] eq "windows"} { - set windres [$PROJECT define get RC windres] + if {[${PROJECT} config get TEACUP_OS] eq "windows"} { + set windres [$PROJECT config get RC windres] set RSOBJ [file join $path objs tclkit.res.o] - 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 RCSRC [${PROJECT} config get kit_resource_file] + set RCMAN [${PROJECT} config get kit_manifest_file] + set RCICO [${PROJECT} config get kit_icon_file] set cmd [list $windres -o $RSOBJ -DSTATIC_BUILD --include [::practcl::file_relative $path [file join $TCLSRC generic]]] - if {[$PROJECT define get static_tk]} { + if {[$PROJECT config 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 define get builddir] wish.exe.manifest] + set RCMAN [file join [$TKOBJ config 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] @@ -4809,17 +5024,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 define get builddir] tclsh.exe.manifest] + set RCMAN [file join [$TCLOBJ config get builddir] tclsh.exe.manifest] } if {$RCICO eq {} || ![file exists $RCICO]} { set RCICO [file join $TCLSRCDIR win tclsh.ico] } } - foreach item [${PROJECT} define get resource_include] { + foreach item [${PROJECT} config 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]] @@ -4853,16 +5068,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 define get static_tk]} { + if {[$PROJECT config get static_tk]} { append cmd " -L[file dirname $TK(build_stub_lib_path)] -ltk86g" } } else { append cmd " $TCL(build_lib_spec)" - if {[$PROJECT define get static_tk]} { + if {[$PROJECT config get static_tk]} { append cmd " $TK(build_lib_spec)" } } foreach obj $PKG_OBJS { append cmd " [$obj linker-products $config($obj)]" @@ -4870,11 +5085,11 @@ set LIBS {} foreach item $TCL(libs) { if {[string range $item 0 1] eq "-l" && $item in $LIBS } continue lappend LIBS $item } - if {[$PROJECT define get static_tk]} { + if {[$PROJECT config get static_tk]} { foreach item $TK(libs) { if {[string range $item 0 1] eq "-l" && $item in $LIBS } continue lappend LIBS $item } } @@ -4899,16 +5114,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 define get static_tk]} { + if {[$PROJECT config 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 define get static_tk]} { + if {[$PROJECT config get static_tk]} { append cmd " $TK(build_stub_lib_spec)" } } if {[info exists TCL(cc_search_flags)]} { append cmd " $TCL(cc_search_flags)" @@ -4931,55 +5146,55 @@ # START: class toolset msvc.tcl ### ::clay::define ::practcl::toolset.msvc { superclass ::practcl::toolset method BuildDir {PWD} { - set srcdir [my define get srcdir] + set srcdir [my Config_get srcdir] return $srcdir } Ensemble make::autodetect {} { } Ensemble make::clean {} { set PWD [pwd] - set srcdir [my define get srcdir] + set srcdir [my Config_get srcdir] cd $srcdir catch {::practcl::doexec nmake -f makefile.vc clean} cd $PWD } Ensemble make::compile {} { - set srcdir [my define get srcdir] - if {[my define get static 1]} { + set srcdir [my Config_get srcdir] + if {[my Config_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 define get debug 0]} { + if {[my Config_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> define get installdir] {*}[my NmakeOpts] release + ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> config 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> define get installdir] {*}[my NmakeOpts] release + ::practcl::doexec nmake -f makefile.vc INSTALLDIR=[my <project> config 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 define get srcdir] + set srcdir [my Config_get srcdir] cd $srcdir if {$DEST eq {}} { error "No destination given" } - if {[my <project> define get LOCAL 0] || $DEST eq {}} { + if {[my <project> config 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 { @@ -4999,37 +5214,37 @@ cd $PWD } method MakeDir {srcdir} { set localsrcdir $srcdir if {[file exists [file join $srcdir generic]]} { - my define add include_dir [file join $srcdir generic] + my Config_add include_dir [file join $srcdir generic] } if {[file exists [file join $srcdir win]]} { - my define add include_dir [file join $srcdir win] + my Config_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 define get builddir]] + set builddir [file normalize [my Config_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> define get tclsrcdir] ..]]] - set TCLGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tclsrcdir] .. generic]]] + 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]]] 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> define get tksrcdir] ..]]] - set TKGENERIC [::practcl::file_relative [file normalize $builddir] [file normalize [file join $::CWD [my <project> define get tksrcdir] .. generic]]] + 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]]] #lappend opts --with-tk=$TKSRCDIR --with-tkinclude=$TKGENERIC lappend opts TKDIR=[file normalize $TKSRCDIR] } return $opts } @@ -5045,20 +5260,19 @@ superclass ::practcl::metaclass constructor {module_object name info {action_body {}}} { my variable define triggered domake set triggered 0 set domake 0 - set define(name) $name - set define(action) {} - array set define $info + my Config_set name $name action {} + my Config_merge $info my select my initialize foreach {stub obj} [$module_object child organs] { my graft $stub $obj } if {$action_body ne {}} { - set define(action) $action_body + my Config_set action $action_body } } method do {} { my variable domake return $domake @@ -5071,11 +5285,11 @@ if {[info exists needs_make]} { return $needs_make } set make_objects [my <module> make objects] set needs_make 0 - foreach item [my define get depends] { + foreach item [my Config_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 @@ -5093,15 +5307,15 @@ } return $needs_make } method output {} { set result {} - set filename [my define get filename] + set filename [my Config_get filename] if {$filename ne {}} { lappend result $filename } - foreach filename [my define get files] { + foreach filename [my Config_get files] { if {$filename ne {}} { lappend result $filename } } return $result @@ -5118,11 +5332,11 @@ return $domake } set triggered 1 set make_objects [my <module> make objects] - foreach item [my define get depends] { + foreach item [my Config_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 @@ -5132,11 +5346,11 @@ $depobj triggers } } } set domake 1 - my <module> make trigger {*}[my define get triggers] + my <module> make trigger {*}[my Config_get triggers] } } ### # END: class target.tcl @@ -5145,35 +5359,38 @@ # START: class object.tcl ### ::clay::define ::practcl::object { superclass ::practcl::metaclass constructor {parent args} { - my variable links define + my variable links set organs [$parent child organs] my clay delegate {*}$organs - array set define $organs - array set define [$parent child define] + my Config_merge $organs + my Config_merge [$parent child define] array set links {} if {[llength $args]==1 && [file exists [lindex $args 0]]} { - my define set filename [lindex $args 0] + my Config_set filename [lindex $args 0] ::practcl::product select [self] } elseif {[llength $args] == 1} { set data [uplevel 1 [list subst [lindex $args 0]]] - array set define $data + my Config_merge $data my select } else { - array set define [uplevel 1 [list subst $args]] + my Config_merge [uplevel 1 [list subst $args]] my select } my initialize } - method child {method} { + method Child_delegate {} { + return {} + } + method Child_organs {} { return {} } method go {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable links foreach {linktype objs} [array get links] { foreach obj $objs { $obj go } @@ -5198,17 +5415,17 @@ if {![dict exists $cstruct $name public]} { dict set cstruct $name public 1 } } method include header { - my define add include $header + my Config_add include $header } method include_dir args { - my define add include_dir {*}$args + my Config_add include_dir {*}$args } method include_directory args { - my define add include_dir {*}$args + my Config_add include_dir {*}$args } method c_header body { my variable code ::practcl::cputs code(header) $body } @@ -5333,33 +5550,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 define get output_c] + set filename [my Config_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 define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] } else { - set filename [my define get cfile] + set filename [my Config_get cfile] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] } } foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } @@ -5366,49 +5583,49 @@ return $result } method implement path { my go my Collate_Source $path - 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 + 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 set fout [open $filename w] puts $fout [my generate-c] - if {[my define get initfunc] ne {}} { - puts $fout "extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \x7B" + if {[my Config_get initfunc] ne {}} { + puts $fout "extern int DLLEXPORT [my Config_get initfunc]( Tcl_Interp *interp ) \x7B" puts $fout [my generate-loader-module] - if {[my define get pkg_name] ne {}} { - puts $fout " Tcl_PkgProvide(interp, \"[my define get pkg_name]\", \"[my define get pkg_vers]\");" + if {[my Config_get pkg_name] ne {}} { + puts $fout " Tcl_PkgProvide(interp, \"[my Config_get pkg_name]\", \"[my Config_get pkg_vers]\");" } puts $fout " return TCL_OK\;" puts $fout "\x7D" } close $fout } method initialize {} { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename eq {}} { return } - if {[my define get name] eq {}} { - my define set name [file tail [file rootname $filename]] + if {[my Config_get name] eq {}} { + my Config_set name [file tail [file rootname $filename]] } - if {[my define get localpath] eq {}} { - my define set localpath [my <module> define get localpath]_[my define get name] + if {[my Config_get localpath] eq {}} { + my Config_set localpath [my <module> config get localpath]_[my Config_get name] } ::source $filename } method linktype {} { return {subordinate product dynamic} } method generate-cfile-constant {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} my variable code cstruct methods tcltype if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my define get filename] CONSTANT */" + ::practcl::cputs result "/* [my Config_get filename] CONSTANT */" ::practcl::cputs result $code(constant) } if {[info exists cstruct]} { foreach {name info} $cstruct { set map {} @@ -5478,17 +5695,17 @@ dict set methods $name methodtype $methodtype } } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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) } @@ -5505,13 +5722,13 @@ if {[dict exists $info header]} { ::practcl::cputs result "[dict get $info header]\;" } } } - ::practcl::debug [list methods [info exists methods] [my define get cclass]] + ::practcl::debug [list methods [info exists methods] [my Config_get cclass]] if {[info exists methods]} { - set thisclass [my define get cclass] + set thisclass [my Config_get cclass] foreach {name info} $methods { if {[dict exists $info header]} { ::practcl::cputs result "[dict get $info header]\;" } } @@ -5518,22 +5735,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 define get output_c] ne {}} continue + if {[$obj config get output_c] ne {}} continue set dat [$obj generate-cfile-header] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-header */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-header */" } } return $result } method generate-cfile-tclapi {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code methods tclprocs set result {} if {[info exists code(method)]} { ::practcl::cputs result $code(method) } @@ -5549,11 +5766,11 @@ } } if {[info exists methods]} { - set thisclass [my define get cclass] + set thisclass [my Config_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] @@ -5561,11 +5778,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 define get class]] { + ::practcl::cputs result [string map [list @CCLASS@ $thisclass @TCLCLASS@ [my Config_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 */ @@ -5612,17 +5829,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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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) { @@ -5668,14 +5885,14 @@ Tcl_Export(interp, modPtr, "[a-z]*", 1); }] } ::practcl::cputs result " \}" } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_get filename]] foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} { + if {[$obj config get output_c] ne {}} { ::practcl::cputs result [$obj generate-loader-external] } else { ::practcl::cputs result [$obj generate-loader-module] } } @@ -5682,12 +5899,12 @@ return $result } method Collate_Source CWD { my variable methods code cstruct tclprocs if {[info exists methods]} { - ::practcl::debug [self] methods [my define get cclass] - set thisclass [my define get cclass] + ::practcl::debug [self] methods [my Config_get cclass] + set thisclass [my Config_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 @@ -5704,11 +5921,11 @@ } if {![info exists code(initfuncts)] || "${thisclass}_OO_Init" ni $code(initfuncts)} { lappend code(initfuncts) "${thisclass}_OO_Init" } } - set thisnspace [my define get nspace] + set thisnspace [my Config_get nspace] if {[info exists tclprocs]} { ::practcl::debug [self] tclprocs [dict keys $tclprocs] foreach {name info} $tclprocs { if {![dict exists $info callproc]} { @@ -5739,104 +5956,104 @@ } method Collate_Source CWD {} method project-compile-products {} { set result {} noop { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - 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]] + 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]] } } 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 define get filename]] links [my link list]]" + ::practcl::cputs result "$spaces[list [self] [list class [info object class [self]] filename [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} my variable code cstruct methods tcltype if {[info exists code(constant)]} { - ::practcl::cputs result "/* [my define get filename] CONSTANT */" + ::practcl::cputs result "/* [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config get output_c] ne {}} continue set dat [$obj generate-cfile-header] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-header */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-header */" + ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-header */" } } return $result } method generate-cfile-global {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config get output_c] ne {}} continue set dat [$obj generate-cfile-global] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN [$obj define get filename] generate-cfile-global */" + ::practcl::cputs result "/* BEGIN [$obj config get filename] generate-cfile-global */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END [$obj define get filename] generate-cfile-global */" + ::practcl::cputs result "/* END [$obj config get filename] generate-cfile-global */" } } return $result } method generate-cfile-private-typedef {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(private-typedef)]} { ::practcl::cputs result $code(private-typedef) } @@ -5850,18 +6067,18 @@ ::practcl::cputs result "typedef struct $name ${n}\;" } } } } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(private-structure)]} { ::practcl::cputs result $code(private-structure) } @@ -5872,18 +6089,18 @@ ::practcl::cputs result [dict get $info comment] } ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" } } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cfunct set result {} if {[info exists code(funct)]} { ::practcl::cputs result $code(funct) } @@ -5897,59 +6114,59 @@ } } } foreach obj [my link list product] { # Exclude products that will generate their own C files - if {[$obj define get output_c] ne {}} { + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get output_c] ne {}} continue + if {[$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(public-typedef)]} { ::practcl::cputs result $code(public-typedef) } @@ -5963,18 +6180,18 @@ ::practcl::cputs result "typedef struct $name ${n}\;" } } } } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cstruct set result {} if {[info exists code(public-structure)]} { ::practcl::cputs result $code(public-structure) } @@ -5985,18 +6202,18 @@ ::practcl::cputs result [dict get $info comment] } ::practcl::cputs result "struct $name \{[dict get $info body]\}\;" } } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code tcltype set result {} if {[info exists code(public-header)]} { ::practcl::cputs result $code(public-header) } @@ -6012,40 +6229,40 @@ } } if {[info exists code(public)]} { ::practcl::cputs result $code(public) } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code cfunct tcltype set result {} - if {[my define get initfunc] ne {}} { - ::practcl::cputs result "int [my define get initfunc](Tcl_Interp *interp);" + if {[my Config_get initfunc] ne {}} { + ::practcl::cputs result "int [my Config_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 define get filename]] + set result [::practcl::_tagblock $result c [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set includes {} - foreach item [my define get public-include] { + foreach item [my Config_get public-include] { if {$item ni $includes} { lappend includes $item } } foreach mod [my link list product] { @@ -6056,13 +6273,13 @@ } } return $includes } method generate-hfile-public-verbatim {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set includes {} - foreach item [my define get public-verbatim] { + foreach item [my Config_get public-verbatim] { if {$item ni $includes} { lappend includes $item } } foreach mod [my link list subordinate] { @@ -6073,37 +6290,37 @@ } } return $includes } method generate-loader-external {} { - if {[my define get initfunc] eq {}} { - return "/* [my define get filename] declared not initfunc */" + if {[my Config_get initfunc] eq {}} { + return "/* [my Config_get filename] declared not initfunc */" } - return " if([my define get initfunc](interp)) return TCL_ERROR\;" + return " if([my Config_get initfunc](interp)) return TCL_ERROR\;" } method generate-loader-module {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] my variable code set result {} if {[info exists code(cinit)]} { ::practcl::cputs result $code(cinit) } - if {[my define get initfunc] ne {}} { - ::practcl::cputs result " if([my define get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" + if {[my Config_get initfunc] ne {}} { + ::practcl::cputs result " if([my Config_get initfunc](interp)!=TCL_OK) return TCL_ERROR\;" } - set result [::practcl::_tagblock $result c [my define get filename]] + set result [::practcl::_tagblock $result c [my Config_get filename]] foreach item [my link list product] { - if {[$item define get output_c] ne {}} { + if {[$item config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 @@ -6128,15 +6345,15 @@ } } } method generate-tcl-loader {} { set result {} - 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] + 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] ::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@ @@ -6150,30 +6367,30 @@ }] } return $result } method generate-tcl-pre {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} my variable code if {[info exists code(tcl)]} { - set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] + set result [::practcl::_tagblock $code(tcl) tcl [my Config_get filename]] } if {[info exists code(tcl-pre)]} { - set result [::practcl::_tagblock $code(tcl) tcl [my define get filename]] + set result [::practcl::_tagblock $code(tcl) tcl [my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_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 define get filename]] + set result [::practcl::_tagblock $code(tcl-post) tcl [my Config_get filename]] } foreach mod [my link list product] { ::practcl::cputs result [$mod generate-tcl-post] } return $result @@ -6180,25 +6397,25 @@ } method linktype {} { return {subordinate product} } method Ofile filename { - set lpath [my <module> define get localpath] + set lpath [my <module> config get localpath] if {$lpath eq {}} { - set lpath [my <module> define get name] + set lpath [my <module> config get name] } return ${lpath}_[file rootname [file tail $filename]] } method project-static-packages {} { - set result [my define get static_packages] - set initfunc [my define get initfunc] + set result [my Config_get static_packages] + set initfunc [my Config_get initfunc] if {$initfunc ne {}} { - set pkg_name [my define get pkg_name] + set pkg_name [my Config_get pkg_name] if {$pkg_name ne {}} { dict set result $pkg_name initfunc $initfunc - 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] + 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] } } foreach item [my link list subordinate] { foreach {pkg info} [$item project-static-packages] { dict set result $pkg $info @@ -6205,12 +6422,12 @@ } } return $result } method toolset-include-directory {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set result [my define get include_dir] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + set result [my Config_get include_dir] foreach obj [my link list product] { foreach path [$obj toolset-include-directory] { lappend result $path } } @@ -6223,14 +6440,14 @@ } } oo::objdefine ::practcl::product { method select {object} { - set class [$object define get class] - set mixin [$object define get product] + set class [$object config get class] + set mixin [$object config get product] if {$class eq {} && $mixin eq {}} { - set filename [$object define get filename] + set filename [$object config get filename] if {$filename ne {} && [file exists $filename]} { switch [file extension $filename] { .tcl { set mixin ::practcl::product.dynamic } @@ -6274,20 +6491,20 @@ } ::clay::define ::practcl::product.csource { superclass ::practcl::product method project-compile-products {} { set result {} - set filename [my define get filename] + set filename [my Config_get filename] if {$filename ne {}} { ::practcl::debug [self] [self class] [self method] project-compile-products $filename if {[my define exists ofile]} { - set ofile [my define get ofile] + set ofile [my Config_get ofile] } else { set ofile [my Ofile $filename] - my define set ofile $ofile + my Config_set ofile $ofile } - lappend result $ofile [list cfile $filename extra [my define get extra] external [string is true -strict [my define get external]] object [self]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]] object [self]] } foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } return $result @@ -6294,34 +6511,34 @@ } } ::clay::define ::practcl::product.clibrary { superclass ::practcl::product method linker-products {configdict} { - return [my define get filename] + return [my Config_get filename] } } ::clay::define ::practcl::product.dynamic { superclass ::practcl::dynamic ::practcl::product method initialize {} { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename eq {}} { return } - if {[my define get name] eq {}} { - my define set name [file tail [file rootname $filename]] + if {[my Config_get name] eq {}} { + my Config_set name [file tail [file rootname $filename]] } - if {[my define get localpath] eq {}} { - my define set localpath [my <module> define get localpath]_[my define get name] + if {[my Config_get localpath] eq {}} { + my Config_set localpath [my <module> config get localpath]_[my Config_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 define get output_c] ne {}} { + if {[my Config_get output_c] ne {}} { # Turn into a module if we have an output_c file my morph ::practcl::module } } } @@ -6360,11 +6577,11 @@ ### # Build local variables needed for install ### package require platform set result {} - set dat [my define dump] + set dat [my Config_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 {} @@ -6434,11 +6651,11 @@ } } } Ensemble make::filename name { if {[dict exists $make_object $name]} { - return [[dict get $make_object $name] define get filename] + return [[dict get $make_object $name] config get filename] } } Ensemble make::target {name Info body} { set info [uplevel #0 [list subst $Info]] set nspace [namespace current] @@ -6470,24 +6687,22 @@ } Ensemble make::do {} { global CWD SRCDIR project SANDBOX foreach {name obj} $make_object { if {[$obj do]} { - eval [$obj define get action] + eval [$obj config 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 define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result { /* This file was generated by practcl */ } set includes {} @@ -6496,20 +6711,20 @@ $mod go } set headers {} my IncludeAdd headers <tcl.h> <tclOO.h> - if {[my define get tk 0]} { + if {[my Config_get tk 0]} { my IncludeAdd headers <tk.h> } - if {[my define get output_h] ne {}} { - my IncludeAdd headers [my define get output_h] + if {[my Config_get output_h] ne {}} { + my IncludeAdd headers [my Config_get output_h] } - my IncludeAdd headers {*}[my define get include] + my IncludeAdd headers {*}[my Config_get include] foreach mod [my link list dynamic] { - my IncludeAdd headers {*}[$mod define get include] + my IncludeAdd headers {*}[$mod config get include] } foreach inc $headers { ::practcl::cputs result "#include $inc" } foreach {method} { @@ -6522,20 +6737,20 @@ generate-cfile-functions generate-cfile-tclapi } { set dat [my $method] if {[string length [string trim $dat]]} { - ::practcl::cputs result "/* BEGIN $method [my define get filename] */" + ::practcl::cputs result "/* BEGIN $method [my Config_get filename] */" ::practcl::cputs result $dat - ::practcl::cputs result "/* END $method [my define get filename] */" + ::practcl::cputs result "/* END $method [my Config_get filename] */" } } - ::practcl::debug [list /[self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list /[self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] return $result } method generate-h {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} foreach method { generate-hfile-public-define generate-hfile-public-macro } { @@ -6575,22 +6790,22 @@ ::practcl::cputs result "/* END SECTION $method */" } return $result } method generate-loader {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set result {} - if {[my define get initfunc] eq {}} return + if {[my Config_get initfunc] eq {}} return ::practcl::cputs result " -extern int DLLEXPORT [my define get initfunc]( Tcl_Interp *interp ) \{" +extern int DLLEXPORT [my Config_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 define get tk 0]} { + if {[my Config_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]]} { @@ -6601,25 +6816,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 define get pkg_name [my define get name]]\" , \"[my define get pkg_vers [my define get version]]\" )) return TCL_ERROR\;" + ::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 " return TCL_OK\;\n\}\n" return $result } method initialize {} { - set filename [my define get filename] + set filename [my Config_get filename] if {$filename eq {}} { return } - if {[my define get name] eq {}} { - my define set name [file tail [file dirname $filename]] + if {[my Config_get name] eq {}} { + my Config_set name [file tail [file dirname $filename]] } - if {[my define get localpath] eq {}} { - my define set localpath [my <project> define get name]_[my define get name] + if {[my Config_get localpath] eq {}} { + my Config_set localpath [my <project> config get name]_[my Config_get name] } my graft module [self] ::practcl::debug [self] SOURCE $filename my source $filename } @@ -6627,21 +6842,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 define get filename] $err" + lappend errs "Skipped $item: [$item config 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 define get filename] $err" + lappend errs "Skipped $item: [$item config get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } @@ -6657,12 +6872,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 define get filename] [info object class [self]]] - set filename [my define get output_c] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + set filename [my Config_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] @@ -6716,104 +6931,100 @@ if {[dict exists $rawcontents $field]} { dict set contents $field [dict get $rawcontents $field] } } my graft module [self] - array set define $contents + my Config_merge $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 define get TEACUP_OS] + set os [my Config_get TEACUP_OS] if {$os eq {}} { set os [::practcl::os] - my define set os $os + my Config_set os $os } - set fossilinfo [list download [my define get download] tag trunk sandbox [my define get sandbox]] + set fossilinfo [list download [my Config_get download] tag trunk sandbox [my Config_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 define get profile release]: + set profile [my Config_get profile release]: if {[dict exists $info profile $profile]} { dict set info tag [dict get $info profile $profile] } - dict set info USEMSVC [my define get USEMSVC 0] - dict set info debug [my define get debug 0] + dict set info USEMSVC [my Config_get USEMSVC 0] + dict set info debug [my Config_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 define set masterpath $::CWD + $obj config 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 define get download] tag trunk sandbox [my define get sandbox]] + set fossilinfo [list download [my Config_get download] tag trunk sandbox [my Config_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 define get profile release]: + set profile [my Config_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 define set masterpath $::CWD + $obj config set masterpath $::CWD $obj go return $obj } method build-tclcore {} { - set os [my define get TEACUP_OS] + set os [my Config_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 define get prefix] --exec-prefix [my define get prefix] + lappend tcl_config_opts --prefix [my Config_get prefix] --exec-prefix [my Config_get prefix] set tclobj [my tclcore] - if {[my define get debug 0]} { - $tclobj define set debug 1 + if {[my Config_get debug 0]} { + $tclobj config set debug 1 lappend tcl_config_opts --enable-symbols=true } - $tclobj define set config_opts $tcl_config_opts + $tclobj config set config_opts $tcl_config_opts $tclobj go $tclobj compile - set _TclSrcDir [$tclobj define get localsrcdir] - my define set tclsrcdir $_TclSrcDir - if {[my define get tk 0]} { + set _TclSrcDir [$tclobj config get localsrcdir] + my Config_set tclsrcdir $_TclSrcDir + if {[my Config_get tk 0]} { set tkobj [my tkcore] - 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 --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 --enable-symbols=true } - $tkobj define set config_opts $tk_config_opts + $tkobj config 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 - return [list project [self] module [self]] - } - } + method Child_delegate {} { + return [list project [self] module [self]] + } + method Child_organs {} { + return [list project [self] module [self]] } method linktype {} { return project } method project {pkg args} { @@ -6883,11 +7094,11 @@ # START: class project library.tcl ### ::clay::define ::practcl::library { superclass ::practcl::project method clean {PATH} { - set objext [my define get OBJEXT o] + set objext [my Config_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} } } @@ -6895,11 +7106,11 @@ file delete $ofile } foreach ofile [glob -nocomplain [file join $PATH objs *]] { file delete $ofile } - set libfile [my define get libfile] + set libfile [my Config_get libfile] if {[file exists [file join $PATH $libfile]]} { file delete [file join $PATH $libfile] } my implement $PATH } @@ -6906,68 +7117,68 @@ method project-compile-products {} { set result {} foreach item [my link list subordinate] { lappend result {*}[$item project-compile-products] } - set filename [my define get output_c] + set filename [my Config_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 define get extra] external [string is true -strict [my define get external]]] + lappend result $ofile [list cfile $filename extra [my Config_get extra] external [string is true -strict [my Config_get external]]] } return $result } method go {} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] - set name [my define getnull name] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] + set name [my Config_get name] if {$name eq {}} { set name generic my define name generic } - if {[my define get tk] eq {@TEA_TK_EXTENSION@}} { - my define set tk 0 + if {[my Config_get tk] eq {@TEA_TK_EXTENSION@}} { + my Config_set tk 0 } - set output_c [my define getnull output_c] + set output_c [my Config_get output_c] if {$output_c eq {}} { set output_c [file rootname $name].c - my define set output_c $output_c + my Config_set output_c $output_c } - set output_h [my define getnull output_h] + set output_h [my Config_get output_h] if {$output_h eq {}} { set output_h [file rootname $output_c].h - my define set output_h $output_h + my Config_set output_h $output_h } - set output_tcl [my define getnull output_tcl] + set output_tcl [my Config_get output_tcl] #if {$output_tcl eq {}} { # set output_tcl [file rootname $output_c].tcl - # my define set output_tcl $output_tcl + # my Config_set output_tcl $output_tcl #} - #set output_mk [my define getnull output_mk] + #set output_mk [my Config_get output_mk] #if {$output_mk eq {}} { # set output_mk [file rootname $output_c].mk - # my define set output_mk $output_mk + # my Config_set output_mk $output_mk #} - set initfunc [my define getnull initfunc] + set initfunc [my Config_get initfunc] if {$initfunc eq {}} { set initfunc [string totitle $name]_Init - my define set initfunc $initfunc + my Config_set initfunc $initfunc } - set output_decls [my define getnull output_decls] + set output_decls [my Config_get output_decls] if {$output_decls eq {}} { set output_decls [file rootname $output_c].decls - my define set output_decls $output_decls + my Config_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 define get filename] [info object class [self]]] + ::practcl::debug [list /[self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] } method generate-decls {pkgname path} { - ::practcl::debug [list [self] [self method] [self class] -- [my define get filename] [info object class [self]]] + ::practcl::debug [list [self] [self method] [self class] -- [my Config_get filename] [info object class [self]]] set outfile [file join $path/$pkgname.decls] ### # Build the decls file ## # @@ -6989,12 +7200,12 @@ set thisline {} set functcount 0 foreach {func header} $stubfuncts { puts $fout [list declare [incr functcount] $header] } - 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)"] + 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)"] close $fout ### # Build [package]Decls.h @@ -7061,21 +7272,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 define get filename] $err" + lappend errs "Skipped $item: [$item config 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 define get filename] $err" + lappend errs "Skipped $item: [$item config get filename] $err" if {[dict exists $errdat -errorinfo]} { lappend errs [dict get $errdat -errorinfo] } else { lappend errs $errdat } @@ -7091,21 +7302,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 define get output_c]] w] + set cout [open [file join $path [my Config_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 define get output_h]]]_H - set hout [open [file join $path [my define get output_h]] w] + 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] 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}" @@ -7112,13 +7323,13 @@ puts $hout "#define ${macro} 1" puts $hout [my generate-h] puts $hout "#endif" close $hout - set output_tcl [my define get output_tcl] + set output_tcl [my Config_get output_tcl] if {$output_tcl ne {}} { - set tclout [open [file join $path [my define get output_tcl]] w] + set tclout [open [file join $path [my Config_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] @@ -7133,20 +7344,20 @@ method linktype {} { return library } method package-ifneeded {args} { set result {} - set name [my define get pkg_name [my define get name]] - set version [my define get pkg_vers [my define get version]] + set name [my Config_get pkg_name [my Config_get name]] + set version [my Config_get pkg_vers [my Config_get version]] if {$version eq {}} { set version 0.1a } - set output_tcl [my define get output_tcl] + set output_tcl [my Config_get output_tcl] if {$output_tcl ne {}} { set script "\[list source \[file join \$dir $output_tcl\]\]" - } elseif {[my define get SHARED_BUILD 0]} { - set script "\[list load \[file join \$dir [my define get libfile]\] $name\]" + } elseif {[my Config_get SHARED_BUILD 0]} { + set script "\[list load \[file join \$dir [my Config_get libfile]\] $name\]" } else { # Provide a null passthrough set script "\[list package provide $name $version\]" } set result "package ifneeded [list $name] [list $version] $script" @@ -7155,31 +7366,31 @@ append result \n\n [list package ifneeded $alias $version $script] } return $result } method shared_library {{filename {}}} { - set name [string tolower [my define get name [my define get pkg_name]]] + set name [string tolower [my Config_get name [my Config_get pkg_name]]] set NAME [string toupper $name] - set version [my define get version [my define get pkg_vers]] + set version [my Config_get version [my Config_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 define getnull libprefix] - set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]][my define get SHLIB_SUFFIX] + lappend map %LIBRARY_PREFIX% [my Config_get libprefix] + set outfile [string map $map [my Config_get PRACTCL_NAME_LIBRARY]][my Config_get SHLIB_SUFFIX] return $outfile } method static_library {{filename {}}} { - set name [string tolower [my define get name [my define get pkg_name]]] + set name [string tolower [my Config_get name [my Config_get pkg_name]]] set NAME [string toupper $name] - set version [my define get version [my define get pkg_vers]] + set version [my Config_get version [my Config_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 define getnull libprefix] - set outfile [string map $map [my define get PRACTCL_NAME_LIBRARY]].a + lappend map %LIBRARY_PREFIX% [my Config_get libprefix] + set outfile [string map $map [my Config_get PRACTCL_NAME_LIBRARY]].a return $outfile } } ### @@ -7243,14 +7454,14 @@ } # Build an area of the file for #define directives and # function declarations set define {} - 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 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 vfs_main "${vfsroot}/${mainscript}" set map {} foreach var { vfsroot mainhook mainfunc vfs_main @@ -7282,23 +7493,22 @@ append preinitscript \n $script if {[dict get $info autoload]} { append main_init_script \n [list ::load {} $statpkg] } } - append preinitscript \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 { # Specify a user-specific startup file to invoke if the application # is run interactively. Typically the startup file is "~/.apprc" # where "app" is the name of the application. If this line is deleted # then no user-specific startup file will be run under any conditions. } - append main_init_script \n [list set tcl_rcFileName [$PROJECT define get tcl_rcFileName ~/.tclshrc]] + 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 preinitscript \n [list set ::starkit::thread_init $thread_init_script] append preinitscript \n {eval $::starkit::thread_init} set zvfsboot { /* * %mainhook% -- @@ -7311,11 +7521,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 define get tip_430 0]} { + if {![$PROJECT config 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, @@ -7363,11 +7573,11 @@ } }])\;" ::practcl::cputs zvfsboot " \x7D" ::practcl::cputs zvfsboot " return TCL_OK;" - if {[$PROJECT define get TEACUP_OS] eq "windows"} { + if {[$PROJECT config 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] @@ -7380,11 +7590,11 @@ if ((Tcl_Init)(interp) == TCL_ERROR) { return TCL_ERROR; } } - if {![$PROJECT define get tip_430 0]} { + if {![$PROJECT config get tip_430 0]} { ::practcl::cputs appinit { TclZipfs_Init(interp);} } foreach {statpkg info} $statpkglist { set initfunc {} if {[dict exists $info initfunc]} { @@ -7411,57 +7621,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 define get name] + set name [my Config_get name] # Assume a static shell if {[my define exists SHARED_BUILD]} { - my define set SHARED_BUILD 0 + my Config_set SHARED_BUILD 0 } if {![my define exists TCL_LOCAL_APPINIT]} { - my define set TCL_LOCAL_APPINIT Tclkit_AppInit + my Config_set TCL_LOCAL_APPINIT Tclkit_AppInit } if {![my define exists TCL_LOCAL_MAIN_HOOK]} { - my define set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook + my Config_set TCL_LOCAL_MAIN_HOOK Tclkit_MainHook } set PROJECT [self] - set os [$PROJECT define get TEACUP_OS] - if {[my define get SHARED_BUILD 0]} { + set os [$PROJECT config get TEACUP_OS] + if {[my Config_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 define get srcdir] + set TCLSRCDIR [$TCLOBJ config get srcdir] set PKG_OBJS {} foreach item [$PROJECT link list core.library] { - if {[string is true [$item define get static]]} { + if {[string is true [$item config get static]]} { lappend PKG_OBJS $item } } foreach item [$PROJECT link list package] { - if {[string is true [$item define get static]]} { + if {[string is true [$item config 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 define get SHARED_BUILD 0]} { + if {![my Config_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 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]] + 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]] } else { set PLATFORM_SRC_DIR unix - 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]] + 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]] } - if {![my define get SHARED_BUILD 0]} { + if {![my Config_get SHARED_BUILD 0]} { ### # Add local static Zlib implementation ### set cdir [file join $TCLSRCDIR compat zlib] foreach file { @@ -7477,57 +7687,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 define set ZIPFS_VOLUME "zipfs:/" + $PROJECT config set ZIPFS_VOLUME "zipfs:/" } - $PROJECT code header "#define ZIPFS_VOLUME \"[$PROJECT define get ZIPFS_VOLUME]\"" + $PROJECT code header "#define ZIPFS_VOLUME \"[$PROJECT config get ZIPFS_VOLUME]\"" if {[file exists $zipfs]} { - $TCLOBJ define set tip_430 1 - my define set tip_430 1 + $TCLOBJ config set tip_430 1 + my Config_set tip_430 1 } else { # The Tclconfig project maintains a mirror of the version # released with the Tcl core - my define set tip_430 0 - set tclzipfs_c [my define get tclzipfs_c] + my Config_set tip_430 0 + set tclzipfs_c [my Config_get tclzipfs_c] if {![file exists $tclzipfs_c]} { ::practcl::LOCAL tool tclconfig unpack - set COMPATSRCROOT [::practcl::LOCAL tool tclconfig define get srcdir] + set COMPATSRCROOT [::practcl::LOCAL tool tclconfig config 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 define add include_dir [file join $TCLSRCDIR generic] - my define add include_dir [file join $TCLSRCDIR $PLATFORM_SRC_DIR] + my Config_add include_dir [file join $TCLSRCDIR generic] + my Config_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 define get name] - set libsrcdir [$item define get srcdir] + set name [$item config get name] + set libsrcdir [$item config 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 define get installdir] ne {}} { - # ::practcl::copyDir [file join [my define get installdir] [string trimleft [my define get prefix] /] lib] [file join $vfspath lib] + #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] #} foreach arg $args { ::practcl::copyDir $arg $vfspath } set fout [open [file join $vfspath pkgIndex.tcl] w] - puts $fout [string map [list %platform% [my define get TEACUP_PROFILE]] {set ::tcl_teapot_profile {%platform%}}] + puts $fout [string map [list %platform% [my Config_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"} { @@ -7559,14 +7769,14 @@ } } } close $fout - set EXEEXT [my define get EXEEXT] - set tclkit_bare [my define get tclkit_bare] + set EXEEXT [my Config_get EXEEXT] + set tclkit_bare [my Config_get tclkit_bare] ::practcl::mkzip ${exename}${EXEEXT} $tclkit_bare $vfspath - if { [my define get TEACUP_OS] ne "windows" } { + if { [my Config_get TEACUP_OS] ne "windows" } { file attributes ${exename}${EXEEXT} -permissions a+x } } } @@ -7585,35 +7795,35 @@ tags {} isodate {} } } method DistroMixIn {} { - my define set scm none + my Config_set scm none } method Sandbox {} { if {[my define exists sandbox]} { - return [my define get sandbox] + return [my Config_get sandbox] } if {[my clay delegate project] ni {::noop {}}} { - set sandbox [my <project> define get sandbox] + set sandbox [my <project> config get sandbox] if {$sandbox ne {}} { - my define set sandbox $sandbox + my Config_set sandbox $sandbox return $sandbox } } set sandbox [file normalize [file join $::CWD ..]] - my define set sandbox $sandbox + my Config_set sandbox $sandbox return $sandbox } method SrcDir {} { - set pkg [my define get name] + set pkg [my Config_get name] if {[my define exists srcdir]} { - return [my define get srcdir] + return [my Config_get srcdir] } set sandbox [my Sandbox] set srcdir [file join [my Sandbox] $pkg] - my define set srcdir $srcdir + my Config_set srcdir $srcdir return $srcdir } method ScmTag {} {} method ScmClone {} {} method ScmUnpack {} {} @@ -7621,14 +7831,14 @@ method Unpack {} { set srcdir [my SrcDir] if {[file exists $srcdir]} { return } - set pkg [my define get name] + set pkg [my Config_get name] if {[my define exists download]} { # Utilize a staged download - set download [my define get download] + set download [my Config_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 } @@ -7637,61 +7847,61 @@ } } oo::objdefine ::practcl::distribution { method Sandbox {object} { if {[$object define exists sandbox]} { - return [$object define get sandbox] + return [$object config get sandbox] } if {[$object clay delegate project] ni {::noop {}}} { - set sandbox [$object <project> define get sandbox] + set sandbox [$object <project> config get sandbox] if {$sandbox ne {}} { - $object define set sandbox $sandbox + $object config set sandbox $sandbox return $sandbox } } - set pkg [$object define get name] + set pkg [$object config get name] set sandbox [file normalize [file join $::CWD ..]] - $object define set sandbox $sandbox + $object config set sandbox $sandbox return $sandbox } method select object { if {[$object define exists scm]} { - return [$object define get scm] + return [$object config get scm] } - set pkg [$object define get name] - if {[$object define get srcdir] ne {}} { - set srcdir [$object define get srcdir] + set pkg [$object config get name] + if {[$object config get srcdir] ne {}} { + set srcdir [$object config get srcdir] } else { set srcdir [file join [my Sandbox $object] $pkg] - $object define set srcdir $srcdir + $object config 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 define set scm $name + $object config 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 define set scm $name + $object config set scm $name return $name } } - if {[$object define get scm] eq {} && [$object define exists file_url]} { + if {[$object config get scm] eq {} && [$object define exists file_url]} { set class ::practcl::distribution.snapshot set name [$class claim_option] - $object define set scm $name + $object config set scm $name $object clay mixinmap distribution $class return $name } error "Cannot determine source distribution method" } @@ -7720,12 +7930,12 @@ method ScmUnpack {} { set srcdir [my SrcDir] if {[file exists [file join $srcdir .download]]} { return 0 } - set dpath [::practcl::LOCAL define get download] - set url [my define get file_url] + set dpath [::practcl::LOCAL config get download] + set url [my Config_get file_url] set fname [file tail $url] set archive [file join $dpath $fname] if {![file exists $archive]} { ::http::wget $url $archive } @@ -7782,11 +7992,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 define get srcdir]] { + foreach {field value} [::practcl::fossil_status [my Config_get srcdir]] { dict set info $field $value } return $info } method ScmClone {} { @@ -7799,19 +8009,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 define get name] + set pkg [my Config_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 define get download] + set download [::practcl::LOCAL config get download] set fosdb [file join $download $pkg.fos] if {[file exists $fosdb]} { return $fosdb } @@ -7822,23 +8032,23 @@ } set cloned 0 # Attempt to clone from a local network mirror if {[::practcl::LOCAL define exists fossil_mirror]} { - set localmirror [::practcl::LOCAL define get fossil_mirror] + set localmirror [::practcl::LOCAL config 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 define get fossil_url] ne {}} { + if {[my Config_get fossil_url] ne {}} { catch { - ::practcl::doexec fossil clone [my define get fossil_url] $fosdb + ::practcl::doexec fossil clone [my Config_get fossil_url] $fosdb set cloned 1 } if {$cloned} { return $fosdb } @@ -7847,18 +8057,18 @@ ::practcl::doexec fossil clone http://fossil.etoyoc.com/fossil/$pkg $fosdb return $fosdb } method ScmTag {} { if {[my define exists scm_tag]} { - return [my define get scm_tag] + return [my Config_get scm_tag] } if {[my define exists tag]} { - set tag [my define get tag] + set tag [my Config_get tag] } else { set tag trunk } - my define set scm_tag $tag + my Config_set scm_tag $tag return $tag } method ScmUnpack {} { set srcdir [my SrcDir] if {[file exists [file join $srcdir .fslckout]]} { @@ -7885,15 +8095,15 @@ } oo::objdefine ::practcl::distribution.fossil { # Check for markers in the metadata method claim_object obj { - set path [$obj define get srcdir] + set path [$obj config get srcdir] if {[my claim_path $path]} { return true } - if {[$obj define get fossil_url] ne {}} { + if {[$obj config get fossil_url] ne {}} { return true } return false } @@ -7921,30 +8131,30 @@ ### ::clay::define ::practcl::distribution.git { superclass ::practcl::distribution method ScmTag {} { if {[my define exists scm_tag]} { - return [my define get scm_tag] + return [my Config_get scm_tag] } if {[my define exists tag]} { - set tag [my define get tag] + set tag [my Config_get tag] } else { set tag master } - my define set scm_tag $tag + my Config_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 define get name] + set pkg [my Config_get name] if {[my define exists git_url]} { - ::practcl::doexec git clone --branch $tag [my define get git_url] $srcdir + ::practcl::doexec git clone --branch $tag [my Config_get git_url] $srcdir } else { ::practcl::doexec git clone --branch $tag https://github.com/eviltwinskippy/$pkg $srcdir } return 1 } @@ -7960,15 +8170,15 @@ } } oo::objdefine ::practcl::distribution.git { method claim_object obj { - set path [$obj define get srcdir] + set path [$obj config get srcdir] if {[my claim_path $path]} { return true } - if {[$obj define get git_url] ne {}} { + if {[$obj config get git_url] ne {}} { return true } return false } @@ -7994,28 +8204,24 @@ superclass ::practcl::module method _MorphPatterns {} { return {{::practcl::subproject.@name@} {::practcl::@name@} {@name@} {::practcl::subproject}} } method BuildDir {PWD} { - 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 - return [list project [self] module [self]] - } - } + return [my Config_get srcdir] + } + method Child_delegate {} { + return [list project [self] module [self]] + } + method Child_organs {} { + return [list project [self] module [self]] } method compile {} {} method go {} { ::practcl::distribution select [self] - 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]] + 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]] my sources } method install args {} method linktype {} { return {subordinate package} @@ -8034,11 +8240,11 @@ return [dict get $configdict PRACTCL_LINKER_EXTRA] } return {} } method env-bootstrap {} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] package require $pkg } method env-exec {} {} method env-install {} { my unpack @@ -8053,11 +8259,11 @@ } my env-bootstrap set loaded 1 } method env-present {} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] if {[catch [list package require $pkg]]} { return 0 } return 1 } @@ -8074,49 +8280,49 @@ } } ::clay::define ::practcl::subproject.source { superclass ::practcl::subproject ::practcl::library method env-bootstrap {} { - set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] + set LibraryRoot [file join [my Config_get srcdir] [my Config_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 define get srcdir] + set path [my Config_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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] package require $pkg } method env-install {} { - set pkg [my define get pkg_name [my define get name]] - set download [my <project> define get download] + set pkg [my Config_get pkg_name [my Config_get name]] + set download [my <project> config get download] my unpack - set prefix [string trimleft [my <project> define get prefix] /] + set prefix [string trimleft [my <project> config 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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] if {[catch [list package require $pkg]]} { return 0 } return 1 } method install DEST { - set pkg [my define get pkg_name [my define get name]] - set download [my <project> define get download] + set pkg [my Config_get pkg_name [my Config_get name]] + set download [my <project> config get download] my unpack - set prefix [string trimleft [my <project> define get prefix] /] + set prefix [string trimleft [my <project> config 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 { @@ -8123,11 +8329,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 define get srcdir] kettle] + set kettle [file join [::practcl::LOCAL tool kettle config get srcdir] kettle] } set srcdir [my SourceRoot] ::practcl::dotclexec $kettle -f [file join $srcdir build.tcl] {*}$args } method install DEST { @@ -8135,58 +8341,58 @@ } } ::clay::define ::practcl::subproject.critcl { superclass ::practcl::subproject method install DEST { - my critcl -pkg [my define get name] + my critcl -pkg [my Config_get name] set srcdir [my SourceRoot] - ::practcl::copyDir [file join $srcdir [my define get name]] [file join $DEST lib [my define get name]] + ::practcl::copyDir [file join $srcdir [my Config_get name]] [file join $DEST lib [my Config_get name]] } } ::clay::define ::practcl::subproject.sak { superclass ::practcl::subproject method env-bootstrap {} { - set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] + set LibraryRoot [file join [my Config_get srcdir] [my Config_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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set srcdir [my Config_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 define get srcdir] + set path [my Config_get srcdir] return [file exists $path] } method install DEST { ### # Handle teapot installs ### - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - set prefix [string trimleft [my <project> define get prefix] /] - set srcdir [my define get srcdir] + set prefix [string trimleft [my <project> config get prefix] /] + set srcdir [my Config_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 define get srcdir] + set srcdir [my Config_get srcdir] if {[llength $args]==1 && [lindex $args 0] in {* all}} { - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_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 { @@ -8197,39 +8403,39 @@ } } ::clay::define ::practcl::subproject.practcl { superclass ::practcl::subproject method env-bootstrap {} { - set LibraryRoot [file join [my define get srcdir] [my define get module_root modules]] + set LibraryRoot [file join [my Config_get srcdir] [my Config_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 define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set srcdir [my Config_get srcdir] ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $prefix lib $pkg] } method install DEST { ### # Handle teapot installs ### - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] my unpack - 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]] + 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]] ::practcl::dotclexec [file join $srcdir make.tcl] install [file join $DEST $prefix lib $pkg] } method install-module {DEST args} { - set pkg [my define get pkg_name [my define get name]] - set srcdir [my define get srcdir] + set pkg [my Config_get pkg_name [my Config_get name]] + set srcdir [my Config_get srcdir] ::practcl::dotclexec [file join $srcdir make.tcl] install-module $DEST {*}$args } } ### @@ -8239,11 +8445,11 @@ # START: class subproject binary.tcl ### ::clay::define ::practcl::subproject.binary { superclass ::practcl::subproject method clean {} { - set builddir [file normalize [my define get builddir]] + set builddir [file normalize [my Config_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} @@ -8251,44 +8457,44 @@ } method env-install {} { ### # Handle tea installs ### - set pkg [my define get pkg_name [my define get name]] + set pkg [my Config_get pkg_name [my Config_get name]] set os [::practcl::local_os] - my define set os $os + my Config_set os $os my unpack - set prefix [my <project> define get prefix [file normalize [file join ~ tcl]]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] + set srcdir [my Config_get srcdir] lappend options --prefix $prefix --exec-prefix $prefix - my define set config_opts $options + my Config_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 define get install] { + switch [my Config_get install] { static { - my define set static 1 - my define set autoload 0 + my Config_set static 1 + my Config_set autoload 0 } static-autoload { - my define set static 1 - my define set autoload 1 + my Config_set static 1 + my Config_set autoload 1 } vfs { - my define set static 0 - my define set autoload 0 - my define set vfsinstall 1 + my Config_set static 0 + my Config_set autoload 0 + my Config_set vfsinstall 1 } null { - my define set static 0 - my define set autoload 0 - my define set vfsinstall 0 + my Config_set static 0 + my Config_set autoload 0 + my Config_set vfsinstall 0 } default { } } @@ -8296,46 +8502,46 @@ } method go {} { next ::practcl::distribution select [self] my ComputeInstall - my define set builddir [my BuildDir [my define get masterpath]] + my Config_set builddir [my BuildDir [my Config_get masterpath]] } method linker-products {configdict} { - if {![my define get static 0]} { + if {![my Config_get static 0]} { return {} } - set srcdir [my define get builddir] + set srcdir [my Config_get builddir] if {[dict exists $configdict libfile]} { return " [file join $srcdir [dict get $configdict libfile]]" } } method project-static-packages {} { - if {![my define get static 0]} { + if {![my Config_get static 0]} { return {} } - set result [my define get static_packages] - set statpkg [my define get static_pkg] - set initfunc [my define get initfunc] + set result [my Config_get static_packages] + set statpkg [my Config_get static_pkg] + set initfunc [my Config_get initfunc] if {$initfunc ne {}} { - set pkg_name [my define get pkg_name] + set pkg_name [my Config_get pkg_name] if {$pkg_name ne {}} { dict set result $pkg_name initfunc $initfunc - set version [my define get version] + set version [my Config_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 define set version $version + my Config_set version $version } dict set result $pkg_name version $version - dict set result $pkg_name autoload [my define get autoload 0] + dict set result $pkg_name autoload [my Config_get autoload 0] } } foreach item [my link list subordinate] { foreach {pkg info} [$item project-static-packages] { dict set result $pkg $info @@ -8342,35 +8548,35 @@ } } return $result } method BuildDir {PWD} { - 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]] + 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]] } if {$debug} { - return [my define get builddir [file join $PWD debug $name]] + return [my Config_get builddir [file join $PWD debug $name]] } else { - return [my define get builddir [file join $PWD pkg $name]] + return [my Config_get builddir [file join $PWD pkg $name]] } } method compile {} { - set name [my define get name] + set name [my Config_get name] set PWD $::CWD cd $PWD my unpack set srcdir [file normalize [my SrcDir]] set localsrcdir [my MakeDir $srcdir] - my define set localsrcdir $localsrcdir + my Config_set localsrcdir $localsrcdir my Collate_Source $PWD ### # Build a starter VFS for both Tcl and wish ### - set srcdir [my define get srcdir] - if {[my define get static 1]} { + set srcdir [my Config_get srcdir] + if {[my Config_get static 1]} { puts "BUILDING Static $name $srcdir" } else { puts "BUILDING Dynamic $name $srcdir" } my make compile @@ -8378,26 +8584,26 @@ } method Configure {} { cd $::CWD my unpack ::practcl::toolset select [self] - set srcdir [file normalize [my define get srcdir]] - set builddir [file normalize [my define get builddir]] + set srcdir [file normalize [my Config_get srcdir]] + set builddir [file normalize [my Config_get builddir]] file mkdir $builddir my make autodetect } method install DEST { set PWD [pwd] - set PREFIX [my <project> define get prefix] + set PREFIX [my <project> config get prefix] ### # Handle teapot installs ### - 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 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 found 0 - foreach ver [my define get pkg_vers [my define get version]] { + foreach ver [my Config_get pkg_vers [my Config_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 @@ -8433,29 +8639,29 @@ ### ::clay::define ::practcl::subproject.core { superclass ::practcl::subproject.binary method env-bootstrap {} {} method env-present {} { - set PREFIX [my <project> define get prefix] - set name [my define get name] + set PREFIX [my <project> config get prefix] + set name [my Config_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> define get prefix [file normalize [file join ~ tcl]]] + set prefix [my <project> config get prefix [file normalize [file join ~ tcl]]] lappend options --prefix $prefix --exec-prefix $prefix - my define set config_opts $options + my Config_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 define set core_binary 1 + my Config_set core_binary 1 next } method linktype {} { return {subordinate core.library} } @@ -8468,12 +8674,12 @@ # START: class tool.tcl ### set ::practcl::MAIN ::practcl::LOCAL set ::auto_index(::practcl::LOCAL) { ::practcl::project create ::practcl::LOCAL - ::practcl::LOCAL define set [::practcl::local_os] - ::practcl::LOCAL define set LOCAL 1 + ::practcl::LOCAL config set [::practcl::local_os] + ::practcl::LOCAL config 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 { @@ -8498,12 +8704,12 @@ method env-bootstrap {} { package require critcl::app } method env-install {} { my unpack - set prefix [my <project> define get prefix [file join [file normalize ~] tcl]] - set srcdir [my define get srcdir] + set prefix [my <project> config get prefix [file join [file normalize ~] tcl]] + set srcdir [my Config_get srcdir] ::practcl::dotclexec [file join $srcdir build.tcl] install [file join $prefix lib] } } ::practcl::LOCAL add_tool odie { tag trunk class subproject.source