Posted to tcl by patthoyts at Thu Mar 12 10:54:37 GMT 2009view pretty
Index: setupvfs.tcl =================================================================== --- setupvfs.tcl (revision 4467) +++ setupvfs.tcl (working copy) @@ -149,8 +149,8 @@ lib/tk8@/unsupported.tcl lib/tk8@/xmfbox.tcl } -# handle files no longer present -foreach f { lib/tk8@/prolog.ps } { +# handle new or deleted files +foreach f { lib/tk8@/prolog.ps lib/tk8@/icons.tcl } { set fx [string map $versmap $f] if {[file exists build/$fx]} { lappend guifiles $f @@ -220,6 +220,9 @@ if {$::debugOpt} { puts " $n ==> \$vfs/$f" } + } elseif {[string match "lib/vfs*/pkgIndex.tcl" $f]} { + set n [mk_tclvfs_index build/$f] + if {$::debugOpt} {puts " $n ==> \$vfs/$f" } } else { set n build/files/$f if {[file exists $n]} { @@ -233,6 +236,26 @@ return $n } +# We use a modified tclvfs pkgIndex with a reduced set of vfs' and force +# the use of vfslib.tcl for utility functions. +proc mk_tclvfs_index {src} { + global versmap + set fin [open $src r] + set fout [open ${src}.tclkit w] + puts $fout [string map $versmap \ + "package ifneeded vfs [package provide vfs] \[list load {} vfs\]"] + while {[gets $fin line] != -1} { + foreach pkg {starkit vfslib vfs::mk4 vfs::zip vfs::tar mk4vfs} { + if {[string match "package ifneeded $pkg *" $line]} { + puts $fout $line + } + } + } + close $fin + close $fout + return ${src}.tclkit +} + # copy file to m2m-mounted vfs proc vfscopy {argv} { global vfs versmap @@ -268,6 +291,8 @@ } } +# Create a pkgIndex file for a statick package 'pkg'. If the version +# is not provided then it is detected when creating the vfs. proc staticpkg {pkg {ver {}} {init {}}} { global vfs if {$ver eq {}} {