subproc

diff --git a/applet.tcl b/applet.tcl
index 2bb9ac4452ec172e04845e57c6f8d59ad7b6971c..8a0193f47e3e518dff545bf7b9274857fb835ce1 100644 (file)
--- a/applet.tcl
+++ b/applet.tcl
@@ -218,43 +218,3 @@ proc setupinnerwindow {w} {
 proc setimage {image} {
     .i configure -image $image
 }
-
-proc fork-then {ondeath inchild} {
-    global children 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 {} {
-    global 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 chld-handler }

diff --git a/example b/example
index 8c5e0c921bda0c32f673221aafa18f64aa1de37b..b719c50409dae9a48ce7b4e60c42ab5da791c125 100755 (executable)
--- a/example
+++ b/example
@@ -2,6 +2,7 @@
 # -*- Tcl -*-
 
 source applet.tcl
+source subproc.tcl
 
 #----- menu -----
 
@@ -68,7 +69,7 @@ proc run-child {} {
     }
 
     set status none
-    set status [fork-then child-died {
+    set status [subproc::fork child-died {
        execl xacpi-simple [list -into [winfo id .i.i.b.c]]
     }]
     puts "FORKED $status"

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 }
+
+}