Differences From Artifact [6dee5fa1e9]:
- File
kitsh/buildsrc/kitsh-0.0/boot.tcl
— part of check-in
[77e40265de]
at
2010-09-26 04:49:35
on branch trunk
— Updated issue with opening directory
Updated to not panic if native encodings cannot be found (user: rkeene, size: 4087) [annotate] [blame] [check-ins using]
To Artifact [29ebce96a4]:
- File kitsh/buildsrc/kitsh-0.0/boot.tcl — part of check-in [0d35af4b22] at 2011-05-23 17:50:31 on branch merge-kitdll-kitsh-common — Updated to load vfs files from initial VFS (user: rkeene, size: 5561) [annotate] [blame] [check-ins using]
1 2 3 4 5 6 | proc tclInit {} { rename tclInit {} global auto_path tcl_library tcl_libPath global tcl_version tcl_rcFileName | | | | | < < < | > > > > < < | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 | 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] |
︙ | ︙ | |||
70 71 72 73 74 75 76 77 78 79 | } } seek $::tclKitStorage_fd 0 set vfsHandler [list ::vfs::zip::handler $::tclKitStorage_fd] unset ::tclKitStorage_fd } } # mount the executable, i.e. make all runtime files available | > > > > > > > > > > > > > > > > > > | < > > > < < | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | > > > | | | 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 | } } seek $::tclKitStorage_fd 0 set vfsHandler [list ::vfs::zip::handler $::tclKitStorage_fd] unset ::tclKitStorage_fd } "cvfs" { set vfsHandler [list ::vfs::kitdll::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::kitdll::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 } |