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
31
|
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 noe [info nameofexecutable]
set mountpoint [subst "$::TCLKIT_MOUNTPOINT_VAR"]
# Resolve symlinks
set noe [file dirname [file normalize [file join $noe __dummy__]]]
set mountpoint [file dirname [file normalize [file join $mountpoint __dummy__]]]
set tcl_library [file join $noe lib tcl$tcl_version]
set tcl_libPath [list $tcl_library [file join $noe lib]]
set tcl_library [file join $mountpoint lib tcl$tcl_version]
set tcl_libPath [list $tcl_library [file join $mountpoint lib]]
# get rid of a build residue
unset -nocomplain ::tclDefaultLibrary
if {[info exists tcl_rcFileName]} {
if {[info exists ::TCLKIT_INITVFS]} {
catch {
load {} vfs
}
# lookup and emulate "source" of lib/vfs/{vfs*.tcl,mk4vfs.tcl}
switch -- $::tclKitStorage {
"mk4" {
load {} vfs
|
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
|
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 $noe $vfsHandler
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
}
}
unset -nocomplain ::tclkit_system_encoding
set noe [info nameofexecutable]
set noe [file dirname [file normalize [file join $noe __dummy__]]]
set mountpoint [file dirname [file normalize [file join $mountpoint __dummy__]]]
set tcl_library [file join $noe lib tcl$tcl_version]
set tcl_libPath [list $tcl_library [file join $noe lib]]
set tcl_library [file join $mountpoint lib tcl$tcl_version]
set tcl_libPath [list $tcl_library [file join $mountpoint lib]]
vfs::filesystem mount $noe $vfsHandler
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 $noe config.tcl]] }
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"]
}
}
}
# Cleanup
unset ::tclKitStorage
unset -nocomplain ::tclKitStorage_fd
# 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
}
|