Tcl Source Code

Artifact d0141d68dea0239b4fe9bfb9dd389b21150cb7c9:

Attachment "tst_chan.tcl" to ticket [1913876fff] added by schwarzkopf 2008-03-14 04:53:56.

---

lappend auto_path .teapot/repository/package/linux-glibc2.3-x86_64/lib
lappend auto_path /opt/ActiveTcl-8.5/lib
#package require Memchan

set contents [string repeat "this is a tring to test on\n" 1000]

namespace eval ::vchan {

    variable chans
    variable idx
    variable basemap

    set basemap(start) 0
    set basemap(end) 0
    set basemap(current) 0

    proc initialize {chan mode} {
        variable chans
        variable idx

        set chans($chan) ""
        set idx($chan) 0

        return [list initialize finalize watch read write seek]
    }

    proc finalize {chan} {
        variable chans
        variable idx

        unset chans($chan)
        unset idx($chan)

        return
    }

    proc watch {chan eventspec} {
    }

    proc read {chan count} {

        variable idx
        variable chans

        set len [string length $chans($chan)]
        if {$count > $len} {
            set idx($chan) $len
            return $chans($chan)
        }
        set idx($chan) $count
        return [string range $chans($chan) $idx($chan) ${count}-1]
    }

    proc write {chan data} {
        variable idx
        variable chans

        ## probably should start at idx
        append chans($chan) $data
        #set idx($chan) [string length $chans($chan)]

        return
    }

    proc seek {chan offset {base start}} {
        variable idx
        variable basemap
        variable chans

        set basemap(current) $idx($chan)
        set basemap(end) [string length $chans($chan)]

        set idx($chan) [expr {$basemap($base) + $offset}]
 
        if {$idx($chan) > $basemap(end)} {
            set idx($chan) $basemap(end)
        }

        return [return $idx($chan)]
    }

    namespace ensemble create
    namespace export initialize finalize read write seek watch
}

parray tcl_platform

puts "Tcl patch: [info patch]"

#set chan create 

set fid [chan create {r w} ::vchan]


chan puts $fid "HELLO THERE"
chan seek $fid 0 start
set data [read $fid]
catch {chan close $fid}

#set fid2 [open junkit.txt w+]
#chan puts $fid2 "THIS IS JUNK"
#set data [read $fid2]