Posted to tcl by dbohdan at Thu Apr 09 16:52:02 GMT 2015view raw

  1. namespace eval ::wordchan {
  2. namespace export *
  3. namespace ensemble create
  4.  
  5. variable storage {}
  6.  
  7. proc initialize {channelId mode} {
  8. variable storage
  9. dict set storage $channelId data {}
  10. dict set storage $channelId ticktock 0
  11. return [list initialize finalize watch read write]
  12. }
  13. proc finalize {channelId} {
  14. variable storage
  15. dict unset storage $channelId
  16. }
  17. proc watch {channelId eventspec} {}
  18. proc read {channelId count} {
  19. # We ignore $count.
  20. variable storage
  21.  
  22. if {[TickTock $channelId] == 0} {
  23. set chanData [dict get $storage $channelId data]
  24. dict set storage $channelId data [lrange $chanData 1 end]
  25. return [lindex $chanData 0]
  26. } else {
  27. error EAGAIN
  28. }
  29. }
  30. proc write {channelId data} {
  31. variable storage
  32. set chanData [dict get $storage $channelId data]
  33. dict set storage $channelId data [concat $chanData $data]
  34. return [string length $data]
  35. }
  36.  
  37. proc TickTock {channelId} {
  38. variable storage
  39. set ticktock [dict get $storage $channelId ticktock]
  40. dict set storage $channelId ticktock [expr {!$ticktock}]
  41. return $ticktock
  42. }
  43. }
  44.  
  45. set ch [chan create {read write} ::wordchan]
  46. chan configure $ch -buffering none
  47. puts -nonewline $ch [list a]
  48. puts -nonewline $ch [list b c]
  49. puts --[read $ch]-- ;# prints "a"
  50. puts --[read $ch]-- ;# prints "b"
  51.