Posted to tcl by aspect at Thu Apr 17 05:22:54 GMT 2014view pretty
#!/usr/bin/tclsh package require Tk set input "" ;# what's currently in the text entry set sent "" ;# what has already been sent set rate 1 ;# max number to send per second set outfd stdout ;# this could be [open |...] grid [ttk::labelframe .f -text "Type in here"] -sticky nsew grid [entry .e -textvariable input -validate key] -in .f -sticky nsew grid [label .l -textvariable sent] -in .f -sticky nsew grid [button .b -text Exit -command exit] -sticky ns grid columnconfigure . 0 -weight 1 set normalbg [.b cget -background] fconfigure $outfd -buffering none ;# ensure we can send one char at a time proc every {ms script} { ;# this comes from http://wiki.tcl.tk/every if 1 $script after $ms [list after idle [info level 0]] } proc sendChars {} { global input global sent global outfd if {[string length $input]} { .b configure -background green set c [string index $input 0] set input [string range $input 1 end] append sent $c puts -nonewline $c flush $outfd } else { .b configure -background red } after 100 {.b configure -background $::normalbg} ;# note the different way of referencing a global } every [expr {int(1000.0/$rate)}] {sendChars} if {!$::tcl_interactive} { ;# this is a hack so if you [source] it into a running tclsh/wish, you can keep typing commands vwait forever ;# start the event loop }