Updated 2016-07-10 12:29:16 by dkf

Marco Maggi - This package provides the ability to handle one-to-many relations. This code deals with two types of entities: the subject and the observer. The subject is some data type instance in the script whose state changes must be notified to a set of observers.

The subject can be a variable or class instance or widget, the observer any kind of module.

An overview of the procedures follows.

[observer_attach subject observer] - Attaches an observer to a subject. "subject" is a string representing the subject, "observer" is a script to be evaluated to notify the observer of state changes.

[observer_detach subject observer] - Detaches an observer from a subject. The arguments must be the same as the one used in the invocation of [observer_attach].

[observer_notify subject ?arg ...?] - Notifies all the registered observers that the state of "subject" has changed. All the registered scripts are evaluated in the global namespace, with no arguments appended. Errors in script evaluation are ignored.

Optional "arg"s can be appended to the invocation of [observer_notify], but they are ignored. This is to allow the procedure to be used as command in variable traces.

Here is the basic usage of the observer package. The state is represented by a static variable (a global or namespace variable) that can be an array.

Some module in the script controls the members of the array using them to store some state. Other modules are interested in changes to the state, so a controlling module binds the actors.
 proc controller_setup { ... } {
    set statevar ::tmp::zero

    # Initialises the subject module handing the state
    # variable name to it.
    initialise_subject $statevar ...

    # Initalises an observer.
    initialise_observer ...

    # Bind the observer and the subject.    
    observer_attach $statevar [list observer_command $statevar]


We see that a static variable name is used as subject identifier. The observer module is notified of state changes with a call to [observer_command]; the observer module knows nothing about the subject module. The first argument to the observer script is the static variable name.

When the subject needs to notify the observers of a state change:
     observer_notify ::tmp::zero

It is possible to bind the notification action to a variable trace:
     trace add variable ::tmp::zero write \
            [namespace eval :: observer_notify ::tmp::zero]

There's choice in selecting which one between the subject and the observer will trigger the notification, that is: which one will invoke [observer_notify].

If the subject does it, small changes to the state will trigger the invocation of all the observers scripts; observers not interested in changes will be notified. If an observer does it, all the observers will be notified, not only the requesting one.

These problems can be solved by splitting the observed state in different variables and creating a one-to-many relation for each of them.

The notification operation provides no direct way to inform the observers about which state change has occurred. In the case of the state array presented in the example, the subject can do this by setting an element in the state itself.
    upvar ::tmp::zero state
    set state(CHANGE) updated_selection
    observer_notify ::tmp::zero

It is not safe to simply destroy a relation without notifying all the observers. Avoiding the notification to the subject could be safe, though.

The best method is to let the observers detach themselves. For example when the subject is destroyed, it could store an appropriate value in the state variable and then invoke [observer_notify]:
    upvar ::tmp::zero state
    set state(CHANGE) destroy
    observer_notify ::tmp::zero

and the observer code could be:
 proc observer_command { subject } {
    upvar $subject state

    switch $state(CHANGE) {
        destroy   {
            observer_detach $subject [list observer_command $subject]

Now the code.
 namespace eval observer {
     namespace export observer_*
     variable observer_map

 proc observer::observer_attach { subject observer } {
    variable        observer_map

    lappend observer_map($subject) $observer

 proc observer::observer_detach { subject observer } {
    variable        observer_map

    if { ! [info exists observer_map($subject)] } {
        return -code error [format "unknown subject \"%s\"" $subject]
    upvar        0 observer_map($subject) lst

    set idx [lsearch  $lst $observer]
    if { $idx < 0 } {
        return -code error [format "unknown observer \"%s\"" $observer]

    set lst [lreplace $lst $idx $idx]
    if { [llength $lst] == 0 } {
        unset observer_map($subject)

 proc observer::observer_notify { subject args } {
    variable        observer_map

    foreach script $observer_map($subject) {
        catch {namespace eval :: $script}