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