Index: openacs-4/packages/acs-tcl/tcl/callback-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/callback-procs.tcl,v
diff -u
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ openacs-4/packages/acs-tcl/tcl/callback-procs.tcl	11 Apr 2005 22:21:21 -0000	1.1
@@ -0,0 +1,40 @@
+ad_library {
+    Supports the use of callbacks.
+
+    @author Lee Denison (lee@xarg.co.uk)
+}
+
+namespace eval callback {}
+
+ad_proc -public callback::impl_exists {
+    {-callback:required}
+    {-impl:required}
+} {
+    Returns whether the specified implementation exists.
+} {
+    return [expr {![string equal \
+        [info commands ::callback::${callback}::impl::${impl}] \
+        ""]}]
+}
+
+ad_proc -public callback::get_object_type_impl {
+    {-object_type:required}
+    {-callback:required}
+} {
+    Finds the most type specific implementation of <code>callback</code>.
+} {
+    if {[callback::impl_exists -callback $callback -impl $object_type]} {
+        return $object_type
+    } else {
+        set supertypes [acs_object_type::supertypes \
+            -subtype $object_type]
+
+        foreach type $supertypes {
+            if {[callback::impl_exists -callback $callback -impl $type]} {
+                return $type
+            }
+        }
+    }
+
+    return ""
+}