diff options
Diffstat (limited to 'library/package.tcl')
| -rw-r--r-- | library/package.tcl | 88 |
1 files changed, 37 insertions, 51 deletions
diff --git a/library/package.tcl b/library/package.tcl index d8729b2..52daa0e 100644 --- a/library/package.tcl +++ b/library/package.tcl @@ -3,8 +3,6 @@ # utility procs formerly in init.tcl which can be loaded on demand # for package management. # -# RCS: @(#) $Id: package.tcl,v 1.37 2009/07/26 11:40:23 dkf Exp $ -# # Copyright (c) 1991-1993 The Regents of the University of California. # Copyright (c) 1994-1998 Sun Microsystems, Inc. # @@ -29,7 +27,7 @@ namespace eval tcl::Pkg {} # Results: # Returns 1 if the extension matches, 0 otherwise -proc tcl::Pkg::CompareExtension { fileName {ext {}} } { +proc tcl::Pkg::CompareExtension {fileName {ext {}}} { global tcl_platform if {$ext eq ""} {set ext [info sharedlibextension]} if {$tcl_platform(platform) eq "windows"} { @@ -42,7 +40,7 @@ proc tcl::Pkg::CompareExtension { fileName {ext {}} } { 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 @@ -50,7 +48,7 @@ proc tcl::Pkg::CompareExtension { fileName {ext {}} } { # tcl::Pkg::CompareExtension foo.so.bar .so # which should not match. - if { ![string is integer -strict [string range $currExt 1 end]] } { + if {![string is integer -strict [string range $currExt 1 end]]} { return 0 } set root [file rootname $root] @@ -83,7 +81,7 @@ proc tcl::Pkg::CompareExtension { fileName {ext {}} } { # dir. proc pkg_mkIndex {args} { - set usage {"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?"}; + set usage {"pkg_mkIndex ?-direct? ?-lazy? ?-load pattern? ?-verbose? ?--? dir ?pattern ...?"} set argCount [llength $args] if {$argCount < 1} { @@ -129,7 +127,7 @@ proc pkg_mkIndex {args} { set dir [lindex $args $idx] set patternList [lrange $args [expr {$idx + 1}] end] - if {[llength $patternList] == 0} { + if {![llength $patternList]} { set patternList [list "*.tcl" "*[info sharedlibextension]"] } @@ -165,7 +163,7 @@ proc pkg_mkIndex {args} { } } foreach pkg [info loaded] { - if {! [string match -nocase $loadPat [lindex $pkg 1]]} { + if {![string match -nocase $loadPat [lindex $pkg 1]]} { continue } if {$doVerbose} { @@ -301,17 +299,17 @@ proc pkg_mkIndex {args} { # 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 } { + 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)]} { + 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 } @@ -320,19 +318,19 @@ proc pkg_mkIndex {args} { } 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) } @@ -365,7 +363,7 @@ proc pkg_mkIndex {args} { set cmds [lsort [$c eval array names ::tcl::newCmds]] set pkgs [$c eval set ::tcl::newPkgs] if {$doVerbose} { - if { !$direct } { + if {!$direct} { tclLog "commands provided were $cmds" } tclLog "packages provided were $pkgs" @@ -397,13 +395,11 @@ proc pkg_mkIndex {args} { foreach pkg [lsort [array names files]] { set cmd {} - foreach {name version} $pkg { - break - } + lassign $pkg name version lappend cmd ::tcl::Pkg::Create -name $name -version $version - foreach spec $files($pkg) { + foreach spec [lsort -index 0 $files($pkg)] { foreach {file type procs} $spec { - if { $direct } { + if {$direct} { set procs {} } lappend cmd "-$type" [list $file $procs] @@ -446,7 +442,7 @@ proc tclPkgSetup {dir pkg version files} { set auto_index($cmd) [list load [file join $dir $f] $pkg] } else { set auto_index($cmd) [list source [file join $dir $f]] - } + } } } } @@ -475,7 +471,7 @@ proc tclPkgUnknown {name args} { 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] @@ -507,7 +503,7 @@ proc tclPkgUnknown {name args} { 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", + # safe interps usually don't have "file exists", if {([interp issafe] || [file exists $file])} { try { source $file @@ -546,8 +542,7 @@ proc tclPkgUnknown {name args} { # 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)] - && ([lsearch -exact $use_path $dir] == -1) } { + if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} { lappend use_path $dir } } @@ -630,8 +625,7 @@ proc tcl::MacOSXPkgUnknown {original name args} { # 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)] - && ([lsearch -exact $use_path $dir] == -1) } { + if {![info exists tclSeenPath($dir)] && ($dir ni $use_path)} { lappend use_path $dir } } @@ -678,15 +672,12 @@ proc ::tcl::Pkg::Create {args} { # process arguments set len [llength $args] - if { $len < 6 } { + if {$len < 6} { error $err(wrongNumArgs) } - + # Initialize parameters - set opts(-name) {} - set opts(-version) {} - set opts(-source) {} - set opts(-load) {} + array set opts {-name {} -version {} -source {} -load {}} # process parameters for {set i 0} {$i < $len} {incr i} { @@ -695,14 +686,14 @@ proc ::tcl::Pkg::Create {args} { switch -glob -- $flag { "-name" - "-version" { - if { $i >= $len } { + if {$i >= $len} { error [format $err(valueMissing) $flag] } set opts($flag) [lindex $args $i] } "-source" - "-load" { - if { $i >= $len } { + if {$i >= $len} { error [format $err(valueMissing) $flag] } lappend opts($flag) [lindex $args $i] @@ -714,32 +705,27 @@ proc ::tcl::Pkg::Create {args} { } # Validate the parameters - if { [llength $opts(-name)] == 0 } { + if {![llength $opts(-name)]} { error [format $err(valueMissing) "-name"] } - if { [llength $opts(-version)] == 0 } { + if {![llength $opts(-version)]} { error [format $err(valueMissing) "-version"] } - - if { [llength $opts(-source)] == 0 && [llength $opts(-load)] == 0 } { + + 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) { - foreach {filename proclist} {{} {}} { - break - } - foreach {filename proclist} $filespec { - break - } + lassign $filespec filename proclist if { [llength $proclist] == 0 } { set cmd "\[list $key \[file join \$dir [list $filename]\]\]" @@ -750,7 +736,7 @@ proc ::tcl::Pkg::Create {args} { } } - if { [llength $lazyFileList] > 0 } { + if {[llength $lazyFileList]} { lappend cmdList "\[list tclPkgSetup \$dir $opts(-name)\ $opts(-version) [list $lazyFileList]\]" } @@ -758,4 +744,4 @@ proc ::tcl::Pkg::Create {args} { return $cmdline } -interp alias {} ::pkg::create {} ::tcl::Pkg::Create +interp alias {} ::pkg::create {} ::tcl::Pkg::Create |