Page maintainer: Marco Maggi Email: mailname:marcomaggi mailhost:tiscalinet.it First Date: 26 Jan 2003 ---- 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 variable traces to trigger the evaluation of scripts, so first we need to obtain a unique fully qualified name: we declare an array and use it as a map that associates event names to variable traces. 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 } 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 } 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 args } { upvar $this map if { ! [info exists map($event)] } { return -code error -errorcode "LOGIC INVALID_ARGUMENT" \ [format "unknown event \"%s\"" $event] } foreach script [concat [list $script] $args] { if { [string length $script] } { set name [set this]($event) trace add variable $name write \ [list after 0 [namespace code \ [list _event_eval $script ]]] } } return } we see that scripts are queued in the event loop with the [[after]] command. To generate events: proc event::event_generate { this event } { upvar $this map set name ${this}($event) if { [info exists $name] } { set $name 1 } else { return -code error -errorcode "LOGIC INVALID_ARGUMENT" \ [format "unknown event \"%s\"" $event] } return } We may want to remove an event declaration and all the associated variable traces: proc UTP::event_forget { this event args } { upvar $this map foreach event [concat [list $event] $args] { unset -nocomplain -- map($event) } return } we don't care if we invoke this with an unexistent event name, this can be changed easily. 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: 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 "registers and generates events" { -setup { set this [::tcl::tmp::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-1.2 "registers, generates, then forgets" { -setup { set this [::tcl::tmp::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::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. ---- MarcoMaggi: 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 if 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.