File: subproc.tcl

package info (click to toggle)
chiark-tcl-applet 1.0-2
  • links: PTS
  • area: main
  • in suites: bullseye, sid
  • size: 144 kB
  • sloc: tcl: 860; makefile: 32
file content (65 lines) | stat: -rw-r--r-- 1,481 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

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

}