Tcl Source Code

Artifact 6df6a7c51076b6860ced2a4f36309bdc9cab830794b51b6f9773dabd52e67388:

Attachment "refchan-async-test.tcl" to ticket [de232b49f2] added by apnadkarni 2024-03-31 15:59:35.

---

set ::numBytesWritten 0

namespace eval refchan {
    namespace ensemble create
    namespace export *


    proc finalize {chan args} {
        namespace delete c_$chan
    }

    proc initialize {chan args} {
        namespace eval c_$chan {}
        namespace upvar c_$chan watching watching
        set watching {}
        list finalize initialize seek watch write
    }

    proc watch {chan args} {
        namespace upvar c_$chan watching watching
        foreach arg $args {
            switch $arg {
                write {
                    if {$arg ni $watching} {
                        lappend watching $arg
                    }
                    after idle after 0 chan postevent $chan $arg
                }
            }
        }
    }

    proc write {chan args} {
        incr ::counter
        after idle after 0 chan postevent $chan write
        return 1
    }
}

set f [chan create w [namespace which refchan]]
chan configure $f -blocking 0
chan event $f writable [namespace code {
    puts $f X
}]

proc every1 {} {
    after idle after 1000 every1
    puts [clock seconds]
}

every1

vwait forever