#//# # A library for registering, managing and executing events and event handlers. # # An event is associated always with a tag. Therefore a binding is between # a Tcl procedure and an tag/event combination. # # The invocation can be synchronous or asynchronous. This is determined on # a binding per binding basis at the moment of registration. # # Event handlers are only valid until system shutdown. For an event handler # to have persistent nature, it must be registered every time on boot. #//# namespace eval event { namespace export generate bind unbind variable Handlers ; # Stores the list of handlers associated with an event. # Emit an event and execute associated handlers # # @param tag An alphanumeric that uniquely identifies the tag. As a convention it should be all upper-case. # @param name An alphanumeric that uniquely identifies the event's name. As a convention it should be all upper-case. # @param params Optional list of arguments that accompany the event and provide extra information. # @error proc generate {tag name {params {}}} { variable Handlers set id "$tag $name" if {[info exists Handlers($id)]} { foreach h $Handlers($id) { lassign $h hdlr async if {[catch { if {$async} { after idle $hdlr {*}$params } else { $hdlr {*}$params } } result options]} { log::Error -stack $options "Error while executing handler \"$h\" for $id" $result } } } } # Register a handler to be executed when a certain event occurs. # # @param tag An alphanumeric that uniquely identifies the tag. As a convention it should be all upper-case. # @param name An alphanumeric that uniquely identifies the event's name. As a convention it should be all upper-case. # @param handler Some code to be executed, typically the full path to a procedure. # @return The binding id that can be used to unbind this binding later. # @error proc bind {tag name handler {param {-async}}} { variable Handlers set id "$tag $name" if {$param eq "-async"} { set async 1 } else { set async 0 } lappend Handlers($id) [list $handler $async] return [list $id $Handlers($id)] } # Unregister a previously registered handler. # # @param id The binding id as returned by 'bind'. # @return Nothing. # @error proc unbind {bindid} { variable Handlers lassign $bindid id hid if {! [info exists Handlers($id)]} { error "No bindings for '$id'" } if {$hid ni $Handlers($id)} { error "Could not find binding '$hid' for '$id'" } lremoveitem Handlers($id) $hid } namespace ensemble create } ;# End of Namespace