summaryrefslogtreecommitdiffstats
path: root/tcl8.6/library/package.tcl
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2018-01-02 21:03:49 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2018-01-02 21:03:49 (GMT)
commit914501b5b992e7b6c7e0a4c958712a8ba9cab41c (patch)
treeedbc059b9557d5fdb79e5a5c47889bc54708da53 /tcl8.6/library/package.tcl
parentf88c190a01bc7f57e79dfaf91a3c0c48c2031549 (diff)
downloadblt-914501b5b992e7b6c7e0a4c958712a8ba9cab41c.zip
blt-914501b5b992e7b6c7e0a4c958712a8ba9cab41c.tar.gz
blt-914501b5b992e7b6c7e0a4c958712a8ba9cab41c.tar.bz2
upgrade to tcl/tk 8.6.8
Diffstat (limited to 'tcl8.6/library/package.tcl')
-rw-r--r--tcl8.6/library/package.tcl747
1 files changed, 747 insertions, 0 deletions
diff --git a/tcl8.6/library/package.tcl b/tcl8.6/library/package.tcl
new file mode 100644
index 0000000..44e3b28
--- /dev/null
+++ b/tcl8.6/library/package.tcl
@@ -0,0 +1,747 @@
+# package.tcl --
+#
+# utility procs formerly in init.tcl which can be loaded on demand
+# for package management.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994-1998 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+namespace eval tcl::Pkg {}
+
+# ::tcl::Pkg::CompareExtension --
+#
+# Used internally by pkg_mkIndex to compare the extension of a file to a given
+# extension. On Windows, it uses a case-insensitive comparison because the
+# file system can be file insensitive.
+#
+# Arguments:
+# fileName name of a file whose extension is compared
+# ext (optional) The extension to compare against; you must
+# provide the starting dot.
+# Defaults to [info sharedlibextension]
+#
+# Results:
+# Returns 1 if the extension matches, 0 otherwise
+
+proc tcl::Pkg::CompareExtension {fileName {ext {}}} {
+ global tcl_platform
+ if {$ext eq ""} {set ext [info sharedlibextension]}
+ if {$tcl_platform(platform) eq "windows"} {
+ return [string equal -nocase [file extension $fileName] $ext]
+ } else {
+ # Some unices add trailing numbers after the .so, so
+ # we could have something like '.so.1.2'.
+ set root $fileName
+ while {1} {
+ set currExt [file extension $root]
+ if {$currExt eq $ext} {
+ return 1
+ }
+
+ # The current extension does not match; if it is not a numeric
+ # value, quit, as we are only looking to ignore version number
+ # extensions. Otherwise we might return 1 in this case:
+ # tcl::Pkg::CompareExtension foo.so.bar .so
+ # which should not match.
+
+ if {![string is integer -strict [string range $currExt 1 end]]} {
+ return 0
+ }
+ set root [file rootname $root]
+ }
+ }
+}
+
+# pkg_mkIndex --
+# This procedure creates a package index in a given directory. The package
+# index consists of a "pkgIndex.tcl" file whose contents are a Tcl script that
+# sets up package information with "package require" commands. The commands
+# describe all of the packages defined by the files given as arguments.
+#
+# Arguments:
+# -direct (optional) If this flag is present, the generated
+# code in pkgMkIndex.tcl will cause the package to be
+# loaded when "package require" is executed, rather
+# than lazily when the first reference to an exported
+# procedure in the package is made.
+# -verbose (optional) Verbose output; the name of each file that
+# was successfully rocessed is printed out. Additionally,
+# if processing of a file failed a message is printed.
+# -load pat (optional) Preload any packages whose names match
+# the pattern. Used to handle DLLs that depend on
+# other packages during their Init procedure.
+# dir - Name of the directory in which to create the index.
+# args - Any number of additional arguments, each giving
+# a glob pattern that matches the names of one or
+# more shared libraries or Tcl script files in
+# dir.
+
+proc pkg_mkIndex {args} {
+ set usage {"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?"}
+
+ set argCount [llength $args]
+ if {$argCount < 1} {
+ return -code error "wrong # args: should be\n$usage"
+ }
+
+ set more ""
+ set direct 1
+ set doVerbose 0
+ set loadPat ""
+ for {set idx 0} {$idx < $argCount} {incr idx} {
+ set flag [lindex $args $idx]
+ switch -glob -- $flag {
+ -- {
+ # done with the flags
+ incr idx
+ break
+ }
+ -verbose {
+ set doVerbose 1
+ }
+ -lazy {
+ set direct 0
+ append more " -lazy"
+ }
+ -direct {
+ 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 {
+ # done with the flags
+ break
+ }
+ }
+ }
+
+ set dir [lindex $args $idx]
+ set patternList [lrange $args [expr {$idx + 1}] end]
+ if {![llength $patternList]} {
+ set patternList [list "*.tcl" "*[info sharedlibextension]"]
+ }
+
+ try {
+ set fileList [glob -directory $dir -tails -types {r f} -- \
+ {*}$patternList]
+ } on error {msg opt} {
+ return -options $opt $msg
+ }
+ foreach file $fileList {
+ # For each file, figure out what commands and packages it provides.
+ # To do this, create a child interpreter, load the file into the
+ # interpreter, and get a list of the new commands and packages that
+ # are defined.
+
+ if {$file eq "pkgIndex.tcl"} {
+ continue
+ }
+
+ set c [interp create]
+
+ # Load into the child any packages currently loaded in the parent
+ # interpreter that match the -load pattern.
+
+ if {$loadPat ne ""} {
+ if {$doVerbose} {
+ tclLog "currently loaded packages: '[info loaded]'"
+ tclLog "trying to load all packages matching $loadPat"
+ }
+ if {![llength [info loaded]]} {
+ tclLog "warning: no packages are currently loaded, nothing"
+ tclLog "can possibly match '$loadPat'"
+ }
+ }
+ foreach pkg [info loaded] {
+ if {![string match -nocase $loadPat [lindex $pkg 1]]} {
+ continue
+ }
+ if {$doVerbose} {
+ tclLog "package [lindex $pkg 1] matches '$loadPat'"
+ }
+ try {
+ load [lindex $pkg 0] [lindex $pkg 1] $c
+ } on error err {
+ if {$doVerbose} {
+ tclLog "warning: load [lindex $pkg 0]\
+ [lindex $pkg 1]\nfailed with: $err"
+ }
+ } on ok {} {
+ if {$doVerbose} {
+ tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]"
+ }
+ }
+ if {[lindex $pkg 1] eq "Tk"} {
+ # Withdraw . if Tk was loaded, to avoid showing a window.
+ $c eval [list wm withdraw .]
+ }
+ }
+
+ $c eval {
+ # Stub out the package command so packages can require other
+ # packages.
+
+ rename package __package_orig
+ proc package {what args} {
+ switch -- $what {
+ require {
+ return; # Ignore transitive requires
+ }
+ default {
+ __package_orig $what {*}$args
+ }
+ }
+ }
+ proc tclPkgUnknown args {}
+ package unknown tclPkgUnknown
+
+ # Stub out the unknown command so package can call into each other
+ # during their initialilzation.
+
+ proc unknown {args} {}
+
+ # Stub out the auto_import mechanism
+
+ proc auto_import {args} {}
+
+ # reserve the ::tcl namespace for support procs and temporary
+ # variables. This might make it awkward to generate a
+ # pkgIndex.tcl file for the ::tcl namespace.
+
+ namespace eval ::tcl {
+ variable dir ;# Current directory being processed
+ variable file ;# Current file being processed
+ variable direct ;# -direct flag value
+ variable x ;# Loop variable
+ variable debug ;# For debugging
+ variable type ;# "load" or "source", for -direct
+ variable namespaces ;# Existing namespaces (e.g., ::tcl)
+ variable packages ;# Existing packages (e.g., Tcl)
+ variable origCmds ;# Existing commands
+ variable newCmds ;# Newly created commands
+ variable newPkgs {} ;# Newly created packages
+ }
+ }
+
+ $c eval [list set ::tcl::dir $dir]
+ $c eval [list set ::tcl::file $file]
+ $c eval [list set ::tcl::direct $direct]
+
+ # Download needed procedures into the slave because we've just deleted
+ # the unknown procedure. This doesn't handle procedures with default
+ # arguments.
+
+ foreach p {::tcl::Pkg::CompareExtension} {
+ $c eval [list namespace eval [namespace qualifiers $p] {}]
+ $c eval [list proc $p [info args $p] [info body $p]]
+ }
+
+ try {
+ $c eval {
+ set ::tcl::debug "loading or sourcing"
+
+ # we need to track command defined by each package even in the
+ # -direct case, because they are needed internally by the
+ # "partial pkgIndex.tcl" step above.
+
+ proc ::tcl::GetAllNamespaces {{root ::}} {
+ set list $root
+ foreach ns [namespace children $root] {
+ lappend list {*}[::tcl::GetAllNamespaces $ns]
+ }
+ return $list
+ }
+
+ # init the list of existing namespaces, packages, commands
+
+ foreach ::tcl::x [::tcl::GetAllNamespaces] {
+ set ::tcl::namespaces($::tcl::x) 1
+ }
+ foreach ::tcl::x [package names] {
+ if {[package provide $::tcl::x] ne ""} {
+ set ::tcl::packages($::tcl::x) 1
+ }
+ }
+ set ::tcl::origCmds [info commands]
+
+ # Try to load the file if it has the shared library extension,
+ # otherwise source it. It's important not to try to load
+ # files that aren't shared libraries, because on some systems
+ # (like SunOS) the loader will abort the whole application
+ # when it gets an error.
+
+ if {[::tcl::Pkg::CompareExtension $::tcl::file [info sharedlibextension]]} {
+ # The "file join ." command below is necessary. Without
+ # it, if the file name has no \'s and we're on UNIX, the
+ # load command will invoke the LD_LIBRARY_PATH search
+ # mechanism, which could cause the wrong file to be used.
+
+ set ::tcl::debug loading
+ load [file join $::tcl::dir $::tcl::file]
+ set ::tcl::type load
+ } else {
+ set ::tcl::debug sourcing
+ source [file join $::tcl::dir $::tcl::file]
+ set ::tcl::type source
+ }
+
+ # As a performance optimization, if we are creating direct
+ # load packages, don't bother figuring out the set of commands
+ # created by the new packages. We only need that list for
+ # setting up the autoloading used in the non-direct case.
+ if {!$::tcl::direct} {
+ # See what new namespaces appeared, and import commands
+ # from them. Only exported commands go into the index.
+
+ foreach ::tcl::x [::tcl::GetAllNamespaces] {
+ if {![info exists ::tcl::namespaces($::tcl::x)]} {
+ namespace import -force ${::tcl::x}::*
+ }
+
+ # Figure out what commands appeared
+
+ foreach ::tcl::x [info commands] {
+ set ::tcl::newCmds($::tcl::x) 1
+ }
+ foreach ::tcl::x $::tcl::origCmds {
+ unset -nocomplain ::tcl::newCmds($::tcl::x)
+ }
+ foreach ::tcl::x [array names ::tcl::newCmds] {
+ # determine which namespace a command comes from
+
+ set ::tcl::abs [namespace origin $::tcl::x]
+
+ # special case so that global names have no
+ # leading ::, this is required by the unknown
+ # command
+
+ set ::tcl::abs \
+ [lindex [auto_qualify $::tcl::abs ::] 0]
+
+ if {$::tcl::x ne $::tcl::abs} {
+ # Name changed during qualification
+
+ set ::tcl::newCmds($::tcl::abs) 1
+ unset ::tcl::newCmds($::tcl::x)
+ }
+ }
+ }
+ }
+
+ # Look through the packages that appeared, and if there is a
+ # version provided, then record it
+
+ foreach ::tcl::x [package names] {
+ if {[package provide $::tcl::x] ne ""
+ && ![info exists ::tcl::packages($::tcl::x)]} {
+ lappend ::tcl::newPkgs \
+ [list $::tcl::x [package provide $::tcl::x]]
+ }
+ }
+ }
+ } on error msg {
+ set what [$c eval set ::tcl::debug]
+ if {$doVerbose} {
+ tclLog "warning: error while $what $file: $msg"
+ }
+ } on ok {} {
+ set what [$c eval set ::tcl::debug]
+ if {$doVerbose} {
+ tclLog "successful $what of $file"
+ }
+ set type [$c eval set ::tcl::type]
+ set cmds [lsort [$c eval array names ::tcl::newCmds]]
+ set pkgs [$c eval set ::tcl::newPkgs]
+ if {$doVerbose} {
+ if {!$direct} {
+ tclLog "commands provided were $cmds"
+ }
+ tclLog "packages provided were $pkgs"
+ }
+ if {[llength $pkgs] > 1} {
+ tclLog "warning: \"$file\" provides more than one package ($pkgs)"
+ }
+ foreach pkg $pkgs {
+ # cmds is empty/not used in the direct case
+ lappend files($pkg) [list $file $type $cmds]
+ }
+
+ if {$doVerbose} {
+ tclLog "processed $file"
+ }
+ }
+ interp delete $c
+ }
+
+ 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"
+
+ foreach pkg [lsort [array names files]] {
+ set cmd {}
+ lassign $pkg name version
+ lappend cmd ::tcl::Pkg::Create -name $name -version $version
+ foreach spec [lsort -index 0 $files($pkg)] {
+ foreach {file type procs} $spec {
+ if {$direct} {
+ set procs {}
+ }
+ lappend cmd "-$type" [list $file $procs]
+ }
+ }
+ append index "\n[eval $cmd]"
+ }
+
+ set f [open [file join $dir pkgIndex.tcl] w]
+ puts $f $index
+ close $f
+}
+
+# tclPkgSetup --
+# This is a utility procedure use by pkgIndex.tcl files. It is invoked as
+# part of a "package ifneeded" script. It calls "package provide" to indicate
+# that a package is available, then sets entries in the auto_index array so
+# that the package's files will be auto-loaded when the commands are used.
+#
+# Arguments:
+# dir - Directory containing all the files for this package.
+# pkg - Name of the package (no version number).
+# version - Version number for the package, such as 2.1.3.
+# files - List of files that constitute the package. Each
+# element is a sub-list with three elements. The first
+# is the name of a file relative to $dir, the second is
+# "load" or "source", indicating whether the file is a
+# loadable binary or a script to source, and the third
+# is a list of commands defined by this file.
+
+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 eq "load"} {
+ set auto_index($cmd) [list load [file join $dir $f] $pkg]
+ } else {
+ set auto_index($cmd) [list source [file join $dir $f]]
+ }
+ }
+ }
+}
+
+# tclPkgUnknown --
+# This procedure provides the default for the "package unknown" function. It
+# is invoked when a package that's needed can't be found. It scans the
+# auto_path directories and their immediate children looking for pkgIndex.tcl
+# files and sources any such files that are found to setup the package
+# database. As it searches, it will recognize changes to the auto_path and
+# scan any new directories.
+#
+# Arguments:
+# name - Name of desired package. Not used.
+# version - Version of desired package. Not used.
+# exact - Either "-exact" or omitted. Not used.
+
+proc tclPkgUnknown {name args} {
+ global auto_path env
+
+ if {![info exists auto_path]} {
+ return
+ }
+ # Cache the auto_path, because it may change while we run through the
+ # first set of pkgIndex.tcl files
+ set old_path [set use_path $auto_path]
+ while {[llength $use_path]} {
+ set dir [lindex $use_path end]
+
+ # Make sure we only scan each directory one time.
+ if {[info exists tclSeenPath($dir)]} {
+ set use_path [lrange $use_path 0 end-1]
+ continue
+ }
+ set tclSeenPath($dir) 1
+
+ # we can't use glob in safe interps, so enclose the following in a
+ # catch statement, where we get the pkgIndex files out of the
+ # subdirectories
+ catch {
+ foreach file [glob -directory $dir -join -nocomplain \
+ * pkgIndex.tcl] {
+ set dir [file dirname $file]
+ if {![info exists procdDirs($dir)]} {
+ try {
+ source $file
+ } trap {POSIX EACCES} {} {
+ # $file was not readable; silently ignore
+ continue
+ } on error msg {
+ tclLog "error reading package index file $file: $msg"
+ } on ok {} {
+ set procdDirs($dir) 1
+ }
+ }
+ }
+ }
+ set dir [lindex $use_path end]
+ if {![info exists procdDirs($dir)]} {
+ set file [file join $dir pkgIndex.tcl]
+ # safe interps usually don't have "file exists",
+ if {([interp issafe] || [file exists $file])} {
+ try {
+ source $file
+ } trap {POSIX EACCES} {} {
+ # $file was not readable; silently ignore
+ continue
+ } on error msg {
+ tclLog "error reading package index file $file: $msg"
+ } on ok {} {
+ set procdDirs($dir) 1
+ }
+ }
+ }
+
+ set use_path [lrange $use_path 0 end-1]
+
+ # Check whether any of the index scripts we [source]d above set a new
+ # value for $::auto_path. If so, then find any new directories on the
+ # $::auto_path, and lappend them to the $use_path we are working from.
+ # This gives index scripts the (arguably unwise) power to expand the
+ # index script search path while the search is in progress.
+ set index 0
+ if {[llength $old_path] == [llength $auto_path]} {
+ foreach dir $auto_path old $old_path {
+ if {$dir ne $old} {
+ # This entry in $::auto_path has changed.
+ break
+ }
+ incr index
+ }
+ }
+
+ # $index now points to the first element of $auto_path that has
+ # changed, or the beginning if $auto_path has changed length Scan the
+ # new elements of $auto_path for directories to add to $use_path.
+ # Don't add directories we've already seen, or ones already on the
+ # $use_path.
+ foreach dir [lrange $auto_path $index end] {
+ if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} {
+ lappend use_path $dir
+ }
+ }
+ set old_path $auto_path
+ }
+}
+
+# tcl::MacOSXPkgUnknown --
+# This procedure extends the "package unknown" function for MacOSX. It scans
+# the Resources/Scripts directories of the immediate children of the auto_path
+# directories for pkgIndex files.
+#
+# Arguments:
+# original - original [package unknown] procedure
+# name - Name of desired package. Not used.
+# version - Version of desired package. Not used.
+# exact - Either "-exact" or omitted. Not used.
+
+proc tcl::MacOSXPkgUnknown {original name args} {
+ # First do the cross-platform default search
+ uplevel 1 $original [linsert $args 0 $name]
+
+ # Now do MacOSX specific searching
+ global auto_path
+
+ if {![info exists auto_path]} {
+ return
+ }
+ # Cache the auto_path, because it may change while we run through the
+ # first set of pkgIndex.tcl files
+ set old_path [set use_path $auto_path]
+ while {[llength $use_path]} {
+ set dir [lindex $use_path end]
+
+ # Make sure we only scan each directory one time.
+ if {[info exists tclSeenPath($dir)]} {
+ set use_path [lrange $use_path 0 end-1]
+ continue
+ }
+ set tclSeenPath($dir) 1
+
+ # get the pkgIndex files out of the subdirectories
+ foreach file [glob -directory $dir -join -nocomplain \
+ * Resources Scripts pkgIndex.tcl] {
+ set dir [file dirname $file]
+ if {![info exists procdDirs($dir)]} {
+ try {
+ source $file
+ } trap {POSIX EACCES} {} {
+ # $file was not readable; silently ignore
+ continue
+ } on error msg {
+ tclLog "error reading package index file $file: $msg"
+ } on ok {} {
+ set procdDirs($dir) 1
+ }
+ }
+ }
+ set use_path [lrange $use_path 0 end-1]
+
+ # Check whether any of the index scripts we [source]d above set a new
+ # value for $::auto_path. If so, then find any new directories on the
+ # $::auto_path, and lappend them to the $use_path we are working from.
+ # This gives index scripts the (arguably unwise) power to expand the
+ # index script search path while the search is in progress.
+ set index 0
+ if {[llength $old_path] == [llength $auto_path]} {
+ foreach dir $auto_path old $old_path {
+ if {$dir ne $old} {
+ # This entry in $::auto_path has changed.
+ break
+ }
+ incr index
+ }
+ }
+
+ # $index now points to the first element of $auto_path that has
+ # changed, or the beginning if $auto_path has changed length Scan the
+ # new elements of $auto_path for directories to add to $use_path.
+ # Don't add directories we've already seen, or ones already on the
+ # $use_path.
+ foreach dir [lrange $auto_path $index end] {
+ if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} {
+ lappend use_path $dir
+ }
+ }
+ set old_path $auto_path
+ }
+}
+
+# ::tcl::Pkg::Create --
+#
+# Given a package specification generate a "package ifneeded" statement
+# for the package, suitable for inclusion in a pkgIndex.tcl file.
+#
+# Arguments:
+# args arguments used by the Create function:
+# -name packageName
+# -version packageVersion
+# -load {filename ?{procs}?}
+# ...
+# -source {filename ?{procs}?}
+# ...
+#
+# Any number of -load and -source parameters may be
+# specified, so long as there is at least one -load or
+# -source parameter. If the procs component of a module
+# specifier is left off, that module will be set up for
+# direct loading; otherwise, it will be set up for lazy
+# loading. If both -source and -load are specified, the
+# -load'ed files will be loaded first, followed by the
+# -source'd files.
+#
+# Results:
+# An appropriate "package ifneeded" statement for the package.
+
+proc ::tcl::Pkg::Create {args} {
+ append err(usage) "[lindex [info level 0] 0] "
+ append err(usage) "-name packageName -version packageVersion"
+ append err(usage) "?-load {filename ?{procs}?}? ... "
+ append err(usage) "?-source {filename ?{procs}?}? ..."
+
+ set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""
+ set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""
+ set err(unknownOpt) "unknown option \"%s\": should be \"$err(usage)\""
+ set err(noLoadOrSource) "at least one of -load and -source must be given"
+
+ # process arguments
+ set len [llength $args]
+ if {$len < 6} {
+ error $err(wrongNumArgs)
+ }
+
+ # Initialize parameters
+ array set opts {-name {} -version {} -source {} -load {}}
+
+ # process parameters
+ for {set i 0} {$i < $len} {incr i} {
+ set flag [lindex $args $i]
+ incr i
+ switch -glob -- $flag {
+ "-name" -
+ "-version" {
+ if {$i >= $len} {
+ error [format $err(valueMissing) $flag]
+ }
+ set opts($flag) [lindex $args $i]
+ }
+ "-source" -
+ "-load" {
+ if {$i >= $len} {
+ error [format $err(valueMissing) $flag]
+ }
+ lappend opts($flag) [lindex $args $i]
+ }
+ default {
+ error [format $err(unknownOpt) [lindex $args $i]]
+ }
+ }
+ }
+
+ # Validate the parameters
+ if {![llength $opts(-name)]} {
+ error [format $err(valueMissing) "-name"]
+ }
+ if {![llength $opts(-version)]} {
+ error [format $err(valueMissing) "-version"]
+ }
+
+ if {!([llength $opts(-source)] || [llength $opts(-load)])} {
+ error $err(noLoadOrSource)
+ }
+
+ # OK, now everything is good. Generate the package ifneeded statment.
+ set cmdline "package ifneeded $opts(-name) $opts(-version) "
+
+ set cmdList {}
+ set lazyFileList {}
+
+ # Handle -load and -source specs
+ foreach key {load source} {
+ foreach filespec $opts(-$key) {
+ lassign $filespec filename proclist
+
+ if { [llength $proclist] == 0 } {
+ set cmd "\[list $key \[file join \$dir [list $filename]\]\]"
+ lappend cmdList $cmd
+ } else {
+ lappend lazyFileList [list $filename $key $proclist]
+ }
+ }
+ }
+
+ if {[llength $lazyFileList]} {
+ lappend cmdList "\[list tclPkgSetup \$dir $opts(-name)\
+ $opts(-version) [list $lazyFileList]\]"
+ }
+ append cmdline [join $cmdList "\\n"]
+ return $cmdline
+}
+
+interp alias {} ::pkg::create {} ::tcl::Pkg::Create