@ -8106,13 +8106,216 @@ namespace eval punk::lib {
return [expr {($deg_celsius * (9/5.0)) + 32}]
}
proc interp_sync_package_paths {interp} {
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::snapshot_package_paths
@cmd -name punk::lib::snapshot_package_paths\
-summary\
"Return a script string that reproduces the caller's package loading state in a new interp or thread."\
-help\
"Captures the caller's tcl::tm::list (ordered), ::auto_path (ordered), and package prefer
setting and returns a script string that, when evaluated in a new interpreter or thread
init script, reproduces the same package search paths and version preference.
This is intended for use in thread::create init scripts and interp eval calls where
a child interp or thread needs to inherit the parent's package resolution state.
With -libunknown 1, the script also copies the punk::libunknown epoch dict and
sources+inits punk::libunknown in the target, so the child gets the same custom
package unknown handler and scan cache as the parent. This avoids re-scanning
all module and library paths on every package require in the child.
The returned script uses only Tcl builtins (tcl::tm, set, package) and does not
require any punk packages to be loaded in the target — except when -libunknown 1
is used, in which case punk::libunknown is sourced from the tm paths that were
already set up by the earlier part of the script.
See also: punk::lib::interp_sync_package_paths"
@opts
-libunknown -type boolean -default 0 -help\
"If 1, the script also sets up punk::libunknown in the target: copies the epoch
dict, finds and sources libunknown-*.tm from the tm paths, and calls
punk::libunknown::init. The child inherits the parent's scan cache and
custom package unknown handler."
}]
}
proc snapshot_package_paths {args} {
#Returns a script string that reproduces the caller's tcl::tm::list,
#auto_path, and package prefer state in a new interp or thread.
#Optional -libunknown 1 also includes punk::libunknown epoch copy + init.
set do_libunknown 0
for {set i 0} {$i < [llength $args]} {incr i} {
set arg [lindex $args $i]
switch -- $arg {
-libunknown {
set do_libunknown 1
incr i
#value is 0 or 1
if {$i < [llength $args]} {
set do_libunknown [lindex $args $i]
}
}
default {
error "snapshot_package_paths: unknown option '$arg'"
}
}
}
set tmlist [tcl::tm::list]
set ap $::auto_path
set prefer [package prefer]
set script ""
append script "tcl::tm::remove \{*\}\[tcl::tm::list\]\n"
append script "tcl::tm::add \{*\}\[list [lreverse $tmlist]\]\n"
append script "set ::auto_path \[list $ap\]\n"
append script "package prefer $prefer\n"
if {$do_libunknown} {
if {[info exists ::punk::libunknown::epoch]} {
append script "namespace eval ::punk::libunknown {}\n"
append script "set ::punk::libunknown::epoch [list $::punk::libunknown::epoch]\n"
}
#find and source libunknown, then call init
append script {
apply {{} {
set libunks [list]
foreach tm_path [tcl::tm::list] {
set punkdir [file join $tm_path punk]
if {![file exists $punkdir]} {continue}
lappend libunks {*}[glob -nocomplain -dir $punkdir -type f libunknown-*.tm]
}
set libunknown ""
set libunknown_version_sofar ""
foreach lib $libunks {
set vtail [lindex [split [file tail $lib] -] 1]
set thisver [file rootname $vtail]
if {$libunknown_version_sofar eq ""} {
set libunknown_version_sofar $thisver
set libunknown $lib
} else {
if {[package vcompare $thisver $libunknown_version_sofar] == 1} {
set libunknown_version_sofar $thisver
set libunknown $lib
}
}
}
if {$libunknown ne ""} {
uplevel 1 [list source $libunknown]
if {[catch {punk::libunknown::init -caller "snapshot_package_paths"} errM]} {
puts stderr "snapshot_package_paths: error initialising punk::libunknown\n$errM"
}
}
}}
}
append script "\n"
}
return $script
}
namespace eval argdoc {
variable PUNKARGS
lappend PUNKARGS [list {
@id -id ::punk::lib::interp_sync_package_paths
@cmd -name punk::lib::interp_sync_package_paths\
-summary\
"Propagate the caller's tcl::tm::list, auto_path, and package prefer to a child interpreter."\
-help\
"Synchronises a child interpreter's package search paths and version preference
to match the caller's state. The child interp must already exist (create it first
with [interp create] or [interp create -safe]).
This propagates:
- tcl::tm::list (ordered — same priority ordering as parent)
- ::auto_path (ordered)
- package prefer (e.g 'latest' or 'stable')
With -libunknown 1, also copies the punk::libunknown epoch dict to the child
and sources+inits punk::libunknown there, giving the child the same custom
package unknown handler and scan cache as the parent. This is recommended
when the child will do significant package loading.
This is an opt-in helper — call sites that don't use it keep their current
behavior. It does not load packages, install punk::packagepreference, share
channels, or configure safe-interp restrictions — those remain caller
responsibilities.
See also: punk::lib::snapshot_package_paths"
@leaders
interp -type string -help\
"Name of the child interpreter to synchronise. Must already exist."
@opts
-libunknown -type boolean -default 0 -help\
"If 1, also copy punk::libunknown epoch, source libunknown-*.tm in the child,
and call punk::libunknown::init so the child inherits the parent's scan
cache and custom package unknown handler."
}]
}
proc interp_sync_package_paths {interp args} {
if {![interp exists $interp]} {
error "interp_sync_package_paths error. interp '$interp' not found. Create it first with \[interp create $interp\]"
}
set do_libunknown 0
for {set i 0} {$i < [llength $args]} {incr i} {
set arg [lindex $args $i]
switch -- $arg {
-libunknown {
set do_libunknown 1
incr i
if {$i < [llength $args]} {
set do_libunknown [lindex $args $i]
}
}
default {
error "interp_sync_package_paths: unknown option '$arg'"
}
}
}
#basic propagation: tm list, auto_path, package prefer
interp eval $interp [list set ::auto_path $::auto_path]
interp eval $interp {tcl::tm::remove {*}[tcl::tm::list]}
interp eval $interp [list tcl::tm::add {*}[lreverse [tcl::tm::list]]]
interp eval $interp [list package prefer [package prefer]]
#extended: copy epoch + source libunknown + call init
if {$do_libunknown} {
if {[info exists ::punk::libunknown::epoch]} {
interp eval $interp {namespace eval ::punk::libunknown {}}
interp eval $interp [list set ::punk::libunknown::epoch $::punk::libunknown::epoch]
}
#use snapshot's libunknown sourcing logic via interp eval
set libunknown_script [punk::lib::snapshot_package_paths -libunknown 1]
#extract just the libunknown sourcing part (after the basic propagation)
#we already did basic propagation above, so only run the libunknown init part
interp eval $interp {
apply {{} {
set libunks [list]
foreach tm_path [tcl::tm::list] {
set punkdir [file join $tm_path punk]
if {![file exists $punkdir]} {continue}
lappend libunks {*}[glob -nocomplain -dir $punkdir -type f libunknown-*.tm]
}
set libunknown ""
set libunknown_version_sofar ""
foreach lib $libunks {
set vtail [lindex [split [file tail $lib] -] 1]
set thisver [file rootname $vtail]
if {$libunknown_version_sofar eq ""} {
set libunknown_version_sofar $thisver
set libunknown $lib
} else {
if {[package vcompare $thisver $libunknown_version_sofar] == 1} {
set libunknown_version_sofar $thisver
set libunknown $lib
}
}
}
if {$libunknown ne ""} {
uplevel 1 [list source $libunknown]
if {[catch {punk::libunknown::init -caller "interp_sync_package_paths"} errM]} {
puts stderr "interp_sync_package_paths: error initialising punk::libunknown\n$errM"
}
}
}}
}
}
}
proc valcopy {obj} {
