Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: data/trunk/Media/tcl8.5/package.tcl @ 5285

Last change on this file since 5285 was 5180, checked in by dafrick, 16 years ago
File size: 22.6 KB
RevLine 
[5180]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 2006/11/03 00:34:52 hobbs 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)] && [file readable $file]} {
489                    if {[catch {source $file} msg]} {
490                        tclLog "error reading package index file $file: $msg"
491                    } else {
492                        set procdDirs($dir) 1
493                    }
494                }
495            }
496        }
497        set dir [lindex $use_path end]
498        if {![info exists procdDirs($dir)]} {
499            set file [file join $dir pkgIndex.tcl]
500            # safe interps usually don't have "file readable",
501            # nor stderr channel
502            if {([interp issafe] || [file readable $file])} {
503                if {[catch {source $file} msg] && ![interp issafe]}  {
504                    tclLog "error reading package index file $file: $msg"
505                } else {
506                    set procdDirs($dir) 1
507                }
508            }
509        }
510
511        set use_path [lrange $use_path 0 end-1]
512
513        # Check whether any of the index scripts we [source]d above
514        # set a new value for $::auto_path.  If so, then find any
515        # new directories on the $::auto_path, and lappend them to
516        # the $use_path we are working from.  This gives index scripts
517        # the (arguably unwise) power to expand the index script search
518        # path while the search is in progress.
519        set index 0
520        if {[llength $old_path] == [llength $auto_path]} {
521            foreach dir $auto_path old $old_path {
522                if {$dir ne $old} {
523                    # This entry in $::auto_path has changed.
524                    break
525                }
526                incr index
527            }
528        }
529
530        # $index now points to the first element of $auto_path that
531        # has changed, or the beginning if $auto_path has changed length
532        # Scan the new elements of $auto_path for directories to add to
533        # $use_path.  Don't add directories we've already seen, or ones
534        # already on the $use_path.
535        foreach dir [lrange $auto_path $index end] {
536            if {![info exists tclSeenPath($dir)] 
537                    && ([lsearch -exact $use_path $dir] == -1) } {
538                lappend use_path $dir
539            }
540        }
541        set old_path $auto_path
542    }
543}
544
545# tcl::MacOSXPkgUnknown --
546# This procedure extends the "package unknown" function for MacOSX.
547# It scans the Resources/Scripts directories of the immediate children
548# of the auto_path directories for pkgIndex files.
549# Only installed in interps that are not safe so we don't check
550# for [interp issafe] as in tclPkgUnknown.
551#
552# Arguments:
553# original -            original [package unknown] procedure
554# name -                Name of desired package.  Not used.
555# version -             Version of desired package.  Not used.
556# exact -               Either "-exact" or omitted.  Not used.
557
558proc tcl::MacOSXPkgUnknown {original name args} {
559
560    #  First do the cross-platform default search
561    uplevel 1 $original [linsert $args 0 $name]
562
563    # Now do MacOSX specific searching
564    global auto_path
565
566    if {![info exists auto_path]} {
567        return
568    }
569    # Cache the auto_path, because it may change while we run through
570    # the first set of pkgIndex.tcl files
571    set old_path [set use_path $auto_path]
572    while {[llength $use_path]} {
573        set dir [lindex $use_path end]
574
575        # Make sure we only scan each directory one time.
576        if {[info exists tclSeenPath($dir)]} {
577            set use_path [lrange $use_path 0 end-1]
578            continue
579        }
580        set tclSeenPath($dir) 1
581
582        # get the pkgIndex files out of the subdirectories
583        foreach file [glob -directory $dir -join -nocomplain \
584                * Resources Scripts pkgIndex.tcl] {
585            set dir [file dirname $file]
586            if {![info exists procdDirs($dir)] && [file readable $file]} {
587                if {[catch {source $file} msg]} {
588                    tclLog "error reading package index file $file: $msg"
589                } else {
590                    set procdDirs($dir) 1
591                }
592            }
593        }
594        set use_path [lrange $use_path 0 end-1]
595
596        # Check whether any of the index scripts we [source]d above
597        # set a new value for $::auto_path.  If so, then find any
598        # new directories on the $::auto_path, and lappend them to
599        # the $use_path we are working from.  This gives index scripts
600        # the (arguably unwise) power to expand the index script search
601        # path while the search is in progress.
602        set index 0
603        if {[llength $old_path] == [llength $auto_path]} {
604            foreach dir $auto_path old $old_path {
605                if {$dir ne $old} {
606                    # This entry in $::auto_path has changed.
607                    break
608                }
609                incr index
610            }
611        }
612
613        # $index now points to the first element of $auto_path that
614        # has changed, or the beginning if $auto_path has changed length
615        # Scan the new elements of $auto_path for directories to add to
616        # $use_path.  Don't add directories we've already seen, or ones
617        # already on the $use_path.
618        foreach dir [lrange $auto_path $index end] {
619            if {![info exists tclSeenPath($dir)] 
620                    && ([lsearch -exact $use_path $dir] == -1) } {
621                lappend use_path $dir
622            }
623        }
624        set old_path $auto_path
625    }
626}
627
628# ::tcl::Pkg::Create --
629#
630#       Given a package specification generate a "package ifneeded" statement
631#       for the package, suitable for inclusion in a pkgIndex.tcl file.
632#
633# Arguments:
634#       args            arguments used by the Create function:
635#                       -name           packageName
636#                       -version        packageVersion
637#                       -load           {filename ?{procs}?}
638#                       ...
639#                       -source         {filename ?{procs}?}
640#                       ...
641#
642#                       Any number of -load and -source parameters may be
643#                       specified, so long as there is at least one -load or
644#                       -source parameter.  If the procs component of a
645#                       module specifier is left off, that module will be
646#                       set up for direct loading; otherwise, it will be
647#                       set up for lazy loading.  If both -source and -load
648#                       are specified, the -load'ed files will be loaded
649#                       first, followed by the -source'd files.
650#
651# Results:
652#       An appropriate "package ifneeded" statement for the package.
653
654proc ::tcl::Pkg::Create {args} {
655    append err(usage) "[lindex [info level 0] 0] "
656    append err(usage) "-name packageName -version packageVersion"
657    append err(usage) "?-load {filename ?{procs}?}? ... "
658    append err(usage) "?-source {filename ?{procs}?}? ..."
659
660    set err(wrongNumArgs) "wrong # args: should be \"$err(usage)\""
661    set err(valueMissing) "value for \"%s\" missing: should be \"$err(usage)\""
662    set err(unknownOpt)   "unknown option \"%s\": should be \"$err(usage)\""
663    set err(noLoadOrSource) "at least one of -load and -source must be given"
664
665    # process arguments
666    set len [llength $args]
667    if { $len < 6 } {
668        error $err(wrongNumArgs)
669    }
670   
671    # Initialize parameters
672    set opts(-name)             {}
673    set opts(-version)          {}
674    set opts(-source)           {}
675    set opts(-load)             {}
676
677    # process parameters
678    for {set i 0} {$i < $len} {incr i} {
679        set flag [lindex $args $i]
680        incr i
681        switch -glob -- $flag {
682            "-name"             -
683            "-version"          {
684                if { $i >= $len } {
685                    error [format $err(valueMissing) $flag]
686                }
687                set opts($flag) [lindex $args $i]
688            }
689            "-source"           -
690            "-load"             {
691                if { $i >= $len } {
692                    error [format $err(valueMissing) $flag]
693                }
694                lappend opts($flag) [lindex $args $i]
695            }
696            default {
697                error [format $err(unknownOpt) [lindex $args $i]]
698            }
699        }
700    }
701
702    # Validate the parameters
703    if { [llength $opts(-name)] == 0 } {
704        error [format $err(valueMissing) "-name"]
705    }
706    if { [llength $opts(-version)] == 0 } {
707        error [format $err(valueMissing) "-version"]
708    }
709   
710    if { [llength $opts(-source)] == 0 && [llength $opts(-load)] == 0 } {
711        error $err(noLoadOrSource)
712    }
713
714    # OK, now everything is good.  Generate the package ifneeded statment.
715    set cmdline "package ifneeded $opts(-name) $opts(-version) "
716   
717    set cmdList {}
718    set lazyFileList {}
719
720    # Handle -load and -source specs
721    foreach key {load source} {
722        foreach filespec $opts(-$key) {
723            foreach {filename proclist} {{} {}} {
724                break
725            }
726            foreach {filename proclist} $filespec {
727                break
728            }
729           
730            if { [llength $proclist] == 0 } {
731                set cmd "\[list $key \[file join \$dir [list $filename]\]\]"
732                lappend cmdList $cmd
733            } else {
734                lappend lazyFileList [list $filename $key $proclist]
735            }
736        }
737    }
738
739    if { [llength $lazyFileList] > 0 } {
740        lappend cmdList "\[list tclPkgSetup \$dir $opts(-name)\
741                $opts(-version) [list $lazyFileList]\]"
742    }
743    append cmdline [join $cmdList "\\n"]
744    return $cmdline
745}
746
747interp alias {} ::pkg::create {} ::tcl::Pkg::Create
Note: See TracBrowser for help on using the repository browser.