[Gd-chatter] r11673 - in trunk/libraries/layer: . layer-test
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Sat Feb 9 05:00:10 CET 2008
Author: hannes
Date: Sat Feb 9 05:00:10 2008
New Revision: 11673
Modified:
trunk/libraries/layer/layer-test/layer-test.dylan
trunk/libraries/layer/layer.dylan
trunk/libraries/layer/new-layer.dylan
Log:
Job: 7299
some more tests, nicer API for de/register-event
Modified: trunk/libraries/layer/layer-test/layer-test.dylan
==============================================================================
--- trunk/libraries/layer/layer-test/layer-test.dylan (original)
+++ trunk/libraries/layer/layer-test/layer-test.dylan Sat Feb 9 05:00:10 2008
@@ -32,7 +32,7 @@
define test simple-layer-callback ()
let callback-called? = #f;
let a = make(<simple-layer>);
- register-event(get-property(a, #"a"), method(c) callback-called? := #t end);
+ register-event(a, #"a", method(c) callback-called? := #t end);
a. at a := 42;
check-true("callback called", callback-called?);
end;
@@ -40,16 +40,40 @@
define test simple-layer-null-callback ()
let callback-called? = #f;
let a = make(<simple-layer>);
- register-event(get-property(a, #"a"), method(c) callback-called? := #t end);
+ register-event(a, #"a", method(c) callback-called? := #t end);
a. at a := 23;
check-false("callback not called", callback-called?);
end;
+define test simple-layer-null-callback-2 ()
+ let callback-called? = #f;
+ let a = make(<simple-layer>);
+ register-event(a, #"a", method(c) callback-called? := #t end);
+ a. at a := 23;
+ check-false("callback not called", callback-called?);
+ a. at a := 42;
+ check-true("callback called", callback-called?);
+end;
+
+define test simple-layer-callback-with-deregister ()
+ let callback-called? = #f;
+ let a = make(<simple-layer>);
+ let callback = method(c) callback-called? := #t end;
+ register-event(a, #"a", callback);
+ a. at a := 23;
+ check-false("callback not called", callback-called?);
+ deregister-event(a, #"a", callback);
+ a. at a := 42;
+ check-false("callback also not called", callback-called?);
+end;
+
define suite layer-suite ()
test simple-layer-basic;
test simple-layer-with-default;
test simple-layer-callback;
test simple-layer-null-callback;
+ test simple-layer-null-callback-2;
+ test simple-layer-callback-with-deregister;
end;
begin
Modified: trunk/libraries/layer/layer.dylan
==============================================================================
--- trunk/libraries/layer/layer.dylan (original)
+++ trunk/libraries/layer/layer.dylan Sat Feb 9 05:00:10 2008
@@ -403,6 +403,8 @@
slot raw-input;
end;
+//XXX: probably should use radix trees
+//http://www.matasano.com/log/1009/aguri-coolest-data-structure-youve-never-heard-of/
define class <route> (<object>)
constant slot cidr :: <cidr>, required-init-keyword: cidr:;
end;
Modified: trunk/libraries/layer/new-layer.dylan
==============================================================================
--- trunk/libraries/layer/new-layer.dylan (original)
+++ trunk/libraries/layer/new-layer.dylan Sat Feb 9 05:00:10 2008
@@ -61,7 +61,8 @@
end; }
end;
-define function init-layer (layer :: <layer>, default-name :: <string>, name)
+define inline function init-layer
+ (layer :: <layer>, default-name :: <string>, name)
unless(name)
name := as(<symbol>, format-to-string("%s%=", default-name, layer.instance-count));
layer.instance-count := layer.instance-count + 1;
@@ -73,7 +74,7 @@
$layer-registry[name] := layer;
end;
-define function init-properties (layer :: <layer>, args :: <collection>)
+define inline function init-properties (layer :: <layer>, args :: <collection>)
for (i from 0 below args.size by 2)
if (get-property(layer, args[i]))
let prop = get-property(layer, args[i]);
@@ -89,16 +90,21 @@
slot listeners = #();
end;
-define method event-notify (source :: <event-source>, event :: <event>)
+define inline function event-notify
+ (source :: <event-source>, event :: <event>) => ()
do(method (x) x(event) end, source.listeners)
end;
-define method register-event (source :: <event-source>, callback :: <function>)
- source.listeners := add!(source.listeners, callback);
+define inline function register-event
+ (source :: <layer>, name :: <symbol>, callback :: <function>) => ()
+ let prop = get-property(source, name);
+ prop.listeners := add!(prop.listeners, callback);
end;
-define method deregister-event (source :: <event-source>, callback :: <function>)
- source.listeners := remove!(source.listeners, callback);
+define inline function deregister-event
+ (source :: <layer>, name :: <symbol>, callback :: <function>) => ()
+ let prop = get-property(source, name);
+ prop.listeners := remove!(prop.listeners, callback);
end;
define class <property> (<event-source>)
@@ -111,35 +117,44 @@
//constant slot property-setter, init-keyword: setter:;
end;
-define function get-property (object :: <layer>, property-name :: <symbol>)
- => (res :: <property>)
+define open generic check-property (owner, property-name :: <symbol>, value)
+ => ();
+
+define method check-property (owner, property-name :: <symbol>, value) => ()
+ //move along
+end;
+
+define inline function get-property
+ (object :: <layer>, property-name :: <symbol>)
+ => (property :: <property>)
element(object.properties, property-name);
end;
-define function set-property-value (object :: <layer>, property-name :: <symbol>, new-value)
- => (res)
+define inline function set-property-value
+ (object :: <layer>, property-name :: <symbol>, new-value)
+ => (value)
get-property(object, property-name).property-value := new-value;
end;
-define function get-property-value (object :: <layer>, property-name :: <symbol>)
- => (res)
+define inline function get-property-value
+ (object :: <layer>, property-name :: <symbol>)
+ => (value)
get-property(object, property-name).property-value;
end;
-define inline method property-value (property :: <property>)
+define inline function property-value (property :: <property>)
%property-value(property)
end;
-define open generic check-property (owner, property-name :: <symbol>, value) => ();
-define method check-property (owner, property-name :: <symbol>, value) => ()
- //move along
-end;
-define inline method property-value-setter (value, property :: <property>)
+define inline function property-value-setter
+ (value, property :: <property>) => (value)
let old-value = property.property-value;
check-property(property.property-owner, property.property-name, value);
if (old-value ~= value)
property.%property-value := value;
- let event = make(<property-changed-event>, property: property, old-value: old-value);
+ let event = make(<property-changed-event>,
+ property: property,
+ old-value: old-value);
event-notify(property, event);
end;
value
@@ -147,7 +162,9 @@
define class <property-changed-event> (<event>)
- constant slot property-changed-event-property :: <property>, required-init-keyword: property:;
- constant slot property-changed-event-old-value, required-init-keyword: old-value:;
+ constant slot property-changed-event-property :: <property>,
+ required-init-keyword: property:;
+ constant slot property-changed-event-old-value,
+ required-init-keyword: old-value:;
end;
More information about the chatter
mailing list