More cleanups
parent
7240c9f717
commit
f28dde2c65
|
@ -42,7 +42,8 @@ M: border pref-dim*
|
|||
M: border layout*
|
||||
dup border-child-rect swap gadget-child
|
||||
over loc>> >>loc
|
||||
swap dim>> swap (>>dim) ;
|
||||
swap dim>> >>dim
|
||||
drop ;
|
||||
|
||||
M: border focusable-child*
|
||||
gadget-child ;
|
||||
|
|
|
@ -132,9 +132,9 @@ M: array gadget-text*
|
|||
: gadget-text ( gadget -- string ) [ gadget-text* ] "" make ;
|
||||
|
||||
: invalidate ( gadget -- )
|
||||
\ invalidate swap (>>layout-state) ;
|
||||
\ invalidate >>layout-state drop ;
|
||||
|
||||
: forget-pref-dim ( gadget -- ) f swap (>>pref-dim) ;
|
||||
: forget-pref-dim ( gadget -- ) f >>pref-dim drop ;
|
||||
|
||||
: layout-queue ( -- queue ) \ layout-queue get ;
|
||||
|
||||
|
@ -160,9 +160,9 @@ DEFER: relayout
|
|||
dup layout-state>>
|
||||
[ drop ] [ dup invalidate layout-later ] if ;
|
||||
|
||||
: show-gadget ( gadget -- ) t swap (>>visible?) ;
|
||||
|
||||
: hide-gadget ( gadget -- ) f swap (>>visible?) ;
|
||||
: show-gadget ( gadget -- ) t >>visible? drop ;
|
||||
|
||||
: hide-gadget ( gadget -- ) f >>visible? drop ;
|
||||
|
||||
DEFER: in-layout?
|
||||
|
||||
|
@ -194,9 +194,9 @@ GENERIC: layout* ( gadget -- )
|
|||
|
||||
M: gadget layout* drop ;
|
||||
|
||||
: prefer ( gadget -- ) dup pref-dim swap (>>dim) ;
|
||||
: prefer ( gadget -- ) dup pref-dim >>dim drop ;
|
||||
|
||||
: validate ( gadget -- ) f swap (>>layout-state) ;
|
||||
: validate ( gadget -- ) f >>layout-state drop ;
|
||||
|
||||
: layout ( gadget -- )
|
||||
dup layout-state>> [
|
||||
|
@ -255,11 +255,10 @@ M: gadget ungraft* drop ;
|
|||
: (unparent) ( gadget -- )
|
||||
dup ungraft
|
||||
dup forget-pref-dim
|
||||
f swap (>>parent) ;
|
||||
f >>parent drop ;
|
||||
|
||||
: unfocus-gadget ( child gadget -- )
|
||||
tuck focus>> eq?
|
||||
[ f swap (>>focus) ] [ drop ] if ;
|
||||
tuck focus>> eq? [ f >>focus ] when drop ;
|
||||
|
||||
SYMBOL: in-layout?
|
||||
|
||||
|
|
|
@ -8,7 +8,7 @@ $nl
|
|||
$nl
|
||||
"Children are managed with the " { $link add-incremental } " and " { $link clear-incremental } " words."
|
||||
$nl
|
||||
"Not every " { $link pack } " can use incremental layout, since incremental layout does not support non-default values for " { $snippet "align" } ", " { $snippet "fill" } ", and " { $snippet "gap" } "." } ;
|
||||
"Not every " { $link pack } " can use incremental layout, since incremental layout does not support non-default values for the " { $slot "align" } ", " { $slot "fill" } ", and " { $slot "gap" } " slots." } ;
|
||||
|
||||
HELP: <incremental>
|
||||
{ $values { "incremental" "a new instance of " { $link incremental } } }
|
||||
|
|
|
@ -27,8 +27,7 @@ TUPLE: list < pack index presenter color hook ;
|
|||
control-value length 1- min 0 max ;
|
||||
|
||||
: bound-index ( list -- )
|
||||
dup index>> over calc-bounded-index
|
||||
swap (>>index) ;
|
||||
dup index>> over calc-bounded-index >>index drop ;
|
||||
|
||||
: list-presentation-hook ( list -- quot )
|
||||
hook>> [ [ list? ] find-parent ] prepend ;
|
||||
|
|
|
@ -122,14 +122,14 @@ M: f update-scroller drop dup scroller-value swap scroll ;
|
|||
M: scroller layout*
|
||||
dup call-next-method
|
||||
dup follows>>
|
||||
[ update-scroller ] 2keep
|
||||
swap (>>follows) ;
|
||||
2dup update-scroller
|
||||
>>follows drop ;
|
||||
|
||||
M: scroller focusable-child*
|
||||
viewport>> ;
|
||||
|
||||
M: scroller model-changed
|
||||
nip f swap (>>follows) ;
|
||||
nip f >>follows drop ;
|
||||
|
||||
TUPLE: limited-scroller < scroller fixed-dim ;
|
||||
|
||||
|
|
|
@ -46,7 +46,7 @@ M: slider model-changed nip elevator>> relayout-1 ;
|
|||
TUPLE: thumb < gadget ;
|
||||
|
||||
: begin-drag ( thumb -- )
|
||||
find-slider dup slider-value swap (>>saved) ;
|
||||
find-slider dup slider-value >>saved drop ;
|
||||
|
||||
: do-drag ( thumb -- )
|
||||
find-slider drag-loc over orientation>> v.
|
||||
|
|
|
@ -89,7 +89,7 @@ SYMBOL: ui-error-hook
|
|||
(draw-world)
|
||||
] [
|
||||
over <world-error> ui-error
|
||||
f swap (>>active?)
|
||||
f >>active? drop
|
||||
] recover
|
||||
] with-variable
|
||||
] [
|
||||
|
|
|
@ -165,7 +165,7 @@ M: stack-display tool-scroller
|
|||
} cleave ;
|
||||
|
||||
: init-listener ( listener -- )
|
||||
f <model> swap (>>stack) ;
|
||||
f <model> >>stack drop ;
|
||||
|
||||
: <listener-gadget> ( -- gadget )
|
||||
{ 0 1 } listener-gadget new-track
|
||||
|
|
|
@ -69,7 +69,7 @@ M: world graft*
|
|||
#! when restoring saved worlds on image startup.
|
||||
dup fonts>> clear-assoc
|
||||
dup unfocus-world
|
||||
f swap (>>handle) ;
|
||||
f >>handle drop ;
|
||||
|
||||
M: world ungraft*
|
||||
dup free-fonts
|
||||
|
|
|
@ -173,7 +173,7 @@ M: world client-event
|
|||
dup window-loc>> over rect-dim glx-window
|
||||
over "Factor" create-xic <x11-handle>
|
||||
2dup window>> register-window
|
||||
swap (>>handle) ;
|
||||
>>handle drop ;
|
||||
|
||||
: wait-event ( -- event )
|
||||
QueuedAfterFlush events-queued 0 > [
|
||||
|
|
Loading…
Reference in New Issue