Page maintainer: [Marco Maggi] ---- The [[event]] TK command allows us to declare and generate events that can trigger procedure invocations in the same way as GUI interaction and file events do. TCL doesn't come with an [[event]] command, but we can mimic one with few lines of code. We'll use an array to map event names to registered scripts, so first we need to obtain a unique fully qualified name. namespace eval ::tcl::tmp { variable global_counter 0 proc unique_name {} { variable global_counter set pattern "[namespace current]::%s" set name [format $pattern [incr global_counter]] while { [info exists $name] || [namespace exists $name] || [llength [info commands $name]] } { set name [format $pattern [incr global_counter]] } return $name } } Now we can declare a namespace for our little package, but it's not strictly required. namespace eval event { namespace export \ event_declare event_bind \ event_generate event_forget \ event_detach } We need a procedure to declare a new event: we could declare new events and bind them to script directly, but it's better to split the declaration from the first usage to avoid typos problems. proc event::event_declare { this event } { upvar $this map if { [string length $event] } { set map($event) -1 set map($event:list) {} } else { return -code error -errorcode "LOGIC INVALID_ARGUMENT" \ "null event identifier" } return } We could declare a list of events with a single invocation of [[event_declare]] changing the "prototype" to: proc event::event_declare { this event args } but we save the "args" parameter for a future implementation of event specific properties. Now we can bind events to scripts: proc event::event_bind { this event script {idvar {}} } { upvar $this map if { [string length $idvar] } { upvar $idvar id } if { ! [info exists map($event)] } { return -code error -errorcode "LOGIC INVALID_ARGUMENT" \ [format "unknown event \"%s\"" $event] } set id [incr map($event)] set map($event:$id) $script lappend map($event:list) $id return $id } the scripts are stored the array and a unique identifier is generated so that later we can use it to detach the script. There are two equivalent ways to invoke this procedure: set id [event_bind $this { puts uno }] event_bind $this { puts uno } id the second form uses the optional variable argument, and it's more readable. To generate events: proc event::event_generate { this event } { upvar $this map if { [info exists map($event)] } { foreach id $map($event:list) { after 0 [namespace code \ [list _event_eval $map($event:$id)]] } return } else { return -code error -errorcode "LOGIC INVALID_ARGUMENT" \ [format "unknown event \"%s\"" $event] } } the [[foreach]] loop will queue the scripts in the event loop, in the same order in which they were registered. We may want to remove one or more event declarations and all the associated scripts: proc UTP::event_forget { this event args } { upvar $this map foreach key [array names map $event*] { unset map($key) } foreach event $args { foreach key [array names map $event*] { unset map($key) } } return } we can use the -nocomplain option to [[unset]] if we don't care to invoke this procedure with an unexistent event name. To detach a single script from an event: proc UTP::event_detach { this event id } { upvar $this map if { ! [info exists map($event)] } { return -code error -errorcode "LOGIC INVALID_ARGUMENT" \ [format "unknown event \"%s\"" $event] } if { ! [info exists map($event:$id)] } { return -code error -errorcode "LOGIC INVALID_ARGUMENT" \ [format "unknown script identifier \"%s\" for event \"%s\"" \ $id $event] } unset map($event:$id) set idx [lsearch -sorted $map($event:list) $id] set map($event:list) [lreplace $map($event:list) $idx $idx] return } Here is the simple procedure that evaluates the [[after 0 ...]] scripts. Scripts must be evaluated in the global namespace. proc event::_event_eval { script args } { uplevel \#0 $script } Changing it we can add control to turn on/off script evaluation, although this doesn't seem so useful. More useful is the possibility to preprocess $script with [[subst]] or [[string map]] to allow the substitution of special symbols, like TK does. What's a package without a test suite? Here we go (it's loooong maybe it's better if I remove it): package require Tcl 8.4 package require tcltest 2.2 source ... ;# source the file here namespace eval test { namespace import ::event::event_* variable forever 0 ::tcltest::test event-1.1 \ "\[event_declare\] error: null identifier" { -setup { set this [::UTP::unique_name] } -body { catch {event_declare $this {}} res set res } -result "null event identifier" -cleanup { unset -nocomplain $this this res } } ::tcltest::test event-1.2 \ "\[event_bind\] error: unkwnown identifier" { -setup { set this [::UTP::unique_name] } -body { event_declare $this catch {event_bind $this {}} res set res } -result "unknown event \"\"" -cleanup { unset -nocomplain $this this res } } ::tcltest::test event-1.3 \ "\[event_generate\] error: unkwnown event" { -setup { set this [::UTP::unique_name] } -body { event_declare $this event_bind $this {} catch {event_generate $this } res set res } -result "unknown event \"\"" -cleanup { unset -nocomplain $this this res } } ::tcltest::test event-1.4 \ "\[event_detach\] error: unkwnown event" { -setup { set this [::UTP::unique_name] } -body { event_declare $this event_bind $this {} id catch {event_detach $this $id} res set res } -result "unknown event \"\"" -cleanup { unset -nocomplain $this this res } } ::tcltest::test event-1.5 \ "\[event_detach\] error: unkwnown id" { -setup { set this [::UTP::unique_name] } -body { event_declare $this event_bind $this {} id catch {event_detach $this dummy} res set res } -result "unknown script identifier \"dummy\" for event \"\"" -cleanup { unset -nocomplain $this this res } } ::tcltest::test event-2.1 \ "registers and generates events" { -setup { set this [::UTP::unique_name] set uno 0 } -body { event_declare $this event_declare $this event_bind $this [namespace code { incr uno }] event_bind $this [namespace code { set forever 1 }] event_generate $this event_generate $this event_generate $this event_generate $this vwait [namespace current]::forever set uno } -result 3 -cleanup { unset -nocomplain $this this uno } } ::tcltest::test event-2.2 \ "registers and generates events, then forgets" { -setup { set this [::UTP::unique_name] set uno 0 } -body { event_declare $this event_declare $this event_bind $this [namespace code { incr uno }] event_bind $this [namespace code { set forever 1 }] event_generate $this event_generate $this event_generate $this event_generate $this vwait [namespace current]::forever event_forget $this catch {event_generate $this } res set res } -result "unknown event \"\"" -cleanup { unset -nocomplain $this this uno res } } ::tcltest::test event-2.3 \ "registers and generates events, then forgets" { -setup { set this [::UTP::unique_name] set uno 0 } -body { event_declare $this event_declare $this event_bind $this [namespace code { incr uno }] event_bind $this [namespace code { incr uno }] id event_bind $this [namespace code { set forever 1 }] event_generate $this event_generate $this event_generate $this event_generate $this vwait [namespace current]::forever event_detach $this $id event_generate $this event_generate $this set uno 0 vwait [namespace current]::forever set uno } -result 1 -cleanup { unset -nocomplain $this this uno res id } } ::tcltest::cleanupTests } namespace delete ::test That's it. ---- COMMENTS ---- This is a nice start. There are some interesting pros and cons of this compared with Tk bindings. On the plus side, it's much nicer to be able to independently bind multiple scripts to the same event as done here, compared with the hack in Tk that treats scripts beginning with '''+''' as scripts to be appended instead of replaced. However, because of that difference, this scheme does not offer any way to remove a binding without removing an entire event, and *all* of its bindings. The big thing that Tk's bindings have over this scheme, though, is the layer of indirection through bind tags that give Tk bindings so much power and flexibility. As you hint, there's no reason this start could not be expanded in ways to more closely match Tk, where it makes sense to do so. ---- Marco Maggi (27 Jan 2003) The TK scheme is good for GUI: the ability to [[break]] out of the binding scripts evaluation sequence is required; it's a specialised version of the "Observer" design pattern in which the "Subject" of the observation is the TK widget and the "Observers" are all the chunks of code that require to be notified of the event. In the TK scheme an Observer can influence the Subject behaviour and so the other Observers. In the "event" package I don't think this is required. About tags: again they are good for GUI, because there's a well known hierarchy of Subjects to which we append a tag. But we can see it as if the TK widgets code is invoking the [[event generate]] command each time the user clicks or "key-downs" etc. In the "event" package the role of the tag is played by the event map array: nothing prevents us from building a set of event maps and link them in a graph, with an event script that triggers events in other maps. This is dangerous (infinite loops, etc.) and confused: but just because in a normal script there's no "well known" hierarchy of Subjects. The ability to "detach" an Observer from a Subject is missing. It's not difficult to add it: just use an array element for each registered script, with a trace on each element. This requires generating a unique script identifier that's returned by [[event_bind]] to the Observer code, and can be later used to detach the script. I want to think over this, because I like the extreme simplicity of the code as it is now and I don't want to mess it up. ---- Marco Maggi (27 Jan 2003) Well, I've added the [[event_detach]] procedure to detach a script from an event. I've added the ability to generate a unique map-specific identifier for each registered script (a lot of words that means: a counter), so now I can evaluate all the scripts in the same order as they are registered. Now the package no longer uses variable traces: they were good before because the code was small, but now with an element in the array for each registered script, it's useless to keep them. ---- MM (28 Jan 2003) Corrected a dumb error in the [[event_generate]] loop. ---- MM (28 Jan 2003) I see bit of interest in allowing a mnemonic name to be associated to the event map, or better wrap the [[event_*]] commands so that the array disappears from the procedure invocation: set this [::tcl::tmp::unique_name] interp alias {} apples_generate {} event_generate $this # etc With TK the "event map" is implicit in each invocation of [[bind]], [[event]] and [[bindtags]]. ---- MM (28 Jan 2003) Still not convinced about binding tags. When creating a Subject it is possible to hand to it more than one event map: it can store them in a list and then? Let's investigate this with the following UNTESTED code: proc event::subject_declare { this subject args } { upvar $this tagmap set tagmap($subject) $args } here "this" is not the event map but the "tag map" a fully qualified variable name that we use as array to store the associations between a Subject identifier ("subject") and the list of event maps. "args" is the list of event maps (fully qualified array names) to be associated with the Subject. We don't care here about the possibility to associate a mnemonic name to the event map. Now, when the Subject needs to signal an event: proc event::tag_generate { this subject event } { upvar $this tagmap if { ! [info exists tagmap($subject)] } { return -code error -errorcode "LOGIC INVALID_ARGUMENT" \ [format "unknown subject \"%s\"" $subject] } foreach map $tagmap($subject) { catch {event_generate $map $event} } return } here we trigger the event in all the event maps; we [[catch]] because some map may not include the requested event. To mess with the tag list: proc event::tag_bindtags { this subject {lst {}} } { upvar $this tagmap if { ! [info exists tagmap($subject) } { return -code error -errorcode "LOGIC INVALID_ARGUMENT" \ [format "unknown subject \"%s\"" $subject] } if { [llength $lst] } { set tagmap($subject) $lst return } else { return $tagmap($subject) } } The first arguments to the [[tag_*]] procedures are always "this" and "subject", so it's possible to [[interp alias]] them. I cannot find an example for which this is useful. The Observer pattern IS good; but with tags? [Brian Theado] (29 Jan 2003) - A good example of where [bindtags] is useful in Tk is described in the c.l.t article at [http://groups.google.com/groups?hl=en&lr=&ie=UTF-8&oe=UTF-8&selm=f%258B9.1468%24nr.667881641%40newssvr12.news.prodigy.com] by Bryan Oakley. He describes how easy it would be to implement vi's insert vs. command mode in Tk's text widget using [bindtags]. An example outside of Tk would be if you were to implement the TCP protocol. A bindtag would be defined for each TCP state (represented by bubbles in the state transition diagram at http://www4.informatik.uni-erlangen.de/Projects/JX/Misc/Projects/TCP/tcpstate.gif). Each tag would get the appropriate bindings for each of the events (i.e. recv FIN, recv SYN, recv ACK, etc.). Changing state would simply be a matter of swapping bindtags. Then if you also want to trace the events for debugging purposes, you can define another bindtag that logs the events. Entering and leaving debug mode is as simple as inserting and removing this bindtag. ---- MM (28 Jan 2003) To [[after 0]] or not to [[after 0]]? It's more general if I let the user choose if he want to queue scripts in the event loop or not. But: I like the event loop a lot. If you want to remove [[after 0]], just change the [[foreach]] loop in [[event_generate]] like this: foreach id $map($event:list) { _event_eval $map($event:$id) } and [[_event_eval]] like this: catch {uplevel \#0 $script} we have to catch all the errors here: let the script take care of itself. ---- ulis, 2003-02-16: very nice idea and implementation.