# zevents --
 #
 #       Package for handling events
 #
 
 namespace eval zevents {}
 
 # zevents::settags --
 #
 #       Sets the tags (names) that should be executed when this tag (name)
 #       is to be executed.
 #
 # Arguments:
 #       collection      Name of the collection which the event is in
 #       name            The name of the event to call
 #       tags            A list of tags (names) to be called
 #
 # Results:
 #       None
 
 proc zevents::settags {collection name taglist} {
    variable syncTags
    set fn ${collection}::::${name}
    set syncTags($fn) $taglist
    updatedEvent $fn
 }
 
 # zevents::gettags --
 #
 #       Gets the tags (names) that should be executed when this tag (name)
 #       is to be executed.
 #
 # Arguments:
 #       collection      Name of the collection which the event is in
 #       name            The name of the event to call
 #
 # Results:
 #       A list of tags (names) to be called
 #
 # Side Effects:
 #       None
 #
 proc zevents::gettags {collection name} {
    variable syncTags
    set fn ${collection}::::${name}
    recreateEvent $name $fn
    return $syncTags($fn)
 }
 
 # zevents::bind --
 #
 #       Binds a command to a certain event. The command will get executed
 #       once an event is called.
 #
 #       NOTE: It only allows binding a command once.
 #       NOTE: There is no reliable ordering of commands with same priority
 #
 # Arguments:
 #       collection      Name of the collection which the event is in
 #       name            The name of the event to call
 #       priority        Priority at which to register the command
 #       command         A command to be executed (lists of arguments allowed)
 #
 # Results:
 #       None
 #
 # Side Effects:
 #       None
 #
 proc zevents::bind {collection name priority command} {
    variable syncCallback
    set fn ${collection}::::${name}
    lappend syncCallback($fn) [list $priority $command]
    updatedEvent $fn
 }
 
 # zevents::unbind --
 #
 #       Unbinds a command to a certain event. The command will no longer get
 #       executed once an event is called.
 #
 # Arguments:
 #       collection      Name of the collection which the event is in
 #       name            The name of the event to call
 #       command         A command to be removed from being executed
 #
 # Results:
 #       None
 #
 # Side Effects:
 #       None
 #
 proc zevents::unbind {collection name command} {
    variable syncCallback
    set fn ${collection}::::${name}
    # if we haven't created any bindings for this event, then just leave
    if {![info exists syncCallback($fn)]} {
        return
    }
 
    # make a copy of the list only with other commands
    set oldlist $syncCallback($fn); set newlist [list]
    foreach e $oldlist {
        if {![string equal [lindex $e 1] $command]} {
            lappend newlist $e
        }
    }
 
    # this prevents errors from dropping an entire list
    set syncCallback($fn) $newlist
    updatedEvent $fn
    return ""
 }
 
 # zevents::init --
 #
 #       Initialize an event - clean up event lists.
 #
 # Arguments:
 #       collection      Name of the collection which the event is in
 #       name            The name of the event to call
 #
 # Results:
 #       None
 #
 # Side Effects:
 #       None
 #
 
 proc zevents::init {collection name} {
    variable syncCallback
    set fn ${collection}::::${name}
    set syncCallback($fn) [list]
    updatedEvent $fn
    return ""
 }
 
 # zevents::call --
 #
 #       Call an event and pass the arguments to it
 #
 # Arguments:
 #       collection      Name of the collection which the event is in
 #       name            The name of the event to call
 #       args            A list of all arguments appended to the listeners
 #
 # Results:
 #       None
 #
 # Side Effects:
 #       One or more background errors may be thrown
 #
 proc zevents::call {collection name args} {
    zevents::call0 $collection $name $args
 }
 
 # same as above, but using one argument as a list of arguments (varargs)
 proc zevents::call0 {collection name ar} {
    variable syncBody
    variable syncTags
    set fn ${collection}::::${name}
 
    # optionally update the sync body
    recreateEvent $name $fn
 
    # eval the most recent syncBody in the current interpreter
    # (not using [eval] since it would not bytecompile the code)
 
    foreach tag $syncTags($fn) {
        set fn ${collection}::::${tag}
 
        recreateEvent $tag $fn
        interp eval {} $syncBody($fn)
    }
 }
 
 #
 # internal functions
 # 
 
 # sets that an event definition has been updated and needs to be recreated ASAP
 proc zevents::updatedEvent {fn} {
    variable syncEvent
 
    # unset that the event has been synchronized
    if {[info exists syncEvent($fn)]} {
        unset syncEvent($fn)
    }
 }
 
 # recreate event internal storage
 proc zevents::recreateEvent {name fn} {
    variable syncEvent
    variable syncTags
    variable syncCallback
    variable syncBody
    
    # only sync if it hasn't been synchronized
    if {[info exists syncEvent($fn)]} {
        return
    }
 
    if {![info exists syncTags($fn)]} {
        set syncTags($fn) [list $name]
    }
 
    if {![info exists syncCallback($fn)]} {
        set syncCallback($fn) [list]
    }
 
    set syncCallback($fn) [lsort -index 0 -integer -decreasing \
        [lsort -unique -index 1 $syncCallback($fn)]]
 
    set b ""
 
    # create a static body to call on each invocation
    foreach cmd $syncCallback($fn) {
        set cmd [lindex $cmd 1]
        set body ""
        append body "set c \[catch \[list uplevel #0 \[concat [list $cmd] \$ar\]\] rc\]" \n
        append body "switch -- \$c \{" \n
        # 0 - ok; 4 - continue -- continue executing
 
        # 2 - return; 3 - break -- 
        append body "    2 - 3 \{" \n
        append body "        return \"\"" \n
        append body "    \}" \n
 
        # 1 - error - throw an error using bgerror in a catch; try to resume executing the bindings
        append body "    1 \{" \n
        append body "        set ei \$::errorInfo" \n
        # if we can't call [bgerror], at least print out the errors to stderr
        append body "        if \{\[catch \{bgerror \$rc\}\]\} \{ puts stderr \$ei \}" \n
        append body "    \}" \n
        append body "\}" \n
 
        append b $body
    }
 
    set syncBody($fn) $b
    set syncEvent($fn) 1
 }
 
 package provide zevents 1.0