Overview | Index by: file name | procedure name | procedure call | annotation
event.tcl (annotations | original source)

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

Overview | Index by: file name | procedure name | procedure call | annotation
File generated 2010-03-13 at 22:28.