proc tclInit {} { rename tclInit {} global auto_path tcl_library tcl_libPath global tcl_version tcl_rcFileName set mountpoint [subst "$::TCLKIT_MOUNTPOINT_VAR"] # Resolve symlinks set mountpoint [file dirname [file normalize [file join $mountpoint __dummy__]]] set tcl_library [file join $mountpoint lib tcl$tcl_version] set tcl_libPath [list $tcl_library [file join $mountpoint lib]] # the following code only gets executed once on startup if {[info exists ::TCLKIT_INITVFS]} { catch { load {} vfs } # lookup and emulate "source" of lib/vfs/{vfs*.tcl,mk4vfs.tcl} switch -- $::tclKitStorage { "mk4" { # must use raw MetaKit calls because VFS is not yet in place set d [mk::select exe.dirs parent 0 name lib] set d [mk::select exe.dirs parent $d name vfs] foreach x {vfsUtils vfslib mk4vfs} { set n [mk::select exe.dirs!$d.files name $x.tcl] set s [mk::get exe.dirs!$d.files!$n contents] catch {set s [zlib decompress $s]} uplevel #0 $s } # use on-the-fly decompression, if mk4vfs understands that set mk4vfs::zstreamed 1 # Set VFS handler name set vfsHandler [list ::vfs::mk4::handler exe] } "zip" { set prefix "lib/vfs" foreach file [list vfsUtils vfslib] { set fullfile "${prefix}/${file}.tcl" ::zip::stat $::tclKitStorage_fd $fullfile finfo seek $::tclKitStorage_fd $finfo(ino) zip::Data $::tclKitStorage_fd sb s switch -- $file { "vfsUtils" { # Preserve our working "::vfs::zip" implementation # so we can replace it after the stub is replaced # from vfsUtils # The correct implementation will be provided by vfslib, # but only if we can read it rename ::vfs::zip ::vfs::zip_impl } } uplevel #0 $s switch -- $file { "vfsUtils" { # Restore preserved "::vfs:zip" implementation rename ::vfs::zip {} rename ::vfs::zip_impl ::vfs::zip } } } seek $::tclKitStorage_fd 0 set vfsHandler [list ::vfs::zip::handler $::tclKitStorage_fd] unset ::tclKitStorage_fd } "cvfs" { set vfsHandler [list ::vfs::cvfs::vfshandler tcl] # Load these, the original Tclkit does so it should be safe. foreach vfsfile [list vfsUtils vfslib] { unset -nocomplain s catch { set s [::vfs::cvfs::data::getData tcl "lib/vfs/${vfsfile}.tcl"] } if {![info exists s]} { continue } uplevel #0 $s } } } # mount the executable, i.e. make all runtime files available vfs::filesystem mount $mountpoint $vfsHandler # alter path to find encodings if {[info tclversion] eq "8.4"} { load {} pwb librarypath [info library] } else { encoding dirs [list [file join [info library] encoding]] ;# TIP 258 } # fix system encoding, if it wasn't properly set up (200207.004 bug) if {[encoding system] eq "identity"} { if {[info exists ::tclkit_system_encoding] && $::tclkit_system_encoding != ""} { catch { encoding system $::tclkit_system_encoding } } } # If we've still not been able to set the encoding, revert to Tclkit defaults if {[encoding system] eq "identity"} { catch { switch $::tcl_platform(platform) { windows { encoding system cp1252 } macintosh { encoding system macRoman } default { encoding system iso8859-1 } } } } # Re-evaluate mountpoint with correct encoding set set mountpoint [subst "$::TCLKIT_MOUNTPOINT_VAR"] # now remount the executable with the correct encoding vfs::filesystem unmount [lindex [::vfs::filesystem info] 0] # Resolve symlinks set mountpoint [file dirname [file normalize [file join $mountpoint __dummy__]]] set tcl_library [file join $mountpoint lib tcl$tcl_version] set tcl_libPath [list $tcl_library [file join $mountpoint lib]] vfs::filesystem mount $mountpoint $vfsHandler } # load config settings file if present namespace eval ::vfs { variable tclkit_version 1 } catch { uplevel #0 [list source [file join $mountpoint config.tcl]] } # Perform expected initialization uplevel #0 [list source [file join $tcl_library init.tcl]] # reset auto_path, so that init.tcl's search outside of tclkit is cancelled set auto_path $tcl_libPath # This loads everything needed for "clock scan" to work # "clock scan" is used within "vfs::zip", which may be # loaded before this is run causing the root VFS to break catch { clock scan } if {$::TCLKIT_TYPE == "kitdll"} { # Set a maximum seek to avoid reading the entire file looking for a # zip header catch { package require vfs::zip set ::zip::max_header_seek 8192 } # Now that the initialization is complete, mount the user VFS if needed ## Mount the VFS from the Shared Object if {[info exists ::TCLKIT_INITVFS] && [info exists ::tclKitFilename]} { catch { vfs::zip::Mount $::tclKitFilename "/.KITDLL_USER" lappend auto_path [file normalize "/.KITDLL_USER/lib"] } } ## Mount the VFS from executable if {[info exists ::TCLKIT_INITVFS]} { catch { vfs::zip::Mount [info nameofexecutable] "/.KITDLL_APP" lappend auto_path [file normalize "/.KITDLL_APP/lib"] } } } # Clean up unset -nocomplain ::zip::max_header_seek unset -nocomplain ::TCLKIT_TYPE ::TCLKIT_INITVFS unset -nocomplain ::TCLKIT_MOUNTPOINT ::TCLKIT_VFSSOURCE ::TCLKIT_MOUNTPOINT_VAR ::TCLKIT_VFSSOURCE_VAR unset -nocomplain ::tclKitStorage ::tclKitStorage_fd ::tclKitFilename unset -nocomplain ::tclkit_system_encoding }