jn
/
punkshell
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

bootsupport: propagate punk::lib 0.2.0 and punk::repl 0.2.0 snapshots to bootsupport and project layouts

master
Julian Noble 3 weeks ago
parent
b21c804641
commit
e44b2d6906
6 changed files with 4834 additions and 126 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 211
      src/bootsupport/modules/punk/lib-0.2.0.tm
  2. 73
      src/bootsupport/modules/punk/repl-0.2.0.tm
  3. 211
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.2.0.tm
  4. 73
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.2.0.tm
  5. 211
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.2.0.tm
  6. 4181
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.2.0.tm

211
src/bootsupport/modules/punk/lib-0.1.6.tm → src/bootsupport/modules/punk/lib-0.2.0.tm
Unescape View File

@ -8,7 +8,7 @@
# (C) 2024
#
# @@ Meta Begin
# Application punk::lib 0.1.6
# Application punk::lib 0.2.0
# Meta platform tcl
# Meta license BSD
# @@ Meta End
@ -18,7 +18,7 @@
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin punkshell_module_punk::lib 0 0.1.6]
#[manpage_begin punkshell_module_punk::lib 0 0.2.0]
#[copyright "2024"]
#[titledesc {punk general utility functions}] [comment {-- Name section and table of contents description --}]
#[moddesc {punk library}] [comment {-- Description at end of page heading --}]
@ -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} {
@ -8866,7 +9069,7 @@ namespace eval ::punk::args::register {
package provide punk::lib [tcl::namespace::eval punk::lib {
variable pkg punk::lib
variable version
set version 0.1.6
set version 0.2.0
}]
return

73
src/bootsupport/modules/punk/repl-0.1.6.tm → src/bootsupport/modules/punk/repl-0.2.0.tm
Unescape View File

@ -3197,6 +3197,7 @@ namespace eval repl {
} %tmlist% [list [tcl::tm::list]] {*}{
} %autopath% [list $::auto_path] {*}{
} %lib_epoch% [list $::punk::libunknown::epoch] {*}{
} %packageprefer% [list [package prefer]] {*}{
}
]
#scriptmap applied at end to satisfy silly editor highlighting.
@ -3211,6 +3212,7 @@ namespace eval repl {
#this sets the auto_path in the thread but outside of the code interp that will be created.
#It will also need to be added in that interp
set ::auto_path %autopath%
package prefer %packageprefer%
set tclmajorv [lindex [split [tcl::info::tclversion] .] 0]
#jmn
#puts stdout "CODETHREAD tm list"
@ -3575,6 +3577,12 @@ namespace eval repl {
switch -- $repltype {
safe {
interp create -safe -- code
#propagate tm list, auto_path, and package prefer to the safe code interp.
#-libunknown is not used because safe interps cannot source arbitrary files;
#the epoch copy below remains for cooperative use if libunknown is later
#adapted for safe interps (see TODO at line ~3634).
package require punk::lib
catch {punk::lib::interp_sync_package_paths code}
code eval [list namespace eval ::punk::libunknown {}]
catch {
code eval [list set ::punk::libunknown::epoch $::punk::libunknown::epoch]
@ -3604,13 +3612,10 @@ namespace eval repl {
}
punk - 0 {
interp create code
code eval [list namespace eval ::punk::libunknown {}]
catch {
#JJJ REVIEW.
#If libunknown was loaded when packages already in the package database
#then the epoch info may be wrong.
code eval [list set ::punk::libunknown::epoch $::punk::libunknown::epoch]
}
#use punk::lib helper to propagate tm list, auto_path, package prefer,
#and libunknown epoch + init from this codethread to the code interp.
package require punk::lib
punk::lib::interp_sync_package_paths code -libunknown 1
}
punkisland {
interp create code
@ -4012,55 +4017,9 @@ namespace eval repl {
set ::argv0 %argv0%
set ::argv %argv%
set ::argc %argc%
set ::auto_path %autopath%
tcl::tm::remove {*}[tcl::tm::list]
tcl::tm::add {*}[lreverse %tmlist%]
#puts "code interp chan names-->[chan names]"
#-----------------------------------------------------------------------------
if {[package provide punk::libunknown] eq ""} {
namespace eval ::punk::libunknown {}
set ::punk::libunknown::epoch %lib_epoch%
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 {
#expecting to be of form libunknown-<tclversion>.tm
set vtail [lindex [split [file tail $lib] -] 1]
set thisver [file rootname $vtail] ;#file rootname x.y.z.tm
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 "repl::init init_script code interp for punk"} errM]} {
puts stderr "error initialising punk::libunknown\n from: '$libunknown'"
puts stderr "tcl::tm::list: [tcl::tm::list]"
puts stderr "error: $errM"
}
}
}}
} else {
puts stderr "punk::libunknown [package provide punk::libunknown] already loaded"
}
#-----------------------------------------------------------------------------
#package require punk::packagepreference
#punk::packagepreference::install
#tm list, auto_path, package prefer, and libunknown were already
#propagated by punk::lib::interp_sync_package_paths code -libunknown 1
#at interp creation time above.
# -- ---
#review
@ -4213,7 +4172,7 @@ namespace eval repl {
}
package provide punk::repl [namespace eval punk::repl {
variable version
set version 0.1.6
set version 0.2.0
}]
#repl::start $program_read_stdin_pipe

211
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.1.6.tm → src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.2.0.tm
Unescape View File

@ -8,7 +8,7 @@
# (C) 2024
#
# @@ Meta Begin
# Application punk::lib 0.1.6
# Application punk::lib 0.2.0
# Meta platform tcl
# Meta license BSD
# @@ Meta End
@ -18,7 +18,7 @@
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin punkshell_module_punk::lib 0 0.1.6]
#[manpage_begin punkshell_module_punk::lib 0 0.2.0]
#[copyright "2024"]
#[titledesc {punk general utility functions}] [comment {-- Name section and table of contents description --}]
#[moddesc {punk library}] [comment {-- Description at end of page heading --}]
@ -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} {
@ -8866,7 +9069,7 @@ namespace eval ::punk::args::register {
package provide punk::lib [tcl::namespace::eval punk::lib {
variable pkg punk::lib
variable version
set version 0.1.6
set version 0.2.0
}]
return

73
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.1.6.tm → src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repl-0.2.0.tm
Unescape View File

@ -3197,6 +3197,7 @@ namespace eval repl {
} %tmlist% [list [tcl::tm::list]] {*}{
} %autopath% [list $::auto_path] {*}{
} %lib_epoch% [list $::punk::libunknown::epoch] {*}{
} %packageprefer% [list [package prefer]] {*}{
}
]
#scriptmap applied at end to satisfy silly editor highlighting.
@ -3211,6 +3212,7 @@ namespace eval repl {
#this sets the auto_path in the thread but outside of the code interp that will be created.
#It will also need to be added in that interp
set ::auto_path %autopath%
package prefer %packageprefer%
set tclmajorv [lindex [split [tcl::info::tclversion] .] 0]
#jmn
#puts stdout "CODETHREAD tm list"
@ -3575,6 +3577,12 @@ namespace eval repl {
switch -- $repltype {
safe {
interp create -safe -- code
#propagate tm list, auto_path, and package prefer to the safe code interp.
#-libunknown is not used because safe interps cannot source arbitrary files;
#the epoch copy below remains for cooperative use if libunknown is later
#adapted for safe interps (see TODO at line ~3634).
package require punk::lib
catch {punk::lib::interp_sync_package_paths code}
code eval [list namespace eval ::punk::libunknown {}]
catch {
code eval [list set ::punk::libunknown::epoch $::punk::libunknown::epoch]
@ -3604,13 +3612,10 @@ namespace eval repl {
}
punk - 0 {
interp create code
code eval [list namespace eval ::punk::libunknown {}]
catch {
#JJJ REVIEW.
#If libunknown was loaded when packages already in the package database
#then the epoch info may be wrong.
code eval [list set ::punk::libunknown::epoch $::punk::libunknown::epoch]
}
#use punk::lib helper to propagate tm list, auto_path, package prefer,
#and libunknown epoch + init from this codethread to the code interp.
package require punk::lib
punk::lib::interp_sync_package_paths code -libunknown 1
}
punkisland {
interp create code
@ -4012,55 +4017,9 @@ namespace eval repl {
set ::argv0 %argv0%
set ::argv %argv%
set ::argc %argc%
set ::auto_path %autopath%
tcl::tm::remove {*}[tcl::tm::list]
tcl::tm::add {*}[lreverse %tmlist%]
#puts "code interp chan names-->[chan names]"
#-----------------------------------------------------------------------------
if {[package provide punk::libunknown] eq ""} {
namespace eval ::punk::libunknown {}
set ::punk::libunknown::epoch %lib_epoch%
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 {
#expecting to be of form libunknown-<tclversion>.tm
set vtail [lindex [split [file tail $lib] -] 1]
set thisver [file rootname $vtail] ;#file rootname x.y.z.tm
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 "repl::init init_script code interp for punk"} errM]} {
puts stderr "error initialising punk::libunknown\n from: '$libunknown'"
puts stderr "tcl::tm::list: [tcl::tm::list]"
puts stderr "error: $errM"
}
}
}}
} else {
puts stderr "punk::libunknown [package provide punk::libunknown] already loaded"
}
#-----------------------------------------------------------------------------
#package require punk::packagepreference
#punk::packagepreference::install
#tm list, auto_path, package prefer, and libunknown were already
#propagated by punk::lib::interp_sync_package_paths code -libunknown 1
#at interp creation time above.
# -- ---
#review
@ -4213,7 +4172,7 @@ namespace eval repl {
}
package provide punk::repl [namespace eval punk::repl {
variable version
set version 0.1.6
set version 0.2.0
}]
#repl::start $program_read_stdin_pipe

211
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/lib-0.1.6.tm → src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/lib-0.2.0.tm
Unescape View File

@ -8,7 +8,7 @@
# (C) 2024
#
# @@ Meta Begin
# Application punk::lib 0.1.6
# Application punk::lib 0.2.0
# Meta platform tcl
# Meta license BSD
# @@ Meta End
@ -18,7 +18,7 @@
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin punkshell_module_punk::lib 0 0.1.6]
#[manpage_begin punkshell_module_punk::lib 0 0.2.0]
#[copyright "2024"]
#[titledesc {punk general utility functions}] [comment {-- Name section and table of contents description --}]
#[moddesc {punk library}] [comment {-- Description at end of page heading --}]
@ -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} {
@ -8866,7 +9069,7 @@ namespace eval ::punk::args::register {
package provide punk::lib [tcl::namespace::eval punk::lib {
variable pkg punk::lib
variable version
set version 0.1.6
set version 0.2.0
}]
return

4181
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repl-0.2.0.tm
View File

File diff suppressed because it is too large Load Diff
Write Preview
Loading…
Cancel
Save