Mercurial > repos > rliterman > csp2

comparison CSP2/CSP2_env/env-d9b9114564458d9d-741b3de822f2aaca6c6caa4325c4afce/lib/tcl8.6/package.tcl @ 68:5028fdace37b

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