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
66
namespace eval threads {
variable threads [list main [thread::id]]
variable log [logger::init tclircc::threads]
proc manage {tid name} {
variable threads
variable log
dict set threads $name $tid
${log}::debug "managing thread $tid as \"$name\""
thread::send -head $tid {
namespace eval t {
variable ns
proc update {} {
variable ns
thread::send -head [set ns(main)] threads::update
}
proc ns {name} {
variable ns
set ns($name)
}
}
}
::threads::update
}
proc unmanage {name} {
variable threads
variable log
dict unset threads $name
${log}::debug "unmanaging thread $tid (\"$name\")"
::threads::update
}
proc update {} {
variable threads
dict for {name tid} $threads {
if ![thread::exists $tid] {dict unset $threads $name}
}
dict for {name tid} $threads {
set payload {array unset t::ns; }
dict for {n t} $threads {
append payload {set t::ns(} $n {) } $t {; }
}
thread::send -head $tid $payload
}
::update
}
proc debug {} {
variable log
update
foreach key [array names threads::ns] {
${log}::debug "thread \"$key\" has id [set threads::ns($key)]"
}
}
}
namespace eval t {
variable ns
proc update {} {
variable ns
thread::send -head [set ns(main)] threads::update
}
proc ns {name} {
variable ns
set ns($name)
}
}