subproc

[chiark-tcl-applet.git] / subproc.tcl

diff --git a/subproc.tcl b/subproc.tcl
new file mode 100644 (file)
index 0000000..36d5465
--- /dev/null
+++ b/subproc.tcl
@@ -0,0 +1,59 @@
+
+namespace eval subproc {
+
+#----- general purpose subprocess handling -----
+#
+# One useful procedure:
+#    subprocess::fork ONDEATH INCHILD
+# forks, evaluates INCHILD in the calling context but in the child
+# and when the child dies evaluates [concat [list ONDEATH] W2 W3]
+# where W2 and W3 are the 2nd and 3rd elements of the list returned
+# by tclx's wait.
+#
+# INCHILD should not return; if it does or if it gets an error, the
+# result is that the child gets a SIGKILL.
+
+variable children
+
+proc fork {ondeath inchild} {
+    variable children
+    global errorCode errorInfo
+    foreach f {stdout stderr} {
+       if {[catch { flush $f } emsg]} {
+           catch { bgerror $emsg }
+       }
+    }
+    set pid [::fork]
+    if {!$pid} { 
+       if {[catch { 
+           uplevel 1 $inchild
+       } emsg]} {
+           puts stderr "CHILD ERROR $emsg\n$errorCode\n$errorInfo\n"
+       }
+       kill KILL [id process]
+    }
+    set children($pid) $ondeath
+    return $pid
+}
+
+proc chld-handler {} {
+    variable children
+    while 1 {
+       if {[catch { set got [wait -nohang] }]} break
+       if {![llength $got]} break
+       manyset $got pid how how2
+       if {[info exists children($pid)]} {
+           set l $children($pid)
+           unset children($pid)
+           if {[catch {
+               uplevel #0 [concat [list $l] $how $how2]
+           } emsg]} {
+               catch { bgerror $emsg }
+           }
+       }
+    }  
+}
+
+signal -restart trap CHLD { after idle subproc::chld-handler }
+
+}