Browse Source

bootsupport recursion fix

master
Julian Noble 9 months ago
parent
commit
9013ca5807
  1. 5
      src/bootsupport/include_modules.config
  2. 390
      src/bootsupport/modules/oolib-0.1.tm
  3. 386
      src/bootsupport/modules/punk/cap-0.1.0.tm
  4. 52
      src/bootsupport/modules/punk/cap/handlers/caphandler-0.1.0.tm
  5. 52
      src/bootsupport/modules/punk/cap/handlers/scriptlibs-0.1.0.tm
  6. 127
      src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm
  7. 8
      src/bootsupport/modules/punk/mix-0.2.tm
  8. 1812
      src/bootsupport/modules/punk/mix/base-0.1.tm
  9. 2
      src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm
  10. 10
      src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm
  11. 37
      src/bootsupport/modules/punk/mix/templates-0.1.0.tm
  12. 316
      src/bootsupport/modules/punk/overlay-0.1.tm
  13. 152
      src/make.tcl
  14. 390
      src/mixtemplates/layouts/basic/src/bootsupport/modules/oolib-0.1.tm
  15. 386
      src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap-0.1.0.tm
  16. 52
      src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap/handlers/caphandler-0.1.0.tm
  17. 52
      src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap/handlers/scriptlibs-0.1.0.tm
  18. 127
      src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm
  19. 8
      src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix-0.2.tm
  20. 1812
      src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/base-0.1.tm
  21. 2
      src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm
  22. 10
      src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm
  23. 37
      src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/templates-0.1.0.tm
  24. 316
      src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/overlay-0.1.tm
  25. 152
      src/mixtemplates/layouts/basic/src/make.tcl
  26. 6
      src/modules/punk/cap/handlers/templates-999999.0a1.0.tm
  27. 390
      src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/oolib-0.1.tm
  28. 386
      src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap-0.1.0.tm
  29. 52
      src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap/handlers/caphandler-0.1.0.tm
  30. 52
      src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap/handlers/scriptlibs-0.1.0.tm
  31. 127
      src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm
  32. 8
      src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix-0.2.tm
  33. 1812
      src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/base-0.1.tm
  34. 2
      src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm
  35. 10
      src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm
  36. 37
      src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/templates-0.1.0.tm
  37. 316
      src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/overlay-0.1.tm
  38. 152
      src/modules/punk/mix/templates/layouts/project/src/make.tcl

5
src/bootsupport/include_modules.config

@ -31,3 +31,8 @@ set bootsupport_modules [list\
modules punk::tdl\
modules punk::winpath\
]
#Don't include punk/mix/templates - recursive bootsupport problem!
set bootsupport_module_folders [list\
]

390
src/bootsupport/modules/oolib-0.1.tm

