Artifact
30b8c835ad6ad58a1546e7b6b51584d50bc60e1c6cc3564475d806090e097d2f:
Attachment "refchan-wish-test.tcl" to
ticket [de232b49f2]
added by
apnadkarni
2024-03-31 16:00:25.
0000: 70 61 63 6b 20 5b 74 65 78 74 20 2e 74 5d 0d 0a pack [text .t]..
0010: 75 70 64 61 74 65 20 3b 23 20 53 68 6f 77 20 74 update ;# Show t
0020: 68 65 20 77 69 6e 64 6f 77 0d 0a 0d 0a 73 65 74 he window....set
0030: 20 3a 3a 6e 75 6d 42 79 74 65 73 57 72 69 74 74 ::numBytesWritt
0040: 65 6e 20 30 0d 0a 0d 0a 6e 61 6d 65 73 70 61 63 en 0....namespac
0050: 65 20 65 76 61 6c 20 72 65 66 63 68 61 6e 20 7b e eval refchan {
0060: 0d 0a 20 20 20 20 6e 61 6d 65 73 70 61 63 65 20 .. namespace
0070: 65 6e 73 65 6d 62 6c 65 20 63 72 65 61 74 65 0d ensemble create.
0080: 0a 20 20 20 20 6e 61 6d 65 73 70 61 63 65 20 65 . namespace e
0090: 78 70 6f 72 74 20 2a 0d 0a 0d 0a 0d 0a 20 20 20 xport *......
00a0: 20 70 72 6f 63 20 66 69 6e 61 6c 69 7a 65 20 7b proc finalize {
00b0: 63 68 61 6e 20 61 72 67 73 7d 20 7b 0d 0a 20 20 chan args} {..
00c0: 20 20 20 20 20 20 6e 61 6d 65 73 70 61 63 65 20 namespace
00d0: 64 65 6c 65 74 65 20 63 5f 24 63 68 61 6e 0d 0a delete c_$chan..
00e0: 20 20 20 20 7d 0d 0a 0d 0a 20 20 20 20 70 72 6f }.... pro
00f0: 63 20 69 6e 69 74 69 61 6c 69 7a 65 20 7b 63 68 c initialize {ch
0100: 61 6e 20 61 72 67 73 7d 20 7b 0d 0a 20 20 20 20 an args} {..
0110: 20 20 20 20 6e 61 6d 65 73 70 61 63 65 20 65 76 namespace ev
0120: 61 6c 20 63 5f 24 63 68 61 6e 20 7b 7d 0d 0a 20 al c_$chan {}..
0130: 20 20 20 20 20 20 20 6e 61 6d 65 73 70 61 63 65 namespace
0140: 20 75 70 76 61 72 20 63 5f 24 63 68 61 6e 20 77 upvar c_$chan w
0150: 61 74 63 68 69 6e 67 20 77 61 74 63 68 69 6e 67 atching watching
0160: 0d 0a 20 20 20 20 20 20 20 20 73 65 74 20 77 61 .. set wa
0170: 74 63 68 69 6e 67 20 7b 7d 0d 0a 20 20 20 20 20 tching {}..
0180: 20 20 20 6c 69 73 74 20 66 69 6e 61 6c 69 7a 65 list finalize
0190: 20 69 6e 69 74 69 61 6c 69 7a 65 20 73 65 65 6b initialize seek
01a0: 20 77 61 74 63 68 20 77 72 69 74 65 0d 0a 20 20 watch write..
01b0: 20 20 7d 0d 0a 0d 0a 20 20 20 20 70 72 6f 63 20 }.... proc
01c0: 77 61 74 63 68 20 7b 63 68 61 6e 20 61 72 67 73 watch {chan args
01d0: 7d 20 7b 0d 0a 20 20 20 20 20 20 20 20 6e 61 6d } {.. nam
01e0: 65 73 70 61 63 65 20 75 70 76 61 72 20 63 5f 24 espace upvar c_$
01f0: 63 68 61 6e 20 77 61 74 63 68 69 6e 67 20 77 61 chan watching wa
0200: 74 63 68 69 6e 67 0d 0a 20 20 20 20 20 20 20 20 tching..
0210: 66 6f 72 65 61 63 68 20 61 72 67 20 24 61 72 67 foreach arg $arg
0220: 73 20 7b 0d 0a 20 20 20 20 20 20 20 20 20 20 20 s {..
0230: 20 73 77 69 74 63 68 20 24 61 72 67 20 7b 0d 0a switch $arg {..
0240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0250: 77 72 69 74 65 20 7b 0d 0a 20 20 20 20 20 20 20 write {..
0260: 20 20 20 20 20 20 20 20 20 20 20 20 20 69 66 20 if
0270: 7b 24 61 72 67 20 6e 69 20 24 77 61 74 63 68 69 {$arg ni $watchi
0280: 6e 67 7d 20 7b 0d 0a 20 20 20 20 20 20 20 20 20 ng} {..
0290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c l
02a0: 61 70 70 65 6e 64 20 77 61 74 63 68 69 6e 67 20 append watching
02b0: 24 61 72 67 0d 0a 20 20 20 20 20 20 20 20 20 20 $arg..
02c0: 20 20 20 20 20 20 20 20 20 20 7d 0d 0a 20 20 20 }..
02d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
02e0: 20 61 66 74 65 72 20 69 64 6c 65 20 61 66 74 65 after idle afte
02f0: 72 20 30 20 63 68 61 6e 20 70 6f 73 74 65 76 65 r 0 chan posteve
0300: 6e 74 20 24 63 68 61 6e 20 24 61 72 67 0d 0a 20 nt $chan $arg..
0310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 7d }
0320: 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 7d 0d .. }.
0330: 0a 20 20 20 20 20 20 20 20 7d 0d 0a 20 20 20 20 . }..
0340: 7d 0d 0a 0d 0a 20 20 20 20 70 72 6f 63 20 77 72 }.... proc wr
0350: 69 74 65 20 7b 63 68 61 6e 20 61 72 67 73 7d 20 ite {chan args}
0360: 7b 0d 0a 20 20 20 20 20 20 20 20 69 6e 63 72 20 {.. incr
0370: 3a 3a 63 6f 75 6e 74 65 72 0d 0a 20 20 20 20 20 ::counter..
0380: 20 20 20 61 66 74 65 72 20 69 64 6c 65 20 61 66 after idle af
0390: 74 65 72 20 30 20 63 68 61 6e 20 70 6f 73 74 65 ter 0 chan poste
03a0: 76 65 6e 74 20 24 63 68 61 6e 20 77 72 69 74 65 vent $chan write
03b0: 0d 0a 20 20 20 20 20 20 20 20 72 65 74 75 72 6e .. return
03c0: 20 31 0d 0a 20 20 20 20 7d 0d 0a 7d 0d 0a 0d 0a 1.. }..}....
03d0: 73 65 74 20 66 20 5b 63 68 61 6e 20 63 72 65 61 set f [chan crea
03e0: 74 65 20 77 20 5b 6e 61 6d 65 73 70 61 63 65 20 te w [namespace
03f0: 77 68 69 63 68 20 72 65 66 63 68 61 6e 5d 5d 0d which refchan]].
0400: 0a 63 68 61 6e 20 63 6f 6e 66 69 67 75 72 65 20 .chan configure
0410: 24 66 20 2d 62 6c 6f 63 6b 69 6e 67 20 30 0d 0a $f -blocking 0..
0420: 63 68 61 6e 20 65 76 65 6e 74 20 24 66 20 77 72 chan event $f wr
0430: 69 74 61 62 6c 65 20 5b 6e 61 6d 65 73 70 61 63 itable [namespac
0440: 65 20 63 6f 64 65 20 7b 0d 0a 20 20 20 20 70 75 e code {.. pu
0450: 74 73 20 24 66 20 58 0d 0a 7d 5d 0d 0a 0d 0a 0d ts $f X..}].....
0460: 0a .
