Posted to tcl by patthoyts at Thu Mar 12 10:54:37 GMT 2009view raw

  1. Index: setupvfs.tcl
  2. ===================================================================
  3. --- setupvfs.tcl (revision 4467)
  4. +++ setupvfs.tcl (working copy)
  5. @@ -149,8 +149,8 @@
  6. lib/tk8@/unsupported.tcl
  7. lib/tk8@/xmfbox.tcl
  8. }
  9. -# handle files no longer present
  10. -foreach f { lib/tk8@/prolog.ps } {
  11. +# handle new or deleted files
  12. +foreach f { lib/tk8@/prolog.ps lib/tk8@/icons.tcl } {
  13. set fx [string map $versmap $f]
  14. if {[file exists build/$fx]} {
  15. lappend guifiles $f
  16. @@ -220,6 +220,9 @@
  17. if {$::debugOpt} {
  18. puts " $n ==> \$vfs/$f"
  19. }
  20. + } elseif {[string match "lib/vfs*/pkgIndex.tcl" $f]} {
  21. + set n [mk_tclvfs_index build/$f]
  22. + if {$::debugOpt} {puts " $n ==> \$vfs/$f" }
  23. } else {
  24. set n build/files/$f
  25. if {[file exists $n]} {
  26. @@ -233,6 +236,26 @@
  27. return $n
  28. }
  29.  
  30. +# We use a modified tclvfs pkgIndex with a reduced set of vfs' and force
  31. +# the use of vfslib.tcl for utility functions.
  32. +proc mk_tclvfs_index {src} {
  33. + global versmap
  34. + set fin [open $src r]
  35. + set fout [open ${src}.tclkit w]
  36. + puts $fout [string map $versmap \
  37. + "package ifneeded vfs [package provide vfs] \[list load {} vfs\]"]
  38. + while {[gets $fin line] != -1} {
  39. + foreach pkg {starkit vfslib vfs::mk4 vfs::zip vfs::tar mk4vfs} {
  40. + if {[string match "package ifneeded $pkg *" $line]} {
  41. + puts $fout $line
  42. + }
  43. + }
  44. + }
  45. + close $fin
  46. + close $fout
  47. + return ${src}.tclkit
  48. +}
  49. +
  50. # copy file to m2m-mounted vfs
  51. proc vfscopy {argv} {
  52. global vfs versmap
  53. @@ -268,6 +291,8 @@
  54. }
  55. }
  56.  
  57. +# Create a pkgIndex file for a statick package 'pkg'. If the version
  58. +# is not provided then it is detected when creating the vfs.
  59. proc staticpkg {pkg {ver {}} {init {}}} {
  60. global vfs
  61. if {$ver eq {}} {