1# package.tcl -- 2# 3# utility procs formerly in init.tcl which can be loaded on demand 4# for package management. 5# 6# RCS: @(#) $Id: package.tcl,v 1.35.4.1 2008/07/03 17:22:59 dgp Exp $ 7# 8# Copyright (c) 1991-1993 The Regents of the University of California. 9# Copyright (c) 1994-1998 Sun Microsystems, Inc. 10# 11# See the file "license.terms" for information on usage and redistribution 12# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 13# 14 15namespace eval tcl::Pkg {} 16 17# ::tcl::Pkg::CompareExtension -- 18# 19# Used internally by pkg_mkIndex to compare the extension of a file to 20# a given extension. On Windows, it uses a case-insensitive comparison 21# because the file system can be file insensitive. 22# 23# Arguments: 24# fileName name of a file whose extension is compared 25# ext (optional) The extension to compare against; you must 26# provide the starting dot. 27# Defaults to [info sharedlibextension] 28# 29# Results: 30# Returns 1 if the extension matches, 0 otherwise 31 32proc tcl::Pkg::CompareExtension { fileName {ext {}} } { 33 global tcl_platform 34 if {$ext eq ""} {set ext [info sharedlibextension]} 35 if {$tcl_platform(platform) eq "windows"} { 36 return [string equal -nocase [file extension $fileName] $ext] 37 } else { 38 # Some unices add trailing numbers after the .so, so 39 # we could have something like '.so.1.2'. 40 set root $fileName 41 while {1} { 42 set currExt [file extension $root] 43 if {$currExt eq $ext} { 44 return 1 45 } 46 47 # The current extension does not match; if it is not a numeric 48 # value, quit, as we are only looking to ignore version number 49 # extensions. Otherwise we might return 1 in this case: 50 # tcl::Pkg::CompareExtension foo.so.bar .so 51 # which should not match. 52 53 if { ![string is integer -strict [string range $currExt 1 end]] } { 54 return 0 55 } 56 set root [file rootname $root] 57 } 58 } 59} 60 61# pkg_mkIndex -- 62# This procedure creates a package index in a given directory. The 63# package index consists of a "pkgIndex.tcl" file whose contents are 64# a Tcl script that sets up package information with "package require" 65# commands. The commands describe all of the packages defined by the 66# files given as arguments. 67# 68# Arguments: 69# -direct (optional) If this flag is present, the generated 70# code in pkgMkIndex.tcl will cause the package to be 71# loaded when "package require" is executed, rather 72# than lazily when the first reference to an exported 73# procedure in the package is made. 74# -verbose (optional) Verbose output; the name of each file that 75# was successfully rocessed is printed out. Additionally, 76# if processing of a file failed a message is printed. 77# -load pat (optional) Preload any packages whose names match 78# the pattern. Used to handle DLLs that depend on 79# other packages during their Init procedure. 80# dir - Name of the directory in which to create the index. 81# args - Any number of additional arguments, each giving 82# a glob pattern that matches the names of one or 83# more shared libraries or Tcl script files in 84# dir. 85 86proc pkg_mkIndex {args} { 87 set usage {"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?"}; 88 89 set argCount [llength $args] 90 if {$argCount < 1} { 91 return -code error "wrong # args: should be\n$usage" 92 } 93 94 set more "" 95 set direct 1 96 set doVerbose 0 97 set loadPat "" 98 for {set idx 0} {$idx < $argCount} {incr idx} { 99 set flag [lindex $args $idx] 100 switch -glob -- $flag { 101 -- { 102 # done with the flags 103 incr idx 104 break 105 } 106 -verbose { 107 set doVerbose 1 108 } 109 -lazy { 110 set direct 0 111 append more " -lazy" 112 } 113 -direct { 114 append more " -direct" 115 } 116 -load { 117 incr idx 118 set loadPat [lindex $args $idx] 119 append more " -load $loadPat" 120 } 121 -* { 122 return -code error "unknown flag $flag: should be\n$usage" 123 } 124 default { 125 # done with the flags 126 break 127 } 128 } 129 } 130 131 set dir [lindex $args $idx] 132 set patternList [lrange $args [expr {$idx + 1}] end] 133 if {[llength $patternList] == 0} { 134 set patternList [list "*.tcl" "*[info sharedlibextension]"] 135 } 136 137 if {[catch { 138 glob -directory $dir -tails -types {r f} -- {*}$patternList 139 } fileList o]} { 140 return -options $o $fileList 141 } 142 foreach file $fileList { 143 # For each file, figure out what commands and packages it provides. 144 # To do this, create a child interpreter, load the file into the 145 # interpreter, and get a list of the new commands and packages 146 # that are defined. 147 148 if {$file eq "pkgIndex.tcl"} { 149 continue 150 } 151 152 set c [interp create] 153 154 # Load into the child any packages currently loaded in the parent 155 # interpreter that match the -load pattern. 156 157 if {$loadPat ne ""} { 158 if {$doVerbose} { 159 tclLog "currently loaded packages: '[info loaded]'" 160 tclLog "trying to load all packages matching $loadPat" 161 } 162 if {![llength [info loaded]]} { 163 tclLog "warning: no packages are currently loaded, nothing" 164 tclLog "can possibly match '$loadPat'" 165 } 166 } 167 foreach pkg [info loaded] { 168 if {! [string match -nocase $loadPat [lindex $pkg 1]]} { 169 continue 170 } 171 if {$doVerbose} { 172 tclLog "package [lindex $pkg 1] matches '$loadPat'" 173 } 174 if {[catch { 175 load [lindex $pkg 0] [lindex $pkg 1] $c 176 } err]} { 177 if {$doVerbose} { 178 tclLog "warning: load [lindex $pkg 0] [lindex $pkg 1]\nfailed with: $err" 179 } 180 } elseif {$doVerbose} { 181 tclLog "loaded [lindex $pkg 0] [lindex $pkg 1]" 182 } 183 if {[lindex $pkg 1] eq "Tk"} { 184 # Withdraw . if Tk was loaded, to avoid showing a window. 185 $c eval [list wm withdraw .] 186 } 187 } 188 189 $c eval { 190 # Stub out the package command so packages can 191 # require other packages. 192 193 rename package __package_orig 194 proc package {what args} { 195 switch -- $what { 196 require { return ; # ignore transitive requires } 197 default { __package_orig $what {*}$args } 198 } 199 } 200 proc tclPkgUnknown args {} 201 package unknown tclPkgUnknown 202 203 # Stub out the unknown command so package can call 204 # into each other during their initialilzation. 205 206 proc unknown {args} {} 207 208 # Stub out the auto_import mechanism 209 210 proc auto_import {args} {} 211 212 # reserve the ::tcl namespace for support procs 213 # and temporary variables. This might make it awkward 214 # to generate a pkgIndex.tcl file for the ::tcl namespace. 215 216 namespace eval ::tcl { 217 variable dir ;# Current directory being processed 218 variable file ;# Current file being processed 219 variable direct ;# -direct flag value 220 variable x ;# Loop variable 221 variable debug ;# For debugging 222 variable type ;# "load" or "source", for -direct 223 variable namespaces ;# Existing namespaces (e.g., ::tcl) 224 variable packages ;# Existing packages (e.g., Tcl) 225 variable origCmds ;# Existing commands 226 variable newCmds ;# Newly created commands 227 variable newPkgs {} ;# Newly created packages 228 } 229 } 230 231 $c eval [list set ::tcl::dir $dir] 232 $c eval [list set ::tcl::file $file] 233 $c eval [list set ::tcl::direct $direct] 234 235 # Download needed procedures into the slave because we've 236 # just deleted the unknown procedure. This doesn't handle 237 # procedures with default arguments. 238 239 foreach p {::tcl::Pkg::CompareExtension} { 240 $c eval [list namespace eval [namespace qualifiers $p] {}] 241 $c eval [list proc $p [info args $p] [info body $p]] 242 } 243 244 if {[catch { 245 $c eval { 246 set ::tcl::debug "loading or sourcing" 247 248 # we need to track command defined by each package even in 249 # the -direct case, because they are needed internally by 250 # the "partial pkgIndex.tcl" step above. 251 252 proc ::tcl::GetAllNamespaces {{root ::}} { 253 set list $root 254 foreach ns [namespace children $root] { 255 lappend list {*}[::tcl::GetAllNamespaces $ns] 256 } 257 return $list 258 } 259 260 # init the list of existing namespaces, packages, commands 261 262 foreach ::tcl::x [::tcl::GetAllNamespaces] { 263 set ::tcl::namespaces($::tcl::x) 1 264 } 265 foreach ::tcl::x [package names] { 266 if {[package provide $::tcl::x] ne ""} { 267 set ::tcl::packages($::tcl::x) 1 268 } 269 } 270 set ::tcl::origCmds [info commands] 271 272 # Try to load the file if it has the shared library 273 # extension, otherwise source it. It's important not to 274 # try to load files that aren't shared libraries, because 275 # on some systems (like SunOS) the loader will abort the 276 # whole application when it gets an error. 277 278 if {[::tcl::Pkg::CompareExtension $::tcl::file [info sharedlibextension]]} { 279 # The "file join ." command below is necessary. 280 # Without it, if the file name has no \'s and we're 281 # on UNIX, the load command will invoke the 282 # LD_LIBRARY_PATH search mechanism, which could cause 283 # the wrong file to be used. 284 285 set ::tcl::debug loading 286 load [file join $::tcl::dir $::tcl::file] 287 set ::tcl::type load 288 } else { 289 set ::tcl::debug sourcing 290 source [file join $::tcl::dir $::tcl::file] 291 set ::tcl::type source 292 } 293 294 # As a performance optimization, if we are creating 295 # direct load packages, don't bother figuring out the 296 # set of commands created by the new packages. We 297 # only need that list for setting up the autoloading 298 # used in the non-direct case. 299 if { !$::tcl::direct } { 300 # See what new namespaces appeared, and import commands 301 # from them. Only exported commands go into the index. 302 303 foreach ::tcl::x [::tcl::GetAllNamespaces] { 304 if {! [info exists ::tcl::namespaces($::tcl::x)]} { 305 namespace import -force ${::tcl::x}::* 306 } 307 308 # Figure out what commands appeared 309 310 foreach ::tcl::x [info commands] { 311 set ::tcl::newCmds($::tcl::x) 1 312 } 313 foreach ::tcl::x $::tcl::origCmds { 314 unset -nocomplain ::tcl::newCmds($::tcl::x) 315 } 316 foreach ::tcl::x [array names ::tcl::newCmds] { 317 # determine which namespace a command comes from 318 319 set ::tcl::abs [namespace origin $::tcl::x] 320 321 # special case so that global names have no leading 322 # ::, this is required by the unknown command 323 324 set ::tcl::abs \ 325 [lindex [auto_qualify $::tcl::abs ::] 0] 326 327 if {$::tcl::x ne $::tcl::abs} { 328 # Name changed during qualification 329 330 set ::tcl::newCmds($::tcl::abs) 1 331 unset ::tcl::newCmds($::tcl::x) 332 } 333 } 334 } 335 } 336 337 # Look through the packages that appeared, and if there is 338 # a version provided, then record it 339 340 foreach ::tcl::x [package names] { 341 if {[package provide $::tcl::x] ne "" 342 && ![info exists ::tcl::packages($::tcl::x)]} { 343 lappend ::tcl::newPkgs \ 344 [list $::tcl::x [package provide $::tcl::x]] 345 } 346 } 347 } 348 } msg] == 1} { 349 set what [$c eval set ::tcl::debug] 350 if {$doVerbose} { 351 tclLog "warning: error while $what $file: $msg" 352 } 353 } else { 354 set what [$c eval set ::tcl::debug] 355 if {$doVerbose} { 356 tclLog "successful $what of $file" 357 } 358 set type [$c eval set ::tcl::type] 359 set cmds [lsort [$c eval array names ::tcl::newCmds]] 360 set pkgs [$c eval set ::tcl::newPkgs] 361 if {$doVerbose} { 362 if { !$direct } { 363 tclLog "commands provided were $cmds" 364 } 365 tclLog "packages provided were $pkgs" 366 } 367 if {[llength $pkgs] > 1} { 368 tclLog "warning: \"$file\" provides more than one package ($pkgs)" 369 } 370 foreach pkg $pkgs { 371 # cmds is empty/not used in the direct case 372 lappend files($pkg) [list $file $type $cmds] 373 } 374 375 if {$doVerbose} { 376 tclLog "processed $file" 377 } 378 } 379 interp delete $c 380 } 381 382 append index "# Tcl package index file, version 1.1\n" 383 append index "# This file is generated by the \"pkg_mkIndex$more\" command\n" 384 append index "# and sourced either when an application starts up or\n" 385 append index "# by a \"package unknown\" script. It invokes the\n" 386 append index "# \"package ifneeded\" command to set up package-related\n" 387 append index "# information so that packages will be loaded automatically\n" 388 append index "# in response to \"package require\" commands. When this\n" 389 append index "# script is sourced, the variable \$dir must contain the\n" 390 append index "# full path name of this file's directory.\n" 391 392 foreach pkg [lsort [array names files]] { 393 set cmd {} 394 foreach {name version} $pkg { 395 break 396 } 397 lappend cmd ::tcl::Pkg::Create -name $name -version $version 398 foreach spec $files($pkg) { 399 foreach {file type procs} $spec { 400 if { $direct } { 401 set procs {} 402 } 403 lappend cmd "-$type" [list $file $procs] 404 } 405 } 406 append index "\n[eval $cmd]" 407 } 408 409 set f [open [file join $dir pkgIndex.tcl] w] 410 puts $f $index 411 close $f 412} 413 414# tclPkgSetup -- 415# This is a utility procedure use by pkgIndex.tcl files. It is invoked 416# as part of a "package ifneeded" script. It calls "package provide" 417# to indicate that a package is available, then sets entries in the 418# auto_index array so that the package's files will be auto-loaded when 419# the commands are used. 420# 421# Arguments: 422# dir - Directory containing all the files for this package. 423# pkg - Name of the package (no version number). 424# version - Version number for the package, such as 2.1.3. 425# files - List of files that constitute the package. Each 426# element is a sub-list with three elements. The first 427# is the name of a file relative to $dir, the second is 428# "load" or "source", indicating whether the file is a 429# loadable binary or a script to source, and the third 430# is a list of commands defined by this file. 431 432proc tclPkgSetup {dir pkg version files} { 433 global auto_index 434 435 package provide $pkg $version 436 foreach fileInfo $files { 437 set f [lindex $fileInfo 0] 438 set type [lindex $fileInfo 1] 439 foreach cmd [lindex $fileInfo 2] { 440 if {$type eq "load"} { 441 set auto_index($cmd) [list load [file join $dir $f] $pkg] 442 } else { 443 set auto_index($cmd) [list source [file join $dir $f]] 444 } 445 } 446 } 447} 448 449# tclPkgUnknown -- 450# This procedure provides the default for the "package unknown" function. 451# It is invoked when a package that's needed can't be found. It scans 452# the auto_path directories and their immediate children looking for 453# pkgIndex.tcl files and sources any such files that are found to setup 454# the package database. As it searches, it will recognize changes 455# to the auto_path and scan any new directories. 456# 457# Arguments: 458# name - Name of desired package. Not used. 459# version - Version of desired package. Not used. 460# exact - Either "-exact" or omitted. Not used. 461 462proc tclPkgUnknown {name args} { 463 global auto_path env 464 465 if {![info exists auto_path]} { 466 return 467 } 468 # Cache the auto_path, because it may change while we run through 469 # the first set of pkgIndex.tcl files 470 set old_path [set use_path $auto_path] 471 while {[llength $use_path]} { 472 set dir [lindex $use_path end] 473 474 # Make sure we only scan each directory one time. 475 if {[info exists tclSeenPath($dir)]} { 476 set use_path [lrange $use_path 0 end-1] 477 continue 478 } 479 set tclSeenPath($dir) 1 480 481 # we can't use glob in safe interps, so enclose the following 482 # in a catch statement, where we get the pkgIndex files out 483 # of the subdirectories 484 catch { 485 foreach file [glob -directory $dir -join -nocomplain \ 486 * pkgIndex.tcl] { 487 set dir [file dirname $file] 488 if {![info exists procdDirs($dir)]} { 489 set code [catch {source $file} msg opt] 490 if {$code == 1 && 491 [lindex [dict get $opt -errorcode] 0] eq "POSIX" && 492 [lindex [dict get $opt -errorcode] 1] eq "EACCES"} { 493 # $file was not readable; silently ignore 494 continue 495 } 496 if {$code} { 497 tclLog "error reading package index file $file: $msg" 498 } else { 499 set procdDirs($dir) 1 500 } 501 } 502 } 503 } 504 set dir [lindex $use_path end] 505 if {![info exists procdDirs($dir)]} { 506 set file [file join $dir pkgIndex.tcl] 507 # safe interps usually don't have "file exists", 508 if {([interp issafe] || [file exists $file])} { 509 set code [catch {source $file} msg opt] 510 if {$code == 1 && 511 [lindex [dict get $opt -errorcode] 0] eq "POSIX" && 512 [lindex [dict get $opt -errorcode] 1] eq "EACCES"} { 513 # $file was not readable; silently ignore 514 continue 515 } 516 if {$code} { 517 tclLog "error reading package index file $file: $msg" 518 } else { 519 set procdDirs($dir) 1 520 } 521 } 522 } 523 524 set use_path [lrange $use_path 0 end-1] 525 526 # Check whether any of the index scripts we [source]d above 527 # set a new value for $::auto_path. If so, then find any 528 # new directories on the $::auto_path, and lappend them to 529 # the $use_path we are working from. This gives index scripts 530 # the (arguably unwise) power to expand the index script search 531 # path while the search is in progress. 532 set index 0 533 if {[llength $old_path] == [llength $auto_path]} { 534 foreach dir $auto_path old $old_path { 535 if {$dir ne $old} { 536 # This entry in $::auto_path has changed. 537 break 538 } 539 incr index 540 } 541 } 542 543 # $index now points to the first element of $auto_path that 544 # has changed, or the beginning if $auto_path has changed length 545 # Scan the new elements of $auto_path for directories to add to 546 # $use_path. Don't add directories we've already seen, or ones 547 # already on the $use_path. 548 foreach dir [lrange $auto_path $index end] { 549 if {![info exists tclSeenPath($dir)] 550 && ([lsearch -exact $use_path $dir] == -1) } { 551 lappend use_path $dir 552 } 553 } 554 set old_path $auto_path 555 } 556} 557 558# tcl::MacOSXPkgUnknown -- 559# This procedure extends the "package unknown" function for MacOSX. 560# It scans the Resources/Scripts directories of the immediate children 561# of the auto_path directories for pkgIndex files. 562# 563# Arguments: 564# original - original [package unknown] procedure 565# name - Name of desired package. Not used. 566# version - Version of desired package. Not used. 567# exact - Either "-exact" or omitted. Not used. 568 569proc tcl::MacOSXPkgUnknown {original name args} { 570 571 # First do the cross-platform default search 572 uplevel 1 $original [linsert $args 0 $name] 573 574 # Now do MacOSX specific searching 575 global auto_path 576 577 if {![info exists auto_path]} { 578 return 579 } 580 # Cache the auto_path, because it may change while we run through 581 # the first set of pkgIndex.tcl files 582 set old_path [set use_path $auto_path] 583 while {[llength $use_path]} { 584 set dir [lindex $use_path end] 585 586 # Make sure we only scan each directory one time. 587 if {[info exists tclSeenPath($dir)]} { 588 set use_path [lrange $use_path 0 end-1] 589 continue 590 } 591 set tclSeenPath($dir) 1 592 593 # get the pkgIndex files out of the subdirectories 594 foreach file [glob -directory $dir -join -nocomplain \ 595 * Resources Scripts pkgIndex.tcl] { 596 set dir [file dirname $file] 597 if {![info exists procdDirs($dir)]} { 598 set code [catch {source $file} msg opt] 599 if {$code == 1 && 600 [lindex [dict get $opt -errorcode] 0] eq "POSIX" && 601 [lindex [dict get $opt -errorcode] 1] eq "EACCES"} { 602 # $file was not readable; silently ignore 603 continue 604 } 605 if {$code} { 606 tclLog "error reading package index file $file: $msg" 607 } else { 608 set procdDirs($dir) 1 609 } 610 } 611 } 612 set use_path [lrange $use_path 0 end-1] 613 614 # Check whether any of the index scripts we [source]d above 615 # set a new value for $::auto_path. If so, then find any 616 # new directories on the $::auto_path, and lappend them to 617 # the $use_path we are working from. This gives index scripts 618 # the (arguably unwise) power to expand the index script search 619 # path while the search is in progress. 620 set index 0 621 if {[llength $old_path] == [llength $auto_path]} { 622 foreach dir $auto_path old $old_path { 623 if {$dir ne $old} { 624 # This entry in $::auto_path has changed. 625 break 626 } 627 incr index 628 } 629 } 630 631 # $index now points to the first element of $auto_path that 632 # has changed, or the beginning if $auto_path has changed length 633 # Scan the new elements of $auto_path for directories to add to 634 # $use_path. Don't add directories we've already seen, or ones 635 # already on the $use_path. 636 foreach dir [lrange $auto_path $index end] { 637 if {![info exists tclSeenPath($dir)] 638 && ([lsearch -exact $use_path $dir] == -1) } { 639 lappend use_path $dir 640 } 641 } 642 set old_path $auto_path 643 } 644} 645 646# ::tcl::Pkg::Create -- 647# 648# Given a package specification generate a "package ifneeded" statement 649# for the package, suitable for inclusion in a pkgIndex.tcl file. 650# 651# Arguments: 652# args arguments used by the Create function: 653# -name packageName 654# -version packageVersion 655# -load {filename ?{procs}?} 656# ... 657# -source {filename ?{procs}?} 658# ... 659# 660# Any number of -load and -source parameters may be 661# specified, so long as there is at least one -load or 662# -source parameter. If the procs component of a 663# module specifier is left off, that module will be 664# set up for direct loading; otherwise, it will be 665# set up for lazy loading. If both -source and -load 666# are specified, the -load'ed files will be loaded 667# first, followed by the -source'd files. 668# 669# Results: 670# An appropriate "package ifneeded" statement for the package. 671 672proc ::tcl::Pkg::Create {args} { 673 append err(usage) "[lindex [info level 0] 0] " 674 append err(usage) "-name packageName -version packageVersion" 675 append err(usage) "?-load {filename ?{procs}?}? ... " 676 append err(usage) "?-source {filename ?{procs}?}? ..." 677 678 set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\"" 679 set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\"" 680 set err(unknownOpt) "unknown option \"%s\": should be \"$err(usage)\"" 681 set err(noLoadOrSource) "at least one of -load and -source must be given" 682 683 # process arguments 684 set len [llength $args] 685 if { $len < 6 } { 686 error $err(wrongNumArgs) 687 } 688 689 # Initialize parameters 690 set opts(-name) {} 691 set opts(-version) {} 692 set opts(-source) {} 693 set opts(-load) {} 694 695 # process parameters 696 for {set i 0} {$i < $len} {incr i} { 697 set flag [lindex $args $i] 698 incr i 699 switch -glob -- $flag { 700 "-name" - 701 "-version" { 702 if { $i >= $len } { 703 error [format $err(valueMissing) $flag] 704 } 705 set opts($flag) [lindex $args $i] 706 } 707 "-source" - 708 "-load" { 709 if { $i >= $len } { 710 error [format $err(valueMissing) $flag] 711 } 712 lappend opts($flag) [lindex $args $i] 713 } 714 default { 715 error [format $err(unknownOpt) [lindex $args $i]] 716 } 717 } 718 } 719 720 # Validate the parameters 721 if { [llength $opts(-name)] == 0 } { 722 error [format $err(valueMissing) "-name"] 723 } 724 if { [llength $opts(-version)] == 0 } { 725 error [format $err(valueMissing) "-version"] 726 } 727 728 if { [llength $opts(-source)] == 0 && [llength $opts(-load)] == 0 } { 729 error $err(noLoadOrSource) 730 } 731 732 # OK, now everything is good. Generate the package ifneeded statment. 733 set cmdline "package ifneeded $opts(-name) $opts(-version) " 734 735 set cmdList {} 736 set lazyFileList {} 737 738 # Handle -load and -source specs 739 foreach key {load source} { 740 foreach filespec $opts(-$key) { 741 foreach {filename proclist} {{} {}} { 742 break 743 } 744 foreach {filename proclist} $filespec { 745 break 746 } 747 748 if { [llength $proclist] == 0 } { 749 set cmd "\[list $key \[file join \$dir [list $filename]\]\]" 750 lappend cmdList $cmd 751 } else { 752 lappend lazyFileList [list $filename $key $proclist] 753 } 754 } 755 } 756 757 if { [llength $lazyFileList] > 0 } { 758 lappend cmdList "\[list tclPkgSetup \$dir $opts(-name)\ 759 $opts(-version) [list $lazyFileList]\]" 760 } 761 append cmdline [join $cmdList "\\n"] 762 return $cmdline 763} 764 765interp alias {} ::pkg::create {} ::tcl::Pkg::Create 766