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* M: border layout*
dup border-child-rect swap gadget-child dup border-child-rect swap gadget-child
over loc>> >>loc over loc>> >>loc
swap dim>> swap (>>dim) ; swap dim>> >>dim
drop ;
M: border focusable-child* M: border focusable-child*
gadget-child ; gadget-child ;

View File

@ -132,9 +132,9 @@ M: array gadget-text*
: gadget-text ( gadget -- string ) [ gadget-text* ] "" make ; : gadget-text ( gadget -- string ) [ gadget-text* ] "" make ;
: invalidate ( gadget -- ) : 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 ; : layout-queue ( -- queue ) \ layout-queue get ;
@ -160,9 +160,9 @@ DEFER: relayout
dup layout-state>> dup layout-state>>
[ drop ] [ dup invalidate layout-later ] if ; [ drop ] [ dup invalidate layout-later ] if ;
: show-gadget ( gadget -- ) t swap (>>visible?) ; : show-gadget ( gadget -- ) t >>visible? drop ;
: hide-gadget ( gadget -- ) f swap (>>visible?) ; : hide-gadget ( gadget -- ) f >>visible? drop ;
DEFER: in-layout? DEFER: in-layout?
@ -194,9 +194,9 @@ GENERIC: layout* ( gadget -- )
M: gadget layout* drop ; 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 -- ) : layout ( gadget -- )
dup layout-state>> [ dup layout-state>> [
@ -255,11 +255,10 @@ M: gadget ungraft* drop ;
: (unparent) ( gadget -- ) : (unparent) ( gadget -- )
dup ungraft dup ungraft
dup forget-pref-dim dup forget-pref-dim
f swap (>>parent) ; f >>parent drop ;
: unfocus-gadget ( child gadget -- ) : unfocus-gadget ( child gadget -- )
tuck focus>> eq? tuck focus>> eq? [ f >>focus ] when drop ;
[ f swap (>>focus) ] [ drop ] if ;
SYMBOL: in-layout? SYMBOL: in-layout?

View File

@ -8,7 +8,7 @@ $nl
$nl $nl
"Children are managed with the " { $link add-incremental } " and " { $link clear-incremental } " words." "Children are managed with the " { $link add-incremental } " and " { $link clear-incremental } " words."
$nl $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> HELP: <incremental>
{ $values { "incremental" "a new instance of " { $link 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 ; control-value length 1- min 0 max ;
: bound-index ( list -- ) : bound-index ( list -- )
dup index>> over calc-bounded-index dup index>> over calc-bounded-index >>index drop ;
swap (>>index) ;
: list-presentation-hook ( list -- quot ) : list-presentation-hook ( list -- quot )
hook>> [ [ list? ] find-parent ] prepend ; hook>> [ [ list? ] find-parent ] prepend ;

View File

@ -122,14 +122,14 @@ M: f update-scroller drop dup scroller-value swap scroll ;
M: scroller layout* M: scroller layout*
dup call-next-method dup call-next-method
dup follows>> dup follows>>
[ update-scroller ] 2keep 2dup update-scroller
swap (>>follows) ; >>follows drop ;
M: scroller focusable-child* M: scroller focusable-child*
viewport>> ; viewport>> ;
M: scroller model-changed M: scroller model-changed
nip f swap (>>follows) ; nip f >>follows drop ;
TUPLE: limited-scroller < scroller fixed-dim ; TUPLE: limited-scroller < scroller fixed-dim ;

View File

@ -46,7 +46,7 @@ M: slider model-changed nip elevator>> relayout-1 ;
TUPLE: thumb < gadget ; TUPLE: thumb < gadget ;
: begin-drag ( thumb -- ) : begin-drag ( thumb -- )
find-slider dup slider-value swap (>>saved) ; find-slider dup slider-value >>saved drop ;
: do-drag ( thumb -- ) : do-drag ( thumb -- )
find-slider drag-loc over orientation>> v. find-slider drag-loc over orientation>> v.

View File

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

View File

@ -165,7 +165,7 @@ M: stack-display tool-scroller
} cleave ; } cleave ;
: init-listener ( listener -- ) : init-listener ( listener -- )
f <model> swap (>>stack) ; f <model> >>stack drop ;
: <listener-gadget> ( -- gadget ) : <listener-gadget> ( -- gadget )
{ 0 1 } listener-gadget new-track { 0 1 } listener-gadget new-track

View File

@ -69,7 +69,7 @@ M: world graft*
#! when restoring saved worlds on image startup. #! when restoring saved worlds on image startup.
dup fonts>> clear-assoc dup fonts>> clear-assoc
dup unfocus-world dup unfocus-world
f swap (>>handle) ; f >>handle drop ;
M: world ungraft* M: world ungraft*
dup free-fonts dup free-fonts

View File

@ -173,7 +173,7 @@ M: world client-event
dup window-loc>> over rect-dim glx-window dup window-loc>> over rect-dim glx-window
over "Factor" create-xic <x11-handle> over "Factor" create-xic <x11-handle>
2dup window>> register-window 2dup window>> register-window
swap (>>handle) ; >>handle drop ;
: wait-event ( -- event ) : wait-event ( -- event )
QueuedAfterFlush events-queued 0 > [ QueuedAfterFlush events-queued 0 > [