chiark / gitweb /
reorganise debug etc.
[chiark-tcl-applet.git] / subproc.tcl
1
2 package require Tclx
3
4 namespace eval subproc {
5
6 #----- general purpose subprocess handling -----
7 #
8 # One useful procedure:
9 #    subprocess::fork ONDEATH INCHILD
10 # forks, evaluates INCHILD in the calling context but in the child
11 # and when the child dies evaluates [concat [list ONDEATH] W2 W3]
12 # where W2 and W3 are the 2nd and 3rd elements of the list returned
13 # by tclx's wait.
14 #
15 # INCHILD should not return; if it does or if it gets an error, the
16 # result is that the child gets a SIGKILL.
17
18 variable children
19
20 proc fork {ondeath inchild} {
21     variable children
22     global errorCode errorInfo
23     foreach f {stdout stderr} {
24         if {[catch { flush $f } emsg]} {
25             catch { bgerror $emsg }
26         }
27     }
28     set pid [::fork]
29     if {!$pid} { 
30         if {[catch { 
31             uplevel 1 $inchild
32         } emsg]} {
33             puts stderr "CHILD ERROR $emsg\n$errorCode\n$errorInfo\n"
34         }
35         kill KILL [id process]
36     }
37     set children($pid) $ondeath
38     return $pid
39 }
40
41 proc chld-handler {} {
42     variable children
43     while 1 {
44         if {[catch { set got [wait -nohang] }]} break
45         if {![llength $got]} break
46         manyset $got pid how how2
47         if {[info exists children($pid)]} {
48             set l $children($pid)
49             unset children($pid)
50             if {[catch {
51                 uplevel #0 [concat [list $l] $how $how2]
52             } emsg]} {
53                 catch { bgerror $emsg }
54             }
55         }
56     }   
57 }
58
59 signal -restart trap CHLD { after idle subproc::chld-handler }
60
61 }