code cleanup

diff --git a/library/mk4vfs.tcl b/library/mk4vfs.tcl
index 3ff9f1dce9baf4b0ccf32bef381c58b7f381bd57..41f02caebaeb5fde1fa547bedddd870ee5a7c56a 100644 (file)
--- a/library/mk4vfs.tcl
+++ b/library/mk4vfs.tcl
@@ -129,7 +129,7 @@ proc vfs::mk4::handler {db cmd root relative actualpath args} {
 }
 
 proc vfs::mk4::utime {db path actime modtime} {
-    #puts [list utime $path]
+    #::vfs::log [list utime $path]
     ::mk4vfs::stat $db $path sb
     
     if { $sb(type) == "file" } {
@@ -141,21 +141,21 @@ proc vfs::mk4::utime {db path actime modtime} {
 # virtual file system for zip files.
 
 proc vfs::mk4::matchindirectory {db path actualpath pattern type} {
-    #puts stderr [list matchindirectory $path $actualpath $pattern $type]
+    #::vfs::log [list matchindirectory $path $actualpath $pattern $type]
     set res [::mk4vfs::getdir $db $path $pattern]
-    #puts stderr "got $res"
+    #::vfs::log "got $res"
     set newres [list]
     foreach p [::vfs::matchCorrectTypes $type $res $actualpath] {
        lappend newres "$actualpath$p"
     }
-    #puts "got $newres"
+    #::vfs::log "got $newres"
     return $newres
 }
 
 proc vfs::mk4::stat {db name} {
-    #puts "stat $name"
+    #::vfs::log "stat $name"
     ::mk4vfs::stat $db $name sb
-    #puts [array get sb]
+    #::vfs::log [array get sb]
 
     # for new vfs:
     set sb(dev) 0
@@ -164,7 +164,7 @@ proc vfs::mk4::stat {db name} {
 }
 
 proc vfs::mk4::access {db name mode} {
-    #puts "mk4-access $name $mode"
+    #::vfs::log "mk4-access $name $mode"
     # This needs implementing better.  
     #tclLog "mk4vfs::driver $db access $name $mode"
     switch -- $mode {
@@ -198,7 +198,7 @@ proc vfs::mk4::access {db name mode} {
 }
 
 proc vfs::mk4::open {db file mode permissions} {
-    #puts "open $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
@@ -297,22 +297,22 @@ proc vfs::mk4::open {db file mode permissions} {
 }
 
 proc vfs::mk4::createdirectory {db name} {
-    #puts stderr "createdirectory $name"
+    #::vfs::log "createdirectory $name"
     mk4vfs::mkdir $db $name
 }
 
 proc vfs::mk4::removedirectory {db name} {
-    #puts stderr "removedirectory $name"
+    #::vfs::log "removedirectory $name"
     mk4vfs::delete $db $name
 }
 
 proc vfs::mk4::deletefile {db name} {
-    #puts "deletefile $name"
+    #::vfs::log "deletefile $name"
     mk4vfs::delete $db $name
 }
 
 proc vfs::mk4::fileattributes {db root relative args} {
-    #puts "fileattributes $args"
+    #::vfs::log "fileattributes $args"
     switch -- [llength $args] {
        0 {
            # list strings
@@ -491,7 +491,7 @@ proc mk4vfs::stat {db path arr} {
     
     #foreach n [array names cache] {
     #if {[lsearch -exact $pre $n] == -1} {
-    #puts "added $path $n $cache($n)"
+    #::vfs::log "added $path $n $cache($n)"
     #}
     #}
 }

diff --git a/library/tclIndex b/library/tclIndex
index 73659eaadb84579889c75e3f327f48bdfc83d8cc..063c8b0dcc951bf94c4ac6d246bc87520fae3d42 100644 (file)
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -74,7 +74,6 @@ set auto_index(::vfs::test::deletefile) [list source [file join $dir testvfs.tcl
 set auto_index(::vfs::test::fileattributes) [list source [file join $dir testvfs.tcl]]
 set auto_index(::vfs::test::utime) [list source [file join $dir testvfs.tcl]]
 set auto_index(::vfs::debug) [list source [file join $dir vfs.tcl]]
-set auto_index(::vfs::log) [list source [file join $dir vfs.tcl]]
 set auto_index(::vfs::autoMountExtension) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::autoMountUrl) [list source [file join $dir vfsUtils.tcl]]
 set auto_index(::vfs::log) [list source [file join $dir vfsUtils.tcl]]

diff --git a/library/tclprocvfs.tcl b/library/tclprocvfs.tcl
index 54455a6cd8314dd008b75791dd671e7d8e47d1fc..aea4c624d474ee9b276532ac9073acf89045aae6 100644 (file)
--- a/library/tclprocvfs.tcl
+++ b/library/tclprocvfs.tcl
@@ -13,7 +13,7 @@ proc vfs::tclproc::Mount {ns local} {
     if {![namespace exists ::$ns]} {
        error "No such namespace"
     }
-    puts "tclproc $ns mounted at $local"
+    ::vfs::log "tclproc $ns mounted at $local"
     vfs::filesystem mount $local [list vfs::tclproc::handler $ns]
     vfs::RegisterMount $local [list vfs::tclproc::Unmount]
 }
@@ -35,14 +35,12 @@ proc vfs::tclproc::handler {ns cmd root relative actualpath args} {
 # virtual file system for remote tclproc sites.
 
 proc vfs::tclproc::stat {ns name} {
-    puts stderr "stat $name"
+    ::vfs::log "stat $name"
     if {[namespace exists ::${ns}::${name}]} {
-       puts "directory"
        return [list type directory size 0 mode 0777 \
          ino -1 depth 0 name $name atime 0 ctime 0 mtime 0 dev -1 \
          uid -1 gid -1 nlink 1]
     } elseif {[llength [info procs ::${ns}::${name}]]} {
-       puts "file"
        return [list type file]
     } else {
        return -code error "could not read \"$name\": no such file or directory"
@@ -50,7 +48,7 @@ proc vfs::tclproc::stat {ns name} {
 }
 
 proc vfs::tclproc::access {ns name mode} {
-    puts stderr "access $name $mode"
+    ::vfs::log "access $name $mode"
     if {[namespace exists ::${ns}::${name}]} {
        return 1
     } elseif {[llength [info procs ::${ns}::${name}]]} {
@@ -74,7 +72,7 @@ proc vfs::tclproc::exists {ns name} {
 }
 
 proc vfs::tclproc::open {ns name mode permissions} {
-    puts stderr "open $name $mode $permissions"
+    ::vfs::log "open $name $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
@@ -111,7 +109,7 @@ proc vfs::tclproc::_generate {p} {
 }
 
 proc vfs::tclproc::matchindirectory {ns path actualpath pattern type} {
-    puts stderr "matchindirectory $path $actualpath $pattern $type"
+    ::vfs::log "matchindirectory $path $actualpath $pattern $type"
     set res [list]
 
     if {[::vfs::matchDirectories $type]} {
@@ -128,28 +126,28 @@ proc vfs::tclproc::matchindirectory {ns path actualpath pattern type} {
        regsub "^(::)?${ns}(::)?${path}(::)?" $r $actualpath rr
        lappend realres $rr
     }
-    #puts $realres
+    #::vfs::log $realres
     
     return $realres
 }
 
 proc vfs::tclproc::createdirectory {ns name} {
-    puts stderr "createdirectory $name"
+    ::vfs::log "createdirectory $name"
     namespace eval ::${ns}::${name} {}
 }
 
 proc vfs::tclproc::removedirectory {ns name} {
-    puts stderr "removedirectory $name"
+    ::vfs::log "removedirectory $name"
     namespace delete ::${ns}::${name}
 }
 
 proc vfs::tclproc::deletefile {ns name} {
-    puts stderr "deletefile $name"
+    ::vfs::log "deletefile $name"
     rename ::${ns}::${name} {}
 }
 
 proc vfs::tclproc::fileattributes {ns name args} {
-    puts stderr "fileattributes $args"
+    ::vfs::log "fileattributes $args"
     switch -- [llength $args] {
        0 {
            # list strings
@@ -184,6 +182,6 @@ proc vfs::tclproc::fileattributes {ns name args} {
 }
 
 proc vfs::tclproc::utime {what name actime mtime} {
-    puts stderr "utime $name"
+    ::vfs::log "utime $name"
     error ""
 }

diff --git a/library/vfs.tcl b/library/vfs.tcl
index c5b3f47bc1dca526be93111fb877beaa5d5abe9d..7d886e53a73c864784f55a3478ce2859c8327212 100644 (file)
--- a/library/vfs.tcl
+++ b/library/vfs.tcl
@@ -1,5 +1,5 @@
 # Only useful for TclKit
-# (this file is include in tclvfs so this entire package can be
+# (this file is included in tclvfs so this entire package can be
 # use in tclkit if desired).
 #
 # Initialization script normally executed in the interpreter for each
@@ -13,22 +13,17 @@
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 # Insist on running with compatible version of Tcl.
-
 package require Tcl 8.4
-
 package provide vfslib 0.1
 
-# So I can debug on command line!
+# So I can debug on command line when starting up Tcl from a vfs
+# 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 debug     0
-    if {[info exists env(VFS_DEBUG)]} {
-       set debug $env(VFS_DEBUG)
-    }
-
     variable temp
     global env
 
@@ -65,9 +60,3 @@ namespace eval ::vfs {
        return -code $rc -errorcode $ec -errorinfo $ei $ret
     }
 }
-
-proc vfs::log {msg {lvl 0}} {
-    if {$lvl < ${::vfs::debug}} {
-       tclLog "vfs($lvl): $msg"
-    }
-}

diff --git a/library/vfsUtils.tcl b/library/vfsUtils.tcl
index 0895e8187c4ad4975f05e6a6568c1a98ba624177..829df590e24b2bd7aa02e6eb59816eb725e73f0c 100644 (file)
--- a/library/vfsUtils.tcl
+++ b/library/vfsUtils.tcl
@@ -1,6 +1,14 @@
 
+package require Tcl 8.4
 package require vfs
 
+namespace eval ::vfs {
+    variable debug 0
+    if {[info exists env(VFS_DEBUG)]} {
+       set debug $env(VFS_DEBUG)
+    }
+}
+
 proc ::vfs::autoMountExtension {ext cmd {pkg ""}} {
     variable extMounts
     set extMounts($ext) [list $cmd $pkg]
@@ -11,8 +19,11 @@ proc ::vfs::autoMountUrl {type cmd {pkg ""}} {
     set urlMounts($type) [list $cmd $pkg]
 }
 
-proc ::vfs::log {str} {
-    puts stderr $str
+proc ::vfs::log {msg {lvl 0}} {
+    if {$lvl < ${::vfs::debug}} {
+       #tclLog "vfs($lvl): $msg"
+       puts stderr $msg
+    }
 }
 
 proc ::vfs::RegisterMount {mountpoint unmountcmd} {
@@ -37,7 +48,7 @@ proc ::vfs::haveMount {url} {
 }
 
 proc ::vfs::urlMount {url args} {
-    puts "$url $args"
+    ::vfs::log "$url $args"
     variable urlMounts
     if {[regexp {^([a-zA-Z]+)://(.*)} $url "" urltype rest]} {
        if {[info exists urlMounts($urltype)]} {
@@ -128,7 +139,6 @@ proc vfs::matchCorrectTypes {types filelist {inDir ""}} {
                }
            } else {
                foreach r $filelist {
-                   #puts [file join $inDir $r]
                    if {[::file isdirectory [file join $inDir $r]]} {
                        lappend newres $r
                    }
@@ -228,7 +238,7 @@ proc vfs::attributesGet {root stem index} {
 proc vfs::attributesSet {root stem index val} {
     # Return standard Tcl result, or error.
     set attribute [indexToAttribute $index]
-    #puts "$attribute"
+    #::vfs::log "$attribute"
     switch -- $attribute {
        "-owner" {
            return

diff --git a/library/zipvfs.tcl b/library/zipvfs.tcl
index 1ded361accbfc78213a84c733f0840712c0e009f..d698081a756ac66805937028355b036190e18b3d 100644 (file)
--- a/library/zipvfs.tcl
+++ b/library/zipvfs.tcl
@@ -28,7 +28,7 @@ proc vfs::zip::Unmount {fd local} {
 }
 
 proc vfs::zip::handler {zipfd cmd root relative actualpath args} {
-    #puts [list $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
@@ -41,26 +41,26 @@ proc vfs::zip::handler {zipfd cmd root relative actualpath args} {
 # virtual file system for zip files.
 
 proc vfs::zip::matchindirectory {zipfd path actualpath pattern type} {
-    #puts stderr [list matchindirectory $path $actualpath $pattern $type]
+    #::vfs::log [list matchindirectory $path $actualpath $pattern $type]
     set res [::zip::getdir $zipfd $path $pattern]
-    #puts stderr "got $res"
+    #::vfs::log "got $res"
     set newres [list]
     foreach p [::vfs::matchCorrectTypes $type $res $actualpath] {
        lappend newres "$actualpath$p"
     }
-    #puts "got $newres"
+    #::vfs::log "got $newres"
     return $newres
 }
 
 proc vfs::zip::stat {zipfd name} {
-    #puts "stat $name"
+    #::vfs::log "stat $name"
     ::zip::stat $zipfd $name sb
-    #puts [array get sb]
+    #::vfs::log [array get sb]
     array get sb
 }
 
 proc vfs::zip::access {zipfd name mode} {
-    #puts "zip-access $name $mode"
+    #::vfs::log "zip-access $name $mode"
     if {$mode & 2} {
        error "read-only"
     }
@@ -75,7 +75,7 @@ proc vfs::zip::access {zipfd name mode} {
 }
 
 proc vfs::zip::open {zipfd name mode permissions} {
-    #puts "open $name $mode $permissions"
+    #::vfs::log "open $name $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
@@ -112,22 +112,22 @@ proc vfs::zip::open {zipfd name mode permissions} {
 }
 
 proc vfs::zip::createdirectory {zipfd name} {
-    #puts stderr "createdirectory $name"
+    #::vfs::log "createdirectory $name"
     error "read-only"
 }
 
 proc vfs::zip::removedirectory {zipfd name} {
-    #puts stderr "removedirectory $name"
+    #::vfs::log "removedirectory $name"
     error "read-only"
 }
 
 proc vfs::zip::deletefile {zipfd name} {
-    #puts "deletefile $name"
+    #::vfs::log "deletefile $name"
     error "read-only"
 }
 
 proc vfs::zip::fileattributes {zipfd name args} {
-    #puts "fileattributes $args"
+    #::vfs::log "fileattributes $args"
     switch -- [llength $args] {
        0 {
            # list strings
@@ -287,8 +287,8 @@ proc zip::Data {fd arr {varPtr ""} {verify 0}} {
        if { [catch {
            set data [zip -mode decompress -nowrap 1 $data]
        } err] } {
-           puts "$sb(name): inflate error: $err"
-           puts [hexdump $data]
+           ::vfs::log "$sb(name): inflate error: $err"
+           ::vfs::log [hexdump $data]
        }
     }
     return
@@ -402,7 +402,7 @@ proc zip::FAKEDIR {arr path} {
 }
 
 proc zip::exists {fd path} {
-    #puts stderr "$fd $path"
+    #::vfs::log "$fd $path"
     if {$path == ""} {
        return 1
     } else {
@@ -436,7 +436,7 @@ proc zip::stat {fd path arr} {
 }
 
 proc zip::getdir {fd path {pat *}} {
-#    puts stderr [list getdir $fd $path $pat]
+#    ::vfs::log [list getdir $fd $path $pat]
     upvar #0 zip::$fd.toc toc
 
     if { $path == "." || $path == "" } {
@@ -462,7 +462,7 @@ proc zip::getdir {fd path {pat *}} {
            }
            lappend ret [file tail $sb(name)]
        } else {
-           #puts "$sb(depth) vs $depth for $sb(name)"
+           #::vfs::log "$sb(depth) vs $depth for $sb(name)"
        }
        unset sb
     }