This is a general events mechanism. It uses metaprogramming to speed things up. ---- **Simple example** zevents::bind Something event1 10 {puts EVENT1-before} zevents::bind Something event1 -10 {puts EVENT1-final} zevents::bind Something event1 0 {puts EVENT1-after} zevents::bind Something event2 0 {puts EVENT2} zevents::bind Something puts 0 {puts} zevents::call Something event1 zevents::call Something event2 zevents::call Something puts "Some string" zevents::unbind Something event1 {puts EVENT1-after} zevents::call Something event1 Result: EVENT1-before EVENT1-after EVENT1-final EVENT2 Some string EVENT1-before EVENT1-final ---- **The code** ====== # 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 ====== ---- <> [NEM] ''7 June 2006'': Could you give some explanation of what problem this package solves, and how it differs from Tcl's built-in event loop? Also, in the ''call'' procedure, the call to ''call0'' is redundant - all it does is essentially change the name of "args" to "ar". This variable is then not even used in the body. I also imagine that ''[interp] eval'' and ''[eval]'' behave the same in terms of not byte-compiling the body. [AM] (7 june 2006) The ''event'' command is not available in pure Tcl, only in Tk. As Tk events are associated with widgets, an application that wants to use "events" as a means to drive a simulation can not use that mechanism, but the above package is a solution. You may also look at today's chatroom logs - I initiated the discussion. [NEM]: OK, although the above is not really a replacement for [event], but nearer to something like [trace] -- an implementation of [the observer design pattern]. <> Event Loop