Holding down the mouse button in a slider's elevator now does timer-based scrolling

TODO.FACTOR.txt

@@ -8,7 +8,6 @@
 - the editor should fill up the interior of the scroller completely
 - hide empty command groups in $commands
 - ui quick start doc
-- page scrolling should be timer-based too
 - x11: scroll up/down wiggles caret
 - slider needs to be modelized
 - more compact relocation info

library/ui/gadgets.factor

@@ -97,7 +97,8 @@ M: gadget children-on nip gadget-children ;
     >r gadget-children r> each-with ; inline
 
 : set-gadget-delegate ( delegate gadget -- )
-    dup pick [ set-gadget-parent ] each-child-with set-delegate ;
+    over [ dup pick [ set-gadget-parent ] each-child-with ] when
+    set-delegate ;
 
 : with-gadget ( gadget quot -- )
     [ swap gadget set call ] with-scope ; inline
@@ -126,9 +127,10 @@ C: timer-gadget ( gadget -- gadget )
 M: timer-gadget tick nip timer-gadget-quot call ;
 
 : start-timer-gadget ( gadget quot -- )
+    2dup call
     over >r curry r>
     [ set-timer-gadget-quot ] keep
-    100 add-timer ;
+    100 add-timer ; inline
 
 : stop-timer-gadget ( gadget -- )
     dup remove-timer f swap set-timer-gadget-quot ;

library/ui/gadgets/buttons.factor

@@ -63,7 +63,7 @@ TUPLE: repeat-button ;
 
 repeat-button H{
     { T{ button-down } [ [ button-clicked ] start-timer-gadget ] }
-    { T{ button-up } [ stop-timer-gadget ] }
+    { T{ button-up } [ dup stop-timer-gadget button-update ] }
 } set-gestures
 
 C: repeat-button ( gadget quot -- button )

library/ui/gadgets/sliders.factor

@@ -89,13 +89,15 @@ C: thumb ( vector -- thumb )
     over screen>slider over slider-value - sgn
     swap slide-by-page ;
 
-elevator H{ { T{ button-down } [ elevator-click ] } }
-set-gestures
+elevator H{
+    { T{ button-down } [ [ elevator-click ] start-timer-gadget ] }
+    { T{ button-up } [ stop-timer-gadget ] }
+} set-gestures
 
 C: elevator ( vector -- elevator )
-    dup delegate>gadget
-    dup elevator-theme
-    [ set-gadget-orientation ] keep ;
+    <gadget> <timer-gadget> over set-gadget-delegate
+    [ set-gadget-orientation ] keep
+    dup elevator-theme ;
 
 : (layout-thumb) ( slider n -- n thumb )
     over gadget-orientation n*v swap slider-thumb ;

library/ui/ui.factor

@@ -172,7 +172,7 @@ M: world-error error.
     "This world has been deactivated to prevent cascading errors." print
     delegate error. ;
 
-: draw-world? ( world -- )
+: draw-world? ( world -- ? )
     #! We don't draw deactivated worlds, or those with 0 size.
     #! On Windows, the latter case results in GL errors.
     dup world-active? swap rect-dim [ zero? not ] all? and ;