repeat-button refactoring

library/ui/gadgets.factor

@@ -115,3 +115,20 @@ M: gadget gadget-selection? drop f ;
 GENERIC: gadget-selection ( gadget -- string/f )
 
 M: gadget gadget-selection drop f ;
+
+! Re-firing gestures while mouse held down, etc. Used by
+! slider gadgets
+TUPLE: timer-gadget quot ;
+
+C: timer-gadget ( gadget -- gadget )
+    [ set-gadget-delegate ] keep ;
+
+M: timer-gadget tick nip timer-gadget-quot call ;
+
+: start-timer-gadget ( gadget quot -- )
+    over >r curry r>
+    [ set-timer-gadget-quot ] keep
+    100 add-timer ;
+
+: stop-timer-gadget ( gadget -- )
+    dup remove-timer f swap set-timer-gadget-quot ;

library/ui/gadgets/buttons.factor

@@ -62,16 +62,16 @@ C: button ( gadget quot -- button )
 TUPLE: repeat-button ;
 
 repeat-button H{
-    { T{ button-down } [ repeat-button-down ] }
-    { T{ button-up } [ repeat-button-up ] }
+    { T{ button-down } [ [ button-clicked ] start-timer-gadget ] }
+    { T{ button-up } [ stop-timer-gadget ] }
 } set-gestures
 
 C: repeat-button ( gadget quot -- button )
     #! Button that calls the quotation every 100ms as long as
     #! the mouse is held down.
-    [ >r <bevel-button> r> set-gadget-delegate ] keep ;
-
-M: repeat-button tick nip button-clicked ;
+    [
+        >r <bevel-button> <timer-gadget> r> set-gadget-delegate
+    ] keep ;
 
 TUPLE: button-paint plain rollover pressed selected ;
 

library/ui/models.factor

@@ -88,30 +88,6 @@ M: filter model-changed
     dup filter-model model-value over filter-quot call
     swap set-model ;
 
-TUPLE: validator model quot ;
-
-C: validator ( model quot -- filter )
-    dup delegate>model
-    [ set-validator-quot ] keep
-    [ set-validator-model ] 2keep
-    [ add-dependency ] keep
-    dup model-changed ;
-
-M: validator model-changed
-    dup validator-model model-value dup
-    pick validator-quot call [
-        swap delegate set-model
-    ] [
-        2drop
-    ] if ;
-
-M: validator set-model
-    2dup validator-quot call [
-        validator-model set-model
-    ] [
-        2drop
-    ] if ;
-
 TUPLE: compose ;
 
 C: compose ( models -- compose )

library/ui/test/models.factor

@@ -74,28 +74,3 @@ 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
-
-! Test validators
-3 <model> "x" set
-"x" get [ odd? ] <validator> "y" set
-"y" get activate-model
-
-[ 3 ] [ "y" get model-value ] unit-test
-
-4 "x" get set-model
-
-[ 3 ] [ "y" get model-value ] unit-test
-
-5 "x" get set-model
-
-[ 5 ] [ "y" get model-value ] unit-test
-
-6 "y" get set-model
-
-[ 5 ] [ "x" get model-value ] unit-test
-[ 5 ] [ "y" get model-value ] unit-test
-
-7 "y" get set-model
-
-[ 7 ] [ "x" get model-value ] unit-test
-[ 7 ] [ "y" get model-value ] unit-test