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 {}} {