repeat-button refactoring

diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index bcc46721b03bb9fa15c8a3db4e374ee9e8905f97..83fd3147610957ff113dcec2851ef56f8fa0d3a2 100644 (file)
--- a/library/ui/gadgets.factor
+++ b/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 ;

diff --git a/library/ui/gadgets/buttons.factor b/library/ui/gadgets/buttons.factor
index 011a725a8e2a4abdc0165382dafa30451835b166..f5074c64ef7dc650143d698915d22482464205fb 100644 (file)
--- a/library/ui/gadgets/buttons.factor
+++ b/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 ;
 

diff --git a/library/ui/models.factor b/library/ui/models.factor
index 62ed32e55fa0653b585b08588327837a73fe0ce0..7d0bc6955449b36826e38d917bdcbe35da610ef8 100644 (file)
--- a/library/ui/models.factor
+++ b/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 )

diff --git a/library/ui/test/models.factor b/library/ui/test/models.factor
index 0017ec266d042aa864ada598673c367009667c47..ee861ea51a1a94d2bf50cf01a356e2e9159beafa 100644 (file)
--- a/library/ui/test/models.factor
+++ b/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