How to get the Ctrl-C to interrupt the program running from tcl.

[raj...@gmail.com]

Hi,
I am trying to run a program from tcl. But when I enter Ctrl-C, it
doesn't interrupt the program. When I execute the program diectly,
Ctrl-C interrupts the program. I am using similar to the following
command

exec my_program >@stdout <@stdin

Can someone point me how should I proceed.

Thanks,
Raja

[Bezoar]

If you background the process using exec < program> & the
programs output is automatically redirected to stdout but in
addition the exec command returns the pid of the process. Save
this pid to a global list or variable (depending on how many you
are execing). Set up a signal handler for SIGINT to kill the
pid(s). The Tclx extension will let you set signal handlers and
if you search the web there is another extension specifically for
signals that you can also check out. Here's a code snippet. Modify
for
your setup. You can also adjust output as this script interlaces
parent
output with program output.

#!/bin/sh
# the next line restarts using wish \
exec /opt/usr2/bin/tclsh8.5 "$0" ${1+"$@"}

if { [ catch {package require Tclx } err ] != 0 } {
puts stderr "Unable to find package Tclx ... adjust your
auto_path!";
}
# this is how to use signals in Tclx trap a signal(s)
# and call command the signal is subst into %s befor eval

proc sigInt { signal } {
global pidlist
global forever
puts stderr "I got [pid] got signal $signal and my children are
$pidlist"
foreach pid $pidlist {
catch { kill 15 $pid } ; # process may not exist
puts stderr "....kill -15 $pid!"
}
# dont forget to exit yourself
after cancel [ after info ]
exit 0
}
proc sigchild { signal } {
global pidlist
puts stderr "got signal $signal"
# wait errors if no children
if { [catch { wait -nohang } err ] == 0 } {
foreach { cpid signal exitcode } $err { break; }
puts "Child with pid $cpid Exited with code $exitcode"
set idx [lsearch $pidlist $cpid ]
if { $idx != -1 } {
set pidlist [ lreplace $pidlist $idx $idx ]
puts stderr "Child $cpid was removed"
} else {
puts stderr "Child $cpid was unknown"
}
} else {
# no children blank out pidlist
set pidlist ""
}

}
signal trap { SIGINT} [ list sigInt %S ]
signal trap { SIGCHLD} [ list sigchild %S ]
global pidlist
set pidlist {}
# modify args to taste.
proc myExec { out command args } {
global pidlist
# man page says that you get pid's only if running in background
if { [ catch { eval exec \$command $args >@$out & } err ] != 0 } {
error $err
}
# exe returns list of all pids created only interested in last one
lappend pidlist [lindex $err end ]
}
proc busy { timeout } {
global forever
after $timeout [list busy $timeout ]
incr forever
}
myExec stdout ls -1 | sort | tail -5
myExec stdout sleep 100
busy 2000; # stay busy
while { 1 } {
vwait forever
if { $forever == -1 } {
puts "exiting..."
} else {
puts "busy"
}
}
exit 0

Sample output :

./sigInt.tcl
got signal SIGCHLD
Child with pid 14563 Exited with code 0
Child 14563 was unknown
weather.tcl
whatsupdate.tcl
Widget.tcl
xddts2tm.tcl
zzTop-Legs.mp3
got signal SIGCHLD
Child with pid 14564 Exited with code 0
Child 14564 was unknown
got signal SIGCHLD
Child with pid 14565 Exited with code 0
Child 14565 was removed
I got 14562 got signal SIGINT and my children are 14566
....kill -15 14566!
$

Hope this helps,

Carl