Tcl Source Code

Artifact 30b8c835ad6ad58a1546e7b6b51584d50bc60e1c6cc3564475d806090e097d2f:

Attachment "refchan-wish-test.tcl" to ticket [de232b49f2] added by apnadkarni 2024-03-31 16:00:25.

---

pack [text .t]
update ;# Show the window

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
}]