From: Jean-Claude Wippler <jcw@equi4.com>
Date: Thu, 25 Apr 2002 16:35:09 +0000 (+0000)
Subject: switch to vfs::{crc,memchan,zip}
X-Git-Tag: vfs-1-2~53
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=cb046faf03fff85cd80df5d901901dfb2bfe47cf;p=tclvfs

switch to vfs::{crc,memchan,zip}
---

diff --git a/ChangeLog b/ChangeLog
index 79d6b12..c40c468 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,8 @@
 2002-04-25  Jean-Claude Wippler <jcw@equi4.com>
-	* library/zipvfs.tcl: removed dependencies on pink, switched
-	to "zlib" command (now available in critlib and in tclkit)
+	* library/*vfs.tcl: switching to vfs::{crc,memchan,zip}
 	* library/vfsUtils.tcl: fixed env to be global, added unset
-	so unmounting cleans up its list of mounted file systems
+	so unmounting cleans up its list of mounted file systems,
+	define Trf/memchan-based versions of vfs::{crc,memchan,zip}
 	* library/{scripdoc.tcl,vfs.tcl}: removed, tclkit specific
 	* library/pkgIndex.tcl: drop packages "scripdoc" and "vfslib"
 
diff --git a/library/mk4vfs.tcl b/library/mk4vfs.tcl
index 6ce39c8..080015a 100644
--- a/library/mk4vfs.tcl
+++ b/library/mk4vfs.tcl
@@ -5,90 +5,6 @@
 # $Id$
 #
 
-# 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
-    }
-  }
-    
 namespace eval vfs::mk4 {}
 
 proc vfs::mk4::Mount {what local args} {
@@ -465,7 +381,7 @@ proc mk4vfs::do_close {fd mode cur} {
         # this was a duplicate close!!! 12-10-2001
         #close $fd
         _memchan_handler close $fd
-        set cdata [zip -mode compress $data]
+        set cdata [vfs::zip -mode compress $data]
         set len [string length $data]
         set clen [string length $cdata]
         if { $clen < $len } {
diff --git a/library/vfsUtils.tcl b/library/vfsUtils.tcl
index ee4a1ed..8b9af31 100644
--- a/library/vfsUtils.tcl
+++ b/library/vfsUtils.tcl
@@ -15,10 +15,10 @@ proc ::vfs::memchan {args} {
     uplevel 1 ::memchan $args
 }
 
-# This can be overridden to use a different zlib implementation
-proc ::vfs::zlib {args} {
+# This can be overridden to use a different crc implementation
+proc ::vfs::crc {args} {
     ::package require Trf
-    uplevel 1 ::zlib $args
+    uplevel 1 ::crc $args
 }
 
 # This can be overridden to use a different zip implementation
diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index 830a592..9533705 100644
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -299,7 +299,7 @@ proc zip::Data {fd arr {varPtr ""} {verify 0}} {
     }
     return
     if { $verify } {
-	set ncrc [vfs::zlib crc32 $data]
+	set ncrc [vfs::crc $data]
 	if { $ncrc != $sb(crc) } {
 	    tclLog [format {%s: crc mismatch: expected 0x%x, got 0x%x} \
 		    $sb(name) $sb(crc) $ncrc]