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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
namespace eval threads {
variable threads [list main [thread::id]]
variable log [logger::init tclircc::threads]
variable t_ns_script {
namespace eval ::t {
variable ns
variable self
proc update {} {
variable ns
thread::send -head [set ns(main)] threads::update
}
proc ns {name} {
variable ns
set ns($name)
}
proc debug {} {
variable log
parray t::ns
}
proc util_pctsub {script} {
set new_script {}
set idx 0
while {[set subst_start [string first "%" $script $idx]] != -1} {
append new_script [string range $script $idx $subst_start-1]
if {[string index $script $subst_start+1] == "%"} {
append new_script %
set idx [expr {$subst_start + 2}]
continue
}
regexp -start [expr {$subst_start + 1}] -indices {[^A-Za-z0-9_:]} $script match
if {[llength $match]} {
lassign $match subst_end
set subst_end $subst_end-1
} else {
set subst_end [string length $script]
}
upvar [string range $script $subst_start+1 $subst_end] subst_data
append new_script $subst_data
set idx [expr $subst_end + 1]
}
append new_script [string range $script $idx end]
return $new_script
}
proc exec {name script {followup {}}} {
variable ns
variable self
set script [uplevel [list ::t::util_pctsub $script]]
set followup [uplevel [list ::t::util_pctsub $followup]]
if [string length $followup] {
set realscript {
set result [eval %script]
set script [concat [list set result $result] ";" %followup]
thread::send -async [t::ns %self] $script
}
regsub %self $realscript [list $self] realscript
regsub %followup $realscript [list $followup] realscript
regsub %script $realscript [list $script] script
}
thread::send -async [set ns($name)] $script
}
}
}
eval $t_ns_script
set ::t::self "main"
proc manage {tid name} {
variable threads
variable log
variable t_ns_script
dict set threads $name $tid
${log}::debug "managing thread $tid as \"$name\""
thread::send -head $tid [concat $t_ns_script ";" [list set ::t::self $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 {; }
}
append payload {
if {"on_threads_update" in [info procs on_threads_update]} \
on_threads_update
}
thread::send -head $tid $payload
}
::update
}
}