fix killing program (e.g. with CTRL-X)

shellbox.tcl

@@ -32,8 +32,8 @@ set timeout -1
 
 regsub -all {\$} {shellbox by Dirk Zimoch
 $Source: /cvs/G/EPICS/App/scripts/shellbox.tcl,v $
-$Revision: 1.10 $
-$Date: 2013/07/11 09:49:48 $} {} version
+$Revision: 1.11 $
+$Date: 2015/04/02 09:42:20 $} {} version
 
 proc usage {} {
     puts "usage: shellbox \[options\] port command args"
@@ -132,7 +132,6 @@ proc getClientlist {} {
 set diedyoung 1
 proc startProgram {} {
     global command spawn_id diedyoung directory
-#    catch {close $spawn_id}
     if {[catch {cd $directory} msg]} {
         forwardOutput "**** $msg (trying later) ****\n"
         while {[catch {cd $directory}]} { after 10000 }
@@ -167,14 +166,16 @@ proc startProgram {} {
 
 proc killProgram {} {
     global command spawn_id
-    forwardOutput "**** killing '$command' (pid [exp_pid])****\n"
-    if [catch {exec kill -s SIGHUP [exp_pid]} msg] {forwardOutput "**** hangup failed: $msg ****\n"}
-    after 1000
-    if [catch {exec kill -s SIGKILL [exp_pid]} msg] {forwardOutput "**** kill failed: $msg ****\n"}
-    after 1000
-    forwardOutput "**** '$command' killed ****\n"
-    wait [exp_pid]
-    expect "*"
+    set pid [exp_pid]
+    forwardOutput "**** killing '$command' (pid $pid)****\n"
+    if [catch {
+        exec kill -s SIGTERM -$pid
+        wait $pid
+        forwardOutput "**** '$command' killed ****\n"
+        after idle startProgram
+    } msg] {
+        forwardOutput "**** killing failed: $msg ****\n"
+    }
 }
 
 set paranoid 0