You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
543 lines
28 KiB
543 lines
28 KiB
|
|
#main.tcl - we expect to be in the context of a zipkit or tclkit vfs attached to a tcl executable. |
|
# or cookfs ? |
|
#review - what happens if multiple are somehow attached and for example both vfs and zipfs are available? |
|
# - if that's even possible - we have no control here over which main.tcl was selected as we're already here |
|
# a metakit data portion seems to need to be add the end of the file (from looking at sdx.kit code) |
|
# - todo - investigate if zipfs can be inserted between starkit head executable and metakit tail data |
|
#The logic below will add appropriate package paths from starkit and zipfs vfs paths |
|
# - and restrict package paths to those coming from a vfs (if not launched with 'dev' first arg which allows external paths to remain) |
|
|
|
|
|
|
|
apply { args { |
|
set tclmajorv [lindex [split [info tclversion] .] 0] |
|
|
|
set has_zipfs [expr {[info commands tcl::zipfs::root] ne ""}] |
|
if {$has_zipfs} { |
|
set has_zipfs_attached [expr {[llength [tcl::zipfs::mount]]}] |
|
} else { |
|
set has_zipfs_attached 0 |
|
} |
|
|
|
#REVIEW - cookit/cookfs can be compiled with a different name for it's mount-point |
|
# - we could examine the -handle from 'file attr' for each //something:/ volume (excluding //zipfs:/) |
|
# - but there are situations where handle is empty (? punk repl issue?) |
|
# - for now we only support the known name - REVIEW |
|
set has_cookfs [expr {"//cookit:/" in [file volumes]}] |
|
set cookbase //cookit:/ ;#always define it so we can test on it later.. |
|
if {$has_cookfs} { |
|
set has_cookfs_attached [file exists //cookit:/lib] ;# //cookit:/manifest.txt ? REVIEW |
|
} else { |
|
set has_cookfs_attached 0 |
|
} |
|
|
|
|
|
#here we make an attempt to avoid premature (costly) auto_path/tcl::tm::list scanning caused by our initial 'package require starkit'. |
|
#we will first look for a starkit.tcl in an expected location and try to load that, then fallback to package require. |
|
|
|
#standard way to avoid symlinking issues - review! |
|
set normscript [file dirname [file normalize [file join [info script] __dummy__]]] |
|
|
|
set normexe [file dirname [file normalize [file join [info nameofexecutable] __dummy__]]] |
|
|
|
set topdir [file dirname $normscript] |
|
set found_starkit_tcl 0 |
|
set possible_lib_vfs_folders [glob -nocomplain -dir [file join $topdir lib] -type d vfs*] |
|
foreach test_folder $possible_lib_vfs_folders { |
|
#e.g <name_of_exe>/lib/vfs1.4.1 |
|
#we don't expect multiple vfs* folders - but we will process any found and load the pkgIndex.tcl from these folders. |
|
#order of folder processing shouldn't matter (rely on order returned by 'package versions' - review) |
|
if {[file exists $test_folder/starkit.tcl] && [file exists $test_folder/pkgIndex.tcl]} { |
|
set dir $test_folder |
|
source $test_folder/pkgIndex.tcl |
|
} |
|
} |
|
if {[set starkitv [lindex [package versions starkit] end]] ne ""} { |
|
#run the ifneeded script for the latest found (assuming package versions ordering is correct) |
|
eval [package ifneeded starkit $starkitv] |
|
set found_starkit_tcl 1 |
|
} |
|
if {!$found_starkit_tcl} { |
|
#our internal 'quick' search for starkit failed. |
|
#either we are in a pure zipfs system, or cookfs - or the starkit package is somewhere more devious |
|
#for pure zipfs or cookfs - it's a little wasteful to perform exhaustive search for starkit |
|
#review - only keep searching if not 'dev' first arg? |
|
|
|
#Initially we've done no scans of auto_path/tcl::tm::list - but there will already be a core set of packages known by the kit |
|
#retain it so we can 'forget' the difference after our first 'package require' forces a full scan which includes some paths we may not wish to include or at least include with different preferences |
|
#puts "main.tcl 1)--> package name count: [llength [package names]]" |
|
#puts stderr [join [package names] \n] |
|
set original_packages [package names] |
|
|
|
if {![catch {package require starkit}]} { |
|
#known side-effects of starkit::startup |
|
#sets the ::starkit::mode variable to the way in which it was launched. One of: {starpack starkit unwrapped tclhttpd plugin service sourced} |
|
#set the ::starkit::topdir variable |
|
#if mode not starpack, then: |
|
# - adds $::starkit::topdir/lib to the auto_path if not already present |
|
# |
|
#In this context (vfs attached to tcl kit executable - we expect the launch mode to be 'starkit' |
|
set starkit_startmode [starkit::startup] |
|
puts stderr "STARKIT MODE: $starkit_startmode" |
|
} |
|
#puts "main.tcl 2)--> package name count: [llength [package names]]" |
|
foreach pkg [package names] { |
|
if {$pkg ni $original_packages} { |
|
package forget $pkg |
|
} |
|
} |
|
#puts "main.tcl 3)--> package name count: [llength [package names]]" |
|
} |
|
|
|
|
|
|
|
# -- --- --- |
|
#when run as a tclkit - the exe is mounted as a dir and Tcl's auto_execok doesn't find it. review - for what versions of Tcl does this apply? |
|
#known to occur in old 8.6.8 kits as well as 8.7 |
|
#review - do we want $normexe or [info nameofexecutable] for $thisexe here? Presumably [info nameofexecutable] (possible symlink) ok |
|
#we want to be able to launch a process from the interactive shell using the same name this one was launched with. |
|
set thisexe [file tail [info nameofexecutable]] ;#e.g punk86.exe |
|
set thisexeroot [file rootname $thisexe] ;#e.g punk86 |
|
set ::auto_execs($thisexeroot) [info nameofexecutable] |
|
if {$thisexe ne $thisexeroot} { |
|
#on windows make the .exe point there too |
|
set ::auto_execs($thisexe) [info nameofexecutable] |
|
} |
|
# -- --- --- |
|
|
|
if {[info exists ::tcl::kitpath] && $::tcl::kitpath ne ""} { |
|
set kp $::tcl::kitpath |
|
set existing_module_paths [string tolower [tcl::tm::list]] |
|
foreach p [list modules modules_tcl$tclmajorv] { |
|
if {[string tolower [file join $kp $p]] ni $existing_module_paths} { |
|
tcl::tm::add [file join $kp $p] |
|
} |
|
} |
|
foreach l [list lib lib_tcl$tclmajorv] { |
|
if {[string tolower [file join $kp $l]] ni [string tolower $::auto_path]} { |
|
lappend ::auto_path [file join $kp $l] |
|
} |
|
} |
|
} |
|
if {$has_zipfs_attached} { |
|
#review build option may be different - tclZipFs.c ZIPFS_APP_MOUNT defaults to ZIPFS_VOLUME/app - but it could be something else. (why?) |
|
#default 'zipfs root' has trailing slash (//zipfs:/) - but file join does the right thing |
|
set zipbase [file join [tcl::zipfs::root] app] |
|
if {"$zipbase" in [tcl::zipfs::mount]} { |
|
set existing_module_paths [string tolower [tcl::tm::list]] |
|
foreach p [list modules modules_tcl$tclmajorv] { |
|
if {[string tolower [file join $zipbase $p]] ni $existing_module_paths} { |
|
tcl::tm::add [file join $zipbase $p] |
|
} |
|
} |
|
foreach l [list lib lib_tcl$tclmajorv] { |
|
if {[string tolower [file join $zipbase $l]] ni [string tolower $::auto_path]} { |
|
lappend ::auto_path [file join $zipbase $l] |
|
} |
|
} |
|
} |
|
} |
|
if {$has_cookfs_attached} { |
|
set existing_module_paths [string tolower [tcl::tm::list]] |
|
foreach p [list modules modules_tcl$tclmajorv] { |
|
if {[string tolower [file join $cookbase $p]] ni $existing_module_paths} { |
|
tcl::tm::add [file join $cookbase $p] |
|
} |
|
} |
|
foreach l [list lib lib_tcl$tclmajorv] { |
|
if {[string tolower [file join $cookbase $l]] ni [string tolower $::auto_path]} { |
|
lappend ::auto_path [file join $cookbase $l] |
|
} |
|
} |
|
} |
|
|
|
|
|
|
|
set internal_paths [list] |
|
if {$has_zipfs} { |
|
set ziproot [tcl::zipfs::root] ;#root is enough to determine internal zipkit path |
|
lappend internal_paths $ziproot |
|
} |
|
if {[info exists ::tcl::kitpath] && $::tcl::kitpath ne ""} { |
|
lappend internal_paths $::tcl::kitpath |
|
} |
|
if {$has_cookfs} { |
|
lappend internal_paths $cookbase |
|
} |
|
if {[info exists ::punkboot::internal_paths] && [llength $::punkboot::internal_paths]} { |
|
#somewhat ugly cooperation with external sourcing scripts |
|
lappend internal_paths {*}$::punkboot::internal_paths |
|
} |
|
|
|
if {[lindex $args 0] in {dev devquiet}} { |
|
set arglist [lassign $args devmode] |
|
set ::argv $arglist |
|
set ::argc [llength $arglist] |
|
if {$devmode ne "devquiet"} { |
|
puts stderr "DEV MODE - preferencing external libraries and modules" |
|
} |
|
#Note regarding the use of package forget and binary packages |
|
#If the package has loaded a binary component - then a package forget and a subsequent package require can result in both binaries being present, as seen in 'info loaded' result - potentially resulting in anomalous behaviour |
|
#In general package forget after a package has already been required may need special handling and should be avoided where possible. |
|
#Only a limited set of package support unloading a binary component |
|
#We limit the use of 'package forget' here to packages that have not been loaded (whether pure-tcl or not) |
|
#ie in this context it is used only for manipulating preferences of which packages are loaded in the first place |
|
|
|
#Unintuitive preferencing can occur if the same package version is for example present in a tclkit and in a module or lib folder external to the kit. |
|
#It may be desired for performance or testing reasons to preference the library outside of the kit - and raising the version number may not always be possible/practical. |
|
|
|
#If the executable is a kit - we don't know what packages it contains or whether it allows loading from env based external paths. |
|
#For app-punk projects - the lib/module paths based on the project being run should take preference, even if the version number is the same. |
|
#(these are the 'info nameofexecutable' or 'info script' or 'pwd' relative paths that are added here) |
|
#Some kits will remove lib/module paths (from auto_path & tcl::tm::list) that have been added via TCLLIBPATH / TCLX_Y_TM_PATH environment variables |
|
#Some kits will remove those env-provided lib paths but fail to remove the env-provided module paths |
|
#(differences in boot.tcl in the kits) |
|
|
|
#------------------------------------------------------------------------------ |
|
#Module loading |
|
#------------------------------------------------------------------------------ |
|
#If the current directory contains .tm files when the punk repl starts - then it will attempt to preference them |
|
# - but first add our other known relative modules paths - as it won't make sense to use current directory as a modulepath if it's an ancestor of one of these.. |
|
|
|
#original tm list at this point consists of whatever the kit decided + some prepended internal kit paths that punk decided on. |
|
#we want to bring the existing external paths to the front (probably from the kit looking at various env TCL* values) |
|
#we want to maintain the order of the internal paths. |
|
#we then want to add our external dev paths of the total list |
|
|
|
#assert [llength [package names]] should be small at this point ~ <10 ? |
|
|
|
set original_tm_list [tcl::tm::list] |
|
tcl::tm::remove {*}$original_tm_list |
|
|
|
# -- --- --- --- --- --- --- --- |
|
#split existing paths into internal & external |
|
set internal_tm_dirs [list] ;# |
|
set external_tm_dirs [list] |
|
set lcase_internal_paths [string tolower $internal_paths] |
|
foreach tm $original_tm_list { |
|
set tmlower [string tolower $tm] |
|
set is_internal 0 |
|
foreach okprefix $lcase_internal_paths { |
|
if {[string match "$okprefix*" $tmlower]} { |
|
lappend internal_tm_dirs $tm |
|
set is_internal 1 |
|
break |
|
} |
|
} |
|
if {!$is_internal} { |
|
lappend external_tm_dirs $tm |
|
} |
|
} |
|
# -- --- --- --- --- --- --- --- |
|
set original_external_tm_dirs $external_tm_dirs ;#we check some of our additions and bring to front - so we refer to external list as provided by kit |
|
#assert internal_tm_dirs and external_tm_dirs have their case preserved.. |
|
|
|
set module_folders [list] |
|
|
|
#review - the below statement doesn't seem to be true. |
|
#tm list first added end up later in the list - and then override earlier ones if version the same - so add pwd-relative 1st to give higher priority |
|
#(only if Tcl has scanned all paths - see below bogus package load) |
|
#1 |
|
|
|
#2) |
|
# .../bin/punkXX.exe look for ../modules (i.e modules folder at same level as bin folder) |
|
#using normexe under assumption [info name] might be symlink - and more likely to be where the modules are located. |
|
#we will try both relative to symlink and relative to underlying exe - with those at symlink location earlier in the list |
|
#review - a user may have other expectations. |
|
|
|
#case differences could represent different paths on unix-like platforms. |
|
#It's perhaps a little unwise to configure matching paths with only case differences for a cross-platform tool .. but we should support it for those who use it and have no interest in windows - todo! review |
|
set normexe_dir [file dirname $normexe] |
|
if {[file tail $normexe_dir] eq "bin"} { |
|
#underlying exe in a bin dir - backtrack 1 |
|
lappend exe_module_folders [file dirname $normexe_dir]/modules |
|
lappend exe_module_folders [file dirname $normexe_dir]/modules_tcl$tclmajorv |
|
} else { |
|
lappend exe_module_folders $normexe_dir/modules |
|
lappend exe_module_folders $normexe_dir/modules_tcl$tclmajorv |
|
} |
|
set nameexe_dir [file dirname [info nameofexecutable]] |
|
#possible symlink (may resolve to same path as above - we check below to not add in twice) |
|
if {[file tail $nameexe_dir] eq "bin"} { |
|
lappend exe_module_folders [file dirname $nameexe_dir]/modules |
|
lappend exe_module_folders [file dirname $nameexe_dir]/modules_tcl$tclmajorv |
|
} else { |
|
lappend exe_module_folders $nameexe_dir/modules |
|
lappend exe_module_folders $nameexe_dir/modules_tcl$tclmajorv |
|
} |
|
|
|
foreach modulefolder $exe_module_folders { |
|
set lc_external_tm_dirs [string tolower $external_tm_dirs] |
|
set lc_modulefolder [string tolower $modulefolder] |
|
if {$lc_modulefolder in [string tolower $original_external_tm_dirs]} { |
|
#perhaps we have an env var set pointing to one of our dev foldersl. We don't want to rely on how the kit ordered it. |
|
#bring to front if not already there. |
|
#assert it must be present in $lc_external_tm_dirs if it's in $original_external_tm_dirs |
|
set posn [lsearch $lc_external_tm_dirs $lc_modulefolder] |
|
if {$posn > 0} { |
|
#don't rely on lremove here. Not all runtimes have it and we don't want to load our forward-compatibility packages yet. |
|
#(still need to support tcl 8.6 - and this script used in multiple kits) |
|
set external_tm_dirs [lreplace $external_tm_dirs $posn $posn] |
|
#don't even add it back in if it doesn't exist in filesystem |
|
if {[file isdirectory $modulefolder]} { |
|
set external_tm_dirs [linsert $external_tm_dirs 0 $modulefolder] |
|
} |
|
} |
|
} else { |
|
if {$lc_modulefolder ni $lc_external_tm_dirs && [file isdirectory $modulefolder]} { |
|
set external_tm_dirs [linsert $external_tm_dirs 0 $modulefolder] ;#linsert seems faster than 'concat [list $modulefolder] $external_tm_dirs' - review |
|
} |
|
} |
|
} |
|
if {$devmode ne "devquiet" && ![llength $exe_module_folders]} { |
|
puts stderr "Warning - no 'modules' or 'modules_tcl$tclmajorv' folders found relative to executable (or it's symlink if any)" |
|
} |
|
|
|
|
|
|
|
#add lib and lib_tcl8 lib_tcl9 etc based on tclmajorv |
|
#libs are appended to end - so add higher priority libraries last (opposite to modules) |
|
#auto_path - add exe-relative after exe-relative path |
|
if {"windows" eq $::tcl_platform(platform)} { |
|
#case differences dont matter - but can stop us finding path in auto_path |
|
foreach libsub [list lib_tcl$tclmajorv lib] { |
|
if {[file tail $nameexe_dir] eq "bin"} { |
|
set libfolder [file dirname $nameexe_dir]/$libsub |
|
} else { |
|
set libfolder $nameexe_dir/$libsub |
|
} |
|
if {[string tolower $libfolder] ni [string tolower $::auto_path] && [file isdirectory $libfolder]} { |
|
lappend ::auto_path $libfolder |
|
} |
|
# ------------- |
|
if {[file tail $normexe_dir] eq "bin"} { |
|
set libfolder [file dirname $normexe_dir]/$libsub |
|
} else { |
|
set libfolder $normexe_dir/$libsub |
|
} |
|
if {[string tolower $libfolder] ni [string tolower $::auto_path] && [file isdirectory $libfolder]} { |
|
lappend ::auto_path $libfolder |
|
} |
|
# ------------- |
|
set libfolder [pwd]/$libsub |
|
if {[string tolower $libfolder] ni [string tolower $::auto_path] && [file isdirectory $libfolder]} { |
|
lappend ::auto_path $libfolder |
|
} |
|
} |
|
} else { |
|
#on other platforms, case differences could represent different paths |
|
foreach libsub [list lib_tcl$tclmajorv lib] { |
|
if {[file tail $nameexe_dir] eq "bin"} { |
|
set libfolder [file dirname $nameexe_dir]/$libsub |
|
} else { |
|
set libfolder $nameexe_dir/$libsub |
|
} |
|
if {$libfolder ni $::auto_path && [file isdirectory $libfolder]} { |
|
lappend ::auto_path $libfolder |
|
} |
|
# ------------- |
|
if {[file tail $normexe_dir] eq "bin"} { |
|
set libfolder [file dirname $normexe_dir]/$libsub |
|
} else { |
|
set libfolder $normexe_dir/$libsub |
|
} |
|
if {$libfolder ni $::auto_path && [file isdirectory $libfolder]} { |
|
lappend ::auto_path $libfolder |
|
} |
|
# ------------- |
|
set libfolder [pwd]/$libsub |
|
if {$libfolder ni $::auto_path && [file isdirectory $libfolder]} { |
|
lappend ::auto_path $libfolder |
|
} |
|
} |
|
} |
|
|
|
|
|
#2) support developer running from a folder containing *.tm files they want to make available |
|
# could cause problems if user happens to be in a subdirectory of a tm folder structure as namespaced modules won't work if not at a tm path root. |
|
#The current dir could also be a subdirectory of an existing tm_dir which would fail during tcl::tm::add - we will need to wrap all additions in catch |
|
set currentdir_modules [glob -nocomplain -dir [pwd] -type f -tail *.tm] |
|
#we assume [pwd] will always return an external (not kit) path at this point - REVIEW |
|
if {[llength $currentdir_modules]} { |
|
#now add current dir (if no conflict with above) |
|
#catch {tcl::tm::add [pwd]} |
|
set external_tm_dirs [linsert $external_tm_dirs 0 $currentdir_modules] |
|
if {$devmode ne "devquiet" && ([file exists [pwd]/modules] || [file exists [pwd]/modules_tcl$tclmajorv])} { |
|
puts stderr "WARNING: modules or modules_tcl$tclmajorv folders not added to tcl::tm::path due to modules found in current workding dir [pwd]" |
|
} |
|
} else { |
|
#modules or modules_tclX subdir relative to cwd cannot be added if [pwd] has been added |
|
set cwd_modules_folder [file normalize [file join [pwd] modules]] |
|
if {[file isdirectory $cwd_modules_folder]} { |
|
if {[string tolower $cwd_modules_folder] ni [string tolower $external_tm_dirs]} { |
|
#prepend |
|
set external_tm_dirs [linsert $external_tm_dirs 0 $cwd_modules_folder] |
|
} |
|
} |
|
set cwd_modules_folder [file normalize [file join [pwd] modules_tcl$tclmajorv]] |
|
if {[file isdirectory $cwd_modules_folder]} { |
|
if {[string tolower $cwd_modules_folder] ni [string tolower $external_tm_dirs]} { |
|
#prepend |
|
set external_tm_dirs [linsert $external_tm_dirs 0 $cwd_modules_folder] |
|
} |
|
} |
|
} |
|
|
|
#assert tcl::tm::list still empty here |
|
#restore module paths |
|
#add internals first as in 'dev' mode (dev as first argument on launch) we preference external modules |
|
#note use of lreverse to maintain same order |
|
foreach p [lreverse $internal_tm_dirs] { |
|
if {$p ni [tcl::tm::list]} { |
|
#the prior tm paths go to the head of the list. |
|
#They are processed first.. but an item of same version later in the list will override one at the head. (depending on when list was scanned) REVIEW - true statement??? |
|
#addition can fail if one path is a prefix of another |
|
if {[catch {tcl::tm::add $p} errM]} { |
|
puts stderr "Failed to add internal module dir '$p' to tcl::tm::list\n$errM" |
|
} |
|
} |
|
} |
|
foreach p [lreverse $external_tm_dirs] { |
|
if {$p ni [tcl::tm::list]} { |
|
if {[catch {tcl::tm::add $p} errM]} { |
|
puts stderr "Failed to add external module dir '$p' to tcl::tm::list\n$errM" |
|
} |
|
} |
|
} |
|
|
|
#------------------------------------------------------------------------------ |
|
#REVIEW |
|
#package require a bogus package to ensure Tcl scans the whole auto_path/tm list - otherwise a lower-versioned module earlier in the path may be loaded |
|
#This seems to take not insignificant time depending on size of auto_path and tcl::tm::list (e.g 2023 i9 ssd 100ms) - but seems unavoidable for now |
|
#catch {package require flobrudder666_nonexistant} |
|
#------------------------------------------------------------------------------ |
|
|
|
|
|
} else { |
|
#not dev/devquiet |
|
#Tcl_Init will most likely have set up some external paths |
|
#As our app has been started without the 'dev' first arg - we will prune paths that are not zipfs or tclkit |
|
#(or set via punkboot::internal_paths) |
|
set new_auto_path [list] |
|
#review - case insensitive ok for windows - but could cause issues on other platforms? |
|
foreach ap $::auto_path { |
|
set aplower [string tolower $ap] |
|
foreach okprefix $internal_paths { |
|
if {[string match "[string tolower $okprefix]*" $aplower]} { |
|
lappend new_auto_path $ap |
|
break |
|
} |
|
} |
|
} |
|
set ::auto_path $new_auto_path |
|
#puts stderr "internal_paths: $internal_paths" |
|
|
|
set new_tm_list [list] |
|
foreach tm [tcl::tm::list] { |
|
set tmlower [string tolower $tm] |
|
foreach okprefix $internal_paths { |
|
if {[string match "[string tolower $okprefix]*" $tmlower]} { |
|
lappend new_tm_list $tm |
|
break |
|
} |
|
} |
|
} |
|
tcl::tm::remove {*}[tcl::tm::list] |
|
tcl::tm::add {*}[lreverse $new_tm_list] |
|
|
|
|
|
#If it looks like we are running the vfs/_build/exename.vfs/main.tcl from an external tclsh - try to use vfs folders to simulate kit state |
|
#set script_relative_lib [file normalize [file join [file dirname [info script]] lib]] |
|
#set scriptdir [file dirname [info script]] |
|
set scriptdir [file dirname $normscript] |
|
if {![string match //zipfs:/* $scriptdir] && ![string match "${cookbase}*" $scriptdir] && ![info exists ::tcl::kitpath]} { |
|
#presumably running the vfs/xxx.vfs/main.tcl script using a non-kit tclsh that doesn't have starkit lib or mounted zipfs/cookfs available.. lets see if we can move forward anyway |
|
set vfscontainer [file normalize [file dirname $scriptdir]] |
|
#set vfscommon [file join $vfscontainer _vfscommon] |
|
#we shouldn't be targetting the src/vfs folders - use src/_build/exename.vfs instead |
|
set vfsdir [file normalize $scriptdir] |
|
set projectroot [file dirname [file dirname $vfscontainer]] ;#back below src/_build/exename.vfs/main.tcl |
|
puts stdout "no starkit. projectroot?: $projectroot executable:[info nameofexecutable]" |
|
puts stdout "info lib: [info library]" |
|
|
|
#add back the info lib reported by the executable.. as we can't access the one built into a kit |
|
if {[file exists [info library]]} { |
|
lappend ::auto_path [info library] |
|
} |
|
|
|
set lib_types [list lib lib_tcl$tclmajorv] |
|
foreach l $lib_types { |
|
set lib [file join $vfsdir $l] |
|
if {[file exists $lib] && [string tolower $lib] ni [string tolower $::auto_path]} { |
|
lappend ::auto_path $lib |
|
} |
|
} |
|
#foreach l $lib_types { |
|
# set lib [file join $vfscommon $l] |
|
# if {[file exists $lib] && [string tolower $lib] ni [string tolower $::auto_path]} { |
|
# lappend ::auto_path $lib |
|
# } |
|
#} |
|
set mod_types [list modules modules_tcl$tclmajorv] |
|
foreach m $mod_types { |
|
set modpath [file join $vfsdir $m] |
|
if {[file exists $modpath] && [string tolower $modpath] ni [string tolower [tcl::tm::list]]} { |
|
tcl::tm::add $modpath |
|
} |
|
} |
|
#foreach m $mod_types { |
|
# set modpath [file join $vfscommon $m] |
|
# if {[file exists $modpath] && [string tolower $modpath] ni [string tolower [tcl::tm::list]]} { |
|
# tcl::tm::add $modpath |
|
# } |
|
#} |
|
} |
|
#force rescan |
|
#catch {package require flobrudder666_nonexistant} |
|
set arglist $args |
|
} |
|
|
|
#assert arglist has had 'dev' first arg removed if it was present. |
|
if {[llength $arglist] == 1 && [lindex $arglist 0] eq "tclsh"} { |
|
#called as <executable> dev tclsh or <executable> tclsh |
|
#we would like to drop through to standard tclsh repl without launching another process |
|
#tclMain.c doesn't allow it unless patched. |
|
if {![info exists ::env(TCLSH_PIPEREPL)]} { |
|
set is_tclsh_piperepl_env_true 0 |
|
} else { |
|
if {[string is boolean -strict $::env(TCLSH_PIPEREPL)]} { |
|
set is_tclsh_piperepl_env_true $::env(TCLSH_PIPEREPL) |
|
} else { |
|
set is_tclsh_piperepl_env_true 0 |
|
} |
|
} |
|
if {!$is_tclsh_piperepl_env_true} { |
|
puts stderr "tcl_interactive: $::tcl_interactive" |
|
puts stderr "stdin: [chan configure stdin]" |
|
puts stderr "Environment variable TCLSH_PIPEREPL is not set or is false or is not a boolean" |
|
} else { |
|
#according to env TCLSH_PIPEREPL and our commandline argument - tclsh repl is desired |
|
#check if tclsh/punk has had the piperepl patch applied - in which case tclsh(istty) should exist |
|
if {![info exists ::tclsh(istty)]} { |
|
puts stderr "error: the runtime doesn't appear to have been compiled with the piperepl patch" |
|
} |
|
} |
|
set ::tcl_interactive 1 |
|
set ::tclsh(dorepl) 1 |
|
|
|
} elseif {[llength $arglist]} { |
|
#pass through to shellspy commandline processor |
|
#puts stdout "main.tcl launching app-shellspy" |
|
package require app-shellspy |
|
} else { |
|
#punk shell |
|
#todo logger ? |
|
#puts stdout "main.tcl launching app-punk. pkg names count:[llength [package names]]" |
|
#puts ">> $::auto_path" |
|
#puts ">>> [tcl::tm::list]" |
|
package require app-punk |
|
#app-punk starts repl |
|
#repl::start stdin -title "main.tcl" |
|
} |
|
}} {*}$::argv
|
|
|