# schan.tcl --
  #
  #   A string channel, for read/writing to a string instead of a file
  
  package provide schan 0.2
  
  namespace eval schan {
  
      variable schan
  
      proc initialize {fd mode} {
          variable ::schan::schan
          set schan($fd,s) {}
          set schan($fd,cb) {}
          set schan($fd,ccb) {}
          return [list initialize finalize watch read write]
      }
  
      proc finalize {fd} {
          variable ::schan::schan
          if [string length $schan($fd,ccb)] {
              $schan($fd,ccb) $fd $schan($fd,s)
          }
          unset schan($fd,s)
          unset schan($fd,cb)
          unset schan($fd,ccb)
          return {}
      }
  
      proc watch {fd ev} {
          return {}
      }
  
      proc setccb {fd cb} {
          variable ::schan::schan
          set schan($fd,ccb) $cb
      }
  
      proc setcb {fd cb} {
          variable ::schan::schan
          set schan($fd,cb) $cb
      }
  
      proc write {fd s} {
          variable ::schan::schan
          if [string length $schan($fd,cb)] {
              $schan($fd,cb) $fd $s
          }
          append schan($fd,s) $s
          return [string length $s]
      }
  
      proc read {fd count} {
          variable ::schan::schan
          set s $schan($fd,s)
          set len [string length $s]
          if {$count >= $len} {
              set r $schan($fd,s)
              set schan($fd,s) {}
              return $r
          } else {
              set r [string range $s 0 [expr $count - 1]]
              set schan($fd,s) [string range $s $count end]
              return $r
          }
      }
  
      proc tell {fd} {
          variable ::schan::schan
          set s $schan($fd,s)
          return $s
      }
  
      namespace export *
      namespace ensemble create
  
  # TODO: wrap this in a proper tcltest framework
  
  #    proc testcb {fd s} {
  #        puts "CB: {$s}"
  #    }
  #    proc test {} {
  #        set fd [chan create [list read write] schan]
  #        fconfigure $fd -buffering none -translation {binary binary}
  #        schan setccb $fd testcb
  #        puts $fd "This is a test"
  #        puts $fd "This is another test"
  #        close $fd
  #    }
  
  }
  
  #::schan::test