@ -1,195 +1,195 @@
#JMN - api should be kept in sync with package patternlib where possible
#
package provide oolib [namespace eval oolib {
variable version
set version 0.1
}]
namespace eval oolib {
oo::class create collection {
variable o_data ;#dict
variable o_alias
constructor {} {
set o_data [dict create]
}
method info {} {
return [dict info $o_data]
}
method count {} {
return [dict size $o_data]
}
method isEmpty {} {
expr {[dict size $o_data] == 0}
}
method names {{globOrIdx {}}} {
if {[llength $globOrIdx]} {
if {[string is integer -strict $globOrIdx]} {
if {$idx < 0} {
set idx "end-[expr {abs($idx + 1)}]"
}
if {[catch {lindex [dict keys $o_data] $idx} result]} {
error "[self object] no such index : '$idx'"
} else {
return $result
}
} else {
#glob
return [lsearch -glob -all -inline [dict keys $o_data] $globOrIdx]
}
} else {
return [dict keys $o_data]
}
}
#like names but without globbing
method keys {} {
dict keys $o_data
}
method key {{posn 0}} {
if {$posn < 0} {
set posn "end-[expr {abs($posn + 1)}]"
}
if {[catch {lindex [dict keys $o_data] $posn} result]} {
error "[self object] no such index : '$posn'"
} else {
return $result
}
}
method hasKey {key} {
dict exists $o_data $key
}
method get {} {
return $o_data
}
method items {} {
return [dict values $o_data]
}
method item {key} {
if {[string is integer -strict $key]} {
if {$key > 0} {
set valposn [expr {(2*$key) +1}]
return [lindex $o_data $valposn]
} else {
set key "end-[expr {abs($key + 1)}]"
return [lindex [dict keys $o_data] $key]
}
}
if {[dict exists $o_data $key]} {
return [dict get $o_data $key]
}
}
#inverse lookup
method itemKeys {value} {
set value_indices [lsearch -all [dict values $o_data] $value]
set keylist [list]
foreach i $value_indices {
set idx [expr {(($i + 1) *2) -2}]
lappend keylist [lindex $o_data $idx]
}
return $keylist
}
method search {value args} {
set matches [lsearch {*}$args [dict values $o_data] $value]
if {"-inline" in $args} {
return $matches
} else {
set keylist [list]
foreach i $matches {
set idx [expr {(($i + 1) *2) -2}]
lappend keylist [lindex $o_data $idx]
}
return $keylist
}
}
#review - see patternlib. Is the intention for aliases to be configurable independent of whether the target exists?
method alias {newAlias existingKeyOrAlias} {
if {[string is integer -strict $newAlias]} {
error "[self object] collection key alias cannot be integer"
}
if {[string length $existingKeyOrAlias]} {
set o_alias($newAlias) $existingKeyOrAlias
} else {
unset o_alias($newAlias)
}
}
method aliases {{key ""}} {
if {[string length $key]} {
set result [list]
foreach {n v} [array get o_alias] {
if {$v eq $key} {
lappend result $n $v
}
}
return $result
} else {
return [array get o_alias]
}
}
#if the supplied index is an alias, return the underlying key; else return the index supplied.
method realKey {idx} {
if {[catch {set o_alias($idx)} key]} {
return $idx
} else {
return $key
}
}
method add {value key} {
if {[string is integer -strict $key]} {
error "[self object] collection key must not be an integer. Use another structure if integer keys required"
}
if {[dict exists $o_data $key]} {
error "[self object] col_processors object error: key '$key' already exists in collection"
}
dict set o_data $key $value
return [expr {[dict size $o_data] - 1}] ;#return index of item
}
method remove {idx {endRange ""}} {
if {[string length $endRange]} {
error "[self object] collection error: ranged removal not yet implemented.. remove one item at a time"
}
if {[string is integer -strict $idx]} {
if {$idx < 0} {
set idx "end-[expr {abs($idx+1)}]"
}
set key [lindex [dict keys $o_data] $idx]
set posn $idx
} else {
set key $idx
set posn [lsearch -exact [dict keys $o_data] $key]
if {$posn < 0} {
error "[self object] no such index: '$idx' in this collection"
}
}
dict unset o_data $key
return
}
method clear {} {
set o_data [dict create]
return
}
method reverse {} {
set dictnew [dict create]
foreach k [lreverse [dict keys $o_data]] {
dict set dictnew $k [dict get $o_data $k]
}
set o_data $dictnew
return
}
#review - cmd as list vs cmd as script?
method map {cmd} {
set seed [list]
dict for {k v} $o_data {
lappend seed [uplevel #0 [list {*}$cmd $v]]
}
return $seed
}
method objectmap {cmd} {
set seed [list]
dict for {k v} $o_data {
lappend seed [uplevel #0 [list $v {*}$cmd]]
}
return $seed
}
}
}
#JMN - api should be kept in sync with package patternlib where possible
#
package provide oolib [namespace eval oolib {
variable version
set version 0.1
}]
namespace eval oolib {
oo::class create collection {
variable o_data ;#dict
variable o_alias
constructor {} {
set o_data [dict create]
}
method info {} {
return [dict info $o_data]
}
method count {} {
return [dict size $o_data]
}
method isEmpty {} {
expr {[dict size $o_data] == 0}
}
method names {{globOrIdx {}}} {
if {[llength $globOrIdx]} {
if {[string is integer -strict $globOrIdx]} {
if {$idx < 0} {
set idx "end-[expr {abs($idx + 1)}]"
}
if {[catch {lindex [dict keys $o_data] $idx} result]} {
error "[self object] no such index : '$idx'"
} else {
return $result
}
} else {
#glob
return [lsearch -glob -all -inline [dict keys $o_data] $globOrIdx]
}
} else {
return [dict keys $o_data]
}
}
#like names but without globbing
method keys {} {
dict keys $o_data
}
method key {{posn 0}} {
if {$posn < 0} {
set posn "end-[expr {abs($posn + 1)}]"
}
if {[catch {lindex [dict keys $o_data] $posn} result]} {
error "[self object] no such index : '$posn'"
} else {
return $result
}
}
method hasKey {key} {
dict exists $o_data $key
}
method get {} {
return $o_data
}
method items {} {
return [dict values $o_data]
}
method item {key} {
if {[string is integer -strict $key]} {
if {$key > 0} {
set valposn [expr {(2*$key) +1}]
return [lindex $o_data $valposn]
} else {
set key "end-[expr {abs($key + 1)}]"
return [lindex [dict keys $o_data] $key]
}
}
if {[dict exists $o_data $key]} {
return [dict get $o_data $key]
}
}
#inverse lookup
method itemKeys {value} {
set value_indices [lsearch -all [dict values $o_data] $value]
set keylist [list]
foreach i $value_indices {
set idx [expr {(($i + 1) *2) -2}]
lappend keylist [lindex $o_data $idx]
}
return $keylist
}
method search {value args} {
set matches [lsearch {*}$args [dict values $o_data] $value]
if {"-inline" in $args} {
return $matches
} else {
set keylist [list]
foreach i $matches {
set idx [expr {(($i + 1) *2) -2}]
lappend keylist [lindex $o_data $idx]
}
return $keylist
}
}
#review - see patternlib. Is the intention for aliases to be configurable independent of whether the target exists?
method alias {newAlias existingKeyOrAlias} {
if {[string is integer -strict $newAlias]} {
error "[self object] collection key alias cannot be integer"
}
if {[string length $existingKeyOrAlias]} {
set o_alias($newAlias) $existingKeyOrAlias
} else {
unset o_alias($newAlias)
}
}
method aliases {{key ""}} {
if {[string length $key]} {
set result [list]
foreach {n v} [array get o_alias] {
if {$v eq $key} {
lappend result $n $v
}
}
return $result
} else {
return [array get o_alias]
}
}
#if the supplied index is an alias, return the underlying key; else return the index supplied.
method realKey {idx} {
if {[catch {set o_alias($idx)} key]} {
return $idx
} else {
return $key
}
}
method add {value key} {
if {[string is integer -strict $key]} {
error "[self object] collection key must not be an integer. Use another structure if integer keys required"
}
if {[dict exists $o_data $key]} {
error "[self object] col_processors object error: key '$key' already exists in collection"
}
dict set o_data $key $value
return [expr {[dict size $o_data] - 1}] ;#return index of item
}
method remove {idx {endRange ""}} {
if {[string length $endRange]} {
error "[self object] collection error: ranged removal not yet implemented.. remove one item at a time"
}
if {[string is integer -strict $idx]} {
if {$idx < 0} {
set idx "end-[expr {abs($idx+1)}]"
}
set key [lindex [dict keys $o_data] $idx]
set posn $idx
} else {
set key $idx
set posn [lsearch -exact [dict keys $o_data] $key]
if {$posn < 0} {
error "[self object] no such index: '$idx' in this collection"
}
}
dict unset o_data $key
return
}
method clear {} {
set o_data [dict create]
return
}
method reverse {} {
set dictnew [dict create]
foreach k [lreverse [dict keys $o_data]] {
dict set dictnew $k [dict get $o_data $k]
}
set o_data $dictnew
return
}
#review - cmd as list vs cmd as script?
method map {cmd} {
set seed [list]
dict for {k v} $o_data {
lappend seed [uplevel #0 [list {*}$cmd $v]]
}
return $seed
}
method objectmap {cmd} {
set seed [list]
dict for {k v} $o_data {
lappend seed [uplevel #0 [list $v {*}$cmd]]
}
return $seed
}
}
}

386
src/bootsupport/modules/punk/cap-0.1.0.tm

@ -19,15 +19,171 @@
## Requirements
##e.g package require frobz
#concepts:
# A capability may be something like providing a folder of files, or just a data dictionary, and/or an API
#
# capability handler - a package/namespace which may provide validation and standardised ways of looking up provider data
# registered (or not) using register_capabilityname <capname> <capnamespace>
# capability provider - a package which registers as providing one or more capablities.
# registered using register_package <pkg> <capabilitylist>
# the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability
# A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap {
variable pkgcap [dict create]
variable pkgcapsdeclared [dict create]
variable pkgcapsaccepted [dict create]
variable caps [dict create]
if {[info commands [namespace current]::interface_caphandler.registry] eq ""} {
oo::class create [namespace current]::interface_caphandler.registry {
method pkg_register {pkg capname capdict fullcapabilitylist} {
#handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid
#overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes.
return 1 ;#default to permit
}
method pkg_unregister {pkg} {
return ;#unregistration return is ignored - review
}
}
oo::class create [namespace current]::interface_capprovider.registration {
method get_declarations {} {
error "interface_capprovider.registration not implemented by provider"
}
}
oo::class create [namespace current]::interface_capprovider.provider {
method register {{capabilityname_glob *}} {
}
method capabilities {} {
}
}
}
#Not all capabilities have to be registered.
#A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated capnamespace (handler).
#such unregistered capabilitynames may be used just to flag something, or have datamembers significant to callers cooperatively interested in that capname.
#we allow registering a capability with an empty handler (capnamespace) - but this means another handler could be registered later.
proc register_capabilityname {capname capnamespace} {
variable caps
variable pkgcapsdeclared
variable pkgcapsaccepted
if {$capnamespace ne ""} {
#normalize with leading :: in case caller passed in package name rather than fully qualified namespace
if {![string match ::* $capnamespace]} {
set capnamespace ::$capnamespace
}
}
#allow register of existing capname iff there is no current handler
#as handlers can be used to validate during provider registration - ideally handlers should be registered before any pkgs call register_package
#we allow loading a handler later though - but will need to validate existing data from pkgs that have already registered as providers
if {[set hdlr [get_handler $capname]] ne ""} {
error "register_capabilityname cannot register capability:$capname with handler:$capnamespace. There is already a registered handler:$hdlr"
}
#assert: capnamespace may or may not be empty string, capname may or may not already exist in caps dict, caps $capname providers may have existing entries.
dict set caps $capname handler $capnamespace
if {![dict exists $caps $capname providers]} {
dict set caps $capname providers [list]
}
if {[llength [set providers [dict get $caps $capname providers]]]} {
#some provider(s) were in place before the handler was registered
if {[set capreg [get_caphandler_registry $capname]] ne ""} {
foreach pkg $providers {
set fullcapabilitylist [dict get $pkgcapsdeclared $pkg]
foreach capspec $fullcapabilitylist {
lassign $capspec cn capdict
if {$cn ne $capname} {
continue
}
set do_register [$capreg pkg_register $pkg $capdict $fullcapabilitylist]
set list_accepted [dict get $pkgcapsaccepted $pkg]
if {$do_register} {
if {$capspec ni $list_accepted} {
dict lappend pkgcapsaccepted $pkg $capspec
}
} else {
set posn [lsearch $list_accepted $capspec]
if {$posn >=0} {
set list_accepted [lreplace $list_accepted $posn $posn]
dict set pkgcapsaccepted $pkg $list_accepted
}
}
}
#check if any accepted for this cap and remove from caps as necessary
set count 0
foreach accepted_capspec [dict get $pkgcapsaccepted $pkg] {
if {[lindex $accepted_capspec 0] eq $capname} {
incr count
}
}
if {$count == 0} {
set pkgposn [lsearch $providers $pkg]
if {$pkgposn >= 0} {
set updated_providers [lreplace $providers $posn $posn]
dict set caps $capname providers $updated_providers
}
}
}
}
}
}
proc exists {capname} {
variable caps
return [dict exists $caps $capname]
}
proc has_handler {capname} {
variable caps
return [expr {[dict exists $caps $capname handler] && [dict get $caps $capname handler] ne ""}]
}
proc get_handler {capname} {
variable caps
if {[dict exists $caps $capname]} {
return [dict get $caps $capname handler]
}
return ""
}
#dispatch
#proc call_handler {capname args} {
# if {[set handler [get_handler $capname]] eq ""} {
# error "punk::cap::call_handler $capname $args - no handler registered for capability $capname"
# }
# ${handler}::[lindex $args 0] {*}[lrange $args 1 end]
#}
proc call_handler {capname args} {
if {[set handler [get_handler $capname]] eq ""} {
error "punk::cap::call_handler $capname $args - no handler registered for capability $capname"
}
set obj ${handler}::$capname
$obj [lindex $args 0] {*}[lrange $args 1 end]
}
proc get_caphandler_registry {capname} {
set ns [get_handler $capname]::capsystem
if {[namespace exists ${ns}]} {
if {[info command ${ns}::caphandler.registry] ne ""} {
if {[info object isa object ${ns}::caphandler.registry]} {
return ${ns}::caphandler.registry
}
}
}
return ""
}
proc get_providers {capname} {
variable caps
if {[dict exists $caps $capname]} {
return [dict get $caps $capname providers]
}
return [list]
}
#register package with arbitrary capnames from capabilitylist
#The registered pkg is a module that provides some service to that capname. Possibly just data members, that the capability will use.
proc register_package {pkg capabilitylist} {
variable pkgcap
variable pkgcapsdeclared
variable pkgcapsaccepted
variable caps
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
@ -35,165 +191,209 @@ namespace eval punk::cap {
#for each capability
# - ensure 1st element is a single word
# - ensure that if 2nd element (capdict) is present - it is dict shaped
foreach c $capabilitylist {
lassign $c capname capdict
foreach capspec $capabilitylist {
lassign $capspec capname capdict
if {[llength $capname] !=1} {
error "register_package error. pkg: '$pkg' An entry in the capability list doesn't appear to have a single-word name. Problematic entry:'$c'"
error "register_package error. pkg: '$pkg' An entry in the capability list doesn't appear to have a single-word name. Problematic entry:'$capspec'"
}
if {[expr {[llength $capdict] %2 != 0}]} {
error "register_package error. pkg:'$pkg' The second element for capname:'$capname' doesn't appear to be a valid dict. Problematic entry: '$c'"
error "register_package error. pkg:'$pkg' The second element for capname:'$capname' doesn't appear to be a valid dict. Problematic entry: '$capspec'"
}
if {[dict exists $caps $capname]} {
set cap_pkgs [dict get $caps $capname]
set cap_pkgs [dict get $caps $capname providers]
} else {
dict set caps $capname [dict create handler "" providers [list]]
set cap_pkgs [list]
}
if {$pkg ni $cap_pkgs} {
dict lappend caps $capname $pkg
#todo - if there's a caphandler - call it's init/validation callback for the pkg
set do_register 1 ;#default assumption unless vetoed by handler
if {[set capreg [get_caphandler_registry $capname]] ne ""} {
#Note that the interface_caphandler.registry instance must be able to handle multiple calls for same pkg
set do_register [$capreg pkg_register $pkg $capname $capdict $capabilitylist]
}
if {$do_register} {
if {$pkg ni $cap_pkgs} {
lappend cap_pkgs $pkg
dict set caps $capname providers $cap_pkgs
}
dict lappend pkgcapsaccepted $pkg $capspec ;#if pkg is being registered prior to handler-registration - the handler may undo this entry
}
}
dict set pkgcap $pkg $capabilitylist
#another call to register_pkg with same pkg may have been made (most likely with different capname) so we must append
#dict lappend pkgcapsdeclared $pkg $capabilitylist
if {[dict exists $pkgcapsdeclared $pkg]} {
set caps [dict get $pkgcapsdeclared $pkg]
lappend caps {*}$capabilitylist
dict set pkgcapsdeclared $pkg $caps
} else {
dict set pkgcapsdeclared $pkg $capabilitylist
}
}
proc unregister_package {pkg} {
variable pkgcapsdeclared
variable caps
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {[dict exists $pkgcapsdeclared $pkg]} {
#remove corresponding entries in caps
set capabilitylist [dict get $pkgcapsdeclared $pkg]
foreach c $capabilitylist {
set do_unregister 1
lassign $c capname _capdict
set cap_info [dict get $caps $capname]
set pkglist [dict get $cap_info providers]
set posn [lsearch $pkglist $pkg]
if {$posn >= 0} {
if {[set capreg [get_caphandler_registry $capname]] ne ""} {
#review
# it seems not useful to allow the callback to block this unregister action
#the pkg may have multiple datasets for each capname so callback will only be called for first dataset we encounter
#vetoing unregister would make this more complex for no particular advantage
#if per capability deregistration required this should probably be a separate thing (e.g disable_capability?)
$capreg pkg_unregister $pkg
}
set pkglist [lreplace $pkglist $posn $posn]
dict set caps $capname providers $pkglist
}
}
#delete the main registration record
dict unset pkgcapsdeclared $pkg
}
}
#review promote/demote doesn't always make a lot of sense .. should possibly be per cap for multicap pkgs
#The idea is to provide a crude way to preference/depreference packages independently of order the packages were loaded
#e.g a caller or cap-handler can ascribe some meaning to the order of the 'providers' key returned from punk::cap::capabilities <capname>
#The order of providers will be the order the packages were loaded & registered
#the naming: "promote vs demote" operates on a latest-package-in-list has higher preference assumption (matching last pkg loaded)
#Each capability handler could implement specific preferencing methods if finer control needed.
#In some cases the preference/loading order may be inapplicable/irrelevant to a particular capability anyway.
#As this is just a basic mechanism, which can't support independent per-cap preferencing for multi-cap packages -
# it only allows putting the pkgs to the head or tail of the lists.
#Whether particular caps or users of caps do anything with this ordering is dependent on the cap-handler and/or calling code.
proc promote_package {pkg} {
variable pkgcap
variable pkgcapsdeclared
variable caps
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {![dict exists $pkgcap $pkg]} {
if {![dict exists $pkgcapsdeclared $pkg]} {
error "punk::cap::promote_package error pkg'$pkg' not registered. Use register_package \$pkg first"
}
if {[dict size $pkgcap] > 1} {
set pkginfo [dict get $pkgcap $pkg]
if {[dict size $pkgcapsdeclared] > 1} {
set pkginfo [dict get $pkgcapsdeclared $pkg]
#remove and re-add at end of dict
dict unset pkgcap $pkg
dict set pkgcap $pkg $pkginfo
foreach {cap cap_pkgs} $caps {
dict unset pkgcapsdeclared $pkg
dict set pkgcapsdeclared $pkg $pkginfo
dict for {cap cap_info} $caps {
set cap_pkgs [dict get $cap_info providers]
if {$pkg in $cap_pkgs} {
set posn [lsearch $cap_pkgs $pkg]
if {$posn >=0} {
#rewrite package list with pkg at tail of list for this capability
set cap_pkgs [lreplace $cap_pkgs $posn $posn]
lappend cap_pkgs $pkg
dict set caps $cap $cap_pkgs
dict set caps $cap providers $cap_pkgs
}
}
}
}
}
proc demote_package {pkg} {
variable pkgcap
variable pkgcapsdeclared
variable caps
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {![dict exists $pkgcap $pkg]} {
if {![dict exists $pkgcapsdeclared $pkg]} {
error "punk::cap::promote_package error pkg'$pkg' not registered. Use register_package \$pkg first"
}
if {[dict size $pkgcap] > 1} {
set pkginfo [dict get $pkgcap $pkg]
if {[dict size $pkgcapsdeclared] > 1} {
set pkginfo [dict get $pkgcapsdeclared $pkg]
#remove and re-add at start of dict
dict unset pkgcap $pkg
dict set pkgcap $pkg $pkginfo
set pkgcap [dict merge [dict create $pkg $pkginfo] $pkgcap]
foreach {cap cap_pkgs} $caps {
dict unset pkgcapsdeclared $pkg
dict set pkgcapsdeclared $pkg $pkginfo
set pkgcapsdeclared [dict merge [dict create $pkg $pkginfo] $pkgcapsdeclared]
dict for {cap cap_info} $caps {
set cap_pkgs [dict get $cap_info providers]
if {$pkg in $cap_pkgs} {
set posn [lsearch $cap_pkgs $pkg]
if {$posn >=0} {
#rewrite package list with pkg at head of list for this capability
set cap_pkgs [lreplace $cap_pkgs $posn $posn]
set cap_pkgs [list $pkg {*}$cap_pkgs]
dict set caps $cap $cap_pkgs
dict set caps $cap providers $cap_pkgs
}
}
}
}
}
proc unregister_package {pkg} {
variable pkgcap
variable caps
proc pkgcap {pkg} {
variable pkgcapsdeclared
variable pkgcapsaccepted
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {[dict exists $pkgcap $pkg]} {
#remove corresponding entries in caps
set capabilitylist [dict get $pkgcap $pkg]
foreach c $capabilitylist {
lassign $c capname _capdict
set pkglist [dict get $caps $capname]
set posn [lsearch $pkglist $pkg]
if {$posn >= 0} {
set pkglist [lreplace $pkglist $posn $posn]
dict set caps $capname $pkglist
}
if {[dict exists $pkgcapsdeclared $pkg]} {
set accepted ""
if {[dict exists $pkgcapsaccepted $pkg]} {
set accepted [dict get $pkgcapsaccepted $pkg]
}
#delete the main registration record
dict unset pkgcap $pkg
}
}
proc registered_package {pkg} {
variable pkgcap
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {[dict exists $pkgcap $pkg]} {
return [dict get $pkgcap $pkg]
return [dict create declared [dict get $pkgcapsdeclared $pkg] accepted $accepted]
} else {
return
}
}
proc registered_packages {} {
variable pkgcap
return $pkgcap
proc pkgcaps {} {
variable pkgcapsdeclared
variable pkgcapsaccepted
set result [dict create]
foreach {pkg capsdeclared} $pkgcapsdeclared {
set accepted ""
if {[dict exists $pkgcapsaccepted $pkg]} {
set accepted [dict get $pkgcapsaccepted $pkg]
}
dict set result $pkg declared $capsdeclared
dict set result $pkg accepted $accepted
}
return $result
}
proc capability {capname} {
variable caps
if {[dict exists $caps $capname]} {
return [dict get $caps $capname]
}
return ""
}
proc capabilities {{glob *}} {
variable caps
set keys [lsort [dict keys $caps $glob]]
set capnames [lsort [dict keys $caps $glob]]
set cap_list [list]
foreach k $keys {
lappend cap_list [list $k [dict get $caps $k]]
foreach capname $capnames {
lappend cap_list [list $capname [dict get $caps $capname]]
}
return $cap_list
}
namespace eval templates {
#return a dict keyed on folder with source pkg as value
proc folders {} {
package require punk::cap
set caplist [punk::cap::capabilities templates]
# e.g {templates {punk::mix::templates ::somepkg}}
set templates_record [lindex $caplist 0]
set pkgs [lindex $templates_record 1]
set folderdict [dict create]
foreach pkg $pkgs {
set caplist [punk::cap::registered_package $pkg]
set templates_entries [lsearch -all -inline -index 0 $caplist templates] ;#we generally expect only one - but if multiple exist - use them
foreach templates_info $templates_entries {
lassign $templates_info _templates templates_dict
if {[dict exists $templates_dict relpath]} {
set provide_statement [package ifneeded $pkg [package require $pkg]]
set tmfile [lindex $provide_statement end]
#set tmdir [file dirname [lindex $provide_statement end]]
set tpath [file normalize [file join $tmfile [dict get $templates_dict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
#relpath relative to file is important for tm files that are zip/tar based containers
if {[file isdirectory $tpath]} {
dict set folderdict $tpath [list source $pkg sourcetype package]
} else {
puts stderr "punk::cap::templates::folders WARNING - unable to determine base folder for package '$pkg' which is registered with punk::mix as a provider of 'templates' capability"
}
} else {
puts stderr "punk::cap::templates::folders WARNING - registered pkg 'pkg' has capability 'templates' but no 'relpath' key - unable to use as source of templates"
}
}
proc capabilitynames {{glob *}} {
variable caps
return [lsort [dict keys $caps $glob]]
}
#return only those capnames which have at least one provider
proc capabilitynames_provided {{glob *}} {
variable caps
set keys [lsort [dict keys $caps $glob]]
set cap_list [list]
foreach k $keys {
if {[llength [dict get $caps $k providers]] > 0} {
lappend cap_list $k
}
return $folderdict
}
return $cap_list
}
}

52
src/bootsupport/modules/punk/cap/handlers/caphandler-0.1.0.tm

@ -0,0 +1,52 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application punk::cap::handlers::caphandler 0.1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
##e.g package require frobz
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap::handlers::caphandler {
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::cap::handlers::caphandler [namespace eval punk::cap::handlers::caphandler {
variable pkg punk::cap::handlers::caphandler
variable version
set version 0.1.0
}]
return

52
src/bootsupport/modules/punk/cap/handlers/scriptlibs-0.1.0.tm

@ -0,0 +1,52 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application punk::cap::handlers::scriptlibs 0.1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
##e.g package require frobz
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap::handlers::scriptlibs {
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::cap::handlers::scriptlibs [namespace eval punk::cap::handlers::scriptlibs {
variable pkg punk::cap::handlers::scriptlibs
variable version
set version 0.1.0
}]
return

127
src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm

@ -0,0 +1,127 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application punk::cap::handlers::templates 0.1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
##e.g package require frobz
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#register using:
# punk::cap::register_capabilityname templates ::punk::cap::handlers::templates
#By convention and for consistency, we don't register here during package loading - but require the calling app to do it.
# (even if it tends to be done immediately after package require anyway)
# registering capability handlers can involve validating existing provider data and is best done explicitly as required.
# It is also possible for a capability handler to be registered to handle more than one capabilityname
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap::handlers::templates {
namespace eval capsystem {
#interfaces for punk::cap to call into
if {[info commands caphandler.registry] eq ""} {
punk::cap::interface_caphandler.registry create caphandler.registry
oo::objdefine caphandler.registry {
method pkg_register {pkg capname capdict caplist} {
#caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?)
if {![dict exists $capdict relpath]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing 'relpath' key"
return 0
}
set provide_statement [package ifneeded $pkg [package require $pkg]]
set tmfile [lindex $provide_statement end]
if {![file exists $tmfile]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
return 0
}
set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
if {![file isdirectory $tpath]} {
puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to validate relpath location [dict get $capdict relpath] ($tpath) for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
}
if {$capname ni $::punk::cap::handlers::templates::handled_caps} {
lappend ::punk::cap::handlers::templates::handled_caps $capname
}
if {[info commands punk::cap::handlers::templates::$capname] eq ""} {
punk::cap::handlers::templates::api create ::punk::cap::handlers::templates::$capname $capname
}
set cname [string map [list . _] $capname]
upvar ::punk::cap::handlers::templates::pkg_folders_$cname pfolders
dict lappend pfolders $pkg $tpath
return 1
}
method pkg_unregister {pkg} {
upvar ::punk::cap::handlers::templates::handled_caps hcaps
foreach capname $hcaps {
set cname [string map [list . _] $capname]
upvar ::punk::cap::handlers::templates::pkg_folders_$cname pfolders
dict unset pfolders $pkg
#destroy api objects?
}
}
}
}
}
variable handled_caps [list]
#variable pkg_folders [dict create]
# -- --- --- --- --- --- ---
#handler api for clients of this capability - called via punk::cap::call_handler <capname> <method> ?args?
# -- --- --- --- --- --- ---
namespace export *
oo::class create api {
#return a dict keyed on folder with source pkg as value
constructor {capname} {
variable capabilityname
variable cname
set cname [string map [list . _] $capname]
set capabilityname $capname
}
method folders {} {
variable capabilityname
variable cname
upvar punk::cap::handlers::templates::pkg_folders_$cname pkg_folders
package require punk::cap
set capinfo [punk::cap::capability $capabilityname]
# e.g {punk.templates {handler punk::mix::templates providers ::somepkg}}
#use the order of pkgs as registered with punk::cap - may have been modified with punk::cap::promote_package/demote_package
set pkgs [dict get $capinfo providers]
set folderdict [dict create]
foreach pkg $pkgs {
foreach pfolder [dict get $pkg_folders $pkg] {
dict set folderdict $pfolder [list source $pkg sourcetype package]
}
}
return $folderdict
}
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::cap::handlers::templates [namespace eval punk::cap::handlers::templates {
variable pkg punk::cap::handlers::templates
variable version
set version 0.1.0
}]
return

8
src/bootsupport/modules/punk/mix-0.2.tm

@ -1,6 +1,12 @@
package require punk::cap
package require punk::mix::templates ;#registers 'templates' capability with punk::cap
package require punk::cap::handlers::templates ;#handler for templates cap
punk::cap::register_capabilityname punk.templates ::punk::cap::handlers::templates
package require punk::mix::templates ;#registers as provider pkg for 'punk.templates' capability with punk::cap
#punk::mix::templates::provider register *
package require punk::mix::base
package require punk::mix::cli

1812
src/bootsupport/modules/punk/mix/base-0.1.tm

File diff suppressed because it is too large Load Diff

2
src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm

@ -73,7 +73,7 @@ namespace eval punk::mix::commandset::layout {
set glob *
}
set layouts [list]
#set tplfolderdict [punk::cap::templates::folders]
#set tplfolderdict [punk::cap::call_handler punk.templates folders]
set tplfolderdict [punk::mix::base::lib::get_template_basefolders]
dict for {tdir folderinfo} $tplfolderdict {
set layout_base $tdir/layouts

10
src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm

@ -305,7 +305,7 @@ namespace eval punk::mix::commandset::project {
#todo - tag substitutions in src/doc tree
cd $projectdir
::cd $projectdir
if {[file exists $projectdir/src/modules]} {
foreach m $opt_modules {
@ -323,7 +323,7 @@ namespace eval punk::mix::commandset::project {
#generate www/man/md output in 'embedded' folder which should be checked into repo for online documentation
if {[file exists $projectdir/src]} {
cd $projectdir/src
::cd $projectdir/src
#----------
set installer [punkcheck::installtrack new project.new $projectdir/src/.punkcheck]
$installer set_source_target $projectdir/src/doc $projectdir/src/embedded
@ -357,7 +357,7 @@ namespace eval punk::mix::commandset::project {
$installer destroy
}
cd $projectdir
::cd $projectdir
if {![punk::repo::is_fossil_root $projectdir]} {
set first_fossil 1
@ -742,7 +742,7 @@ namespace eval punk::mix::commandset::project {
set workingdir [lindex $workdirs 0]
puts stdout "1 result. Changing dir to $workingdir"
if {[file exists $workingdir]} {
cd $workingdir
::cd $workingdir
return $workingdir
} else {
puts stderr "path $workingdir doesn't appear to exist"
@ -753,7 +753,7 @@ namespace eval punk::mix::commandset::project {
if {[string trim $answer] in $col_rowids} {
set index [expr {$answer - 1}]
set workingdir [lindex $workdirs $index]
cd $workingdir
::cd $workingdir
puts stdout [pmix stat]
return $workingdir
}

37
src/bootsupport/modules/punk/mix/templates-0.1.0.tm

@ -23,10 +23,43 @@ package require punk::cap
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::mix::templates {
variable pkg punk::mix::templates
variable cap_provider
punk::cap::register_package punk::mix::templates [list\
{templates {relpath ../templates}}\
{punk.templates {relpath ../templates}}\
]
namespace eval capsystem {
if {[info commands capprovider.registration] eq ""} {
punk::cap::interface_capprovider.registration create capprovider.registration
oo::objdefine capprovider.registration {
method get_declarations {} {
set decls [list]
lappend decls punk.templates {relpath ../templates}
lappend decls punk.templates {relpath ../templates2}
return $decls
}
}
}
}
if {[info commands provider] eq ""} {
punk::cap::interface_capprovider.provider create provider
oo::objdefine provider {
method register {{capabilityname_glob *}} {
#puts registering punk::mix::templates $capabilityname
next
}
method capabilities {} {
next
}
}
}
# -- ---
#provider api
# -- ---
#none - declarations only
}

316
src/bootsupport/modules/punk/overlay-0.1.tm

@ -1,158 +1,158 @@
package require punk::mix::util
namespace eval ::punk::overlay {
#based *loosely* on: wiki.tcl-lang.org/page/ensemble+extend
# extend an ensemble-like routine with the routines in some namespace
#
# e.g custom_from_base ::punk::mix::cli ::punk::mix::base
#
proc custom_from_base {routine base} {
if {![string match ::* $routine]} {
set resolved [uplevel 1 [list ::namespace which $routine]]
if {$resolved eq {}} {
error [list {no such routine} $routine]
}
set routine $resolved
}
set routinens [namespace qualifiers $routine]
if {$routinens eq {::}} {
set routinens {}
}
set routinetail [namespace tail $routine]
if {![string match ::* $base]} {
set base [uplevel 1 [
list [namespace which namespace] current]]::$base
}
if {![namespace exists $base]} {
error [list {no such namespace} $base]
}
set base [namespace eval $base [
list [namespace which namespace] current]]
#while 1 {
# set renamed ${routinens}::${routinetail}_[info cmdcount]
# if {[namespace which $renamed] eq {}} break
#}
namespace eval $routine [
list namespace ensemble configure $routine -unknown [
list apply {{base ensemble subcommand args} {
list ${base}::_redirected $ensemble $subcommand
}} $base
]
]
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${routine}::util
#namespace eval ${routine}::util {
#namespace import ::punk::mix::util::*
#}
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ${base}::lib::* ${routine}::lib
#namespace eval ${routine}::lib [string map [list <base> $base] {
# namespace import <base>::lib::*
#}]
namespace eval ${routine}::lib [string map [list <base> $base <routine> $routine] {
if {[namespace exists <base>::lib]} {
set current_paths [namespace path]
if {"<routine>" ni $current_paths} {
lappend current_paths <routine>
}
namespace path $current_paths
}
}]
namespace eval $routine {
set exportlist [list]
foreach cmd [info commands [namespace current]::*] {
set c [namespace tail $cmd]
if {![string match _* $c]} {
lappend exportlist $c
}
}
namespace export {*}$exportlist
}
return $routine
}
#load *exported* commands from cmdnamespace into caller's namespace - prefixing each command with $prefix
#Note: commandset may be imported by different CLIs with different bases *at the same time*
#so we don't make commands from the cli or its base available automatically (will generally require fully-qualified commands to use code from cli/base)
#we do load punk::mix::util::* into the util subnamespace even though the commandset might not be loaded in a cli using punk::mix::base i.e punk::mix::util is a common dependency for CLIs.
#commandsets designed to be used with a specific cli/base may choose to do their own import e.g with util::namespace_import_pattern_to_namespace_noclobber and/or set namespace path if they
#want the convenience of using lib:xxx with commands coming from those packages.
#This won't stop the commandset being used with other cli/bases unless the import is done by looking up the callers namespace.
#The basic principle is that the commandset is loaded into the caller(s) with a prefix
#- but commandsets should explicitly package require if they have any backwards dependencies on cli/base (which they may or may not be loaded into)
proc import_commandset {prefix separator cmdnamespace} {
set bad_seps [list "::"]
if {$separator in $bad_seps} {
error "import_commandset invalid separator '$separator'"
}
#namespace may or may not be a package
# allow with or without leading ::
if {[string range $cmdnamespace 0 1] eq "::"} {
set cmdpackage [string range $cmdnamespace 2 end]
} else {
set cmdpackage $cmdnamespace
set cmdnamespace ::$cmdnamespace
}
if {![namespace exists $cmdnamespace]} {
#only do package require if the namespace not already present
catch {package require $cmdpackage} pkg_load_info
#recheck
if {![namespace exists $cmdnamespace]} {
set prov [package provide $cmdpackage]
if {[string length $prov]} {
set provinfo "(package $cmdpackage is present with version $prov)"
} else {
set provinfo "(package $cmdpackage not present)"
}
error "punk::overlay::import_commandset supplied namespace '$cmdnamespace' doesn't exist. $provinfo Pkg_load_result: $pkg_load_info Usage: import_commandset prefix separator namespace"
}
}
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${cmdnamespace}::util
#let child namespace 'lib' resolve parent namespace and thus util::xxx
namespace eval ${cmdnamespace}::lib [string map [list <cmdns> $cmdnamespace] {
set nspaths [namespace path]
if {"<cmdns>" ni $nspaths} {
lappend nspaths <cmdns>
}
namespace path $nspaths
}]
set imported_commands [list]
set nscaller [uplevel 1 [list namespace current]]
if {[catch {
namespace eval ${nscaller}::temp_import [list namespace import ${cmdnamespace}::*]
foreach cmd [info commands ${nscaller}::temp_import::*] {
set cmdtail [namespace tail $cmd]
if {$cmdtail eq "_default"} {
set import_as ${nscaller}::${prefix}
} else {
set import_as ${nscaller}::${prefix}${separator}${cmdtail}
}
rename $cmd $import_as
lappend imported_commands $import_as
}
} errM]} {
puts stderr "Error loading commandset $prefix $separator $cmdnamespace"
puts stderr "err: $errM"
}
return $imported_commands
}
}
package provide punk::overlay [namespace eval punk::overlay {
variable version
set version 0.1
}]
package require punk::mix::util
namespace eval ::punk::overlay {
#based *loosely* on: wiki.tcl-lang.org/page/ensemble+extend
# extend an ensemble-like routine with the routines in some namespace
#
# e.g custom_from_base ::punk::mix::cli ::punk::mix::base
#
proc custom_from_base {routine base} {
if {![string match ::* $routine]} {
set resolved [uplevel 1 [list ::namespace which $routine]]
if {$resolved eq {}} {
error [list {no such routine} $routine]
}
set routine $resolved
}
set routinens [namespace qualifiers $routine]
if {$routinens eq {::}} {
set routinens {}
}
set routinetail [namespace tail $routine]
if {![string match ::* $base]} {
set base [uplevel 1 [
list [namespace which namespace] current]]::$base
}
if {![namespace exists $base]} {
error [list {no such namespace} $base]
}
set base [namespace eval $base [
list [namespace which namespace] current]]
#while 1 {
# set renamed ${routinens}::${routinetail}_[info cmdcount]
# if {[namespace which $renamed] eq {}} break
#}
namespace eval $routine [
list namespace ensemble configure $routine -unknown [
list apply {{base ensemble subcommand args} {
list ${base}::_redirected $ensemble $subcommand
}} $base
]
]
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${routine}::util
#namespace eval ${routine}::util {
#namespace import ::punk::mix::util::*
#}
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ${base}::lib::* ${routine}::lib
#namespace eval ${routine}::lib [string map [list <base> $base] {
# namespace import <base>::lib::*
#}]
namespace eval ${routine}::lib [string map [list <base> $base <routine> $routine] {
if {[namespace exists <base>::lib]} {
set current_paths [namespace path]
if {"<routine>" ni $current_paths} {
lappend current_paths <routine>
}
namespace path $current_paths
}
}]
namespace eval $routine {
set exportlist [list]
foreach cmd [info commands [namespace current]::*] {
set c [namespace tail $cmd]
if {![string match _* $c]} {
lappend exportlist $c
}
}
namespace export {*}$exportlist
}
return $routine
}
#load *exported* commands from cmdnamespace into caller's namespace - prefixing each command with $prefix
#Note: commandset may be imported by different CLIs with different bases *at the same time*
#so we don't make commands from the cli or its base available automatically (will generally require fully-qualified commands to use code from cli/base)
#we do load punk::mix::util::* into the util subnamespace even though the commandset might not be loaded in a cli using punk::mix::base i.e punk::mix::util is a common dependency for CLIs.
#commandsets designed to be used with a specific cli/base may choose to do their own import e.g with util::namespace_import_pattern_to_namespace_noclobber and/or set namespace path if they
#want the convenience of using lib:xxx with commands coming from those packages.
#This won't stop the commandset being used with other cli/bases unless the import is done by looking up the callers namespace.
#The basic principle is that the commandset is loaded into the caller(s) with a prefix
#- but commandsets should explicitly package require if they have any backwards dependencies on cli/base (which they may or may not be loaded into)
proc import_commandset {prefix separator cmdnamespace} {
set bad_seps [list "::"]
if {$separator in $bad_seps} {
error "import_commandset invalid separator '$separator'"
}
#namespace may or may not be a package
# allow with or without leading ::
if {[string range $cmdnamespace 0 1] eq "::"} {
set cmdpackage [string range $cmdnamespace 2 end]
} else {
set cmdpackage $cmdnamespace
set cmdnamespace ::$cmdnamespace
}
if {![namespace exists $cmdnamespace]} {
#only do package require if the namespace not already present
catch {package require $cmdpackage} pkg_load_info
#recheck
if {![namespace exists $cmdnamespace]} {
set prov [package provide $cmdpackage]
if {[string length $prov]} {
set provinfo "(package $cmdpackage is present with version $prov)"
} else {
set provinfo "(package $cmdpackage not present)"
}
error "punk::overlay::import_commandset supplied namespace '$cmdnamespace' doesn't exist. $provinfo Pkg_load_result: $pkg_load_info Usage: import_commandset prefix separator namespace"
}
}
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${cmdnamespace}::util
#let child namespace 'lib' resolve parent namespace and thus util::xxx
namespace eval ${cmdnamespace}::lib [string map [list <cmdns> $cmdnamespace] {
set nspaths [namespace path]
if {"<cmdns>" ni $nspaths} {
lappend nspaths <cmdns>
}
namespace path $nspaths
}]
set imported_commands [list]
set nscaller [uplevel 1 [list namespace current]]
if {[catch {
namespace eval ${nscaller}::temp_import [list namespace import ${cmdnamespace}::*]
foreach cmd [info commands ${nscaller}::temp_import::*] {
set cmdtail [namespace tail $cmd]
if {$cmdtail eq "_default"} {
set import_as ${nscaller}::${prefix}
} else {
set import_as ${nscaller}::${prefix}${separator}${cmdtail}
}
rename $cmd $import_as
lappend imported_commands $import_as
}
} errM]} {
puts stderr "Error loading commandset $prefix $separator $cmdnamespace"
puts stderr "err: $errM"
}
return $imported_commands
}
}
package provide punk::overlay [namespace eval punk::overlay {
variable version
set version 0.1
}]

152
src/make.tcl

@ -259,84 +259,110 @@ if {$::punkmake::command eq "bootsupport"} {
proc bootsupport_localupdate {projectroot} {
set bootsupport_modules [list]
set bootsupport_module_folders [list]
set bootsupport_config $projectroot/src/bootsupport/include_modules.config ;#
if {[file exists $bootsupport_config]} {
set targetroot $projectroot/src/bootsupport/modules
source $bootsupport_config ;#populate $bootsupport_modules with project-specific list
if {![llength $bootsupport_modules]} {
puts stderr "No local bootsupport modules configured for updating"
return
}
set targetroot $projectroot/src/bootsupport/modules
if {[catch {
#----------
set boot_installer [punkcheck::installtrack new make.tcl $projectroot/src/bootsupport/.punkcheck]
$boot_installer set_source_target $projectroot $projectroot/src/bootsupport
set boot_event [$boot_installer start_event {-make_step bootsupport}]
#----------
} errM]} {
puts stderr "Unable to use punkcheck for bootsupport error: $errM"
set boot_event ""
}
} else {
foreach {relpath module} $bootsupport_modules {
set module [string trim $module :]
set module_subpath [string map [list :: /] [namespace qualifiers $module]]
set srclocation [file join $projectroot $relpath $module_subpath]
#puts stdout "$relpath $module $module_subpath $srclocation"
set pkgmatches [glob -nocomplain -dir $srclocation -tail [namespace tail $module]-*]
#lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1
if {![llength $pkgmatches]} {
puts stderr "Missing source for bootsupport module $module - not found in $srclocation"
continue
}
set latestfile [lindex $pkgmatches 0]
set latestver [lindex [split [file rootname $latestfile] -] 1]
foreach m $pkgmatches {
lassign [split [file rootname $m] -] _pkg ver
#puts "comparing $ver vs $latestver"
if {[package vcompare $ver $latestver] == 1} {
set latestver $ver
set latestfile $m
}
}
set srcfile [file join $srclocation $latestfile]
set tgtfile [file join $targetroot $module_subpath $latestfile]
if {$boot_event ne ""} {
if {[catch {
#----------
$boot_event targetset_init INSTALL $tgtfile
$boot_event targetset_addsource $srcfile
set boot_installer [punkcheck::installtrack new make.tcl $projectroot/src/bootsupport/.punkcheck]
$boot_installer set_source_target $projectroot $projectroot/src/bootsupport
set boot_event [$boot_installer start_event {-make_step bootsupport}]
#----------
if {\
[llength [dict get [$boot_event targetset_source_changes] changed]]\
|| [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\
} {
file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists
$boot_event targetset_started
# -- --- --- --- --- ---
puts "BOOTSUPPORT update: $srcfile -> $tgtfile"
if {[catch {
file copy -force $srcfile $tgtfile
} errM]} {
$boot_event targetset_end FAILED
} errM]} {
puts stderr "Unable to use punkcheck for bootsupport error: $errM"
set boot_event ""
}
foreach {relpath module} $bootsupport_modules {
set module [string trim $module :]
set module_subpath [string map [list :: /] [namespace qualifiers $module]]
set srclocation [file join $projectroot $relpath $module_subpath]
#puts stdout "$relpath $module $module_subpath $srclocation"
set pkgmatches [glob -nocomplain -dir $srclocation -tail [namespace tail $module]-*]
#lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1
if {![llength $pkgmatches]} {
puts stderr "Missing source for bootsupport module $module - not found in $srclocation"
continue
}
set latestfile [lindex $pkgmatches 0]
set latestver [lindex [split [file rootname $latestfile] -] 1]
foreach m $pkgmatches {
lassign [split [file rootname $m] -] _pkg ver
#puts "comparing $ver vs $latestver"
if {[package vcompare $ver $latestver] == 1} {
set latestver $ver
set latestfile $m
}
}
set srcfile [file join $srclocation $latestfile]
set tgtfile [file join $targetroot $module_subpath $latestfile]
if {$boot_event ne ""} {
#----------
$boot_event targetset_init INSTALL $tgtfile
$boot_event targetset_addsource $srcfile
#----------
if {\
[llength [dict get [$boot_event targetset_source_changes] changed]]\
|| [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\
} {
file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists
$boot_event targetset_started
# -- --- --- --- --- ---
puts "BOOTSUPPORT update: $srcfile -> $tgtfile"
if {[catch {
file copy -force $srcfile $tgtfile
} errM]} {
$boot_event targetset_end FAILED
} else {
$boot_event targetset_end OK
}
# -- --- --- --- --- ---
} else {
$boot_event targetset_end OK
puts -nonewline stderr "."
$boot_event targetset_end SKIPPED
}
# -- --- --- --- --- ---
$boot_event end
} else {
puts -nonewline stderr "."
$boot_event targetset_end SKIPPED
file copy -force $srcfile $tgtfile
}
$boot_event end
} else {
file copy -force $srcfile $tgtfile
}
if {$boot_event ne ""} {
puts \n
$boot_event destroy
$boot_installer destroy
}
}
if {$boot_event ne ""} {
puts \n
$boot_event destroy
$boot_installer destroy
foreach folder $bootsupport_module_folders {
#explicitly ignore punk/mix/templates folder even if specified in config.
#punk/mix/templates contains modules including punk/mix/templates itself - the actual templates aren't needed for the bootsupport system,
# as make.tcl shouldn't be building new projects from the one being made.
#review.
#should we be autodetecting such recursive folder structures - (or is the bootsupport copying in need of a rethink?)
if {[string trim $folder /] eq "punk/mix/templates"} {
puts stderr "IGNORING punk/mix/templates - not needed/desirable in bootsupport"
continue
}
set src [file join $projectroot/modules $folder]
if {![file isdirectory $src]} {
puts stderr "bootsupport folder not found: $src"
continue
}
set tgt [file join $targetroot $folder]
file mkdir $tgt
puts stdout "BOOTSUPPORT non_tm_files $src - copying to $tgt (if source file changed)"
set overwrite "installedsourcechanged-targets"
set resultdict [punkcheck::install_non_tm_files $src $tgt -installer make.tcl -overwrite $overwrite -punkcheck_folder $projectroot/src/bootsupport]
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
}
}
}

390
src/mixtemplates/layouts/basic/src/bootsupport/modules/oolib-0.1.tm

@ -1,195 +1,195 @@
#JMN - api should be kept in sync with package patternlib where possible
#
package provide oolib [namespace eval oolib {
variable version
set version 0.1
}]
namespace eval oolib {
oo::class create collection {
variable o_data ;#dict
variable o_alias
constructor {} {
set o_data [dict create]
}
method info {} {
return [dict info $o_data]
}
method count {} {
return [dict size $o_data]
}
method isEmpty {} {
expr {[dict size $o_data] == 0}
}
method names {{globOrIdx {}}} {
if {[llength $globOrIdx]} {
if {[string is integer -strict $globOrIdx]} {
if {$idx < 0} {
set idx "end-[expr {abs($idx + 1)}]"
}
if {[catch {lindex [dict keys $o_data] $idx} result]} {
error "[self object] no such index : '$idx'"
} else {
return $result
}
} else {
#glob
return [lsearch -glob -all -inline [dict keys $o_data] $globOrIdx]
}
} else {
return [dict keys $o_data]
}
}
#like names but without globbing
method keys {} {
dict keys $o_data
}
method key {{posn 0}} {
if {$posn < 0} {
set posn "end-[expr {abs($posn + 1)}]"
}
if {[catch {lindex [dict keys $o_data] $posn} result]} {
error "[self object] no such index : '$posn'"
} else {
return $result
}
}
method hasKey {key} {
dict exists $o_data $key
}
method get {} {
return $o_data
}
method items {} {
return [dict values $o_data]
}
method item {key} {
if {[string is integer -strict $key]} {
if {$key > 0} {
set valposn [expr {(2*$key) +1}]
return [lindex $o_data $valposn]
} else {
set key "end-[expr {abs($key + 1)}]"
return [lindex [dict keys $o_data] $key]
}
}
if {[dict exists $o_data $key]} {
return [dict get $o_data $key]
}
}
#inverse lookup
method itemKeys {value} {
set value_indices [lsearch -all [dict values $o_data] $value]
set keylist [list]
foreach i $value_indices {
set idx [expr {(($i + 1) *2) -2}]
lappend keylist [lindex $o_data $idx]
}
return $keylist
}
method search {value args} {
set matches [lsearch {*}$args [dict values $o_data] $value]
if {"-inline" in $args} {
return $matches
} else {
set keylist [list]
foreach i $matches {
set idx [expr {(($i + 1) *2) -2}]
lappend keylist [lindex $o_data $idx]
}
return $keylist
}
}
#review - see patternlib. Is the intention for aliases to be configurable independent of whether the target exists?
method alias {newAlias existingKeyOrAlias} {
if {[string is integer -strict $newAlias]} {
error "[self object] collection key alias cannot be integer"
}
if {[string length $existingKeyOrAlias]} {
set o_alias($newAlias) $existingKeyOrAlias
} else {
unset o_alias($newAlias)
}
}
method aliases {{key ""}} {
if {[string length $key]} {
set result [list]
foreach {n v} [array get o_alias] {
if {$v eq $key} {
lappend result $n $v
}
}
return $result
} else {
return [array get o_alias]
}
}
#if the supplied index is an alias, return the underlying key; else return the index supplied.
method realKey {idx} {
if {[catch {set o_alias($idx)} key]} {
return $idx
} else {
return $key
}
}
method add {value key} {
if {[string is integer -strict $key]} {
error "[self object] collection key must not be an integer. Use another structure if integer keys required"
}
if {[dict exists $o_data $key]} {
error "[self object] col_processors object error: key '$key' already exists in collection"
}
dict set o_data $key $value
return [expr {[dict size $o_data] - 1}] ;#return index of item
}
method remove {idx {endRange ""}} {
if {[string length $endRange]} {
error "[self object] collection error: ranged removal not yet implemented.. remove one item at a time"
}
if {[string is integer -strict $idx]} {
if {$idx < 0} {
set idx "end-[expr {abs($idx+1)}]"
}
set key [lindex [dict keys $o_data] $idx]
set posn $idx
} else {
set key $idx
set posn [lsearch -exact [dict keys $o_data] $key]
if {$posn < 0} {
error "[self object] no such index: '$idx' in this collection"
}
}
dict unset o_data $key
return
}
method clear {} {
set o_data [dict create]
return
}
method reverse {} {
set dictnew [dict create]
foreach k [lreverse [dict keys $o_data]] {
dict set dictnew $k [dict get $o_data $k]
}
set o_data $dictnew
return
}
#review - cmd as list vs cmd as script?
method map {cmd} {
set seed [list]
dict for {k v} $o_data {
lappend seed [uplevel #0 [list {*}$cmd $v]]
}
return $seed
}
method objectmap {cmd} {
set seed [list]
dict for {k v} $o_data {
lappend seed [uplevel #0 [list $v {*}$cmd]]
}
return $seed
}
}
}
#JMN - api should be kept in sync with package patternlib where possible
#
package provide oolib [namespace eval oolib {
variable version
set version 0.1
}]
namespace eval oolib {
oo::class create collection {
variable o_data ;#dict
variable o_alias
constructor {} {
set o_data [dict create]
}
method info {} {
return [dict info $o_data]
}
method count {} {
return [dict size $o_data]
}
method isEmpty {} {
expr {[dict size $o_data] == 0}
}
method names {{globOrIdx {}}} {
if {[llength $globOrIdx]} {
if {[string is integer -strict $globOrIdx]} {
if {$idx < 0} {
set idx "end-[expr {abs($idx + 1)}]"
}
if {[catch {lindex [dict keys $o_data] $idx} result]} {
error "[self object] no such index : '$idx'"
} else {
return $result
}
} else {
#glob
return [lsearch -glob -all -inline [dict keys $o_data] $globOrIdx]
}
} else {
return [dict keys $o_data]
}
}
#like names but without globbing
method keys {} {
dict keys $o_data
}
method key {{posn 0}} {
if {$posn < 0} {
set posn "end-[expr {abs($posn + 1)}]"
}
if {[catch {lindex [dict keys $o_data] $posn} result]} {
error "[self object] no such index : '$posn'"
} else {
return $result
}
}
method hasKey {key} {
dict exists $o_data $key
}
method get {} {
return $o_data
}
method items {} {
return [dict values $o_data]
}
method item {key} {
if {[string is integer -strict $key]} {
if {$key > 0} {
set valposn [expr {(2*$key) +1}]
return [lindex $o_data $valposn]
} else {
set key "end-[expr {abs($key + 1)}]"
return [lindex [dict keys $o_data] $key]
}
}
if {[dict exists $o_data $key]} {
return [dict get $o_data $key]
}
}
#inverse lookup
method itemKeys {value} {
set value_indices [lsearch -all [dict values $o_data] $value]
set keylist [list]
foreach i $value_indices {
set idx [expr {(($i + 1) *2) -2}]
lappend keylist [lindex $o_data $idx]
}
return $keylist
}
method search {value args} {
set matches [lsearch {*}$args [dict values $o_data] $value]
if {"-inline" in $args} {
return $matches
} else {
set keylist [list]
foreach i $matches {
set idx [expr {(($i + 1) *2) -2}]
lappend keylist [lindex $o_data $idx]
}
return $keylist
}
}
#review - see patternlib. Is the intention for aliases to be configurable independent of whether the target exists?
method alias {newAlias existingKeyOrAlias} {
if {[string is integer -strict $newAlias]} {
error "[self object] collection key alias cannot be integer"
}
if {[string length $existingKeyOrAlias]} {
set o_alias($newAlias) $existingKeyOrAlias
} else {
unset o_alias($newAlias)
}
}
method aliases {{key ""}} {
if {[string length $key]} {
set result [list]
foreach {n v} [array get o_alias] {
if {$v eq $key} {
lappend result $n $v
}
}
return $result
} else {
return [array get o_alias]
}
}
#if the supplied index is an alias, return the underlying key; else return the index supplied.
method realKey {idx} {
if {[catch {set o_alias($idx)} key]} {
return $idx
} else {
return $key
}
}
method add {value key} {
if {[string is integer -strict $key]} {
error "[self object] collection key must not be an integer. Use another structure if integer keys required"
}
if {[dict exists $o_data $key]} {
error "[self object] col_processors object error: key '$key' already exists in collection"
}
dict set o_data $key $value
return [expr {[dict size $o_data] - 1}] ;#return index of item
}
method remove {idx {endRange ""}} {
if {[string length $endRange]} {
error "[self object] collection error: ranged removal not yet implemented.. remove one item at a time"
}
if {[string is integer -strict $idx]} {
if {$idx < 0} {
set idx "end-[expr {abs($idx+1)}]"
}
set key [lindex [dict keys $o_data] $idx]
set posn $idx
} else {
set key $idx
set posn [lsearch -exact [dict keys $o_data] $key]
if {$posn < 0} {
error "[self object] no such index: '$idx' in this collection"
}
}
dict unset o_data $key
return
}
method clear {} {
set o_data [dict create]
return
}
method reverse {} {
set dictnew [dict create]
foreach k [lreverse [dict keys $o_data]] {
dict set dictnew $k [dict get $o_data $k]
}
set o_data $dictnew
return
}
#review - cmd as list vs cmd as script?
method map {cmd} {
set seed [list]
dict for {k v} $o_data {
lappend seed [uplevel #0 [list {*}$cmd $v]]
}
return $seed
}
method objectmap {cmd} {
set seed [list]
dict for {k v} $o_data {
lappend seed [uplevel #0 [list $v {*}$cmd]]
}
return $seed
}
}
}

386
src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap-0.1.0.tm

@ -19,15 +19,171 @@
## Requirements
##e.g package require frobz
#concepts:
# A capability may be something like providing a folder of files, or just a data dictionary, and/or an API
#
# capability handler - a package/namespace which may provide validation and standardised ways of looking up provider data
# registered (or not) using register_capabilityname <capname> <capnamespace>
# capability provider - a package which registers as providing one or more capablities.
# registered using register_package <pkg> <capabilitylist>
# the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability
# A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap {
variable pkgcap [dict create]
variable pkgcapsdeclared [dict create]
variable pkgcapsaccepted [dict create]
variable caps [dict create]
if {[info commands [namespace current]::interface_caphandler.registry] eq ""} {
oo::class create [namespace current]::interface_caphandler.registry {
method pkg_register {pkg capname capdict fullcapabilitylist} {
#handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid
#overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes.
return 1 ;#default to permit
}
method pkg_unregister {pkg} {
return ;#unregistration return is ignored - review
}
}
oo::class create [namespace current]::interface_capprovider.registration {
method get_declarations {} {
error "interface_capprovider.registration not implemented by provider"
}
}
oo::class create [namespace current]::interface_capprovider.provider {
method register {{capabilityname_glob *}} {
}
method capabilities {} {
}
}
}
#Not all capabilities have to be registered.
#A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated capnamespace (handler).
#such unregistered capabilitynames may be used just to flag something, or have datamembers significant to callers cooperatively interested in that capname.
#we allow registering a capability with an empty handler (capnamespace) - but this means another handler could be registered later.
proc register_capabilityname {capname capnamespace} {
variable caps
variable pkgcapsdeclared
variable pkgcapsaccepted
if {$capnamespace ne ""} {
#normalize with leading :: in case caller passed in package name rather than fully qualified namespace
if {![string match ::* $capnamespace]} {
set capnamespace ::$capnamespace
}
}
#allow register of existing capname iff there is no current handler
#as handlers can be used to validate during provider registration - ideally handlers should be registered before any pkgs call register_package
#we allow loading a handler later though - but will need to validate existing data from pkgs that have already registered as providers
if {[set hdlr [get_handler $capname]] ne ""} {
error "register_capabilityname cannot register capability:$capname with handler:$capnamespace. There is already a registered handler:$hdlr"
}
#assert: capnamespace may or may not be empty string, capname may or may not already exist in caps dict, caps $capname providers may have existing entries.
dict set caps $capname handler $capnamespace
if {![dict exists $caps $capname providers]} {
dict set caps $capname providers [list]
}
if {[llength [set providers [dict get $caps $capname providers]]]} {
#some provider(s) were in place before the handler was registered
if {[set capreg [get_caphandler_registry $capname]] ne ""} {
foreach pkg $providers {
set fullcapabilitylist [dict get $pkgcapsdeclared $pkg]
foreach capspec $fullcapabilitylist {
lassign $capspec cn capdict
if {$cn ne $capname} {
continue
}
set do_register [$capreg pkg_register $pkg $capdict $fullcapabilitylist]
set list_accepted [dict get $pkgcapsaccepted $pkg]
if {$do_register} {
if {$capspec ni $list_accepted} {
dict lappend pkgcapsaccepted $pkg $capspec
}
} else {
set posn [lsearch $list_accepted $capspec]
if {$posn >=0} {
set list_accepted [lreplace $list_accepted $posn $posn]
dict set pkgcapsaccepted $pkg $list_accepted
}
}
}
#check if any accepted for this cap and remove from caps as necessary
set count 0
foreach accepted_capspec [dict get $pkgcapsaccepted $pkg] {
if {[lindex $accepted_capspec 0] eq $capname} {
incr count
}
}
if {$count == 0} {
set pkgposn [lsearch $providers $pkg]
if {$pkgposn >= 0} {
set updated_providers [lreplace $providers $posn $posn]
dict set caps $capname providers $updated_providers
}
}
}
}
}
}
proc exists {capname} {
variable caps
return [dict exists $caps $capname]
}
proc has_handler {capname} {
variable caps
return [expr {[dict exists $caps $capname handler] && [dict get $caps $capname handler] ne ""}]
}
proc get_handler {capname} {
variable caps
if {[dict exists $caps $capname]} {
return [dict get $caps $capname handler]
}
return ""
}
#dispatch
#proc call_handler {capname args} {
# if {[set handler [get_handler $capname]] eq ""} {
# error "punk::cap::call_handler $capname $args - no handler registered for capability $capname"
# }
# ${handler}::[lindex $args 0] {*}[lrange $args 1 end]
#}
proc call_handler {capname args} {
if {[set handler [get_handler $capname]] eq ""} {
error "punk::cap::call_handler $capname $args - no handler registered for capability $capname"
}
set obj ${handler}::$capname
$obj [lindex $args 0] {*}[lrange $args 1 end]
}
proc get_caphandler_registry {capname} {
set ns [get_handler $capname]::capsystem
if {[namespace exists ${ns}]} {
if {[info command ${ns}::caphandler.registry] ne ""} {
if {[info object isa object ${ns}::caphandler.registry]} {
return ${ns}::caphandler.registry
}
}
}
return ""
}
proc get_providers {capname} {
variable caps
if {[dict exists $caps $capname]} {
return [dict get $caps $capname providers]
}
return [list]
}
#register package with arbitrary capnames from capabilitylist
#The registered pkg is a module that provides some service to that capname. Possibly just data members, that the capability will use.
proc register_package {pkg capabilitylist} {
variable pkgcap
variable pkgcapsdeclared
variable pkgcapsaccepted
variable caps
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
@ -35,165 +191,209 @@ namespace eval punk::cap {
#for each capability
# - ensure 1st element is a single word
# - ensure that if 2nd element (capdict) is present - it is dict shaped
foreach c $capabilitylist {
lassign $c capname capdict
foreach capspec $capabilitylist {
lassign $capspec capname capdict
if {[llength $capname] !=1} {
error "register_package error. pkg: '$pkg' An entry in the capability list doesn't appear to have a single-word name. Problematic entry:'$c'"
error "register_package error. pkg: '$pkg' An entry in the capability list doesn't appear to have a single-word name. Problematic entry:'$capspec'"
}
if {[expr {[llength $capdict] %2 != 0}]} {
error "register_package error. pkg:'$pkg' The second element for capname:'$capname' doesn't appear to be a valid dict. Problematic entry: '$c'"
error "register_package error. pkg:'$pkg' The second element for capname:'$capname' doesn't appear to be a valid dict. Problematic entry: '$capspec'"
}
if {[dict exists $caps $capname]} {
set cap_pkgs [dict get $caps $capname]
set cap_pkgs [dict get $caps $capname providers]
} else {
dict set caps $capname [dict create handler "" providers [list]]
set cap_pkgs [list]
}
if {$pkg ni $cap_pkgs} {
dict lappend caps $capname $pkg
#todo - if there's a caphandler - call it's init/validation callback for the pkg
set do_register 1 ;#default assumption unless vetoed by handler
if {[set capreg [get_caphandler_registry $capname]] ne ""} {
#Note that the interface_caphandler.registry instance must be able to handle multiple calls for same pkg
set do_register [$capreg pkg_register $pkg $capname $capdict $capabilitylist]
}
if {$do_register} {
if {$pkg ni $cap_pkgs} {
lappend cap_pkgs $pkg
dict set caps $capname providers $cap_pkgs
}
dict lappend pkgcapsaccepted $pkg $capspec ;#if pkg is being registered prior to handler-registration - the handler may undo this entry
}
}
dict set pkgcap $pkg $capabilitylist
#another call to register_pkg with same pkg may have been made (most likely with different capname) so we must append
#dict lappend pkgcapsdeclared $pkg $capabilitylist
if {[dict exists $pkgcapsdeclared $pkg]} {
set caps [dict get $pkgcapsdeclared $pkg]
lappend caps {*}$capabilitylist
dict set pkgcapsdeclared $pkg $caps
} else {
dict set pkgcapsdeclared $pkg $capabilitylist
}
}
proc unregister_package {pkg} {
variable pkgcapsdeclared
variable caps
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {[dict exists $pkgcapsdeclared $pkg]} {
#remove corresponding entries in caps
set capabilitylist [dict get $pkgcapsdeclared $pkg]
foreach c $capabilitylist {
set do_unregister 1
lassign $c capname _capdict
set cap_info [dict get $caps $capname]
set pkglist [dict get $cap_info providers]
set posn [lsearch $pkglist $pkg]
if {$posn >= 0} {
if {[set capreg [get_caphandler_registry $capname]] ne ""} {
#review
# it seems not useful to allow the callback to block this unregister action
#the pkg may have multiple datasets for each capname so callback will only be called for first dataset we encounter
#vetoing unregister would make this more complex for no particular advantage
#if per capability deregistration required this should probably be a separate thing (e.g disable_capability?)
$capreg pkg_unregister $pkg
}
set pkglist [lreplace $pkglist $posn $posn]
dict set caps $capname providers $pkglist
}
}
#delete the main registration record
dict unset pkgcapsdeclared $pkg
}
}
#review promote/demote doesn't always make a lot of sense .. should possibly be per cap for multicap pkgs
#The idea is to provide a crude way to preference/depreference packages independently of order the packages were loaded
#e.g a caller or cap-handler can ascribe some meaning to the order of the 'providers' key returned from punk::cap::capabilities <capname>
#The order of providers will be the order the packages were loaded & registered
#the naming: "promote vs demote" operates on a latest-package-in-list has higher preference assumption (matching last pkg loaded)
#Each capability handler could implement specific preferencing methods if finer control needed.
#In some cases the preference/loading order may be inapplicable/irrelevant to a particular capability anyway.
#As this is just a basic mechanism, which can't support independent per-cap preferencing for multi-cap packages -
# it only allows putting the pkgs to the head or tail of the lists.
#Whether particular caps or users of caps do anything with this ordering is dependent on the cap-handler and/or calling code.
proc promote_package {pkg} {
variable pkgcap
variable pkgcapsdeclared
variable caps
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {![dict exists $pkgcap $pkg]} {
if {![dict exists $pkgcapsdeclared $pkg]} {
error "punk::cap::promote_package error pkg'$pkg' not registered. Use register_package \$pkg first"
}
if {[dict size $pkgcap] > 1} {
set pkginfo [dict get $pkgcap $pkg]
if {[dict size $pkgcapsdeclared] > 1} {
set pkginfo [dict get $pkgcapsdeclared $pkg]
#remove and re-add at end of dict
dict unset pkgcap $pkg
dict set pkgcap $pkg $pkginfo
foreach {cap cap_pkgs} $caps {
dict unset pkgcapsdeclared $pkg
dict set pkgcapsdeclared $pkg $pkginfo
dict for {cap cap_info} $caps {
set cap_pkgs [dict get $cap_info providers]
if {$pkg in $cap_pkgs} {
set posn [lsearch $cap_pkgs $pkg]
if {$posn >=0} {
#rewrite package list with pkg at tail of list for this capability
set cap_pkgs [lreplace $cap_pkgs $posn $posn]
lappend cap_pkgs $pkg
dict set caps $cap $cap_pkgs
dict set caps $cap providers $cap_pkgs
}
}
}
}
}
proc demote_package {pkg} {
variable pkgcap
variable pkgcapsdeclared
variable caps
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {![dict exists $pkgcap $pkg]} {
if {![dict exists $pkgcapsdeclared $pkg]} {
error "punk::cap::promote_package error pkg'$pkg' not registered. Use register_package \$pkg first"
}
if {[dict size $pkgcap] > 1} {
set pkginfo [dict get $pkgcap $pkg]
if {[dict size $pkgcapsdeclared] > 1} {
set pkginfo [dict get $pkgcapsdeclared $pkg]
#remove and re-add at start of dict
dict unset pkgcap $pkg
dict set pkgcap $pkg $pkginfo
set pkgcap [dict merge [dict create $pkg $pkginfo] $pkgcap]
foreach {cap cap_pkgs} $caps {
dict unset pkgcapsdeclared $pkg
dict set pkgcapsdeclared $pkg $pkginfo
set pkgcapsdeclared [dict merge [dict create $pkg $pkginfo] $pkgcapsdeclared]
dict for {cap cap_info} $caps {
set cap_pkgs [dict get $cap_info providers]
if {$pkg in $cap_pkgs} {
set posn [lsearch $cap_pkgs $pkg]
if {$posn >=0} {
#rewrite package list with pkg at head of list for this capability
set cap_pkgs [lreplace $cap_pkgs $posn $posn]
set cap_pkgs [list $pkg {*}$cap_pkgs]
dict set caps $cap $cap_pkgs
dict set caps $cap providers $cap_pkgs
}
}
}
}
}
proc unregister_package {pkg} {
variable pkgcap
variable caps
proc pkgcap {pkg} {
variable pkgcapsdeclared
variable pkgcapsaccepted
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {[dict exists $pkgcap $pkg]} {
#remove corresponding entries in caps
set capabilitylist [dict get $pkgcap $pkg]
foreach c $capabilitylist {
lassign $c capname _capdict
set pkglist [dict get $caps $capname]
set posn [lsearch $pkglist $pkg]
if {$posn >= 0} {
set pkglist [lreplace $pkglist $posn $posn]
dict set caps $capname $pkglist
}
if {[dict exists $pkgcapsdeclared $pkg]} {
set accepted ""
if {[dict exists $pkgcapsaccepted $pkg]} {
set accepted [dict get $pkgcapsaccepted $pkg]
}
#delete the main registration record
dict unset pkgcap $pkg
}
}
proc registered_package {pkg} {
variable pkgcap
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {[dict exists $pkgcap $pkg]} {
return [dict get $pkgcap $pkg]
return [dict create declared [dict get $pkgcapsdeclared $pkg] accepted $accepted]
} else {
return
}
}
proc registered_packages {} {
variable pkgcap
return $pkgcap
proc pkgcaps {} {
variable pkgcapsdeclared
variable pkgcapsaccepted
set result [dict create]
foreach {pkg capsdeclared} $pkgcapsdeclared {
set accepted ""
if {[dict exists $pkgcapsaccepted $pkg]} {
set accepted [dict get $pkgcapsaccepted $pkg]
}
dict set result $pkg declared $capsdeclared
dict set result $pkg accepted $accepted
}
return $result
}
proc capability {capname} {
variable caps
if {[dict exists $caps $capname]} {
return [dict get $caps $capname]
}
return ""
}
proc capabilities {{glob *}} {
variable caps
set keys [lsort [dict keys $caps $glob]]
set capnames [lsort [dict keys $caps $glob]]
set cap_list [list]
foreach k $keys {
lappend cap_list [list $k [dict get $caps $k]]
foreach capname $capnames {
lappend cap_list [list $capname [dict get $caps $capname]]
}
return $cap_list
}
namespace eval templates {
#return a dict keyed on folder with source pkg as value
proc folders {} {
package require punk::cap
set caplist [punk::cap::capabilities templates]
# e.g {templates {punk::mix::templates ::somepkg}}
set templates_record [lindex $caplist 0]
set pkgs [lindex $templates_record 1]
set folderdict [dict create]
foreach pkg $pkgs {
set caplist [punk::cap::registered_package $pkg]
set templates_entries [lsearch -all -inline -index 0 $caplist templates] ;#we generally expect only one - but if multiple exist - use them
foreach templates_info $templates_entries {
lassign $templates_info _templates templates_dict
if {[dict exists $templates_dict relpath]} {
set provide_statement [package ifneeded $pkg [package require $pkg]]
set tmfile [lindex $provide_statement end]
#set tmdir [file dirname [lindex $provide_statement end]]
set tpath [file normalize [file join $tmfile [dict get $templates_dict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
#relpath relative to file is important for tm files that are zip/tar based containers
if {[file isdirectory $tpath]} {
dict set folderdict $tpath [list source $pkg sourcetype package]
} else {
puts stderr "punk::cap::templates::folders WARNING - unable to determine base folder for package '$pkg' which is registered with punk::mix as a provider of 'templates' capability"
}
} else {
puts stderr "punk::cap::templates::folders WARNING - registered pkg 'pkg' has capability 'templates' but no 'relpath' key - unable to use as source of templates"
}
}
proc capabilitynames {{glob *}} {
variable caps
return [lsort [dict keys $caps $glob]]
}
#return only those capnames which have at least one provider
proc capabilitynames_provided {{glob *}} {
variable caps
set keys [lsort [dict keys $caps $glob]]
set cap_list [list]
foreach k $keys {
if {[llength [dict get $caps $k providers]] > 0} {
lappend cap_list $k
}
return $folderdict
}
return $cap_list
}
}

52
src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap/handlers/caphandler-0.1.0.tm

@ -0,0 +1,52 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application punk::cap::handlers::caphandler 0.1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
##e.g package require frobz
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap::handlers::caphandler {
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::cap::handlers::caphandler [namespace eval punk::cap::handlers::caphandler {
variable pkg punk::cap::handlers::caphandler
variable version
set version 0.1.0
}]
return

52
src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap/handlers/scriptlibs-0.1.0.tm

@ -0,0 +1,52 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application punk::cap::handlers::scriptlibs 0.1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
##e.g package require frobz
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap::handlers::scriptlibs {
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::cap::handlers::scriptlibs [namespace eval punk::cap::handlers::scriptlibs {
variable pkg punk::cap::handlers::scriptlibs
variable version
set version 0.1.0
}]
return

127
src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm

@ -0,0 +1,127 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application punk::cap::handlers::templates 0.1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
##e.g package require frobz
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#register using:
# punk::cap::register_capabilityname templates ::punk::cap::handlers::templates
#By convention and for consistency, we don't register here during package loading - but require the calling app to do it.
# (even if it tends to be done immediately after package require anyway)
# registering capability handlers can involve validating existing provider data and is best done explicitly as required.
# It is also possible for a capability handler to be registered to handle more than one capabilityname
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap::handlers::templates {
namespace eval capsystem {
#interfaces for punk::cap to call into
if {[info commands caphandler.registry] eq ""} {
punk::cap::interface_caphandler.registry create caphandler.registry
oo::objdefine caphandler.registry {
method pkg_register {pkg capname capdict caplist} {
#caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?)
if {![dict exists $capdict relpath]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing 'relpath' key"
return 0
}
set provide_statement [package ifneeded $pkg [package require $pkg]]
set tmfile [lindex $provide_statement end]
if {![file exists $tmfile]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
return 0
}
set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
if {![file isdirectory $tpath]} {
puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to validate relpath location [dict get $capdict relpath] ($tpath) for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
}
if {$capname ni $::punk::cap::handlers::templates::handled_caps} {
lappend ::punk::cap::handlers::templates::handled_caps $capname
}
if {[info commands punk::cap::handlers::templates::$capname] eq ""} {
punk::cap::handlers::templates::api create ::punk::cap::handlers::templates::$capname $capname
}
set cname [string map [list . _] $capname]
upvar ::punk::cap::handlers::templates::pkg_folders_$cname pfolders
dict lappend pfolders $pkg $tpath
return 1
}
method pkg_unregister {pkg} {
upvar ::punk::cap::handlers::templates::handled_caps hcaps
foreach capname $hcaps {
set cname [string map [list . _] $capname]
upvar ::punk::cap::handlers::templates::pkg_folders_$cname pfolders
dict unset pfolders $pkg
#destroy api objects?
}
}
}
}
}
variable handled_caps [list]
#variable pkg_folders [dict create]
# -- --- --- --- --- --- ---
#handler api for clients of this capability - called via punk::cap::call_handler <capname> <method> ?args?
# -- --- --- --- --- --- ---
namespace export *
oo::class create api {
#return a dict keyed on folder with source pkg as value
constructor {capname} {
variable capabilityname
variable cname
set cname [string map [list . _] $capname]
set capabilityname $capname
}
method folders {} {
variable capabilityname
variable cname
upvar punk::cap::handlers::templates::pkg_folders_$cname pkg_folders
package require punk::cap
set capinfo [punk::cap::capability $capabilityname]
# e.g {punk.templates {handler punk::mix::templates providers ::somepkg}}
#use the order of pkgs as registered with punk::cap - may have been modified with punk::cap::promote_package/demote_package
set pkgs [dict get $capinfo providers]
set folderdict [dict create]
foreach pkg $pkgs {
foreach pfolder [dict get $pkg_folders $pkg] {
dict set folderdict $pfolder [list source $pkg sourcetype package]
}
}
return $folderdict
}
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::cap::handlers::templates [namespace eval punk::cap::handlers::templates {
variable pkg punk::cap::handlers::templates
variable version
set version 0.1.0
}]
return

8
src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix-0.2.tm

@ -1,6 +1,12 @@
package require punk::cap
package require punk::mix::templates ;#registers 'templates' capability with punk::cap
package require punk::cap::handlers::templates ;#handler for templates cap
punk::cap::register_capabilityname punk.templates ::punk::cap::handlers::templates
package require punk::mix::templates ;#registers as provider pkg for 'punk.templates' capability with punk::cap
#punk::mix::templates::provider register *
package require punk::mix::base
package require punk::mix::cli

1812
src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/base-0.1.tm

File diff suppressed because it is too large Load Diff

2
src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm

@ -73,7 +73,7 @@ namespace eval punk::mix::commandset::layout {
set glob *
}
set layouts [list]
#set tplfolderdict [punk::cap::templates::folders]
#set tplfolderdict [punk::cap::call_handler punk.templates folders]
set tplfolderdict [punk::mix::base::lib::get_template_basefolders]
dict for {tdir folderinfo} $tplfolderdict {
set layout_base $tdir/layouts

10
src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm

@ -305,7 +305,7 @@ namespace eval punk::mix::commandset::project {
#todo - tag substitutions in src/doc tree
cd $projectdir
::cd $projectdir
if {[file exists $projectdir/src/modules]} {
foreach m $opt_modules {
@ -323,7 +323,7 @@ namespace eval punk::mix::commandset::project {
#generate www/man/md output in 'embedded' folder which should be checked into repo for online documentation
if {[file exists $projectdir/src]} {
cd $projectdir/src
::cd $projectdir/src
#----------
set installer [punkcheck::installtrack new project.new $projectdir/src/.punkcheck]
$installer set_source_target $projectdir/src/doc $projectdir/src/embedded
@ -357,7 +357,7 @@ namespace eval punk::mix::commandset::project {
$installer destroy
}
cd $projectdir
::cd $projectdir
if {![punk::repo::is_fossil_root $projectdir]} {
set first_fossil 1
@ -742,7 +742,7 @@ namespace eval punk::mix::commandset::project {
set workingdir [lindex $workdirs 0]
puts stdout "1 result. Changing dir to $workingdir"
if {[file exists $workingdir]} {
cd $workingdir
::cd $workingdir
return $workingdir
} else {
puts stderr "path $workingdir doesn't appear to exist"
@ -753,7 +753,7 @@ namespace eval punk::mix::commandset::project {
if {[string trim $answer] in $col_rowids} {
set index [expr {$answer - 1}]
set workingdir [lindex $workdirs $index]
cd $workingdir
::cd $workingdir
puts stdout [pmix stat]
return $workingdir
}

37
src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/mix/templates-0.1.0.tm

@ -23,10 +23,43 @@ package require punk::cap
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::mix::templates {
variable pkg punk::mix::templates
variable cap_provider
punk::cap::register_package punk::mix::templates [list\
{templates {relpath ../templates}}\
{punk.templates {relpath ../templates}}\
]
namespace eval capsystem {
if {[info commands capprovider.registration] eq ""} {
punk::cap::interface_capprovider.registration create capprovider.registration
oo::objdefine capprovider.registration {
method get_declarations {} {
set decls [list]
lappend decls punk.templates {relpath ../templates}
lappend decls punk.templates {relpath ../templates2}
return $decls
}
}
}
}
if {[info commands provider] eq ""} {
punk::cap::interface_capprovider.provider create provider
oo::objdefine provider {
method register {{capabilityname_glob *}} {
#puts registering punk::mix::templates $capabilityname
next
}
method capabilities {} {
next
}
}
}
# -- ---
#provider api
# -- ---
#none - declarations only
}

316
src/mixtemplates/layouts/basic/src/bootsupport/modules/punk/overlay-0.1.tm

@ -1,158 +1,158 @@
package require punk::mix::util
namespace eval ::punk::overlay {
#based *loosely* on: wiki.tcl-lang.org/page/ensemble+extend
# extend an ensemble-like routine with the routines in some namespace
#
# e.g custom_from_base ::punk::mix::cli ::punk::mix::base
#
proc custom_from_base {routine base} {
if {![string match ::* $routine]} {
set resolved [uplevel 1 [list ::namespace which $routine]]
if {$resolved eq {}} {
error [list {no such routine} $routine]
}
set routine $resolved
}
set routinens [namespace qualifiers $routine]
if {$routinens eq {::}} {
set routinens {}
}
set routinetail [namespace tail $routine]
if {![string match ::* $base]} {
set base [uplevel 1 [
list [namespace which namespace] current]]::$base
}
if {![namespace exists $base]} {
error [list {no such namespace} $base]
}
set base [namespace eval $base [
list [namespace which namespace] current]]
#while 1 {
# set renamed ${routinens}::${routinetail}_[info cmdcount]
# if {[namespace which $renamed] eq {}} break
#}
namespace eval $routine [
list namespace ensemble configure $routine -unknown [
list apply {{base ensemble subcommand args} {
list ${base}::_redirected $ensemble $subcommand
}} $base
]
]
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${routine}::util
#namespace eval ${routine}::util {
#namespace import ::punk::mix::util::*
#}
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ${base}::lib::* ${routine}::lib
#namespace eval ${routine}::lib [string map [list <base> $base] {
# namespace import <base>::lib::*
#}]
namespace eval ${routine}::lib [string map [list <base> $base <routine> $routine] {
if {[namespace exists <base>::lib]} {
set current_paths [namespace path]
if {"<routine>" ni $current_paths} {
lappend current_paths <routine>
}
namespace path $current_paths
}
}]
namespace eval $routine {
set exportlist [list]
foreach cmd [info commands [namespace current]::*] {
set c [namespace tail $cmd]
if {![string match _* $c]} {
lappend exportlist $c
}
}
namespace export {*}$exportlist
}
return $routine
}
#load *exported* commands from cmdnamespace into caller's namespace - prefixing each command with $prefix
#Note: commandset may be imported by different CLIs with different bases *at the same time*
#so we don't make commands from the cli or its base available automatically (will generally require fully-qualified commands to use code from cli/base)
#we do load punk::mix::util::* into the util subnamespace even though the commandset might not be loaded in a cli using punk::mix::base i.e punk::mix::util is a common dependency for CLIs.
#commandsets designed to be used with a specific cli/base may choose to do their own import e.g with util::namespace_import_pattern_to_namespace_noclobber and/or set namespace path if they
#want the convenience of using lib:xxx with commands coming from those packages.
#This won't stop the commandset being used with other cli/bases unless the import is done by looking up the callers namespace.
#The basic principle is that the commandset is loaded into the caller(s) with a prefix
#- but commandsets should explicitly package require if they have any backwards dependencies on cli/base (which they may or may not be loaded into)
proc import_commandset {prefix separator cmdnamespace} {
set bad_seps [list "::"]
if {$separator in $bad_seps} {
error "import_commandset invalid separator '$separator'"
}
#namespace may or may not be a package
# allow with or without leading ::
if {[string range $cmdnamespace 0 1] eq "::"} {
set cmdpackage [string range $cmdnamespace 2 end]
} else {
set cmdpackage $cmdnamespace
set cmdnamespace ::$cmdnamespace
}
if {![namespace exists $cmdnamespace]} {
#only do package require if the namespace not already present
catch {package require $cmdpackage} pkg_load_info
#recheck
if {![namespace exists $cmdnamespace]} {
set prov [package provide $cmdpackage]
if {[string length $prov]} {
set provinfo "(package $cmdpackage is present with version $prov)"
} else {
set provinfo "(package $cmdpackage not present)"
}
error "punk::overlay::import_commandset supplied namespace '$cmdnamespace' doesn't exist. $provinfo Pkg_load_result: $pkg_load_info Usage: import_commandset prefix separator namespace"
}
}
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${cmdnamespace}::util
#let child namespace 'lib' resolve parent namespace and thus util::xxx
namespace eval ${cmdnamespace}::lib [string map [list <cmdns> $cmdnamespace] {
set nspaths [namespace path]
if {"<cmdns>" ni $nspaths} {
lappend nspaths <cmdns>
}
namespace path $nspaths
}]
set imported_commands [list]
set nscaller [uplevel 1 [list namespace current]]
if {[catch {
namespace eval ${nscaller}::temp_import [list namespace import ${cmdnamespace}::*]
foreach cmd [info commands ${nscaller}::temp_import::*] {
set cmdtail [namespace tail $cmd]
if {$cmdtail eq "_default"} {
set import_as ${nscaller}::${prefix}
} else {
set import_as ${nscaller}::${prefix}${separator}${cmdtail}
}
rename $cmd $import_as
lappend imported_commands $import_as
}
} errM]} {
puts stderr "Error loading commandset $prefix $separator $cmdnamespace"
puts stderr "err: $errM"
}
return $imported_commands
}
}
package provide punk::overlay [namespace eval punk::overlay {
variable version
set version 0.1
}]
package require punk::mix::util
namespace eval ::punk::overlay {
#based *loosely* on: wiki.tcl-lang.org/page/ensemble+extend
# extend an ensemble-like routine with the routines in some namespace
#
# e.g custom_from_base ::punk::mix::cli ::punk::mix::base
#
proc custom_from_base {routine base} {
if {![string match ::* $routine]} {
set resolved [uplevel 1 [list ::namespace which $routine]]
if {$resolved eq {}} {
error [list {no such routine} $routine]
}
set routine $resolved
}
set routinens [namespace qualifiers $routine]
if {$routinens eq {::}} {
set routinens {}
}
set routinetail [namespace tail $routine]
if {![string match ::* $base]} {
set base [uplevel 1 [
list [namespace which namespace] current]]::$base
}
if {![namespace exists $base]} {
error [list {no such namespace} $base]
}
set base [namespace eval $base [
list [namespace which namespace] current]]
#while 1 {
# set renamed ${routinens}::${routinetail}_[info cmdcount]
# if {[namespace which $renamed] eq {}} break
#}
namespace eval $routine [
list namespace ensemble configure $routine -unknown [
list apply {{base ensemble subcommand args} {
list ${base}::_redirected $ensemble $subcommand
}} $base
]
]
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${routine}::util
#namespace eval ${routine}::util {
#namespace import ::punk::mix::util::*
#}
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ${base}::lib::* ${routine}::lib
#namespace eval ${routine}::lib [string map [list <base> $base] {
# namespace import <base>::lib::*
#}]
namespace eval ${routine}::lib [string map [list <base> $base <routine> $routine] {
if {[namespace exists <base>::lib]} {
set current_paths [namespace path]
if {"<routine>" ni $current_paths} {
lappend current_paths <routine>
}
namespace path $current_paths
}
}]
namespace eval $routine {
set exportlist [list]
foreach cmd [info commands [namespace current]::*] {
set c [namespace tail $cmd]
if {![string match _* $c]} {
lappend exportlist $c
}
}
namespace export {*}$exportlist
}
return $routine
}
#load *exported* commands from cmdnamespace into caller's namespace - prefixing each command with $prefix
#Note: commandset may be imported by different CLIs with different bases *at the same time*
#so we don't make commands from the cli or its base available automatically (will generally require fully-qualified commands to use code from cli/base)
#we do load punk::mix::util::* into the util subnamespace even though the commandset might not be loaded in a cli using punk::mix::base i.e punk::mix::util is a common dependency for CLIs.
#commandsets designed to be used with a specific cli/base may choose to do their own import e.g with util::namespace_import_pattern_to_namespace_noclobber and/or set namespace path if they
#want the convenience of using lib:xxx with commands coming from those packages.
#This won't stop the commandset being used with other cli/bases unless the import is done by looking up the callers namespace.
#The basic principle is that the commandset is loaded into the caller(s) with a prefix
#- but commandsets should explicitly package require if they have any backwards dependencies on cli/base (which they may or may not be loaded into)
proc import_commandset {prefix separator cmdnamespace} {
set bad_seps [list "::"]
if {$separator in $bad_seps} {
error "import_commandset invalid separator '$separator'"
}
#namespace may or may not be a package
# allow with or without leading ::
if {[string range $cmdnamespace 0 1] eq "::"} {
set cmdpackage [string range $cmdnamespace 2 end]
} else {
set cmdpackage $cmdnamespace
set cmdnamespace ::$cmdnamespace
}
if {![namespace exists $cmdnamespace]} {
#only do package require if the namespace not already present
catch {package require $cmdpackage} pkg_load_info
#recheck
if {![namespace exists $cmdnamespace]} {
set prov [package provide $cmdpackage]
if {[string length $prov]} {
set provinfo "(package $cmdpackage is present with version $prov)"
} else {
set provinfo "(package $cmdpackage not present)"
}
error "punk::overlay::import_commandset supplied namespace '$cmdnamespace' doesn't exist. $provinfo Pkg_load_result: $pkg_load_info Usage: import_commandset prefix separator namespace"
}
}
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${cmdnamespace}::util
#let child namespace 'lib' resolve parent namespace and thus util::xxx
namespace eval ${cmdnamespace}::lib [string map [list <cmdns> $cmdnamespace] {
set nspaths [namespace path]
if {"<cmdns>" ni $nspaths} {
lappend nspaths <cmdns>
}
namespace path $nspaths
}]
set imported_commands [list]
set nscaller [uplevel 1 [list namespace current]]
if {[catch {
namespace eval ${nscaller}::temp_import [list namespace import ${cmdnamespace}::*]
foreach cmd [info commands ${nscaller}::temp_import::*] {
set cmdtail [namespace tail $cmd]
if {$cmdtail eq "_default"} {
set import_as ${nscaller}::${prefix}
} else {
set import_as ${nscaller}::${prefix}${separator}${cmdtail}
}
rename $cmd $import_as
lappend imported_commands $import_as
}
} errM]} {
puts stderr "Error loading commandset $prefix $separator $cmdnamespace"
puts stderr "err: $errM"
}
return $imported_commands
}
}
package provide punk::overlay [namespace eval punk::overlay {
variable version
set version 0.1
}]

152
src/mixtemplates/layouts/basic/src/make.tcl

@ -259,84 +259,110 @@ if {$::punkmake::command eq "bootsupport"} {
proc bootsupport_localupdate {projectroot} {
set bootsupport_modules [list]
set bootsupport_module_folders [list]
set bootsupport_config $projectroot/src/bootsupport/include_modules.config ;#
if {[file exists $bootsupport_config]} {
set targetroot $projectroot/src/bootsupport/modules
source $bootsupport_config ;#populate $bootsupport_modules with project-specific list
if {![llength $bootsupport_modules]} {
puts stderr "No local bootsupport modules configured for updating"
return
}
set targetroot $projectroot/src/bootsupport/modules
if {[catch {
#----------
set boot_installer [punkcheck::installtrack new make.tcl $projectroot/src/bootsupport/.punkcheck]
$boot_installer set_source_target $projectroot $projectroot/src/bootsupport
set boot_event [$boot_installer start_event {-make_step bootsupport}]
#----------
} errM]} {
puts stderr "Unable to use punkcheck for bootsupport error: $errM"
set boot_event ""
}
} else {
foreach {relpath module} $bootsupport_modules {
set module [string trim $module :]
set module_subpath [string map [list :: /] [namespace qualifiers $module]]
set srclocation [file join $projectroot $relpath $module_subpath]
#puts stdout "$relpath $module $module_subpath $srclocation"
set pkgmatches [glob -nocomplain -dir $srclocation -tail [namespace tail $module]-*]
#lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1
if {![llength $pkgmatches]} {
puts stderr "Missing source for bootsupport module $module - not found in $srclocation"
continue
}
set latestfile [lindex $pkgmatches 0]
set latestver [lindex [split [file rootname $latestfile] -] 1]
foreach m $pkgmatches {
lassign [split [file rootname $m] -] _pkg ver
#puts "comparing $ver vs $latestver"
if {[package vcompare $ver $latestver] == 1} {
set latestver $ver
set latestfile $m
}
}
set srcfile [file join $srclocation $latestfile]
set tgtfile [file join $targetroot $module_subpath $latestfile]
if {$boot_event ne ""} {
if {[catch {
#----------
$boot_event targetset_init INSTALL $tgtfile
$boot_event targetset_addsource $srcfile
set boot_installer [punkcheck::installtrack new make.tcl $projectroot/src/bootsupport/.punkcheck]
$boot_installer set_source_target $projectroot $projectroot/src/bootsupport
set boot_event [$boot_installer start_event {-make_step bootsupport}]
#----------
if {\
[llength [dict get [$boot_event targetset_source_changes] changed]]\
|| [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\
} {
file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists
$boot_event targetset_started
# -- --- --- --- --- ---
puts "BOOTSUPPORT update: $srcfile -> $tgtfile"
if {[catch {
file copy -force $srcfile $tgtfile
} errM]} {
$boot_event targetset_end FAILED
} errM]} {
puts stderr "Unable to use punkcheck for bootsupport error: $errM"
set boot_event ""
}
foreach {relpath module} $bootsupport_modules {
set module [string trim $module :]
set module_subpath [string map [list :: /] [namespace qualifiers $module]]
set srclocation [file join $projectroot $relpath $module_subpath]
#puts stdout "$relpath $module $module_subpath $srclocation"
set pkgmatches [glob -nocomplain -dir $srclocation -tail [namespace tail $module]-*]
#lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1
if {![llength $pkgmatches]} {
puts stderr "Missing source for bootsupport module $module - not found in $srclocation"
continue
}
set latestfile [lindex $pkgmatches 0]
set latestver [lindex [split [file rootname $latestfile] -] 1]
foreach m $pkgmatches {
lassign [split [file rootname $m] -] _pkg ver
#puts "comparing $ver vs $latestver"
if {[package vcompare $ver $latestver] == 1} {
set latestver $ver
set latestfile $m
}
}
set srcfile [file join $srclocation $latestfile]
set tgtfile [file join $targetroot $module_subpath $latestfile]
if {$boot_event ne ""} {
#----------
$boot_event targetset_init INSTALL $tgtfile
$boot_event targetset_addsource $srcfile
#----------
if {\
[llength [dict get [$boot_event targetset_source_changes] changed]]\
|| [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\
} {
file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists
$boot_event targetset_started
# -- --- --- --- --- ---
puts "BOOTSUPPORT update: $srcfile -> $tgtfile"
if {[catch {
file copy -force $srcfile $tgtfile
} errM]} {
$boot_event targetset_end FAILED
} else {
$boot_event targetset_end OK
}
# -- --- --- --- --- ---
} else {
$boot_event targetset_end OK
puts -nonewline stderr "."
$boot_event targetset_end SKIPPED
}
# -- --- --- --- --- ---
$boot_event end
} else {
puts -nonewline stderr "."
$boot_event targetset_end SKIPPED
file copy -force $srcfile $tgtfile
}
$boot_event end
} else {
file copy -force $srcfile $tgtfile
}
if {$boot_event ne ""} {
puts \n
$boot_event destroy
$boot_installer destroy
}
}
if {$boot_event ne ""} {
puts \n
$boot_event destroy
$boot_installer destroy
foreach folder $bootsupport_module_folders {
#explicitly ignore punk/mix/templates folder even if specified in config.
#punk/mix/templates contains modules including punk/mix/templates itself - the actual templates aren't needed for the bootsupport system,
# as make.tcl shouldn't be building new projects from the one being made.
#review.
#should we be autodetecting such recursive folder structures - (or is the bootsupport copying in need of a rethink?)
if {[string trim $folder /] eq "punk/mix/templates"} {
puts stderr "IGNORING punk/mix/templates - not needed/desirable in bootsupport"
continue
}
set src [file join $projectroot/modules $folder]
if {![file isdirectory $src]} {
puts stderr "bootsupport folder not found: $src"
continue
}
set tgt [file join $targetroot $folder]
file mkdir $tgt
puts stdout "BOOTSUPPORT non_tm_files $src - copying to $tgt (if source file changed)"
set overwrite "installedsourcechanged-targets"
set resultdict [punkcheck::install_non_tm_files $src $tgt -installer make.tcl -overwrite $overwrite -punkcheck_folder $projectroot/src/bootsupport]
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
}
}
}

6
src/modules/punk/cap/handlers/templates-999999.0a1.0.tm

@ -40,18 +40,18 @@ namespace eval punk::cap::handlers::templates {
method pkg_register {pkg capname capdict caplist} {
#caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?)
if {![dict exists $capdict relpath]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of 'templates' capability, but is missing 'relpath' key"
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing 'relpath' key"
return 0
}
set provide_statement [package ifneeded $pkg [package require $pkg]]
set tmfile [lindex $provide_statement end]
if {![file exists $tmfile]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of 'templates' capability"
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
return 0
}
set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
if {![file isdirectory $tpath]} {
puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to determine relpath location [dict get $capdict relpath] for package '$pkg' which is attempting to register with punk::cap as a provider of 'templates' capability"
puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to validate relpath location [dict get $capdict relpath] ($tpath) for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
}
if {$capname ni $::punk::cap::handlers::templates::handled_caps} {
lappend ::punk::cap::handlers::templates::handled_caps $capname

390
src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/oolib-0.1.tm

@ -1,195 +1,195 @@
#JMN - api should be kept in sync with package patternlib where possible
#
package provide oolib [namespace eval oolib {
variable version
set version 0.1
}]
namespace eval oolib {
oo::class create collection {
variable o_data ;#dict
variable o_alias
constructor {} {
set o_data [dict create]
}
method info {} {
return [dict info $o_data]
}
method count {} {
return [dict size $o_data]
}
method isEmpty {} {
expr {[dict size $o_data] == 0}
}
method names {{globOrIdx {}}} {
if {[llength $globOrIdx]} {
if {[string is integer -strict $globOrIdx]} {
if {$idx < 0} {
set idx "end-[expr {abs($idx + 1)}]"
}
if {[catch {lindex [dict keys $o_data] $idx} result]} {
error "[self object] no such index : '$idx'"
} else {
return $result
}
} else {
#glob
return [lsearch -glob -all -inline [dict keys $o_data] $globOrIdx]
}
} else {
return [dict keys $o_data]
}
}
#like names but without globbing
method keys {} {
dict keys $o_data
}
method key {{posn 0}} {
if {$posn < 0} {
set posn "end-[expr {abs($posn + 1)}]"
}
if {[catch {lindex [dict keys $o_data] $posn} result]} {
error "[self object] no such index : '$posn'"
} else {
return $result
}
}
method hasKey {key} {
dict exists $o_data $key
}
method get {} {
return $o_data
}
method items {} {
return [dict values $o_data]
}
method item {key} {
if {[string is integer -strict $key]} {
if {$key > 0} {
set valposn [expr {(2*$key) +1}]
return [lindex $o_data $valposn]
} else {
set key "end-[expr {abs($key + 1)}]"
return [lindex [dict keys $o_data] $key]
}
}
if {[dict exists $o_data $key]} {
return [dict get $o_data $key]
}
}
#inverse lookup
method itemKeys {value} {
set value_indices [lsearch -all [dict values $o_data] $value]
set keylist [list]
foreach i $value_indices {
set idx [expr {(($i + 1) *2) -2}]
lappend keylist [lindex $o_data $idx]
}
return $keylist
}
method search {value args} {
set matches [lsearch {*}$args [dict values $o_data] $value]
if {"-inline" in $args} {
return $matches
} else {
set keylist [list]
foreach i $matches {
set idx [expr {(($i + 1) *2) -2}]
lappend keylist [lindex $o_data $idx]
}
return $keylist
}
}
#review - see patternlib. Is the intention for aliases to be configurable independent of whether the target exists?
method alias {newAlias existingKeyOrAlias} {
if {[string is integer -strict $newAlias]} {
error "[self object] collection key alias cannot be integer"
}
if {[string length $existingKeyOrAlias]} {
set o_alias($newAlias) $existingKeyOrAlias
} else {
unset o_alias($newAlias)
}
}
method aliases {{key ""}} {
if {[string length $key]} {
set result [list]
foreach {n v} [array get o_alias] {
if {$v eq $key} {
lappend result $n $v
}
}
return $result
} else {
return [array get o_alias]
}
}
#if the supplied index is an alias, return the underlying key; else return the index supplied.
method realKey {idx} {
if {[catch {set o_alias($idx)} key]} {
return $idx
} else {
return $key
}
}
method add {value key} {
if {[string is integer -strict $key]} {
error "[self object] collection key must not be an integer. Use another structure if integer keys required"
}
if {[dict exists $o_data $key]} {
error "[self object] col_processors object error: key '$key' already exists in collection"
}
dict set o_data $key $value
return [expr {[dict size $o_data] - 1}] ;#return index of item
}
method remove {idx {endRange ""}} {
if {[string length $endRange]} {
error "[self object] collection error: ranged removal not yet implemented.. remove one item at a time"
}
if {[string is integer -strict $idx]} {
if {$idx < 0} {
set idx "end-[expr {abs($idx+1)}]"
}
set key [lindex [dict keys $o_data] $idx]
set posn $idx
} else {
set key $idx
set posn [lsearch -exact [dict keys $o_data] $key]
if {$posn < 0} {
error "[self object] no such index: '$idx' in this collection"
}
}
dict unset o_data $key
return
}
method clear {} {
set o_data [dict create]
return
}
method reverse {} {
set dictnew [dict create]
foreach k [lreverse [dict keys $o_data]] {
dict set dictnew $k [dict get $o_data $k]
}
set o_data $dictnew
return
}
#review - cmd as list vs cmd as script?
method map {cmd} {
set seed [list]
dict for {k v} $o_data {
lappend seed [uplevel #0 [list {*}$cmd $v]]
}
return $seed
}
method objectmap {cmd} {
set seed [list]
dict for {k v} $o_data {
lappend seed [uplevel #0 [list $v {*}$cmd]]
}
return $seed
}
}
}
#JMN - api should be kept in sync with package patternlib where possible
#
package provide oolib [namespace eval oolib {
variable version
set version 0.1
}]
namespace eval oolib {
oo::class create collection {
variable o_data ;#dict
variable o_alias
constructor {} {
set o_data [dict create]
}
method info {} {
return [dict info $o_data]
}
method count {} {
return [dict size $o_data]
}
method isEmpty {} {
expr {[dict size $o_data] == 0}
}
method names {{globOrIdx {}}} {
if {[llength $globOrIdx]} {
if {[string is integer -strict $globOrIdx]} {
if {$idx < 0} {
set idx "end-[expr {abs($idx + 1)}]"
}
if {[catch {lindex [dict keys $o_data] $idx} result]} {
error "[self object] no such index : '$idx'"
} else {
return $result
}
} else {
#glob
return [lsearch -glob -all -inline [dict keys $o_data] $globOrIdx]
}
} else {
return [dict keys $o_data]
}
}
#like names but without globbing
method keys {} {
dict keys $o_data
}
method key {{posn 0}} {
if {$posn < 0} {
set posn "end-[expr {abs($posn + 1)}]"
}
if {[catch {lindex [dict keys $o_data] $posn} result]} {
error "[self object] no such index : '$posn'"
} else {
return $result
}
}
method hasKey {key} {
dict exists $o_data $key
}
method get {} {
return $o_data
}
method items {} {
return [dict values $o_data]
}
method item {key} {
if {[string is integer -strict $key]} {
if {$key > 0} {
set valposn [expr {(2*$key) +1}]
return [lindex $o_data $valposn]
} else {
set key "end-[expr {abs($key + 1)}]"
return [lindex [dict keys $o_data] $key]
}
}
if {[dict exists $o_data $key]} {
return [dict get $o_data $key]
}
}
#inverse lookup
method itemKeys {value} {
set value_indices [lsearch -all [dict values $o_data] $value]
set keylist [list]
foreach i $value_indices {
set idx [expr {(($i + 1) *2) -2}]
lappend keylist [lindex $o_data $idx]
}
return $keylist
}
method search {value args} {
set matches [lsearch {*}$args [dict values $o_data] $value]
if {"-inline" in $args} {
return $matches
} else {
set keylist [list]
foreach i $matches {
set idx [expr {(($i + 1) *2) -2}]
lappend keylist [lindex $o_data $idx]
}
return $keylist
}
}
#review - see patternlib. Is the intention for aliases to be configurable independent of whether the target exists?
method alias {newAlias existingKeyOrAlias} {
if {[string is integer -strict $newAlias]} {
error "[self object] collection key alias cannot be integer"
}
if {[string length $existingKeyOrAlias]} {
set o_alias($newAlias) $existingKeyOrAlias
} else {
unset o_alias($newAlias)
}
}
method aliases {{key ""}} {
if {[string length $key]} {
set result [list]
foreach {n v} [array get o_alias] {
if {$v eq $key} {
lappend result $n $v
}
}
return $result
} else {
return [array get o_alias]
}
}
#if the supplied index is an alias, return the underlying key; else return the index supplied.
method realKey {idx} {
if {[catch {set o_alias($idx)} key]} {
return $idx
} else {
return $key
}
}
method add {value key} {
if {[string is integer -strict $key]} {
error "[self object] collection key must not be an integer. Use another structure if integer keys required"
}
if {[dict exists $o_data $key]} {
error "[self object] col_processors object error: key '$key' already exists in collection"
}
dict set o_data $key $value
return [expr {[dict size $o_data] - 1}] ;#return index of item
}
method remove {idx {endRange ""}} {
if {[string length $endRange]} {
error "[self object] collection error: ranged removal not yet implemented.. remove one item at a time"
}
if {[string is integer -strict $idx]} {
if {$idx < 0} {
set idx "end-[expr {abs($idx+1)}]"
}
set key [lindex [dict keys $o_data] $idx]
set posn $idx
} else {
set key $idx
set posn [lsearch -exact [dict keys $o_data] $key]
if {$posn < 0} {
error "[self object] no such index: '$idx' in this collection"
}
}
dict unset o_data $key
return
}
method clear {} {
set o_data [dict create]
return
}
method reverse {} {
set dictnew [dict create]
foreach k [lreverse [dict keys $o_data]] {
dict set dictnew $k [dict get $o_data $k]
}
set o_data $dictnew
return
}
#review - cmd as list vs cmd as script?
method map {cmd} {
set seed [list]
dict for {k v} $o_data {
lappend seed [uplevel #0 [list {*}$cmd $v]]
}
return $seed
}
method objectmap {cmd} {
set seed [list]
dict for {k v} $o_data {
lappend seed [uplevel #0 [list $v {*}$cmd]]
}
return $seed
}
}
}

386
src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap-0.1.0.tm

@ -19,15 +19,171 @@
## Requirements
##e.g package require frobz
#concepts:
# A capability may be something like providing a folder of files, or just a data dictionary, and/or an API
#
# capability handler - a package/namespace which may provide validation and standardised ways of looking up provider data
# registered (or not) using register_capabilityname <capname> <capnamespace>
# capability provider - a package which registers as providing one or more capablities.
# registered using register_package <pkg> <capabilitylist>
# the capabilitylist is a list of 2-element lists where the first element is the capabilityname and the second element is a (possibly empty) dict of data relevant to that capability
# A capabilityname may appear multiple times. ie a package may register that it provides the capability with multiple datasets.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap {
variable pkgcap [dict create]
variable pkgcapsdeclared [dict create]
variable pkgcapsaccepted [dict create]
variable caps [dict create]
if {[info commands [namespace current]::interface_caphandler.registry] eq ""} {
oo::class create [namespace current]::interface_caphandler.registry {
method pkg_register {pkg capname capdict fullcapabilitylist} {
#handler may override and return 0 (indicating don't register)e.g if pkg capdict data wasn't valid
#overridden handler must be able to handle multiple calls for same pkg - but it may return 1 or 0 as it wishes.
return 1 ;#default to permit
}
method pkg_unregister {pkg} {
return ;#unregistration return is ignored - review
}
}
oo::class create [namespace current]::interface_capprovider.registration {
method get_declarations {} {
error "interface_capprovider.registration not implemented by provider"
}
}
oo::class create [namespace current]::interface_capprovider.provider {
method register {{capabilityname_glob *}} {
}
method capabilities {} {
}
}
}
#Not all capabilities have to be registered.
#A package registering as a provider using register_package can include capabilitynames in it's capabilitylist which have no associated capnamespace (handler).
#such unregistered capabilitynames may be used just to flag something, or have datamembers significant to callers cooperatively interested in that capname.
#we allow registering a capability with an empty handler (capnamespace) - but this means another handler could be registered later.
proc register_capabilityname {capname capnamespace} {
variable caps
variable pkgcapsdeclared
variable pkgcapsaccepted
if {$capnamespace ne ""} {
#normalize with leading :: in case caller passed in package name rather than fully qualified namespace
if {![string match ::* $capnamespace]} {
set capnamespace ::$capnamespace
}
}
#allow register of existing capname iff there is no current handler
#as handlers can be used to validate during provider registration - ideally handlers should be registered before any pkgs call register_package
#we allow loading a handler later though - but will need to validate existing data from pkgs that have already registered as providers
if {[set hdlr [get_handler $capname]] ne ""} {
error "register_capabilityname cannot register capability:$capname with handler:$capnamespace. There is already a registered handler:$hdlr"
}
#assert: capnamespace may or may not be empty string, capname may or may not already exist in caps dict, caps $capname providers may have existing entries.
dict set caps $capname handler $capnamespace
if {![dict exists $caps $capname providers]} {
dict set caps $capname providers [list]
}
if {[llength [set providers [dict get $caps $capname providers]]]} {
#some provider(s) were in place before the handler was registered
if {[set capreg [get_caphandler_registry $capname]] ne ""} {
foreach pkg $providers {
set fullcapabilitylist [dict get $pkgcapsdeclared $pkg]
foreach capspec $fullcapabilitylist {
lassign $capspec cn capdict
if {$cn ne $capname} {
continue
}
set do_register [$capreg pkg_register $pkg $capdict $fullcapabilitylist]
set list_accepted [dict get $pkgcapsaccepted $pkg]
if {$do_register} {
if {$capspec ni $list_accepted} {
dict lappend pkgcapsaccepted $pkg $capspec
}
} else {
set posn [lsearch $list_accepted $capspec]
if {$posn >=0} {
set list_accepted [lreplace $list_accepted $posn $posn]
dict set pkgcapsaccepted $pkg $list_accepted
}
}
}
#check if any accepted for this cap and remove from caps as necessary
set count 0
foreach accepted_capspec [dict get $pkgcapsaccepted $pkg] {
if {[lindex $accepted_capspec 0] eq $capname} {
incr count
}
}
if {$count == 0} {
set pkgposn [lsearch $providers $pkg]
if {$pkgposn >= 0} {
set updated_providers [lreplace $providers $posn $posn]
dict set caps $capname providers $updated_providers
}
}
}
}
}
}
proc exists {capname} {
variable caps
return [dict exists $caps $capname]
}
proc has_handler {capname} {
variable caps
return [expr {[dict exists $caps $capname handler] && [dict get $caps $capname handler] ne ""}]
}
proc get_handler {capname} {
variable caps
if {[dict exists $caps $capname]} {
return [dict get $caps $capname handler]
}
return ""
}
#dispatch
#proc call_handler {capname args} {
# if {[set handler [get_handler $capname]] eq ""} {
# error "punk::cap::call_handler $capname $args - no handler registered for capability $capname"
# }
# ${handler}::[lindex $args 0] {*}[lrange $args 1 end]
#}
proc call_handler {capname args} {
if {[set handler [get_handler $capname]] eq ""} {
error "punk::cap::call_handler $capname $args - no handler registered for capability $capname"
}
set obj ${handler}::$capname
$obj [lindex $args 0] {*}[lrange $args 1 end]
}
proc get_caphandler_registry {capname} {
set ns [get_handler $capname]::capsystem
if {[namespace exists ${ns}]} {
if {[info command ${ns}::caphandler.registry] ne ""} {
if {[info object isa object ${ns}::caphandler.registry]} {
return ${ns}::caphandler.registry
}
}
}
return ""
}
proc get_providers {capname} {
variable caps
if {[dict exists $caps $capname]} {
return [dict get $caps $capname providers]
}
return [list]
}
#register package with arbitrary capnames from capabilitylist
#The registered pkg is a module that provides some service to that capname. Possibly just data members, that the capability will use.
proc register_package {pkg capabilitylist} {
variable pkgcap
variable pkgcapsdeclared
variable pkgcapsaccepted
variable caps
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
@ -35,165 +191,209 @@ namespace eval punk::cap {
#for each capability
# - ensure 1st element is a single word
# - ensure that if 2nd element (capdict) is present - it is dict shaped
foreach c $capabilitylist {
lassign $c capname capdict
foreach capspec $capabilitylist {
lassign $capspec capname capdict
if {[llength $capname] !=1} {
error "register_package error. pkg: '$pkg' An entry in the capability list doesn't appear to have a single-word name. Problematic entry:'$c'"
error "register_package error. pkg: '$pkg' An entry in the capability list doesn't appear to have a single-word name. Problematic entry:'$capspec'"
}
if {[expr {[llength $capdict] %2 != 0}]} {
error "register_package error. pkg:'$pkg' The second element for capname:'$capname' doesn't appear to be a valid dict. Problematic entry: '$c'"
error "register_package error. pkg:'$pkg' The second element for capname:'$capname' doesn't appear to be a valid dict. Problematic entry: '$capspec'"
}
if {[dict exists $caps $capname]} {
set cap_pkgs [dict get $caps $capname]
set cap_pkgs [dict get $caps $capname providers]
} else {
dict set caps $capname [dict create handler "" providers [list]]
set cap_pkgs [list]
}
if {$pkg ni $cap_pkgs} {
dict lappend caps $capname $pkg
#todo - if there's a caphandler - call it's init/validation callback for the pkg
set do_register 1 ;#default assumption unless vetoed by handler
if {[set capreg [get_caphandler_registry $capname]] ne ""} {
#Note that the interface_caphandler.registry instance must be able to handle multiple calls for same pkg
set do_register [$capreg pkg_register $pkg $capname $capdict $capabilitylist]
}
if {$do_register} {
if {$pkg ni $cap_pkgs} {
lappend cap_pkgs $pkg
dict set caps $capname providers $cap_pkgs
}
dict lappend pkgcapsaccepted $pkg $capspec ;#if pkg is being registered prior to handler-registration - the handler may undo this entry
}
}
dict set pkgcap $pkg $capabilitylist
#another call to register_pkg with same pkg may have been made (most likely with different capname) so we must append
#dict lappend pkgcapsdeclared $pkg $capabilitylist
if {[dict exists $pkgcapsdeclared $pkg]} {
set caps [dict get $pkgcapsdeclared $pkg]
lappend caps {*}$capabilitylist
dict set pkgcapsdeclared $pkg $caps
} else {
dict set pkgcapsdeclared $pkg $capabilitylist
}
}
proc unregister_package {pkg} {
variable pkgcapsdeclared
variable caps
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {[dict exists $pkgcapsdeclared $pkg]} {
#remove corresponding entries in caps
set capabilitylist [dict get $pkgcapsdeclared $pkg]
foreach c $capabilitylist {
set do_unregister 1
lassign $c capname _capdict
set cap_info [dict get $caps $capname]
set pkglist [dict get $cap_info providers]
set posn [lsearch $pkglist $pkg]
if {$posn >= 0} {
if {[set capreg [get_caphandler_registry $capname]] ne ""} {
#review
# it seems not useful to allow the callback to block this unregister action
#the pkg may have multiple datasets for each capname so callback will only be called for first dataset we encounter
#vetoing unregister would make this more complex for no particular advantage
#if per capability deregistration required this should probably be a separate thing (e.g disable_capability?)
$capreg pkg_unregister $pkg
}
set pkglist [lreplace $pkglist $posn $posn]
dict set caps $capname providers $pkglist
}
}
#delete the main registration record
dict unset pkgcapsdeclared $pkg
}
}
#review promote/demote doesn't always make a lot of sense .. should possibly be per cap for multicap pkgs
#The idea is to provide a crude way to preference/depreference packages independently of order the packages were loaded
#e.g a caller or cap-handler can ascribe some meaning to the order of the 'providers' key returned from punk::cap::capabilities <capname>
#The order of providers will be the order the packages were loaded & registered
#the naming: "promote vs demote" operates on a latest-package-in-list has higher preference assumption (matching last pkg loaded)
#Each capability handler could implement specific preferencing methods if finer control needed.
#In some cases the preference/loading order may be inapplicable/irrelevant to a particular capability anyway.
#As this is just a basic mechanism, which can't support independent per-cap preferencing for multi-cap packages -
# it only allows putting the pkgs to the head or tail of the lists.
#Whether particular caps or users of caps do anything with this ordering is dependent on the cap-handler and/or calling code.
proc promote_package {pkg} {
variable pkgcap
variable pkgcapsdeclared
variable caps
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {![dict exists $pkgcap $pkg]} {
if {![dict exists $pkgcapsdeclared $pkg]} {
error "punk::cap::promote_package error pkg'$pkg' not registered. Use register_package \$pkg first"
}
if {[dict size $pkgcap] > 1} {
set pkginfo [dict get $pkgcap $pkg]
if {[dict size $pkgcapsdeclared] > 1} {
set pkginfo [dict get $pkgcapsdeclared $pkg]
#remove and re-add at end of dict
dict unset pkgcap $pkg
dict set pkgcap $pkg $pkginfo
foreach {cap cap_pkgs} $caps {
dict unset pkgcapsdeclared $pkg
dict set pkgcapsdeclared $pkg $pkginfo
dict for {cap cap_info} $caps {
set cap_pkgs [dict get $cap_info providers]
if {$pkg in $cap_pkgs} {
set posn [lsearch $cap_pkgs $pkg]
if {$posn >=0} {
#rewrite package list with pkg at tail of list for this capability
set cap_pkgs [lreplace $cap_pkgs $posn $posn]
lappend cap_pkgs $pkg
dict set caps $cap $cap_pkgs
dict set caps $cap providers $cap_pkgs
}
}
}
}
}
proc demote_package {pkg} {
variable pkgcap
variable pkgcapsdeclared
variable caps
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {![dict exists $pkgcap $pkg]} {
if {![dict exists $pkgcapsdeclared $pkg]} {
error "punk::cap::promote_package error pkg'$pkg' not registered. Use register_package \$pkg first"
}
if {[dict size $pkgcap] > 1} {
set pkginfo [dict get $pkgcap $pkg]
if {[dict size $pkgcapsdeclared] > 1} {
set pkginfo [dict get $pkgcapsdeclared $pkg]
#remove and re-add at start of dict
dict unset pkgcap $pkg
dict set pkgcap $pkg $pkginfo
set pkgcap [dict merge [dict create $pkg $pkginfo] $pkgcap]
foreach {cap cap_pkgs} $caps {
dict unset pkgcapsdeclared $pkg
dict set pkgcapsdeclared $pkg $pkginfo
set pkgcapsdeclared [dict merge [dict create $pkg $pkginfo] $pkgcapsdeclared]
dict for {cap cap_info} $caps {
set cap_pkgs [dict get $cap_info providers]
if {$pkg in $cap_pkgs} {
set posn [lsearch $cap_pkgs $pkg]
if {$posn >=0} {
#rewrite package list with pkg at head of list for this capability
set cap_pkgs [lreplace $cap_pkgs $posn $posn]
set cap_pkgs [list $pkg {*}$cap_pkgs]
dict set caps $cap $cap_pkgs
dict set caps $cap providers $cap_pkgs
}
}
}
}
}
proc unregister_package {pkg} {
variable pkgcap
variable caps
proc pkgcap {pkg} {
variable pkgcapsdeclared
variable pkgcapsaccepted
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {[dict exists $pkgcap $pkg]} {
#remove corresponding entries in caps
set capabilitylist [dict get $pkgcap $pkg]
foreach c $capabilitylist {
lassign $c capname _capdict
set pkglist [dict get $caps $capname]
set posn [lsearch $pkglist $pkg]
if {$posn >= 0} {
set pkglist [lreplace $pkglist $posn $posn]
dict set caps $capname $pkglist
}
if {[dict exists $pkgcapsdeclared $pkg]} {
set accepted ""
if {[dict exists $pkgcapsaccepted $pkg]} {
set accepted [dict get $pkgcapsaccepted $pkg]
}
#delete the main registration record
dict unset pkgcap $pkg
}
}
proc registered_package {pkg} {
variable pkgcap
if {[string match ::* $pkg]} {
set pkg [string range $pkg 2 end]
}
if {[dict exists $pkgcap $pkg]} {
return [dict get $pkgcap $pkg]
return [dict create declared [dict get $pkgcapsdeclared $pkg] accepted $accepted]
} else {
return
}
}
proc registered_packages {} {
variable pkgcap
return $pkgcap
proc pkgcaps {} {
variable pkgcapsdeclared
variable pkgcapsaccepted
set result [dict create]
foreach {pkg capsdeclared} $pkgcapsdeclared {
set accepted ""
if {[dict exists $pkgcapsaccepted $pkg]} {
set accepted [dict get $pkgcapsaccepted $pkg]
}
dict set result $pkg declared $capsdeclared
dict set result $pkg accepted $accepted
}
return $result
}
proc capability {capname} {
variable caps
if {[dict exists $caps $capname]} {
return [dict get $caps $capname]
}
return ""
}
proc capabilities {{glob *}} {
variable caps
set keys [lsort [dict keys $caps $glob]]
set capnames [lsort [dict keys $caps $glob]]
set cap_list [list]
foreach k $keys {
lappend cap_list [list $k [dict get $caps $k]]
foreach capname $capnames {
lappend cap_list [list $capname [dict get $caps $capname]]
}
return $cap_list
}
namespace eval templates {
#return a dict keyed on folder with source pkg as value
proc folders {} {
package require punk::cap
set caplist [punk::cap::capabilities templates]
# e.g {templates {punk::mix::templates ::somepkg}}
set templates_record [lindex $caplist 0]
set pkgs [lindex $templates_record 1]
set folderdict [dict create]
foreach pkg $pkgs {
set caplist [punk::cap::registered_package $pkg]
set templates_entries [lsearch -all -inline -index 0 $caplist templates] ;#we generally expect only one - but if multiple exist - use them
foreach templates_info $templates_entries {
lassign $templates_info _templates templates_dict
if {[dict exists $templates_dict relpath]} {
set provide_statement [package ifneeded $pkg [package require $pkg]]
set tmfile [lindex $provide_statement end]
#set tmdir [file dirname [lindex $provide_statement end]]
set tpath [file normalize [file join $tmfile [dict get $templates_dict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
#relpath relative to file is important for tm files that are zip/tar based containers
if {[file isdirectory $tpath]} {
dict set folderdict $tpath [list source $pkg sourcetype package]
} else {
puts stderr "punk::cap::templates::folders WARNING - unable to determine base folder for package '$pkg' which is registered with punk::mix as a provider of 'templates' capability"
}
} else {
puts stderr "punk::cap::templates::folders WARNING - registered pkg 'pkg' has capability 'templates' but no 'relpath' key - unable to use as source of templates"
}
}
proc capabilitynames {{glob *}} {
variable caps
return [lsort [dict keys $caps $glob]]
}
#return only those capnames which have at least one provider
proc capabilitynames_provided {{glob *}} {
variable caps
set keys [lsort [dict keys $caps $glob]]
set cap_list [list]
foreach k $keys {
if {[llength [dict get $caps $k providers]] > 0} {
lappend cap_list $k
}
return $folderdict
}
return $cap_list
}
}

52
src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap/handlers/caphandler-0.1.0.tm

@ -0,0 +1,52 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application punk::cap::handlers::caphandler 0.1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
##e.g package require frobz
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap::handlers::caphandler {
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::cap::handlers::caphandler [namespace eval punk::cap::handlers::caphandler {
variable pkg punk::cap::handlers::caphandler
variable version
set version 0.1.0
}]
return

52
src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap/handlers/scriptlibs-0.1.0.tm

@ -0,0 +1,52 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application punk::cap::handlers::scriptlibs 0.1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
##e.g package require frobz
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap::handlers::scriptlibs {
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::cap::handlers::scriptlibs [namespace eval punk::cap::handlers::scriptlibs {
variable pkg punk::cap::handlers::scriptlibs
variable version
set version 0.1.0
}]
return

127
src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/cap/handlers/templates-0.1.0.tm

@ -0,0 +1,127 @@
# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from <pkg>-buildversion.txt
#
# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem.
# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository.
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# (C) 2023
#
# @@ Meta Begin
# Application punk::cap::handlers::templates 0.1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
##e.g package require frobz
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#register using:
# punk::cap::register_capabilityname templates ::punk::cap::handlers::templates
#By convention and for consistency, we don't register here during package loading - but require the calling app to do it.
# (even if it tends to be done immediately after package require anyway)
# registering capability handlers can involve validating existing provider data and is best done explicitly as required.
# It is also possible for a capability handler to be registered to handle more than one capabilityname
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::cap::handlers::templates {
namespace eval capsystem {
#interfaces for punk::cap to call into
if {[info commands caphandler.registry] eq ""} {
punk::cap::interface_caphandler.registry create caphandler.registry
oo::objdefine caphandler.registry {
method pkg_register {pkg capname capdict caplist} {
#caplist may not be complete set - which somewhat reduces its utility here regarding any decisions based on the context of this capname/capdict (review - remove this arg?)
if {![dict exists $capdict relpath]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - package '$pkg' is attempting to register with punk::cap as a provider of '$capname' capability, but is missing 'relpath' key"
return 0
}
set provide_statement [package ifneeded $pkg [package require $pkg]]
set tmfile [lindex $provide_statement end]
if {![file exists $tmfile]} {
puts stderr "punk::cap::handlers::templates::capsystem::pkg_register WARNING - unable to determine base folder for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
return 0
}
set tpath [file normalize [file join $tmfile [dict get $capdict relpath]]] ;#relpath is relative to the tm *file* - not it's containing folder
if {![file isdirectory $tpath]} {
puts stderr "punk::cap::handlers::templates::capsystem pkg_register WARNING - unable to validate relpath location [dict get $capdict relpath] ($tpath) for package '$pkg' which is attempting to register with punk::cap as a provider of '$capname' capability"
}
if {$capname ni $::punk::cap::handlers::templates::handled_caps} {
lappend ::punk::cap::handlers::templates::handled_caps $capname
}
if {[info commands punk::cap::handlers::templates::$capname] eq ""} {
punk::cap::handlers::templates::api create ::punk::cap::handlers::templates::$capname $capname
}
set cname [string map [list . _] $capname]
upvar ::punk::cap::handlers::templates::pkg_folders_$cname pfolders
dict lappend pfolders $pkg $tpath
return 1
}
method pkg_unregister {pkg} {
upvar ::punk::cap::handlers::templates::handled_caps hcaps
foreach capname $hcaps {
set cname [string map [list . _] $capname]
upvar ::punk::cap::handlers::templates::pkg_folders_$cname pfolders
dict unset pfolders $pkg
#destroy api objects?
}
}
}
}
}
variable handled_caps [list]
#variable pkg_folders [dict create]
# -- --- --- --- --- --- ---
#handler api for clients of this capability - called via punk::cap::call_handler <capname> <method> ?args?
# -- --- --- --- --- --- ---
namespace export *
oo::class create api {
#return a dict keyed on folder with source pkg as value
constructor {capname} {
variable capabilityname
variable cname
set cname [string map [list . _] $capname]
set capabilityname $capname
}
method folders {} {
variable capabilityname
variable cname
upvar punk::cap::handlers::templates::pkg_folders_$cname pkg_folders
package require punk::cap
set capinfo [punk::cap::capability $capabilityname]
# e.g {punk.templates {handler punk::mix::templates providers ::somepkg}}
#use the order of pkgs as registered with punk::cap - may have been modified with punk::cap::promote_package/demote_package
set pkgs [dict get $capinfo providers]
set folderdict [dict create]
foreach pkg $pkgs {
foreach pfolder [dict get $pkg_folders $pkg] {
dict set folderdict $pfolder [list source $pkg sourcetype package]
}
}
return $folderdict
}
}
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide punk::cap::handlers::templates [namespace eval punk::cap::handlers::templates {
variable pkg punk::cap::handlers::templates
variable version
set version 0.1.0
}]
return

8
src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix-0.2.tm

@ -1,6 +1,12 @@
package require punk::cap
package require punk::mix::templates ;#registers 'templates' capability with punk::cap
package require punk::cap::handlers::templates ;#handler for templates cap
punk::cap::register_capabilityname punk.templates ::punk::cap::handlers::templates
package require punk::mix::templates ;#registers as provider pkg for 'punk.templates' capability with punk::cap
#punk::mix::templates::provider register *
package require punk::mix::base
package require punk::mix::cli

1812
src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/base-0.1.tm

File diff suppressed because it is too large Load Diff

2
src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/commandset/layout-0.1.0.tm

@ -73,7 +73,7 @@ namespace eval punk::mix::commandset::layout {
set glob *
}
set layouts [list]
#set tplfolderdict [punk::cap::templates::folders]
#set tplfolderdict [punk::cap::call_handler punk.templates folders]
set tplfolderdict [punk::mix::base::lib::get_template_basefolders]
dict for {tdir folderinfo} $tplfolderdict {
set layout_base $tdir/layouts

10
src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/commandset/project-0.1.0.tm

@ -305,7 +305,7 @@ namespace eval punk::mix::commandset::project {
#todo - tag substitutions in src/doc tree
cd $projectdir
::cd $projectdir
if {[file exists $projectdir/src/modules]} {
foreach m $opt_modules {
@ -323,7 +323,7 @@ namespace eval punk::mix::commandset::project {
#generate www/man/md output in 'embedded' folder which should be checked into repo for online documentation
if {[file exists $projectdir/src]} {
cd $projectdir/src
::cd $projectdir/src
#----------
set installer [punkcheck::installtrack new project.new $projectdir/src/.punkcheck]
$installer set_source_target $projectdir/src/doc $projectdir/src/embedded
@ -357,7 +357,7 @@ namespace eval punk::mix::commandset::project {
$installer destroy
}
cd $projectdir
::cd $projectdir
if {![punk::repo::is_fossil_root $projectdir]} {
set first_fossil 1
@ -742,7 +742,7 @@ namespace eval punk::mix::commandset::project {
set workingdir [lindex $workdirs 0]
puts stdout "1 result. Changing dir to $workingdir"
if {[file exists $workingdir]} {
cd $workingdir
::cd $workingdir
return $workingdir
} else {
puts stderr "path $workingdir doesn't appear to exist"
@ -753,7 +753,7 @@ namespace eval punk::mix::commandset::project {
if {[string trim $answer] in $col_rowids} {
set index [expr {$answer - 1}]
set workingdir [lindex $workdirs $index]
cd $workingdir
::cd $workingdir
puts stdout [pmix stat]
return $workingdir
}

37
src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/mix/templates-0.1.0.tm

@ -23,10 +23,43 @@ package require punk::cap
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
namespace eval punk::mix::templates {
variable pkg punk::mix::templates
variable cap_provider
punk::cap::register_package punk::mix::templates [list\
{templates {relpath ../templates}}\
{punk.templates {relpath ../templates}}\
]
namespace eval capsystem {
if {[info commands capprovider.registration] eq ""} {
punk::cap::interface_capprovider.registration create capprovider.registration
oo::objdefine capprovider.registration {
method get_declarations {} {
set decls [list]
lappend decls punk.templates {relpath ../templates}
lappend decls punk.templates {relpath ../templates2}
return $decls
}
}
}
}
if {[info commands provider] eq ""} {
punk::cap::interface_capprovider.provider create provider
oo::objdefine provider {
method register {{capabilityname_glob *}} {
#puts registering punk::mix::templates $capabilityname
next
}
method capabilities {} {
next
}
}
}
# -- ---
#provider api
# -- ---
#none - declarations only
}

316
src/modules/punk/mix/templates/layouts/project/src/bootsupport/modules/punk/overlay-0.1.tm

@ -1,158 +1,158 @@
package require punk::mix::util
namespace eval ::punk::overlay {
#based *loosely* on: wiki.tcl-lang.org/page/ensemble+extend
# extend an ensemble-like routine with the routines in some namespace
#
# e.g custom_from_base ::punk::mix::cli ::punk::mix::base
#
proc custom_from_base {routine base} {
if {![string match ::* $routine]} {
set resolved [uplevel 1 [list ::namespace which $routine]]
if {$resolved eq {}} {
error [list {no such routine} $routine]
}
set routine $resolved
}
set routinens [namespace qualifiers $routine]
if {$routinens eq {::}} {
set routinens {}
}
set routinetail [namespace tail $routine]
if {![string match ::* $base]} {
set base [uplevel 1 [
list [namespace which namespace] current]]::$base
}
if {![namespace exists $base]} {
error [list {no such namespace} $base]
}
set base [namespace eval $base [
list [namespace which namespace] current]]
#while 1 {
# set renamed ${routinens}::${routinetail}_[info cmdcount]
# if {[namespace which $renamed] eq {}} break
#}
namespace eval $routine [
list namespace ensemble configure $routine -unknown [
list apply {{base ensemble subcommand args} {
list ${base}::_redirected $ensemble $subcommand
}} $base
]
]
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${routine}::util
#namespace eval ${routine}::util {
#namespace import ::punk::mix::util::*
#}
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ${base}::lib::* ${routine}::lib
#namespace eval ${routine}::lib [string map [list <base> $base] {
# namespace import <base>::lib::*
#}]
namespace eval ${routine}::lib [string map [list <base> $base <routine> $routine] {
if {[namespace exists <base>::lib]} {
set current_paths [namespace path]
if {"<routine>" ni $current_paths} {
lappend current_paths <routine>
}
namespace path $current_paths
}
}]
namespace eval $routine {
set exportlist [list]
foreach cmd [info commands [namespace current]::*] {
set c [namespace tail $cmd]
if {![string match _* $c]} {
lappend exportlist $c
}
}
namespace export {*}$exportlist
}
return $routine
}
#load *exported* commands from cmdnamespace into caller's namespace - prefixing each command with $prefix
#Note: commandset may be imported by different CLIs with different bases *at the same time*
#so we don't make commands from the cli or its base available automatically (will generally require fully-qualified commands to use code from cli/base)
#we do load punk::mix::util::* into the util subnamespace even though the commandset might not be loaded in a cli using punk::mix::base i.e punk::mix::util is a common dependency for CLIs.
#commandsets designed to be used with a specific cli/base may choose to do their own import e.g with util::namespace_import_pattern_to_namespace_noclobber and/or set namespace path if they
#want the convenience of using lib:xxx with commands coming from those packages.
#This won't stop the commandset being used with other cli/bases unless the import is done by looking up the callers namespace.
#The basic principle is that the commandset is loaded into the caller(s) with a prefix
#- but commandsets should explicitly package require if they have any backwards dependencies on cli/base (which they may or may not be loaded into)
proc import_commandset {prefix separator cmdnamespace} {
set bad_seps [list "::"]
if {$separator in $bad_seps} {
error "import_commandset invalid separator '$separator'"
}
#namespace may or may not be a package
# allow with or without leading ::
if {[string range $cmdnamespace 0 1] eq "::"} {
set cmdpackage [string range $cmdnamespace 2 end]
} else {
set cmdpackage $cmdnamespace
set cmdnamespace ::$cmdnamespace
}
if {![namespace exists $cmdnamespace]} {
#only do package require if the namespace not already present
catch {package require $cmdpackage} pkg_load_info
#recheck
if {![namespace exists $cmdnamespace]} {
set prov [package provide $cmdpackage]
if {[string length $prov]} {
set provinfo "(package $cmdpackage is present with version $prov)"
} else {
set provinfo "(package $cmdpackage not present)"
}
error "punk::overlay::import_commandset supplied namespace '$cmdnamespace' doesn't exist. $provinfo Pkg_load_result: $pkg_load_info Usage: import_commandset prefix separator namespace"
}
}
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${cmdnamespace}::util
#let child namespace 'lib' resolve parent namespace and thus util::xxx
namespace eval ${cmdnamespace}::lib [string map [list <cmdns> $cmdnamespace] {
set nspaths [namespace path]
if {"<cmdns>" ni $nspaths} {
lappend nspaths <cmdns>
}
namespace path $nspaths
}]
set imported_commands [list]
set nscaller [uplevel 1 [list namespace current]]
if {[catch {
namespace eval ${nscaller}::temp_import [list namespace import ${cmdnamespace}::*]
foreach cmd [info commands ${nscaller}::temp_import::*] {
set cmdtail [namespace tail $cmd]
if {$cmdtail eq "_default"} {
set import_as ${nscaller}::${prefix}
} else {
set import_as ${nscaller}::${prefix}${separator}${cmdtail}
}
rename $cmd $import_as
lappend imported_commands $import_as
}
} errM]} {
puts stderr "Error loading commandset $prefix $separator $cmdnamespace"
puts stderr "err: $errM"
}
return $imported_commands
}
}
package provide punk::overlay [namespace eval punk::overlay {
variable version
set version 0.1
}]
package require punk::mix::util
namespace eval ::punk::overlay {
#based *loosely* on: wiki.tcl-lang.org/page/ensemble+extend
# extend an ensemble-like routine with the routines in some namespace
#
# e.g custom_from_base ::punk::mix::cli ::punk::mix::base
#
proc custom_from_base {routine base} {
if {![string match ::* $routine]} {
set resolved [uplevel 1 [list ::namespace which $routine]]
if {$resolved eq {}} {
error [list {no such routine} $routine]
}
set routine $resolved
}
set routinens [namespace qualifiers $routine]
if {$routinens eq {::}} {
set routinens {}
}
set routinetail [namespace tail $routine]
if {![string match ::* $base]} {
set base [uplevel 1 [
list [namespace which namespace] current]]::$base
}
if {![namespace exists $base]} {
error [list {no such namespace} $base]
}
set base [namespace eval $base [
list [namespace which namespace] current]]
#while 1 {
# set renamed ${routinens}::${routinetail}_[info cmdcount]
# if {[namespace which $renamed] eq {}} break
#}
namespace eval $routine [
list namespace ensemble configure $routine -unknown [
list apply {{base ensemble subcommand args} {
list ${base}::_redirected $ensemble $subcommand
}} $base
]
]
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${routine}::util
#namespace eval ${routine}::util {
#namespace import ::punk::mix::util::*
#}
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ${base}::lib::* ${routine}::lib
#namespace eval ${routine}::lib [string map [list <base> $base] {
# namespace import <base>::lib::*
#}]
namespace eval ${routine}::lib [string map [list <base> $base <routine> $routine] {
if {[namespace exists <base>::lib]} {
set current_paths [namespace path]
if {"<routine>" ni $current_paths} {
lappend current_paths <routine>
}
namespace path $current_paths
}
}]
namespace eval $routine {
set exportlist [list]
foreach cmd [info commands [namespace current]::*] {
set c [namespace tail $cmd]
if {![string match _* $c]} {
lappend exportlist $c
}
}
namespace export {*}$exportlist
}
return $routine
}
#load *exported* commands from cmdnamespace into caller's namespace - prefixing each command with $prefix
#Note: commandset may be imported by different CLIs with different bases *at the same time*
#so we don't make commands from the cli or its base available automatically (will generally require fully-qualified commands to use code from cli/base)
#we do load punk::mix::util::* into the util subnamespace even though the commandset might not be loaded in a cli using punk::mix::base i.e punk::mix::util is a common dependency for CLIs.
#commandsets designed to be used with a specific cli/base may choose to do their own import e.g with util::namespace_import_pattern_to_namespace_noclobber and/or set namespace path if they
#want the convenience of using lib:xxx with commands coming from those packages.
#This won't stop the commandset being used with other cli/bases unless the import is done by looking up the callers namespace.
#The basic principle is that the commandset is loaded into the caller(s) with a prefix
#- but commandsets should explicitly package require if they have any backwards dependencies on cli/base (which they may or may not be loaded into)
proc import_commandset {prefix separator cmdnamespace} {
set bad_seps [list "::"]
if {$separator in $bad_seps} {
error "import_commandset invalid separator '$separator'"
}
#namespace may or may not be a package
# allow with or without leading ::
if {[string range $cmdnamespace 0 1] eq "::"} {
set cmdpackage [string range $cmdnamespace 2 end]
} else {
set cmdpackage $cmdnamespace
set cmdnamespace ::$cmdnamespace
}
if {![namespace exists $cmdnamespace]} {
#only do package require if the namespace not already present
catch {package require $cmdpackage} pkg_load_info
#recheck
if {![namespace exists $cmdnamespace]} {
set prov [package provide $cmdpackage]
if {[string length $prov]} {
set provinfo "(package $cmdpackage is present with version $prov)"
} else {
set provinfo "(package $cmdpackage not present)"
}
error "punk::overlay::import_commandset supplied namespace '$cmdnamespace' doesn't exist. $provinfo Pkg_load_result: $pkg_load_info Usage: import_commandset prefix separator namespace"
}
}
punk::mix::util::namespace_import_pattern_to_namespace_noclobber ::punk::mix::util::* ${cmdnamespace}::util
#let child namespace 'lib' resolve parent namespace and thus util::xxx
namespace eval ${cmdnamespace}::lib [string map [list <cmdns> $cmdnamespace] {
set nspaths [namespace path]
if {"<cmdns>" ni $nspaths} {
lappend nspaths <cmdns>
}
namespace path $nspaths
}]
set imported_commands [list]
set nscaller [uplevel 1 [list namespace current]]
if {[catch {
namespace eval ${nscaller}::temp_import [list namespace import ${cmdnamespace}::*]
foreach cmd [info commands ${nscaller}::temp_import::*] {
set cmdtail [namespace tail $cmd]
if {$cmdtail eq "_default"} {
set import_as ${nscaller}::${prefix}
} else {
set import_as ${nscaller}::${prefix}${separator}${cmdtail}
}
rename $cmd $import_as
lappend imported_commands $import_as
}
} errM]} {
puts stderr "Error loading commandset $prefix $separator $cmdnamespace"
puts stderr "err: $errM"
}
return $imported_commands
}
}
package provide punk::overlay [namespace eval punk::overlay {
variable version
set version 0.1
}]

152
src/modules/punk/mix/templates/layouts/project/src/make.tcl

@ -259,84 +259,110 @@ if {$::punkmake::command eq "bootsupport"} {
proc bootsupport_localupdate {projectroot} {
set bootsupport_modules [list]
set bootsupport_module_folders [list]
set bootsupport_config $projectroot/src/bootsupport/include_modules.config ;#
if {[file exists $bootsupport_config]} {
set targetroot $projectroot/src/bootsupport/modules
source $bootsupport_config ;#populate $bootsupport_modules with project-specific list
if {![llength $bootsupport_modules]} {
puts stderr "No local bootsupport modules configured for updating"
return
}
set targetroot $projectroot/src/bootsupport/modules
if {[catch {
#----------
set boot_installer [punkcheck::installtrack new make.tcl $projectroot/src/bootsupport/.punkcheck]
$boot_installer set_source_target $projectroot $projectroot/src/bootsupport
set boot_event [$boot_installer start_event {-make_step bootsupport}]
#----------
} errM]} {
puts stderr "Unable to use punkcheck for bootsupport error: $errM"
set boot_event ""
}
} else {
foreach {relpath module} $bootsupport_modules {
set module [string trim $module :]
set module_subpath [string map [list :: /] [namespace qualifiers $module]]
set srclocation [file join $projectroot $relpath $module_subpath]
#puts stdout "$relpath $module $module_subpath $srclocation"
set pkgmatches [glob -nocomplain -dir $srclocation -tail [namespace tail $module]-*]
#lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1
if {![llength $pkgmatches]} {
puts stderr "Missing source for bootsupport module $module - not found in $srclocation"
continue
}
set latestfile [lindex $pkgmatches 0]
set latestver [lindex [split [file rootname $latestfile] -] 1]
foreach m $pkgmatches {
lassign [split [file rootname $m] -] _pkg ver
#puts "comparing $ver vs $latestver"
if {[package vcompare $ver $latestver] == 1} {
set latestver $ver
set latestfile $m
}
}
set srcfile [file join $srclocation $latestfile]
set tgtfile [file join $targetroot $module_subpath $latestfile]
if {$boot_event ne ""} {
if {[catch {
#----------
$boot_event targetset_init INSTALL $tgtfile
$boot_event targetset_addsource $srcfile
set boot_installer [punkcheck::installtrack new make.tcl $projectroot/src/bootsupport/.punkcheck]
$boot_installer set_source_target $projectroot $projectroot/src/bootsupport
set boot_event [$boot_installer start_event {-make_step bootsupport}]
#----------
if {\
[llength [dict get [$boot_event targetset_source_changes] changed]]\
|| [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\
} {
file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists
$boot_event targetset_started
# -- --- --- --- --- ---
puts "BOOTSUPPORT update: $srcfile -> $tgtfile"
if {[catch {
file copy -force $srcfile $tgtfile
} errM]} {
$boot_event targetset_end FAILED
} errM]} {
puts stderr "Unable to use punkcheck for bootsupport error: $errM"
set boot_event ""
}
foreach {relpath module} $bootsupport_modules {
set module [string trim $module :]
set module_subpath [string map [list :: /] [namespace qualifiers $module]]
set srclocation [file join $projectroot $relpath $module_subpath]
#puts stdout "$relpath $module $module_subpath $srclocation"
set pkgmatches [glob -nocomplain -dir $srclocation -tail [namespace tail $module]-*]
#lsort won't sort version numbers properly e.g with -dictionary 0.1.1 comes before 0.1
if {![llength $pkgmatches]} {
puts stderr "Missing source for bootsupport module $module - not found in $srclocation"
continue
}
set latestfile [lindex $pkgmatches 0]
set latestver [lindex [split [file rootname $latestfile] -] 1]
foreach m $pkgmatches {
lassign [split [file rootname $m] -] _pkg ver
#puts "comparing $ver vs $latestver"
if {[package vcompare $ver $latestver] == 1} {
set latestver $ver
set latestfile $m
}
}
set srcfile [file join $srclocation $latestfile]
set tgtfile [file join $targetroot $module_subpath $latestfile]
if {$boot_event ne ""} {
#----------
$boot_event targetset_init INSTALL $tgtfile
$boot_event targetset_addsource $srcfile
#----------
if {\
[llength [dict get [$boot_event targetset_source_changes] changed]]\
|| [llength [$boot_event get_targets_exist]] < [llength [$boot_event get_targets]]\
} {
file mkdir [file dirname $tgtfile] ;#ensure containing folder for target exists
$boot_event targetset_started
# -- --- --- --- --- ---
puts "BOOTSUPPORT update: $srcfile -> $tgtfile"
if {[catch {
file copy -force $srcfile $tgtfile
} errM]} {
$boot_event targetset_end FAILED
} else {
$boot_event targetset_end OK
}
# -- --- --- --- --- ---
} else {
$boot_event targetset_end OK
puts -nonewline stderr "."
$boot_event targetset_end SKIPPED
}
# -- --- --- --- --- ---
$boot_event end
} else {
puts -nonewline stderr "."
$boot_event targetset_end SKIPPED
file copy -force $srcfile $tgtfile
}
$boot_event end
} else {
file copy -force $srcfile $tgtfile
}
if {$boot_event ne ""} {
puts \n
$boot_event destroy
$boot_installer destroy
}
}
if {$boot_event ne ""} {
puts \n
$boot_event destroy
$boot_installer destroy
foreach folder $bootsupport_module_folders {
#explicitly ignore punk/mix/templates folder even if specified in config.
#punk/mix/templates contains modules including punk/mix/templates itself - the actual templates aren't needed for the bootsupport system,
# as make.tcl shouldn't be building new projects from the one being made.
#review.
#should we be autodetecting such recursive folder structures - (or is the bootsupport copying in need of a rethink?)
if {[string trim $folder /] eq "punk/mix/templates"} {
puts stderr "IGNORING punk/mix/templates - not needed/desirable in bootsupport"
continue
}
set src [file join $projectroot/modules $folder]
if {![file isdirectory $src]} {
puts stderr "bootsupport folder not found: $src"
continue
}
set tgt [file join $targetroot $folder]
file mkdir $tgt
puts stdout "BOOTSUPPORT non_tm_files $src - copying to $tgt (if source file changed)"
set overwrite "installedsourcechanged-targets"
set resultdict [punkcheck::install_non_tm_files $src $tgt -installer make.tcl -overwrite $overwrite -punkcheck_folder $projectroot/src/bootsupport]
puts stdout [punkcheck::summarize_install_resultdict $resultdict]
}
}
}

Loading…
Cancel
Save