More cleanups

db4
Slava Pestov 2008-09-27 16:45:20 -05:00
parent 7240c9f717
commit f28dde2c65
10 changed files with 21 additions and 22 deletions

View File

@ -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 ;

View File

@ -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?

View File

@ -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 } } }

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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.

View File

@ -89,7 +89,7 @@ SYMBOL: ui-error-hook
(draw-world)
] [
over <world-error> ui-error
f swap (>>active?)
f >>active? drop
] recover
] with-variable
] [

View File

@ -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

View File

@ -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

View File

@ -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 > [