Group,

My son Kevin has written class support for implementing callbacks
between classes in a uniform fashion.  I've made a few minor mods
(such as using the Class class I've mentioned before) to them.

They're kinda useful (Kevin is working on a program that does some
graphics (plotting arrays of reals) that uses the original form of
these to replot when the array changes), so I've attached them, along
with the current version of the class Class.

Hopefully, they won't be mangled if they're attachments!

-- 
Steve Wampler <[EMAIL PROTECTED]>
National Solar Observatory
#
# The Class class provides a foundation for other classes by
#    implementing methods that are generally useful.
#
# This file also provides some procedures that are of general
#   use.  (Think of them as akin to static methods in Java).
#
class Class()

    # This method should be overridden by *every* subclass,
    #    to add to the traversal of the inheritance tree,
    #    as in:
    #
    #    method Type()
    #        suspend CLASSNAME | self$SUPERCLASS.Type()
    #    end
    #
    method Type()
        return "Class"  # base class
    end

    # Succeeds if superClassname is an ancestor of the current
    #   class (provided the current class has overridden the
    #   Type function as shown above).
    #
    method instanceof(superClassname)
        return superClassname == Type()
    end

    # Produces the classname for the current class
    #
    method className()
        return Type()
    end

end

# How to tell if something is a class...
#
#   This can be tricked, but only by evil people.
#
procedure isClass(var)
    return type(var) ? (tab(find("__state")) & move(*"__state") & pos(0))
end
##########
#
#  Abstract
#
#  Provides functionality for a class to have listeners added and
#     for these listeners to be notified etc.
#
#  Author: Kevin Wampler ([EMAIL PROTECTED]) with
#          mods by Steve Wampler ([EMAIL PROTECTED])
#
##########

link "Class"

# Classes that want to attach callbacks to Notifier classes must
#   inherit from this class and overwrite the callback() method.
#
class Listener : Class ()

    # All subclasses of Class must implement the Type method!
    #
    method Type()
        suspend "Listener" | self$Class.Type()
    end

    # Meant to be overridden by subclasses - this is the method
    #    that is invoked when a CallBackHandler is notifying
    #    Listener classes.
    method callback(source, message)
        write(&errout, "Callback from ", source.className(), ": ", message)
    end

end

# Classes that want to notify other classes through call backs
#   must inherit from this class.  Nothing needs to be overridden.
#
class Notifier : Class (listeners)

    # All subclasses of Class must implement the Type method!
    #
    method Type()
        suspend "Notifier" | self$Class.Type()
    end

        #####
        #  Adds a listener to this class, can be called with one or two arguments
        #    1 argument:
        #      1 - Callback procedure, Listener class, or co-expression
        #    2 arguments:
        #      1 - an identifier for the type of the callback (default is the
    #             string "default")
        #      2 - Listener class,  callback procedure, or co-expression
        #####
        method addListener(id, callback)
                if /callback then {
                        callback := id
                        id := "default"
                }
                if /listeners[id] then listeners[id] := list()
                put(listeners[id], callback)
                return
        end

        #####
        #  Removes all listeners with the specified id (defaults to "default")
        #####
        method removeListeners(id)
                /id := "default"
                if \listeners[id] then listeners[id] := list()
                return
        end

        #####
        #  Behaves like removeListeners, but removes all listeners regardless
    #     of their ids
        #####
        method removeAllListeners()
                listeners := table()
                return
        end

        #####
        #  Notifies all callbacks with the given id.  If a callback is a
    #     procedure or a method it is called with <name>(self, message),
    #     if it is a co-expression it is called with [self, message] @ <name>
        #####
        method notify(id, message)
                local listener
                /id := "default"
                every listener := !\listeners[id] do {
                        case type(listener) of {
                                "co-expression" : [self, message] @ listener
                "procedure"     : listener(self, message)
                                default : {   # See if its a subclass of Listener...
                    # WARNING: This will produce a runtime error if
                    #   the listener is a class that doesn't inherit
                    #   from Class!
                    if isClass(listener) &
                       listener.instanceof("Listener") then {
                        listener.callback(self, message)
                        }
                    else {
                        write(&errout, "notify: don't know how to handle ",
                                       type(listener))
                        }
                    }
                        }
                }
                return
        end

        #####
        #  behaves like notify, but notifies all listeners, regardless of their ids.
        #####
        method notifyAll(message)
                every notify(key(listeners), message)
                return
        end
        
        initially()
                listeners := table()
end

Reply via email to