add gtkwave_server.tcl hook for gtkwave to listen to a tcp port

This commit is contained in:
Stefan Schippers 2020-09-24 02:28:00 +02:00
parent da74e5ad36
commit 7a0fa15238
1 changed files with 27 additions and 0 deletions

27
src/gtkwave_server.tcl Normal file
View File

@ -0,0 +1,27 @@
proc gtkwave_getdata {sock} {
global gtkwave_server_getdata
if {[eof $sock] || [catch {gets $sock gtkwave_server_getdata(line,$sock)}]} {
close $sock
puts "Close $gtkwave_server_getdata(addr,$sock)"
unset gtkwave_server_getdata(addr,$sock)
unset gtkwave_server_getdata(line,$sock)
unset gtkwave_server_getdata(res,$sock)
} else {
puts "tcp--> $gtkwave_server_getdata(line,$sock)"
# gtkwave command must be executed at global scope...
uplevel #0 [list catch $gtkwave_server_getdata(line,$sock) gtkwave_server_getdata(res,$sock)]
puts $sock "$gtkwave_server_getdata(res,$sock)"
}
}
proc gtkwave_server {sock addr port} {
global gtkwave_server_getdata
puts "Accept $sock from $addr port $port"
fconfigure $sock -buffering line
set gtkwave_server_getdata(addr,$sock) [list $addr $port]
fileevent $sock readable [list gtkwave_getdata $sock]
}
set gtkwave_port 2022
socket -server gtkwave_server $gtkwave_port