From d100a2c39ef25f0c5908bcef8a33357096a5eb83 Mon Sep 17 00:00:00 2001
From: Vince Darley <vincentdarley@sourceforge.net>
Date: Sun, 10 Mar 2002 22:13:17 +0000
Subject: [PATCH] minor updates

---
 ChangeLog              |    6 +
 Readme.txt             |    6 +-
 library/mk4vfs.tcl     | 1035 ++++++++++++++++++----------------------
 library/tclprocvfs.tcl |    1 +
 library/vfs.tcl        |    2 -
 library/zipvfs.tcl     |   49 +-
 win/makefile.vc        |    2 +-
 7 files changed, 502 insertions(+), 599 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 5a1c2f8..046176c 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2002-03-09  Vince Darley <vincentdarley@sourceforge.net>
+	* library/mk4vfs.tcl: updated version from Jean-Claude Wippler.
+
+2002-03-01  Vince Darley <vincentdarley@sourceforge.net>
+	* library/*.tcl: completed and tested most changes from 02-19.
+
 2002-02-19  Vince Darley <vincentdarley@sourceforge.net>
 	* library/*.tcl: updated the vfs implementations to deal
 	with the 2002-02-01 change below.  More work needed.
diff --git a/Readme.txt b/Readme.txt
index 53347ac..009bc9b 100644
--- a/Readme.txt
+++ b/Readme.txt
@@ -13,9 +13,9 @@ is to expose Tcl 8.4's new filesystem C API to the Tcl level.
 Since 8.4 is still in alpha, the APIs on which this extension depends may of
 course change.  If that happens, it will of course require changes to this
 extension, until the point at which 8.4 goes final, when only
-backwards-compatible changes should occur.  Currently it requires a version
-of Tcl 8.4a4 or newer from September 7th 2001 or newer (if it compiles
-without warning, you should be fine).
+backwards-compatible changes should occur.  Currently it requires the final
+version of Tcl 8.4a4 or newer (from March 8th 2002) --- if it compiles
+without warning, you should be fine.
 
 Using this extension, the editor Alphatk can actually auto-mount, view and
 edit (but not save, since they're read-only) the contents of .zip files
diff --git a/library/mk4vfs.tcl b/library/mk4vfs.tcl
index 32a18e9..86efe11 100644
--- a/library/mk4vfs.tcl
+++ b/library/mk4vfs.tcl
@@ -1,691 +1,578 @@
-#
-# Copyright (C) 1997-1999 Sensus Consulting Ltd. All Rights Reserved.
+# mk4vfs.tcl -- Mk4tcl Virtual File System driver
+# Copyright (C) 1997-2001 Sensus Consulting Ltd. All Rights Reserved.
 # Matt Newman <matt@sensus.org> and Jean-Claude Wippler <jcw@equi4.com>
 #
-# $Header$
+# $Id$
 #
 
-###############################################################################
-# use Pink for zip and md5 replacements, this avoids the dependency on Trf
-
-    package ifneeded Trf 1.3 {
-    
-        package require pink
-        package provide Trf 1.3
-    
-        proc zip {flag value data} {
-            switch -glob -- "$flag $value" {
-            {-mode d*} {
-                set mode decompress
-            }
-            {-mode c*} {
-                set mode compress
-            }
-            default {
-                error "usage: zip -mode {compress|decompress} data"
-            }
-            }
-            return [pink zlib $mode $data]
-        }
-    
-        proc crc {data} {
-            return [pink zlib crc32 $data]
-        }
-    
-        proc md5 {data} {
-            set cmd [pink md5]
-            $cmd update $data
-            set result [$cmd digest]
-            rename $cmd ""
-            return $result
-        }
+# uses Pink for zip and md5 replacements, this avoids the dependency on Trf
+
+  package ifneeded Trf 1.3 {
+    package require pink
+    package provide Trf 1.3
+  
+    proc zip {flag value data} {
+      switch -glob -- "$flag $value" {
+	{-mode d*} { set mode decompress }
+	{-mode c*} { set mode compress }
+	default    { error "usage: zip -mode {compress|decompress} data" }
+      }
+      return [pink zlib $mode $data]
+    }
+  
+    proc crc {data} {
+      return [pink zlib crc32 $data]
+    }
+  
+    proc md5 {data} {
+      set cmd [pink md5]
+      $cmd update $data
+      set result [$cmd digest]
+      rename $cmd ""
+      return $result
     }
+  }
 
-###############################################################################
 # this replacement is for memchan, used for simple (de)compression
 
-    package ifneeded memchan 0.1 {
-    
-	    package require rechan
-	    package provide memchan 0.1
-	
-	    proc _memchan_handler {cmd fd args} {
-	        upvar #0 ::_memchan_buf($fd) _buf
-	        upvar #0 ::_memchan_pos($fd) _pos
-	        set arg1 [lindex $args 0]
-	        
-	        switch -- $cmd {
-	            seek {
-	                switch [lindex $args 1] {
-	                    1 - current { incr arg1 $_pos }
-	                    2 - end { incr arg1 [string length $_buf]}
-	                }
-	                return [set _pos $arg1]
-	            }
-	            read {
-	                set r [string range $_buf $_pos [expr { $_pos + $arg1 - 1 }]]
-	                incr _pos [string length $r]
-	                return $r
-	            }
-	            write {
-	                set n [string length $arg1]
-	                if { $_pos >= [string length $_buf] } {
-	                    append _buf $arg1
-	                } else { # the following doesn't work yet :(
-	                    set last [expr { $_pos + $n - 1 }]
-	                    set _buf [string replace $_buf $_pos $last $arg1]
-			    error "mk4vfs: sorry no inline write yet"
-	                }
-	                incr _pos $n
-	                return $n
-	            }
-	            close {
-	                unset _buf _pos
-	            }
-		    default {
-			error "Bad call to memchan replacement handler: $cmd"
-		    }
-	        }
-	    }
-	    
-	    proc memchan {} {
-	        set fd [rechan _memchan_handler 6]
-	        #fconfigure $fd -translation binary -encoding binary
-	        
-	        set ::_memchan_buf($fd) ""
-	        set ::_memchan_pos($fd) 0
-	        
-	        return $fd
-	    }
+  package ifneeded Memchan 0.1 {
+    package require rechan
+    package provide Memchan 0.1
+  
+    proc _memchan_handler {cmd fd args} {
+      upvar #0 ::_memchan_buf($fd) _buf
+      upvar #0 ::_memchan_pos($fd) _pos
+      set arg1 [lindex $args 0]
+      
+      switch -- $cmd {
+	seek {
+	  switch [lindex $args 1] {
+	    1 - current { incr arg1 $_pos }
+	    2 - end { incr arg1 [string length $_buf]}
+	  }
+	  return [set _pos $arg1]
 	}
-        
-###############################################################################
-
-package require Mk4tcl
-package require vfs
-package require vfslib
-
+	read {
+	  set r [string range $_buf $_pos [expr { $_pos + $arg1 - 1 }]]
+	  incr _pos [string length $r]
+	  return $r
+	}
+	write {
+	  set n [string length $arg1]
+	  if { $_pos >= [string length $_buf] } {
+	    append _buf $arg1
+	  } else { # the following doesn't work yet :(
+	    set last [expr { $_pos + $n - 1 }]
+	    set _buf [string replace $_buf $_pos $last $arg1]
+	    error "mk4vfs: sorry no inline write yet"
+	  }
+	  incr _pos $n
+	  return $n
+	}
+	close {
+	  unset _buf _pos
+	}
+	default {
+	  error "Bad call to memchan replacement handler: $cmd"
+	}
+      }
+    }
+    
+    proc memchan {} {
+      set fd [rechan _memchan_handler 6]
+      #fconfigure $fd -translation binary -encoding binary
+      
+      set ::_memchan_buf($fd) ""
+      set ::_memchan_pos($fd) 0
+      
+      return $fd
+    }
+  }
+    
 namespace eval vfs::mk4 {}
 
 proc vfs::mk4::Mount {what local args} {
-    set db [eval [list ::mk4vfs::_mount $what $local] $args]
-
-    ::vfs::filesystem mount $what [list ::vfs::mk4::handler $db]
-    # Register command to unmount
-    ::vfs::RegisterMount $local [list ::vfs::mk4::Unmount $db]
-    return $db
+  set db [eval [list ::mk4vfs::_mount $what $local] $args]
+  ::vfs::filesystem mount $what [list ::vfs::mk4::handler $db]
+  ::vfs::RegisterMount $local [list ::vfs::mk4::Unmount $db]
+  return $db
 }
 
 proc vfs::mk4::Unmount {db local} {
-    vfs::filesystem unmount $local
-    ::mk4vfs::_umount $db
+  vfs::filesystem unmount $local
+  ::mk4vfs::_umount $db
 }
 
 proc vfs::mk4::handler {db cmd root relative actualpath args} {
-    #tclLog [list $db $cmd $root $relative $actualpath $args]
-    if {$cmd == "matchindirectory"} {
-	eval [list $cmd $db $relative $actualpath] $args
-    } elseif {$cmd == "fileattributes"} {
-	eval [list $cmd $db $root $relative] $args
-    } else {
-	eval [list $cmd $db $relative] $args
-    }
+  if {$cmd == "matchindirectory"} {
+    eval [list $cmd $db $relative $actualpath] $args
+  } elseif {$cmd == "fileattributes"} {
+    eval [list $cmd $db $root $relative] $args
+  } else {
+    eval [list $cmd $db $relative] $args
+  }
 }
 
 proc vfs::mk4::utime {db path actime modtime} {
-    #::vfs::log [list utime $path]
-    ::mk4vfs::stat $db $path sb
-    
-    if { $sb(type) == "file" } {
-	::mk::set $sb(ino) date $modtime
-    }
+  ::mk4vfs::stat $db $path sb
+  
+  if { $sb(type) == "file" } {
+    ::mk::set $sb(ino) date $modtime
+  }
 }
 
 # If we implement the commands below, we will have a perfect
 # virtual file system for zip files.
 
 proc vfs::mk4::matchindirectory {db path actualpath pattern type} {
-    #::vfs::log [list matchindirectory $path $actualpath $pattern $type]
-    set newres [list]
-    if {![string length $pattern]} {
-	# check single file
-	set res [list $path]
-    } else {
-	set res [::mk4vfs::getdir $db $path $pattern]
-    }
-    #::vfs::log "got $res"
-    foreach p [::vfs::matchCorrectTypes $type $res $actualpath] {
-	lappend newres "$actualpath$p"
-    }
-    #::vfs::log "got $newres"
-    return $newres
+  set newres [list]
+  if {![string length $pattern]} {
+    # check single file
+    set res [list $actualpath]
+    set actualpath ""
+  } else {
+    set res [::mk4vfs::getdir $db $path $pattern]
+  }
+  foreach p [::vfs::matchCorrectTypes $type $res $actualpath] {
+    lappend newres "$actualpath$p"
+  }
+  return $newres
 }
 
 proc vfs::mk4::stat {db name} {
-    #::vfs::log "stat $name"
-    ::mk4vfs::stat $db $name sb
-    #::vfs::log [array get sb]
+  ::mk4vfs::stat $db $name sb
 
-    # for new vfs:
-    set sb(ino) 0
-    array get sb
+  set sb(ino) 0
+  array get sb
 }
 
 proc vfs::mk4::access {db name mode} {
-    #::vfs::log "mk4-access $name $mode"
-    # This needs implementing better.  
-    switch -- $mode {
-	0 {
-	    # exists
-	    if {![catch {::mk4vfs::stat $db $name sb}]} {
-		return
-	    }
-	}
-	1 {
-	    # executable
-	    if {![catch {::mk4vfs::stat $db $name sb}]} {
-		return
-	    }
-	}
-	2 {
-	    # writable
-	    if {![catch {::mk4vfs::stat $db $name sb}]} {
-		return
-	    }
-	}
-	4 {
-	    # readable
-	    if {![catch {::mk4vfs::stat $db $name sb}]} {
-		return
-	    }
-	}
-    }
-    #tclLog "access bad"
-    error "bad file" 
+  # This needs implementing better.  
+  ::mk4vfs::stat $db $name sb
 }
 
 proc vfs::mk4::open {db file mode permissions} {
-    #::vfs::log "open $file $mode $permissions"
-    # return a list of two elements:
-    # 1. first element is the Tcl channel name which has been opened
-    # 2. second element (optional) is a command to evaluate when
-    #    the channel is closed.
-    switch -glob -- $mode {
-	{}  -
-	r   {
-	    ::mk4vfs::stat $db $file sb
-	
-	    if { $sb(csize) != $sb(size) } {
-		package require Trf
-		package require memchan
-		#tclLog "$file: decompressing on read"
-
-		set fd [memchan]
-		fconfigure $fd -translation binary
-		set s [mk::get $sb(ino) contents]
-		puts -nonewline $fd [zip -mode decompress $s]
-
-		fconfigure $fd -translation auto
-		seek $fd 0
-		return [list $fd [list _memchan_handler close $fd]]
-	    } elseif { $::mk4vfs::direct } {
-		package require Trf
-		package require memchan
-
-		set fd [memchan]
-		fconfigure $fd -translation binary
-		puts -nonewline $fd [mk::get $sb(ino) contents]
-
-		fconfigure $fd -translation auto
-		seek $fd 0
-		return [list $fd [list _memchan_handler close $fd]]
-	    } else {
-		set fd [mk::channel $sb(ino) contents r]
-	    }
-	    return [list $fd]
-	}
-	a   {
-	    if { [catch {::mk4vfs::stat $db $file sb }] } {
-		#tclLog "stat failed - creating $file"
-		# Create file
-		::mk4vfs::stat $db [file dirname $file] sb
-
-		set cur [mk::row append $sb(ino).files name [file tail $file] size 0 date [clock seconds] ]
-		set sb(ino) $cur
-
-		if { [string match *z* $mode] || ${mk4vfs::compress} } {
-		    set sb(csize) -1    ;# HACK - force compression
-		} else {
-		    set sb(csize) 0
-		}
-	    }
-
-	    if { $sb(csize) != $sb(size) } {
-		package require Trf
-		package require memchan
-
-		#tclLog "$file: compressing on append"
-		append mode z
-		set fd [memchan]
-
-		fconfigure $fd -translation binary
-		set s [mk::get $sb(ino) contents]
-		puts -nonewline $fd [zip -mode decompress $s]
-		fconfigure $fd -translation auto
-	    } else {
-		set fd [mk::channel $sb(ino) contents a]
-	    }
-	    return [list $fd [list mk4vfs::do_close $fd $mode $sb(ino)]]
-	}
-	w*  {
-	    if { [catch {::mk4vfs::stat $db $file sb }] } {
-		#tclLog "stat failed - creating $file"
-		# Create file
-		::mk4vfs::stat $db [file dirname $file] sb
-		set cur [mk::row append $sb(ino).files name [file tail $file] size 0 date [clock seconds] ]
-		set sb(ino) $cur
-	    }
-	    if { [string match *z* $mode] || ${mk4vfs::compress} } {
-		package require Trf
-		package require memchan
-		#tclLog "$file: compressing on write"
-		###zip -attach $fd -mode compress
-		append mode z
-		set fd [memchan]
-	    } else {
-		set fd [mk::channel $sb(ino) contents w]
-	    }
-	    return [list $fd [list mk4vfs::do_close $fd $mode $sb(ino)]]
-	}
-	default     {
-	    error "illegal access mode \"$mode\""
+  # return a list of two elements:
+  # 1. first element is the Tcl channel name which has been opened
+  # 2. second element (optional) is a command to evaluate when
+  #  the channel is closed.
+  switch -glob -- $mode {
+    {}  -
+    r {
+      ::mk4vfs::stat $db $file sb
+    
+      if { $sb(csize) != $sb(size) } {
+        package require Trf
+        package require Memchan
+
+        set fd [memchan]
+        fconfigure $fd -translation binary
+        set s [mk::get $sb(ino) contents]
+        puts -nonewline $fd [zip -mode decompress $s]
+
+        fconfigure $fd -translation auto
+        seek $fd 0
+        return [list $fd [list _memchan_handler close $fd]]
+      } elseif { $::mk4vfs::direct } {
+        package require Trf
+        package require Memchan
+
+        set fd [memchan]
+        fconfigure $fd -translation binary
+        puts -nonewline $fd [mk::get $sb(ino) contents]
+
+        fconfigure $fd -translation auto
+        seek $fd 0
+        return [list $fd [list _memchan_handler close $fd]]
+      } else {
+        set fd [mk::channel $sb(ino) contents r]
+      }
+      return [list $fd]
+    }
+    a {
+      if { [catch {::mk4vfs::stat $db $file sb }] } {
+        # Create file
+        ::mk4vfs::stat $db [file dirname $file] sb
+	set tail [file tail $file]
+        set fview $sb(ino).files
+        if {[info exists mk4vfs::v::fcache($fview)]} {
+	  lappend mk4vfs::v::fcache($fview) $tail
+        }
+	set now [clock seconds]
+        set sb(ino) [mk::row append $fview name $tail size 0 date $now ]
+
+        if { [string match *z* $mode] || $mk4vfs::compress } {
+          set sb(csize) -1  ;# HACK - force compression
+        } else {
+          set sb(csize) 0
+        }
+      }
+
+      if { $sb(csize) != $sb(size) } {
+        package require Trf
+        package require Memchan
+
+        append mode z
+        set fd [memchan]
+
+        fconfigure $fd -translation binary
+        set s [mk::get $sb(ino) contents]
+        puts -nonewline $fd [zip -mode decompress $s]
+        fconfigure $fd -translation auto
+      } else {
+        set fd [mk::channel $sb(ino) contents a]
+      }
+      return [list $fd [list mk4vfs::do_close $fd $mode $sb(ino)]]
+    }
+    w*  {
+      if { [catch {::mk4vfs::stat $db $file sb }] } {
+        # Create file
+        ::mk4vfs::stat $db [file dirname $file] sb
+	set tail [file tail $file]
+        set fview $sb(ino).files
+        if {[info exists mk4vfs::v::fcache($fview)]} {
+	  lappend mk4vfs::v::fcache($fview) $tail
 	}
+	set now [clock seconds]
+        set sb(ino) [mk::row append $fview name $tail size 0 date $now ]
+      }
+
+      if { [string match *z* $mode] || $mk4vfs::compress } {
+        package require Trf
+        package require Memchan
+        append mode z
+        set fd [memchan]
+      } else {
+        set fd [mk::channel $sb(ino) contents w]
+      }
+      return [list $fd [list mk4vfs::do_close $fd $mode $sb(ino)]]
+    }
+    default   {
+      error "illegal access mode \"$mode\""
     }
+  }
 }
 
 proc vfs::mk4::createdirectory {db name} {
-    #::vfs::log "createdirectory $name"
-    mk4vfs::mkdir $db $name
+  mk4vfs::mkdir $db $name
 }
 
 proc vfs::mk4::removedirectory {db name} {
-    #::vfs::log "removedirectory $name"
-    mk4vfs::delete $db $name
+  mk4vfs::delete $db $name
 }
 
 proc vfs::mk4::deletefile {db name} {
-    #::vfs::log "deletefile $name"
-    mk4vfs::delete $db $name
+  mk4vfs::delete $db $name
 }
 
 proc vfs::mk4::fileattributes {db root relative args} {
-    #::vfs::log "fileattributes $args"
-    switch -- [llength $args] {
-	0 {
-	    # list strings
-	    return [::vfs::listAttributes]
-	}
-	1 {
-	    # get value
-	    set index [lindex $args 0]
-	    return [::vfs::attributesGet $root $relative $index]
+  switch -- [llength $args] {
+    0 {
+      # list strings
+      return [::vfs::listAttributes]
+    }
+    1 {
+      # get value
+      set index [lindex $args 0]
+      return [::vfs::attributesGet $root $relative $index]
 
-	}
-	2 {
-	    # set value
-	    set index [lindex $args 0]
-	    set val [lindex $args 1]
-	    return [::vfs::attributesSet $root $relative $index $val]
-	}
     }
+    2 {
+      # set value
+      set index [lindex $args 0]
+      set val [lindex $args 1]
+      return [::vfs::attributesSet $root $relative $index $val]
+    }
+  }
 }
 
+package require Mk4tcl
+package require vfs
+package require vfslib
+
 package provide mk4vfs 1.0
 
 namespace eval mk4vfs {
-    variable uid 0
-    variable compress 1         ;# HACK - needs to be part of "Super-Block"
-    variable flush      5000    ;# Auto-Commit frequency
-    variable direct 0
+  variable compress 1     ;# HACK - needs to be part of "Super-Block"
+  variable flush    5000  ;# Auto-Commit frequency
+  variable direct   0	  ;# read through a memchan, or from Mk4tcl if zero
+
+  namespace eval v {
+    variable seq      0
 
-    namespace export mount umount
+    array set cache {}
+    array set fcache {}
+  }
+
+  namespace export mount umount
 }
 
 proc mk4vfs::init {db} {
-    mk::view layout $db.dirs {name:S parent:I {files {name:S size:I date:I contents:M}}}
+  mk::view layout $db.dirs {name:S parent:I {files {name:S size:I date:I contents:M}}}
 
-    if { [mk::view size $db.dirs] == 0 } {
-        mk::row append $db.dirs name <root> parent 0
-    }
+  if { [mk::view size $db.dirs] == 0 } {
+    mk::row append $db.dirs name <root> parent 0
+  }
+
+  # 2001-12-13: use parent -1 for root level!
+  mk::set $db.dirs!0 parent -1
 }
 
 proc mk4vfs::mount {args} {
-    uplevel ::vfs::mk4::Mount $args
+  uplevel ::vfs::mk4::Mount $args
 }
 
 proc mk4vfs::_mount {path file args} {
-    variable uid
-    set db mk4vfs[incr uid]
+  set db mk4vfs[incr v::seq]
 
-    eval [list mk::file open $db $file] $args
+  eval [list mk::file open $db $file] $args
 
-    init $db
+  init $db
 
-    set flush 1
-    for {set idx 0} {$idx < [llength $args]} {incr idx} {
-        switch -- [lindex $args $idx] {
-        -readonly       -
-        -nocommit       {set flush 0}
-        }
+  set flush 1
+  for {set idx 0} {$idx < [llength $args]} {incr idx} {
+    switch -- [lindex $args $idx] {
+      -readonly   -
+      -nocommit   {set flush 0}
     }
-    if { $flush } {
-        _commit $db
-    }
-    return $db
+  }
+  if { $flush } {
+    _commit $db
+  }
+  return $db
 }
 
 proc mk4vfs::_commit {db} {
-    after ${::mk4vfs::flush} [list mk4vfs::_commit $db]
-    mk::file commit $db
+  variable flush
+  after $flush [list mk4vfs::_commit $db]
+  mk::file commit $db
 }
 
 proc mk4vfs::umount {local} {
-    foreach {db path} [mk::file open] {
-      if {[string equal $local $path]} {
-	uplevel ::vfs::mk4::Unmount $db $local
-	return
-      }
+  foreach {db path} [mk::file open] {
+    if {[string equal $local $path]} {
+      uplevel ::vfs::mk4::Unmount $db $local
+      return
     }
-    tclLog "umount $local? [mk::file open]"
+  }
+  tclLog "umount $local? [mk::file open]"
 }
 
 proc mk4vfs::_umount {db} {
-    after cancel [list mk4vfs::_commit $db]
-    variable cache
-    array unset cache $db.*
-    #tclLog [list unmount $db]
-    mk::file close $db
+  after cancel [list mk4vfs::_commit $db]
+  array unset v::cache $db,*
+  array unset v::fcache $db.*
+  mk::file close $db
 }
 
 proc mk4vfs::stat {db path arr} {
-    variable cache
-    
-    #set pre [array names cache]
-    
-    upvar 1 $arr sb
-    #tclLog "mk4vfs::stat $db $path $arr"
-
-    set sp [::file split $path]
-    set tail [lindex $sp end]
-
-    set parent 0
-    set view $db.dirs
-    set cur $view!$parent
-    set type directory
+  upvar 1 $arr sb
 
-    foreach ele [lrange $sp 0 [expr { [llength $sp] - 2 }]] {
+  set sp [::file split $path]
+  set tail [lindex $sp end]
 
-        if { [info exists cache($cur,$ele)] } {
-            set parent $cache($cur,$ele)
-        } else {
-            #set row [mk::select $view name $ele parent $parent]
-            set row [find/dir $view $ele $parent]
-
-            if { $row == -1 } {
-                #tclLog "select failed: parent $parent name $ele"
-                return -code error "could not read \"$path\": no such file or directory"
-            }
-	    set parent $row
-            set cache($cur,$ele) $parent
-        }
-	set cur $view!$parent
-	#mk::cursor position cur $parent
-    }
-    #
-    # Now check if final comp is a directory or a file
-    #
-    # CACHING is required - it can deliver a x15 speed-up!
-    #
-    if { [string equal $tail "."] || [string equal $tail ":"] || [string equal $tail ""] } {
-	# donothing
-
-    } elseif { [info exists cache($cur,$tail)] } {
-        set type directory
-        #set cur $view!$cache($cur,$tail)
-	mk::cursor position cur $cache($cur,$tail)
+  set parent 0
+  set view $db.dirs
+  set type directory
 
+  foreach ele [lrange $sp 0 end-1] {
+    if {[info exists v::cache($db,$parent,$ele)]} {
+      set parent $v::cache($db,$parent,$ele)
     } else {
-        # File?
-        #set row [mk::select $cur.files name $tail]
-        set row [find/file $cur.files $tail]
-
-        if { $row != -1 } {
-            set type file
-            set view $cur.files
-	    #set cur $view!$row
-	    mk::cursor create cur $view $row
-
-        } else {
-            # Directory?
-            #set row [mk::select $view parent $parent name $tail]
-            set row [find/dir $view $tail $parent]
-
-            if { $row != -1 } {
-                set type directory
-		#set cur $view!$row
-		# MUST SET cache BEFORE calling mk::cursor!!!
-		set cache($cur,$tail) $row
-		mk::cursor position cur $row
-            } else { 
-                return -code error "could not read \"$path\": no such file or directory"
-            }
-        }
+      set row [mk::select $view -count 1 parent $parent name $ele]
+      if { $row == "" } {
+        return -code error "could not read \"$path\": no such file or directory"
+      }
+      set v::cache($db,$parent,$ele) $row
+      set parent $row
     }
-    set sb(type)	$type
-    set sb(view)	$view
-    set sb(ino)		$cur
-
-    if { [string equal $type "directory"] } {
-        set sb(atime)   0
-        set sb(ctime)   0
-	set sb(gid)	0
-        set sb(mode)    0777
-        set sb(mtime)   0
-        set sb(nlink)   [expr { [mk::get $cur files] + 1 }]
-        set sb(size)    0
-        set sb(csize)   0
-	set sb(uid)	0
+  }
+  
+  # Now check if final comp is a directory or a file
+  # CACHING is required - it can deliver a x15 speed-up!
+  
+  if { [string equal $tail "."] || [string equal $tail ":"] ||
+  				  	[string equal $tail ""] } {
+    set row $parent
+
+  } elseif { [info exists v::cache($db,$parent,$tail)] } {
+    set row $v::cache($db,$parent,$tail)
+  } else {
+    # File?
+    set fview $view!$parent.files
+    # create a name cache of files in this directory
+    if {![info exists v::fcache($fview)]} {
+      # cache only a limited number of directories
+      if {[array size v::fcache] >= 10} {
+        array unset v::fcache *
+      }
+      set v::fcache($fview) {}
+      mk::loop c $fview {
+        lappend v::fcache($fview) [mk::get $c name]
+      }
+    }
+    set row [lsearch -exact $v::fcache($fview) $tail]
+    #set row [mk::select $fview -count 1 name $tail]
+    #if {$row == ""} { set row -1 }
+    if { $row != -1 } {
+      set type file
+      set view $view!$parent.files
     } else {
-        set mtime	[mk::get $cur date]
-        set sb(atime)	$mtime
-        set sb(ctime)	$mtime
-	set sb(gid)	0
-        set sb(mode)    0777
-        set sb(mtime)	$mtime
-        set sb(nlink)   1
-        set sb(size)    [mk::get $cur size]
-        set sb(csize)   [mk::get $cur -size contents]
-	set sb(uid)	0
+      # Directory?
+      set row [mk::select $view -count 1 parent $parent name $tail]
+      if { $row != "" } {
+        set v::cache($db,$parent,$tail) $row
+      } else { 
+        return -code error "could not read \"$path\": no such file or directory"
+      }
     }
-    
-    #foreach n [array names cache] {
-    #if {[lsearch -exact $pre $n] == -1} {
-    #::vfs::log "added $path $n $cache($n)"
-    #}
-    #}
+  }
+  set cur $view!$row
+
+  set sb(type)    $type
+  set sb(view)    $view
+  set sb(ino)     $cur
+
+  if { [string equal $type "directory"] } {
+    set sb(atime) 0
+    set sb(ctime) 0
+    set sb(gid)   0
+    set sb(mode)  0777
+    set sb(mtime) 0
+    set sb(nlink) [expr { [mk::get $cur files] + 1 }]
+    set sb(size)  0
+    set sb(csize) 0
+    set sb(uid)   0
+  } else {
+    set mtime   [mk::get $cur date]
+    set sb(atime) $mtime
+    set sb(ctime) $mtime
+    set sb(gid)   0
+    set sb(mode)  0777
+    set sb(mtime) $mtime
+    set sb(nlink) 1
+    set sb(size)  [mk::get $cur size]
+    set sb(csize) [mk::get $cur -size contents]
+    set sb(uid)   0
+  }
 }
 
 proc mk4vfs::do_close {fd mode cur} {
-    # Set size to -1 before the seek - just in case it fails.
-    
-    if {[catch {
-	set iswrite [regexp {[aw]} $mode]
-	    
-	if {$iswrite} {
-	    mk::set $cur size -1 date [clock seconds]
-	    flush $fd
-	    if { [string match *z* $mode] } {
-		fconfigure $fd -translation binary
-		seek $fd 0
-		set data [read $fd]
-		_memchan_handler close $fd
-		set cdata [zip -mode compress $data]
-		set len [string length $data]
-		set clen [string length $cdata]
-		if { $clen < $len } {
-		    mk::set $cur size $len contents $cdata
-		} else {
-		    mk::set $cur size $len contents $data
-		}
-	    } else {
-		mk::set $cur size [mk::get $cur -size contents]
-	    }
-	    # added 30-10-2000
-	    set db [lindex [split $cur .] 0]
-	    mk::file autocommit $db
-	} else {
-	    # This should only be called for write operations...
-	    error "Shouldn't call me for read ops"
-	}
-    } err]} {
-	global errorInfo
-	tclLog "mk4vfs::do_close callback error: $err $errorInfo"
-###!!!	return -code error $err
+  # Set size to -1 before the seek - just in case it fails.
+  
+  if {[catch {
+    set iswrite [regexp {[aw]} $mode]
+      
+    if {$iswrite} {
+      mk::set $cur size -1 date [clock seconds]
+      flush $fd
+      if { [string match *z* $mode] } {
+        fconfigure $fd -translation binary
+        seek $fd 0
+        set data [read $fd]
+        # this was a duplicate close!!! 12-10-2001
+        #close $fd
+        _memchan_handler close $fd
+        set cdata [zip -mode compress $data]
+        set len [string length $data]
+        set clen [string length $cdata]
+        if { $clen < $len } {
+          mk::set $cur size $len contents $cdata
+        } else {
+          mk::set $cur size $len contents $data
+        }
+      } else {
+        mk::set $cur size [mk::get $cur -size contents]
+      }
+      # added 30-10-2000
+      set db [lindex [split $cur .] 0]
+      mk::file autocommit $db
+    } else {
+      # This should only be called for write operations...
+      error "Shouldn't call me for read ops"
     }
+  } err]} {
+    global errorInfo
+    tclLog "mk4vfs::do_close callback error: $err $errorInfo"
+###!!!  return -code error $err
+  }
 }
 
 proc mk4vfs::mkdir {db path} {
-    set sp [::file split $path]
-    set parent 0
-    set view $db.dirs
-
-    set npath {}
-    foreach ele $sp {
-        set npath [file join $npath $ele]
-
-        if { ![catch {stat $db $npath sb}] } {
-            if { $sb(type) != "directory" } {
-                return -code error "can't create directory \"$npath\": file already exists"
-            }
-            set parent [mk::cursor position sb(ino)]
-            continue
-        }
-        #set parent [mk::cursor position sb(ino)]
-#puts "set cur \[mk::row append $view name $ele parent $parent]"
-        set cur [mk::row append $view name $ele parent $parent]
-        set parent [mk::cursor position cur]
-    }
-}
+  set sp [::file split $path]
+  set parent 0
+  set view $db.dirs
 
-# removed this from 'getdir' proc.
-if { 0 } {
-    foreach row [mk::select $sb(view) parent $parent -glob name $pat] {
-	if { $row == 0 } {continue}
+  set npath {}
+  foreach ele $sp {
+    set npath [file join $npath $ele]
 
-	set hits([mk::get $sb(view)!$row name]) 1
-    }
-    # Match files
-    set view $sb(view)!$parent.files
-    foreach row [mk::select $view -glob name $pat] {
-	set hits([mk::get $view!$row name]) 1
+    if { ![catch {stat $db $npath sb}] } {
+      if { $sb(type) != "directory" } {
+        return -code error "can't create directory \"$npath\": file already exists"
+      }
+      set parent [mk::cursor position sb(ino)]
+      continue
     }
-} 
+    #set parent [mk::cursor position sb(ino)]
+    set cur [mk::row append $view name $ele parent $parent]
+    set parent [mk::cursor position cur]
+  }
+}
 
 proc mk4vfs::getdir {db path {pat *}} {
-    #tclLog [list mk4vfs::getdir $db $path $pat]
-
-    if { [catch {
-        stat $db $path sb
-    }] } {
-        return {}
-    }
-
-    if { $sb(type) != "directory" } {
-        return {}
-        #return -code error "bad path \"$path\": not a directory"
-    }
-    # Match directories
-    set parent [mk::cursor position sb(ino)] 
-    mk::loop sb(ino) {
-	if { [mk::get $sb(ino) parent] == $parent &&
-	     [string match $pat [mk::get $sb(ino) name]] &&
-	     [mk::cursor position sb(ino)] != 0 } {
-	    set hits([mk::get $sb(ino) name]) 1
-	}
-    }
-    # Match files
-    mk::loop sb(ino) $sb(view)!$parent.files {
-	if { [string match $pat [mk::get $sb(ino) name]] } {
-	    set hits([mk::get $sb(ino) name]) 1
-	}
-    }
-    return [lsort [array names hits]]
+  if {[catch { stat $db $path sb }] || $sb(type) != "directory" } {
+    return
+  }
+
+  # Match directories
+  set parent [mk::cursor position sb(ino)] 
+  foreach row [mk::select $sb(view) parent $parent -glob name $pat] {
+    set hits([mk::get $sb(view)!$row name]) 1
+  }
+  # Match files
+  set view $sb(view)!$parent.files
+  foreach row [mk::select $view -glob name $pat] {
+    set hits([mk::get $view!$row name]) 1
+  }
+  return [lsort [array names hits]]
 }
 
 proc mk4vfs::mtime {db path time} {
 
-    stat $db $path sb
+  stat $db $path sb
 
-    if { $sb(type) == "file" } {
-        mk::set $sb(ino) date $time
-    }
-    return $time
+  if { $sb(type) == "file" } {
+    mk::set $sb(ino) date $time
+  }
+  return $time
 }
 
 proc mk4vfs::delete {db path {recursive 0}} {
-    #tclLog "trying to delete $path"
-    set rc [catch { stat $db $path sb } err]
-    if { $rc }  {
-	#tclLog "delete error: $err"
-	return -code error $err
+  stat $db $path sb
+  if {$sb(type) == "file" } {
+    mk::row delete $sb(ino)
+    if {[regexp {(.*)!(\d+)} $sb(ino) - v r] && [info exists v::fcache($v)]} {
+      set v::fcache($v) [lreplace $v::fcache($v) $r $r]
     }
-    if {$sb(type) == "file" } {
-	mk::row delete $sb(ino)
+  } else {
+    # just mark dirs as deleted
+    set contents [getdir $db $path *]
+    if {$recursive} {
+      # We have to delete these manually, else
+      # they (or their cache) may conflict with
+      # something later
+      foreach f $contents {
+        delete $db [file join $path $f] $recursive
+      }
     } else {
-	# just mark dirs as deleted
-	set contents [getdir $db $path *]
-	#puts "path, $contents"
-	if {$recursive} {
-	    # We have to delete these manually, else
-	    # they (or their cache) may conflict with
-	    # something later
-	    foreach f $contents {
-		delete $db [file join $path $f] $recursive
-	    }
-	} else {
-	    if {[llength $contents]} {
-		return -code error "Non-empty"
-	    }
-	}
-	set tail [file tail $path]
-	variable cache
-	set var2 "$sb(view)![mk::get $sb(ino) parent],$tail"
-	#puts "del $path, $tail , $var2, [info exists cache($var2)]"
-	if {[info exists cache($var2)]} {
-	    #puts "remove2: $path $var2 $cache($var2)"
-	    unset cache($var2)
-	}
-	
-	mk::set $sb(ino) parent -1
-    }
-    return ""
-}
-
-proc mk4vfs::find/file {v name} {
-    mk::loop cur $v {
-	if { [string equal [mk::get $cur name] $name] } {
-	    return [mk::cursor position cur]
-	}
-    }
-    return -1
-}
-
-proc mk4vfs::find/dir {v name parent} {
-    mk::loop cur $v {
-	if {	[mk::get $cur parent] == $parent &&
-		[string equal [mk::get $cur name] $name] } {
-	    return [mk::cursor position cur]
-	}
+      if {[llength $contents]} {
+        return -code error "Non-empty"
+      }
     }
-    return -1
+    array unset v::cache "$db,[mk::get $sb(ino) parent],[file tail $path]"
+    
+    mk::set $sb(ino) parent -1 name ""
+  }
+  return ""
 }
diff --git a/library/tclprocvfs.tcl b/library/tclprocvfs.tcl
index 43f69b0..2cade50 100644
--- a/library/tclprocvfs.tcl
+++ b/library/tclprocvfs.tcl
@@ -16,6 +16,7 @@ proc vfs::ns::Mount {ns local} {
     ::vfs::log "ns $ns mounted at $local"
     vfs::filesystem mount $local [list vfs::ns::handler $ns]
     vfs::RegisterMount $local [list vfs::ns::Unmount]
+    return $local
 }
 
 proc vfs::ns::Unmount {local} {
diff --git a/library/vfs.tcl b/library/vfs.tcl
index a2b2fb3..b972084 100644
--- a/library/vfs.tcl
+++ b/library/vfs.tcl
@@ -20,8 +20,6 @@ package provide vfslib 0.1
 # when I might not have the history procedures loaded yet!
 #proc history {args} {}
 
-lappend auto_path [file dirname [info script]]
-
 # This stuff is for TclKit
 namespace eval ::vfs {
     variable temp
diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index 98d0689..d68c9af 100644
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -30,7 +30,6 @@ proc vfs::zip::Unmount {fd local} {
 
 proc vfs::zip::handler {zipfd cmd root relative actualpath args} {
     #::vfs::log [list $zipfd $cmd $root $relative $actualpath $args]
-    #update
     if {$cmd == "matchindirectory"} {
 	eval [list $cmd $zipfd $relative $actualpath] $args
     } else {
@@ -48,6 +47,11 @@ proc vfs::zip::matchindirectory {zipfd path actualpath pattern type} {
     # for the existence of a single file $path only
     set res [::zip::getdir $zipfd $path $pattern]
     #::vfs::log "got $res"
+    if {![string length $pattern]} {
+	set res [list $actualpath]
+	set actualpath ""
+    }
+
     set newres [list]
     foreach p [::vfs::matchCorrectTypes $type $res $actualpath] {
 	lappend newres "$actualpath$p"
@@ -441,7 +445,7 @@ proc zip::stat {fd path arr} {
 
 # Treats empty pattern as asking for a particular file only
 proc zip::getdir {fd path {pat *}} {
-#    ::vfs::log [list getdir $fd $path $pat]
+    #::vfs::log [list getdir $fd $path $pat]
     upvar #0 zip::$fd.toc toc
 
     if { $path == "." || $path == "" } {
@@ -454,26 +458,33 @@ proc zip::getdir {fd path {pat *}} {
     }
     set depth [llength [file split $path]]
 
-    set ret {}
-    foreach key [array names toc $path] {
-	if {[string index $key end] == "/"} {
-	    # Directories are listed twice: both with and without
-	    # the trailing '/', so we ignore the one with
-	    continue
-	}
-	array set sb $toc($key)
-
-	if { $sb(depth) == $depth } {
-	    if {[info exists toc(${key}/)]} {
-		array set sb $toc(${key}/)
+    #puts stderr "getdir $fd $path $depth $pat [array names toc $path]"
+    if {$depth} {
+	set ret {}
+	foreach key [array names toc $path] {
+	    if {[string index $key end] == "/"} {
+		# Directories are listed twice: both with and without
+		# the trailing '/', so we ignore the one with
+		continue
+	    }
+	    array set sb $toc($key)
+
+	    if { $sb(depth) == $depth } {
+		if {[info exists toc(${key}/)]} {
+		    array set sb $toc(${key}/)
+		}
+		lappend ret [file tail $sb(name)]
+	    } else {
+		#::vfs::log "$sb(depth) vs $depth for $sb(name)"
 	    }
-	    lappend ret [file tail $sb(name)]
-	} else {
-	    #::vfs::log "$sb(depth) vs $depth for $sb(name)"
+	    unset sb
 	}
-	unset sb
+	return $ret
+    } else {
+	# just the 'root' of the zip archive.  This obviously exists and
+	# is a directory.
+	return [list {}]
     }
-    return $ret
 }
 
 proc zip::_close {fd} {
diff --git a/win/makefile.vc b/win/makefile.vc
index 315911d..49c2e58 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -13,7 +13,7 @@ VFS_VERSION = 1.0
 DLL_VERSION = 10
 
 # comment the following line to compile with symbols
-NODEBUG=0
+NODEBUG=1
 
 !IF "$(NODEBUG)" == "1"
 DEBUGDEFINES =
-- 
2.23.0