Posted to tcl by stevel at Sun Jan 13 04:33:15 GMT 2008view pretty
# # Critcl - build C extensions on-the-fly # # Copyright (c) 2001-2007 Jean-Claude Wippler # Copyright (c) 2002-2007 Steve Landers # # See http://wiki.tcl.tk/critcl # # This is the Critcl runtime that loads the appropriate # shared library when a package is requested # namespace eval ::critcl2 { proc loadlib {dir package version mapping args} { global tcl_platform set path [file join $dir [::critcl::platform $mapping]] set ext [info sharedlibextension] set lib [file join $path $package$ext] set provide [list] if {[llength $args]} { set preload [file join $path preload$ext] foreach p $args { set prelib [file join $path $p$ext] if {[file readable $preload] && [file readable $prelib]} { lappend provide [list load $preload] lappend provide [list ::critcl2::preload $prelib] } } } lappend provide [list load $lib $package] foreach t [glob -nocomplain [file join $dir Tcl *.tcl]] { lappend provide [list source $t] } lappend provide "package provide $package $version" package ifneeded $package $version [join $provide "; "] package ifneeded critcl 0.0 \ "package provide critcl 0.0; [list source [file join $dir critcl.tcl]]" } # ::critcl2::precopy is only used on Windows when preloading out of a # VFS that doesn't support direct loading (usually, a Starkit) # - we preserve the dll name so that dependencies are satisfied # - critcl2::preload is defined in critcl/lib/critcl/critcl_c/preload.c proc precopy {dll} { global env if {[info exists env(TEMP)]} { set dir $env(TEMP) } elseif {[info exists env(TMP)]} { set dir $env(TMP) } elseif {[info exists ~]} { set dir ~ } else { set dir . } set dir [file join $dir TCL[pid]] set i 0 while {[file exists $dir]} { append dir [incr i] } set new [file join $dir [file tail $dll]] file mkdir $dir file copy $dll $new return $new } } namespace eval ::critcl { # a version of critcl::platform that applies the platform mapping proc platform {{mapping ""}} { set platform [::platform::generic] set version $::tcl_platform(osVersion) if {[string match "macosx-*" $platform]} { # "normalize" the osVersion to match OSX release numbers set v [split $version .] set v1 [lindex $v 0] set v2 [lindex $v 1] incr v1 -4 set version 10.$v1.$v2 } foreach {config map} $mapping { if {[string match $config $platform]} { set minver [lindex $map 1] if {[package vcompare $version $minver] != -1} { set platform [lindex $map 0] break } } } return $platform } }