Diff

Differences From Artifact [6dee5fa1e9]:

To Artifact [4987d39e91]:


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

	# the following code only gets executed once on startup
	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

				# 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
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







+
+
+



-
+
















-












+
+
+




-
-

-
+

-
-
+
+

-
+




-
+

+










+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+

					}
				}

				seek $::tclKitStorage_fd 0
				set vfsHandler [list ::vfs::zip::handler $::tclKitStorage_fd]
				unset ::tclKitStorage_fd
			}
			"cvfs" {
				set vfsHandler [list ::vfs::kitdll::vfshandler tcl]
			}
		}

		# 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
		}

		# 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]

		set noe [info nameofexecutable]

		# 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]]

		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
}