
# Copyright 2016,2020 Ian Jackson
# SPDX-License-Identifier: GPL-3.0-or-later
# There is NO WARRANTY.

package require Tclx

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 }

}
