boot.tcl at [015d254dbe]

File kitdll/buildsrc/kitdll-0.0/boot.tcl artifact 2b2126d5c0 part of check-in 015d254dbe


proc tclInit {} {
	rename tclInit {}

	global auto_path tcl_library tcl_libPath
	global tcl_version
  
	# Set path where to mount VFS
	set tcl_mountpoint "/.KITDLL_TCL"

	set tcl_library [file join $tcl_mountpoint lib tcl$tcl_version]
	set tcl_libPath [list $tcl_library [file join $tcl_mountpoint lib]]

	# get rid of a build residue
	unset -nocomplain ::tclDefaultLibrary

	# the following code only gets executed once on startup
	if {[info exists ::initVFS]} {
		set vfsHandler [list ::vfs::kitdll::vfshandler tcl]

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

		# now remount the executable with the correct encoding
		vfs::filesystem unmount [lindex [::vfs::filesystem info] 0]

		# Resolve symlinks
		set tcl_mountpoint [file dirname [file normalize [file join $tcl_mountpoint __dummy__]]]

		set tcl_library [file join $tcl_mountpoint lib tcl$tcl_version]
		set tcl_libPath [list $tcl_library [file join $tcl_mountpoint lib]]

		vfs::filesystem mount $tcl_mountpoint $vfsHandler

	}

	# load config settings file if present
	namespace eval ::vfs { variable tclkit_version 1 }
	catch { uplevel #0 [list source [file join $tcl_mountpoint config.tcl]] }

	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 }

	# Load these, the original Tclkit does so it should be safe.
	uplevel #0 [list source [file join $tcl_mountpoint lib vfs vfsUtils.tcl]]

	# Set a maximum seek to avoid reading the entire DLL 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 ::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 ::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

	# Clean up after the kitInit.c:preInitCmd
	unset -nocomplain ::initVFS ::tclKitFilename
}