diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/init.tcl | 87 |
1 files changed, 84 insertions, 3 deletions
diff --git a/library/init.tcl b/library/init.tcl index de9c30e..fa8a83c 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -37,7 +37,7 @@ catch { unset __dir } -# Windows specific end of initialization +# Windows specific initialization to handle case isses with envars if {(![interp issafe]) && ($tcl_platform(platform) == "windows")} { namespace eval tcl { @@ -77,7 +77,6 @@ if {(![interp issafe]) && ($tcl_platform(platform) == "windows")} { } } - # Setup the unknown package handler package unknown tclPkgUnknown @@ -561,7 +560,7 @@ proc auto_reset {} { global auto_execs auto_index auto_oldpath foreach p [info procs] { if {[info exists auto_index($p)] && ![string match auto_* $p] - && ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup + && ([lsearch -exact {unknown pkg_mkIndex tclPkgSetup tcl_findLibrary tclMacPkgSearch tclPkgUnknown} $p] < 0)} { rename $p {} } @@ -571,6 +570,88 @@ proc auto_reset {} { catch {unset auto_oldpath} } +# tcl_findLibrary +# This is a utility for extensions that searches for a library directory +# using a canonical searching algorithm. A side effect is to source +# the initialization script and set a global library variable. +# Arguments: +# basename Prefix of the directory name, (e.g., "tk") +# version Version number of the package, (e.g., "8.0") +# patch Patchlevel of the package, (e.g., "8.0.3") +# initScript Initialization script to source (e.g., tk.tcl) +# enVarName environment variable to honor (e.g., TK_LIBRARY) +# varName Global variable to set when done (e.g., tk_library) + +proc tcl_findLibrary {basename version patch initScript enVarName varName} { + upvar #0 $varName the_library + global env + + set dirs {} + set errors {} + + # The C application may have hardwired a path, which we honor + + if {[info exist the_library]} { + lappend dirs $the_library + } else { + + # Do the canonical search + + # 1. From an environment variable, if it exists + + if {[info exists env($enVarName)]} { + lappend dirs $env($enVarName) + } + + # 2. Relative to the Tcl library + + lappend dirs [file join [file dirname [info library]] $basename$version] + + # 3. Various locations relative to the executable + # ../lib/foo1.0 (From bin directory in install hierarchy) + # ../../lib/foo1.0 (From bin/arch directory in install hierarchy) + # ../library (From unix directory in build hierarchy) + # ../../library (From unix/arch directory in build hierarchy) + # ../../foo1.0b1/library (From unix directory in parallel build hierarchy) + # ../../../foo1.0b1/library (From unix/arch directory in parallel build hierarchy) + + set parentDir [file dirname [file dirname [info nameofexecutable]]] + set grandParentDir [file dirname $parentDir] + lappend dirs [file join $parentDir lib $basename$version] + lappend dirs [file join $grandParentDir lib $basename$version] + lappend dirs [file join $parentDir library] + lappend dirs [file join $grandParentDir library] + if [string match {*[ab]*} $patch] { + set ver $patch + } else { + set ver $version + } + lappend dirs [file join $grandParentDir] $basename$ver/library] + lappend dirs [file join [file dirname $grandParentDir] $basename$ver/library] + } + foreach i $dirs { + set the_library $i + set file [file join $i $initScript] + + # source everything when in a safe interpreter because + # we have a source command, but no file exists command + + if {[interp issafe] || [file exists $file]} { + if {![catch {uplevel #0 [list source $file]} msg]} { + return + } else { + append errors "$file: $msg\n$errorInfo\n" + } + } + } + set msg "Can't find a usable $initScript in the following directories: \n" + append msg " $dirs\n\n" + append msg "$errors\n\n" + append msg "This probably means that $basename wasn't installed properly.\n" + error $msg +} + + # OPTIONAL SUPPORT PROCEDURES # In Tcl 8.1 all the code below here has been moved to other files to # reduce the size of init.tcl |