Model fixes

TODO.FACTOR.txt

@@ -2,10 +2,8 @@
 
 - menu Command: quots look dumb
 - http://paste.lisp.org/display/30426
-- "ker" C+u: for a moment, full vocab list is shown
 - some module operations don't work on module-links
 - list operations: what if nothing is selected?
-- modules: core/ libs/ apps/
 - top level window positioning on ms windows
 - crashes:
   - windows gcc issue
@@ -40,6 +38,7 @@
 
 + ui:
 
+- listener: if partial parse, RETURN should insert newline
 - some way of intercepting all gestures
 - how do we refer to command shortcuts in the docs?
 - editor:
@@ -51,6 +50,7 @@
 
 + module system:
 
+- modules: core/ libs/ apps/
 - track a list of assets loaded from each module's file
 - C types should be words
   - TYPEDEF: float { ... } { ... } ;   ==> \ float T{ c-type ... } "c-type" swp
@@ -87,6 +87,7 @@
 
 + misc:
 
+- automatic help/effects for slot accessors
 - tuple shape changes
 - should be possible to reload any source file in library
 - growable data heap

library/ui/models.factor

@@ -19,6 +19,10 @@ C: model ( value -- model )
 
 DEFER: add-connection
 
+GENERIC: model-activated ( model -- )
+
+M: model model-activated drop ;
+
 : ref-model ( model -- n )
     dup model-ref 1+ dup rot set-model-ref ;
 
@@ -28,7 +32,8 @@ DEFER: add-connection
 : activate-model ( model -- )
     dup ref-model 1 = [
         dup model-dependencies
-        [ dup activate-model add-connection ] each-with
+        [ dup activate-model dupd add-connection ] each
+        model-activated
     ] [
         drop
     ] if ;
@@ -81,24 +86,26 @@ C: filter ( model quot -- filter )
     dup delegate>model
     [ set-filter-quot ] keep
     [ set-filter-model ] 2keep
-    [ add-dependency ] keep
-    dup model-changed ;
+    [ add-dependency ] keep ;
 
 M: filter model-changed
     dup filter-model model-value over filter-quot call
     swap set-model ;
 
+M: filter model-activated model-changed ;
+
 TUPLE: compose ;
 
 C: compose ( models -- compose )
     dup delegate>model
-    [ set-model-dependencies ] keep
-    dup model-changed ;
+    swap clone over set-model-dependencies ;
 
 M: compose model-changed
     dup model-dependencies [ model-value ] map
     swap delegate set-model ;
 
+M: compose model-activated model-changed ;
+
 M: compose set-model
     model-dependencies [ set-model ] 2each ;
 
@@ -129,16 +136,18 @@ C: history ( value -- history )
 
 TUPLE: delay model timeout ;
 
+: update-delay-model ( delay -- )
+    dup delay-model model-value swap set-model ;
+
 C: delay ( model timeout -- filter )
     dup delegate>model
     [ set-delay-timeout ] keep
     [ set-delay-model ] 2keep
     [ add-dependency ] keep
-    dup model-changed ;
+    dup update-delay-model ;
 
-M: delay model-changed
-    0 over delay-timeout add-timer ;
+M: delay model-changed 0 over delay-timeout add-timer ;
 
-M: delay tick
-    dup remove-timer
-    dup delay-model model-value swap set-model ;
+M: delay model-activated update-delay-model ;
+
+M: delay tick dup remove-timer update-delay-model ;

library/ui/test/models.factor

@@ -18,7 +18,9 @@ M: model-tester model-changed t swap set-model-tester-hit? ;
 4 <model> "model-b" set
 "model-a" get "model-b" get 2array <compose> "model-c" set
 
+"model-c" get activate-model
 [ { 3 4 } ] [ "model-c" get model-value  ] unit-test
+"model-c" get deactivate-model
 
 T{ model-tester f f } "tester" set
 
@@ -74,3 +76,12 @@ f <history> "history" set
 [ 9 ] [ "y" get model-value ] unit-test
 [ ] [ "y" get deactivate-model ] unit-test
 [ f ] [ "z" get "x" get model-connections memq? ] unit-test
+
+3 <model> "x" set
+"x" get [ sq ] <filter> "y" set
+
+4 "x" get set-model
+
+"y" get activate-model
+[ 16 ] [ "y" get model-value ] unit-test
+"y" get deactivate-model