if {[info commands package] == ""} {
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
package require -exact Tcl 8.0
if {![info exists auto_path]} {
if {[info exist env(TCLLIBPATH)]} {
set auto_path $env(TCLLIBPATH)
} else {
set auto_path ""
}
}
foreach __dir [list [info library] [file dirname [info library]]] {
if {[lsearch -exact $auto_path $__dir] < 0} {
lappend auto_path $__dir
}
}
if {[info exist tcl_pkgPath]} {
foreach __dir $tcl_pkgPath {
if {[lsearch -exact $auto_path $__dir] < 0} {
lappend auto_path $__dir
}
}
}
unset __dir
if {(![interp issafe]) && ($tcl_platform(platform) == "windows")} {
namespace eval tcl {
proc envTraceProc {lo n1 n2 op} {
set x $::env($n2)
set ::env($lo) $x
set ::env([string toupper $lo]) $x
}
}
foreach p [array names env] {
set u [string toupper $p]
if {$u != $p} {
switch -- $u {
COMSPEC -
PATH {
if {![info exists env($u)]} {
set env($u) $env($p)
}
trace variable env($p) w [list tcl::envTraceProc $p]
trace variable env($u) w [list tcl::envTraceProc $p]
}
}
}
}
if {[info exists p]} {
unset p
}
if {[info exists u]} {
unset u
}
if {![info exists env(COMSPEC)]} {
if {$tcl_platform(os) == {Windows NT}} {
set env(COMSPEC) cmd.exe
} else {
set env(COMSPEC) command.com
}
}
}
package unknown tclPkgUnknown
if {[info commands exec] == ""} {
set auto_noexec 1
}
set errorCode ""
set errorInfo ""
if {[info commands tclLog] == ""} {
proc tclLog {string} {
catch {puts stderr $string}
}
}
proc unknown args {
global auto_noexec auto_noload env unknown_pending tcl_interactive
global errorCode errorInfo
set cmd [lindex $args 0]
if {[regexp "^namespace\[ \t\n\]+inscope" $cmd] && [llength $cmd] == 4} {
set arglist [lrange $args 1 end]
set ret [catch {uplevel $cmd $arglist} result]
if {$ret == 0} {
return $result
} else {
return -code $ret -errorcode $errorCode $result
}
}
set savedErrorCode $errorCode
set savedErrorInfo $errorInfo
set name [lindex $args 0]
if {![info exists auto_noload]} {
if {[info exists unknown_pending($name)]} {
return -code error "self-referential recursion in \"unknown\" for command \"$name\"";
}
set unknown_pending($name) pending;
set ret [catch {auto_load $name [uplevel 1 {namespace current}]} msg]
unset unknown_pending($name);
if {$ret != 0} {
return -code $ret -errorcode $errorCode \
"error while autoloading \"$name\": $msg"
}
if {![array size unknown_pending]} {
unset unknown_pending
}
if {$msg} {
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
set code [catch {uplevel 1 $args} msg]
if {$code == 1} {
set new [split $errorInfo \n]
set new [join [lrange $new 0 [expr {[llength $new] - 6}]] \n]
return -code error -errorcode $errorCode \
-errorinfo $new $msg
} else {
return -code $code $msg
}
}
}
if {([info level] == 1) && ([info script] == "") \
&& [info exists tcl_interactive] && $tcl_interactive} {
if {![info exists auto_noexec]} {
set new [auto_execok $name]
if {$new != ""} {
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
set redir ""
if {[info commands console] == ""} {
set redir ">&@stdout <@stdin"
}
return [uplevel exec $redir $new [lrange $args 1 end]]
}
}
set errorCode $savedErrorCode
set errorInfo $savedErrorInfo
if {$name == "!!"} {
set newcmd [history event]
} elseif {[regexp {^!(.+)$} $name dummy event]} {
set newcmd [history event $event]
} elseif {[regexp {^\^([^^]*)\^([^^]*)\^?$} $name dummy old new]} {
set newcmd [history event -1]
catch {regsub -all -- $old $newcmd $new newcmd}
}
if {[info exists newcmd]} {
tclLog $newcmd
history change $newcmd 0
return [uplevel $newcmd]
}
set ret [catch {set cmds [info commands $name*]} msg]
if {[string compare $name "::"] == 0} {
set name ""
}
if {$ret != 0} {
return -code $ret -errorcode $errorCode \
"error in unknown while checking if \"$name\" is a unique command abbreviation: $msg"
}
if {[llength $cmds] == 1} {
return [uplevel [lreplace $args 0 0 $cmds]]
}
if {[llength $cmds] != 0} {
if {$name == ""} {
return -code error "empty command name \"\""
} else {
return -code error \
"ambiguous command name \"$name\": [lsort $cmds]"
}
}
}
return -code error "invalid command name \"$name\""
}
proc auto_load {cmd {namespace {}}} {
global auto_index auto_oldpath auto_path
if {[string length $namespace] == 0} {
set namespace [uplevel {namespace current}]
}
set nameList [auto_qualify $cmd $namespace]
lappend nameList $cmd
foreach name $nameList {
if {[info exists auto_index($name)]} {
uplevel return [expr {[info commands $name] != ""}]
}
}
if {![info exists auto_path]} {
return 0
}
if {![auto_load_index]} {
return 0
}
foreach name $nameList {
if {[info exists auto_index($name)]} {
uplevel if {[info commands $name] != ""} {
return 1
}
}
}
return 0
}
proc auto_load_index {} {
global auto_index auto_oldpath auto_path errorInfo errorCode
if {[info exists auto_oldpath]} {
if {$auto_oldpath == $auto_path} {
return 0
}
}
set auto_oldpath $auto_path
set issafe [interp issafe]
for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {
set dir [lindex $auto_path $i]
set f ""
if {$issafe} {
catch {source [file join $dir tclIndex]}
} elseif {[catch {set f [open [file join $dir tclIndex]]}]} {
continue
} else {
set error [catch {
set id [gets $f]
if {$id == "# Tcl autoload index file, version 2.0"} {
eval [read $f]
} elseif {$id == \
"# Tcl autoload index file: each line identifies a Tcl"} {
while {[gets $f line] >= 0} {
if {([string index $line 0] == "#")
|| ([llength $line] != 2)} {
continue
}
set name [lindex $line 0]
set auto_index($name) \
"source [file join $dir [lindex $line 1]]"
}
} else {
error \
"[file join $dir tclIndex] isn't a proper Tcl index file"
}
} msg]
if {$f != ""} {
close $f
}
if {$error} {
error $msg $errorInfo $errorCode
}
}
}
return 1
}
proc auto_qualify {cmd namespace} {
set n [regsub -all {::+} $cmd :: cmd]
if {[regexp {^::(.*)$} $cmd x tail]} {
if {$n > 1} {
return [list $cmd]
} else {
return [list $tail]
}
}
if {$n == 0} {
if {[string compare $namespace ::] == 0} {
return [list $cmd]
} else {
return [list ${namespace}::$cmd $cmd]
}
} else {
if {[string compare $namespace ::] == 0} {
return [list ::$cmd]
} else {
return [list ${namespace}::$cmd ::$cmd]
}
}
}
proc auto_import {pattern} {
global auto_index
set ns [uplevel namespace current]
set patternList [auto_qualify $pattern $ns]
auto_load_index
foreach pattern $patternList {
foreach name [array names auto_index] {
if {[string match $pattern $name] && "" == [info commands $name]} {
uplevel }
}
}
}
if {[string compare $tcl_platform(platform) windows] == 0} {
proc auto_execok name {
global auto_execs env tcl_platform
if {[info exists auto_execs($name)]} {
return $auto_execs($name)
}
set auto_execs($name) ""
if {[lsearch -exact {cls copy date del erase dir echo mkdir md rename
ren rmdir rd time type ver vol} $name] != -1} {
return [set auto_execs($name) [list $env(COMSPEC) /c $name]]
}
if {[llength [file split $name]] != 1} {
foreach ext {{} .com .exe .bat} {
set file ${name}${ext}
if {[file exists $file] && ![file isdirectory $file]} {
return [set auto_execs($name) [list $file]]
}
}
return ""
}
set path "[file dirname [info nameof]];.;"
if {[info exists env(WINDIR)]} {
set windir $env(WINDIR)
}
if {[info exists windir]} {
if {$tcl_platform(os) == "Windows NT"} {
append path "$windir/system32;"
}
append path "$windir/system;$windir;"
}
if {[info exists env(PATH)]} {
if {[llength [info commands ide_cygwin_path]]} {
append path [ide_cygwin_path posix_to_win32_path_list $env(PATH)]
} else {
append path $env(PATH)
}
}
foreach dir [split $path {;}] {
if {$dir == ""} {
set dir .
}
foreach ext {{} .com .exe .bat} {
set file [file join $dir ${name}${ext}]
if {[file exists $file] && ![file isdirectory $file]} {
return [set auto_execs($name) [list $file]]
}
}
}
return ""
}
} else {
proc auto_execok name {
global auto_execs env
if {[info exists auto_execs($name)]} {
return $auto_execs($name)
}
set auto_execs($name) ""
if {[llength [file split $name]] != 1} {
if {[file executable $name] && ![file isdirectory $name]} {
set auto_execs($name) [list $name]
}
return $auto_execs($name)
}
foreach dir [split $env(PATH) :] {
if {$dir == ""} {
set dir .
}
set file [file join $dir $name]
if {[file executable $file] && ![file isdirectory $file]} {
set auto_execs($name) [list $file]
return $auto_execs($name)
}
}
return ""
}
}
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
tcl_findLibrary pkg_compareExtension
tclMacPkgSearch tclPkgUnknown} $p] < 0)} {
rename $p {}
}
}
catch {unset auto_execs}
catch {unset auto_index}
catch {unset auto_oldpath}
}
proc tcl_findLibrary {basename version patch initScript
enVarName varName {srcLibName {}} {instLibName {}}
{pkgName {}} {debug_startup 0}} {
upvar global env errorInfo
set dirs {}
set errors {}
if {[info exist the_library]} {
lappend dirs $the_library
} else {
if {[info exists env($enVarName)]} {
lappend dirs $env($enVarName)
}
if {$srcLibName == ""} {
set srcLibName library
}
if {$instLibName == ""} {
set instLibName $basename$version
}
set parentDir [file dirname [info library]]
set grandParentDir [file dirname $parentDir]
lappend dirs [file join $parentDir $instLibName]
lappend dirs [file join $grandParentDir $instLibName]
lappend dirs [file join $grandParentDir $basename $srcLibName]
lappend dirs [file join $grandParentDir $basename$version $srcLibName]
if {$pkgName != ""} {
lappend dirs [file join $grandParentDir $pkgName $basename $srcLibName]
lappend dirs [file join $grandParentDir $pkgName $basename$version $srcLibName]
}
}
foreach i $dirs {
set the_library $i
set file [file join $i $initScript]
if {[interp issafe] || [file exists $file]} {
if {$debug_startup} {
if {![catch {uplevel \ return
} else {
append errors "$file: $msg\n$errorInfo\n"
}
} else {
if {![catch {uplevel \ 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
}
if {! [interp issafe]} {
proc auto_mkindex {dir args} {
global errorCode errorInfo
set oldDir [pwd]
cd $dir
set dir [pwd]
append index "# Tcl autoload index file, version 2.0\n"
append index "# This file is generated by the \"auto_mkindex\" command\n"
append index "# and sourced to set up indexing information for one or\n"
append index "# more commands. Typically each line is a command that\n"
append index "# sets an element in the auto_index array, where the\n"
append index "# element name is the name of a command and the value is\n"
append index "# a script that loads the command.\n\n"
if {$args == ""} {
set args *.tcl
}
foreach file [eval glob $args] {
auto_mkindex_parser::init
if {[catch {auto_mkindex_parser::mkindex $file} msg] == 0} {
append index $msg
} else {
set code $errorCode
set info $errorInfo
cd $oldDir
error $msg $info $code
}
auto_mkindex_parser::cleanup
}
set fid [open "tclIndex" w]
puts $fid $index nonewline
close $fid
cd $oldDir
}
proc auto_mkindex_old {dir args} {
global errorCode errorInfo
set oldDir [pwd]
cd $dir
set dir [pwd]
append index "# Tcl autoload index file, version 2.0\n"
append index "# This file is generated by the \"auto_mkindex\" command\n"
append index "# and sourced to set up indexing information for one or\n"
append index "# more commands. Typically each line is a command that\n"
append index "# sets an element in the auto_index array, where the\n"
append index "# element name is the name of a command and the value is\n"
append index "# a script that loads the command.\n\n"
if {$args == ""} {
set args *.tcl
}
foreach file [eval glob $args] {
set f ""
set error [catch {
set f [open $file]
while {[gets $f line] >= 0} {
if {[regexp {^proc[ ]+([^ ]*)} $line match procName]} {
set procName [lindex [auto_qualify $procName "::"] 0]
append index "set [list auto_index($procName)]"
append index " \[list source \[file join \$dir [list $file]\]\]\n"
}
}
close $f
} msg]
if {$error} {
set code $errorCode
set info $errorInfo
catch {close $f}
cd $oldDir
error $msg $info $code
}
}
set f ""
set error [catch {
set f [open tclIndex w]
puts $f $index nonewline
close $f
cd $oldDir
} msg]
if {$error} {
set code $errorCode
set info $errorInfo
catch {close $f}
cd $oldDir
error $msg $info $code
}
}
namespace eval auto_mkindex_parser {
variable parser "" ; variable index "" ; variable scriptFile "" ; variable contextStack "" ; variable imports "" ; variable initCommands "" ; proc init {} {
variable parser
variable initCommands
if {![interp issafe]} {
set parser [interp create -safe]
$parser hide info
$parser hide rename
$parser hide proc
$parser hide namespace
$parser hide eval
$parser hide puts
$parser invokehidden namespace delete ::
$parser invokehidden proc unknown {args} {}
$parser expose namespace
$parser invokehidden rename namespace _%@namespace
$parser expose eval
$parser invokehidden rename eval _%@eval
foreach cmd $initCommands {
eval $cmd
}
}
}
proc cleanup {} {
variable parser
interp delete $parser
unset parser
}
}
proc auto_mkindex_parser::mkindex {file} {
variable parser
variable index
variable scriptFile
variable contextStack
variable imports
set scriptFile $file
set fid [open $file]
set contents [read $fid]
close $fid
regsub -all {([^\$])\$([^\$])} $contents {\1\\$\2} contents
set index ""
set contextStack ""
set imports ""
$parser eval $contents
foreach name $imports {
catch {$parser eval [list _%@namespace forget $name]}
}
return $index
}
proc auto_mkindex_parser::hook {cmd} {
variable initCommands
lappend initCommands $cmd
}
proc auto_mkindex_parser::slavehook {cmd} {
variable initCommands
lappend initCommands "\$parser eval [list $cmd]"
}
proc auto_mkindex_parser::command {name arglist body} {
hook [list auto_mkindex_parser::commandInit $name $arglist $body]
}
proc auto_mkindex_parser::commandInit {name arglist body} {
variable parser
set ns [namespace qualifiers $name]
set tail [namespace tail $name]
if {$ns == ""} {
set fakeName "[namespace current]::_%@fake_$tail"
} else {
set fakeName "_%@fake_$name"
regsub -all {::} $fakeName "_" fakeName
set fakeName "[namespace current]::$fakeName"
}
proc $fakeName $arglist $body
if {[regexp {::} $name]} {
set exportCmd [list _%@namespace export [namespace tail $name]]
$parser eval [list _%@namespace eval $ns $exportCmd]
set alias [namespace tail $fakeName]
$parser invokehidden proc $name {args} "_%@eval $alias \$args"
$parser alias $alias $fakeName
} else {
$parser alias $name $fakeName
}
return
}
proc auto_mkindex_parser::fullname {name} {
variable contextStack
if {![string match ::* $name]} {
foreach ns $contextStack {
set name "${ns}::$name"
if {[string match ::* $name]} {
break
}
}
}
if {[namespace qualifiers $name] == ""} {
return [namespace tail $name]
} elseif {![string match ::* $name]} {
return "::$name"
}
return $name
}
auto_mkindex_parser::command proc {name args} {
variable index
variable scriptFile
append index "set [list auto_index([fullname $name])]"
append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
}
auto_mkindex_parser::command namespace {op args} {
switch -- $op {
eval {
variable parser
variable contextStack
set name [lindex $args 0]
set args [lrange $args 1 end]
set contextStack [linsert $contextStack 0 $name]
if {[llength $args] == 1} {
$parser eval [lindex $args 0]
} else {
eval $parser eval $args
}
set contextStack [lrange $contextStack 1 end]
}
import {
variable parser
variable imports
foreach pattern $args {
if {$pattern != "-force"} {
lappend imports $pattern
}
}
catch {$parser eval "_%@namespace import $args"}
}
}
}
}
proc pkg_compareExtension { fileName {ext {}} } {
global tcl_platform
if {[string length $ext] == 0} {
set ext [info sharedlibextension]
}
if {[string compare $tcl_platform(platform) "windows"] == 0} {
return [expr {[string compare \
[string tolower [file extension $fileName]] \
[string tolower $ext]] == 0}]
} else {
return [expr {[string compare [file extension $fileName] $ext] == 0}]
}
}
proc pkg_mkIndex {args} {
global errorCode errorInfo
set usage {"pkg_mkIndex ?-direct? ?-verbose? ?-load pattern? ?--? dir ?pattern ...?"};
set argCount [llength $args]
if {$argCount < 1} {
return -code error "wrong # args: should be\n$usage"
}
set more ""
set direct 0
set doVerbose 0
set loadPat ""
for {set idx 0} {$idx < $argCount} {incr idx} {
set flag [lindex $args $idx]
switch -glob -- $flag {
-- {
incr idx
break
}
-verbose {
set doVerbose 1
}
-direct {
set direct 1
append more " -direct"
}
-load {
incr idx
set loadPat [lindex $args $idx]
append more " -load $loadPat"
}
-* {
return -code error "unknown flag $flag: should be\n$usage"
}
default {
break
}
}
}
set dir [lindex $args $idx]
set patternList [lrange $args [expr {$idx + 1}] end]
if {[llength $patternList] == 0} {
set patternList [list "*.tcl" "*[info sharedlibextension]"]
}
append index "# Tcl package index file, version 1.1\n"
append index "# This file is generated by the \"pkg_mkIndex$more\" command\n"
append index "# and sourced either when an application starts up or\n"
append index "# by a \"package unknown\" script. It invokes the\n"
append index "# \"package ifneeded\" command to set up package-related\n"
append index "# information so that packages will be loaded automatically\n"
append index "# in response to \"package require\" commands. When this\n"
append index "# script is sourced, the variable \$dir must contain the\n"
append index "# full path name of this file's directory.\n"
set oldDir [pwd]
cd $dir
if {[catch {eval glob $patternList} fileList]} {
global errorCode errorInfo
cd $oldDir
return -code error -errorcode $errorCode -errorinfo $errorInfo $fileList
}
foreach file $fileList {
if {[string compare $file "pkgIndex.tcl"] == 0} {
continue
}
cd $oldDir
set c [interp create]
foreach pkg [info loaded] {
if {! [string match $loadPat [lindex $pkg 1]]} {
continue
}
if {[lindex $pkg 1] == "Tk"} {
$c eval {set argv {-geometry +0+0}}
}
if {[catch {
load [lindex $pkg 0] [lindex $pkg 1] $c
} err]} {
if {$doVerbose} {
tclLog "warning: load [lindex $pkg 0] [lindex $pkg 1]\nfailed with: $err"
}
} else {
if {$doVerbose} {
tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
}
}
}
cd $dir
$c eval {
rename package __package_orig
proc package {what args} {
switch -- $what {
require { return ; default { eval __package_orig {$what} $args }
}
}
proc tclPkgUnknown args {}
package unknown tclPkgUnknown
proc unknown {args} {}
proc auto_import {args} {}
namespace eval ::tcl {
variable file ; variable direct ; variable x ; variable debug ; variable type ; variable namespaces ; variable packages ; variable origCmds ; variable newCmds ; variable newPkgs {} ; }
}
$c eval [list set ::tcl::file $file]
$c eval [list set ::tcl::direct $direct]
if {[catch {
$c eval {
set ::tcl::debug "loading or sourcing"
proc ::tcl::GetAllNamespaces {{root ::}} {
set list $root
foreach ns [namespace children $root] {
eval lappend list [::tcl::GetAllNamespaces $ns]
}
return $list
}
foreach ::tcl::x [::tcl::GetAllNamespaces] {
set ::tcl::namespaces($::tcl::x) 1
}
foreach ::tcl::x [package names] {
set ::tcl::packages($::tcl::x) 1
}
set ::tcl::origCmds [info commands]
if {[pkg_compareExtension $::tcl::file [info sharedlibextension]]} {
set ::tcl::debug loading
load [file join . $::tcl::file]
set ::tcl::type load
} else {
set ::tcl::debug sourcing
source $::tcl::file
set ::tcl::type source
}
foreach ::tcl::x [::tcl::GetAllNamespaces] {
if {! [info exists ::tcl::namespaces($::tcl::x)]} {
namespace import ${::tcl::x}::*
}
}
foreach ::tcl::x [info commands] {
set ::tcl::newCmds($::tcl::x) 1
}
foreach ::tcl::x $::tcl::origCmds {
catch {unset ::tcl::newCmds($::tcl::x)}
}
foreach ::tcl::x [array names ::tcl::newCmds] {
set ::tcl::abs [namespace origin $::tcl::x]
set ::tcl::abs [auto_qualify $::tcl::abs ::]
if {[string compare $::tcl::x $::tcl::abs] != 0} {
set ::tcl::newCmds($::tcl::abs) 1
unset ::tcl::newCmds($::tcl::x)
}
}
foreach ::tcl::x [package names] {
if {([string compare [package provide $::tcl::x] ""] != 0) \
&& ![info exists ::tcl::packages($::tcl::x)]} {
lappend ::tcl::newPkgs \
[list $::tcl::x [package provide $::tcl::x]]
}
}
}
} msg] == 1} {
set what [$c eval set ::tcl::debug]
if {$doVerbose} {
tclLog "warning: error while $what $file: $msg"
}
} else {
set type [$c eval set ::tcl::type]
set cmds [lsort [$c eval array names ::tcl::newCmds]]
set pkgs [$c eval set ::tcl::newPkgs]
if {[llength $pkgs] > 1} {
tclLog "warning: \"$file\" provides more than one package ($pkgs)"
}
foreach pkg $pkgs {
lappend files($pkg) [list $file $type $cmds]
}
if {$doVerbose} {
tclLog "processed $file"
}
}
interp delete $c
}
foreach pkg [lsort [array names files]] {
append index "\npackage ifneeded $pkg "
if {$direct} {
set cmdList {}
foreach elem $files($pkg) {
set file [lindex $elem 0]
set type [lindex $elem 1]
lappend cmdList "\[list $type \[file join \$dir\
[list $file]\]\]"
}
append index [join $cmdList "\\n"]
} else {
append index "\[list tclPkgSetup \$dir [lrange $pkg 0 0]\
[lrange $pkg 1 1] [list $files($pkg)]\]"
}
}
set f [open pkgIndex.tcl w]
puts $f $index
close $f
cd $oldDir
}
proc tclPkgSetup {dir pkg version files} {
global auto_index
package provide $pkg $version
foreach fileInfo $files {
set f [lindex $fileInfo 0]
set type [lindex $fileInfo 1]
foreach cmd [lindex $fileInfo 2] {
if {$type == "load"} {
set auto_index($cmd) [list load [file join $dir $f] $pkg]
} else {
set auto_index($cmd) [list source [file join $dir $f]]
}
}
}
}
proc tclMacPkgSearch {dir} {
foreach x [glob -nocomplain [file join $dir *.shlb]] {
if {[file isfile $x]} {
set res [resource open $x]
foreach y [resource list TEXT $res] {
if {$y == "pkgIndex"} {source -rsrc pkgIndex}
}
catch {resource close $res}
}
}
}
proc tclPkgUnknown {name version {exact {}}} {
global auto_path tcl_platform env
if {![info exists auto_path]} {
return
}
for {set i [expr {[llength $auto_path] - 1}]} {$i >= 0} {incr i -1} {
catch {
foreach file [glob -nocomplain [file join [lindex $auto_path $i] \
* pkgIndex.tcl]] {
set dir [file dirname $file]
if {[catch {source $file} msg]} {
tclLog "error reading package index file $file: $msg"
}
}
}
set dir [lindex $auto_path $i]
set file [file join $dir pkgIndex.tcl]
if {[interp issafe] || [file readable $file]} {
if {[catch {source $file} msg] && ![interp issafe]} {
tclLog "error reading package index file $file: $msg"
}
}
if {(![interp issafe]) && ($tcl_platform(platform) == "macintosh")} {
set dir [lindex $auto_path $i]
tclMacPkgSearch $dir
foreach x [glob -nocomplain [file join $dir *]] {
if {[file isdirectory $x]} {
set dir $x
tclMacPkgSearch $dir
}
}
}
}
}