1 # vim: foldmarker=<<<,>>>
8 method register_handler
{type handler
}
9 method deregister_handler
{type handler
}
10 method handlers_available
{type
}
11 method dump_handlers
{}
15 variable allow_unregistered
1
17 method invoke_handlers
{type args
}
19 method handlers_debug
{lvl msg
}
25 variable processing_handlers
0
26 variable processing_stack
{}
28 method throw_hissy_handler
{handler arglist
}
33 body tlc
::Handlers::constructor {} { #<<<1
39 body tlc
::Handlers::destructor {} { #<<<1
40 foreach {key val
} [array names afterids
] {
42 array unset afterids
$key
47 body tlc
::Handlers::register_handler {type handler
} { #<<<1
49 ![info exists handlers
($type)]
50 ||
[lsearch $handlers($type) $handler] == -1
52 handlers_debug trivia
"Registering handler ($type) ($handler)"
53 lappend handlers
($type) $handler
58 body tlc
::Handlers::deregister_handler {type handler
} { #<<<1
59 if {![info exists handlers
($type)]} return
60 set idx
[lsearch $handlers($type) $handler]
61 # log trivia "$this Deregistering handler ($type) ($handler)"
62 set handlers
($type) [lreplace $handlers($type) $idx $idx]
66 body tlc
::Handlers::invoke_handlers {type args
} { #<<<1
67 if {![info exists handlers
($type)]} {
68 if {$allow_unregistered} {
71 error "$this: No handlers found for type: ($type)"
76 if {$processing_handlers} {
77 handlers_debug debug
"detected reentrant handling for ($type) stack: ($processing_stack)\n[tlc::stackdump]"
79 incr processing_handlers
1
80 lappend processing_stack
$type
83 handlers_debug debug
"entering processing of $type"
84 foreach handler
$handlers($type) {
85 # Check if a previous handler removed this one <<<
87 ![info exists handlers
($type)]
88 ||
[lsearch $handlers($type) $handler] == -1
90 handlers_debug debug
"Skipping handler ($handler) which has just been removed (presumably by a previous handler in the list"
93 # Check if a previous handler removed this one >>>
95 [after 3000 [code
$this throw_hissy_handler
$handler $args]]
96 set last_handler
$handler
97 set afterids
(invoke_handler_
$handler) $pending_afterid
98 handlers_debug debug
"Invoking callback for ($type): ($handler)"
99 lappend results
[uplevel #0 $handler $args]
100 after cancel
$pending_afterid
101 array unset afterids invoke_handler_
$handler
104 incr processing_handlers
-1
105 set processing_stack
[lrange $processing_stack 0 end-1
]
106 handlers_debug debug
"leaving processing of $type"
110 incr processing_handlers
-1
111 set processing_stack
[lrange $processing_stack 0 end-1
]
112 handlers_debug
error "\nError processing handlers for ($type), in handler ($last_handler): $errmsg\n$::errorInfo"
113 error "$errmsg while processing handler for ($type): ($last_handler)" $::errorInfo $::errorCode
119 body tlc
::Handlers::handlers_available {type
} { #<<<1
120 return [expr {[info exists handlers
($type)] && [llength $handlers($type)] >= 1}]
124 body tlc
::Handlers::dump_handlers {} { #<<<1
125 return [array get handlers
]
129 body tlc
::Handlers::throw_hissy_handler {handler arglist
} { #<<<1
130 puts stderr
"\n\nHandlers::throw_hissy: obj: ($this) taking way too long to complete invoke_handlers for handler: ($handler)\n\targs: ($arglist)\n\n"
134 body tlc
::Handlers::handlers_debug {lvl msg
} { #<<<1
135 # Override in derived class
139 puts stderr
"tlc::Handlers::handlers_debug($this): $lvl $msg"
145 body tlc
::Handlers::_debug {msg
} { #<<<1
146 return [handlers_debug debug
$msg]