steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ui.gadgets.buttons: Rewrite to not use 'gadget,'

db4
Eduardo Cavazos 2008-07-13 16:26:13 -05:00
parent 202e15cd9c
commit c1e9268a45
1 changed files with 14 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
extra/ui/gadgets/buttons/buttons.factor
View File

@ -187,9 +187,9 @@ M: radio-control model-changed
over set-button-selected? over set-button-selected?
relayout-1 ; relayout-1 ;
: <radio-controls> ( model assoc quot -- ) : <radio-controls> ( parent model assoc quot -- parent )
#! quot has stack effect ( value model label -- ) #! quot has stack effect ( value model label -- )
swapd [ swapd call gadget, ] 2curry assoc-each ; inline swapd [ swapd call add-gadget ] 2curry assoc-each ; inline
: radio-button-theme ( gadget -- gadget ) : radio-button-theme ( gadget -- gadget )
{ 5 5 } >>gap { 5 5 } >>gap
@ -202,14 +202,18 @@ M: radio-control model-changed
{ 5 5 } >>gap drop ; { 5 5 } >>gap drop ;
: <radio-buttons> ( model assoc -- gadget ) : <radio-buttons> ( model assoc -- gadget )
[ [ <radio-button> ] <radio-controls> ] make-filled-pile <filled-pile>
dup radio-buttons-theme ; -rot
[ <radio-button> ] <radio-controls>
dup radio-buttons-theme ;
: <toggle-button> ( value model label -- gadget ) : <toggle-button> ( value model label -- gadget )
<radio-control> bevel-button-theme ; <radio-control> bevel-button-theme ;
: <toggle-buttons> ( model assoc -- gadget ) : <toggle-buttons> ( model assoc -- gadget )
[ [ <toggle-button> ] <radio-controls> ] make-shelf ; <shelf>
-rot
[ <toggle-button> ] <radio-controls> ;
: command-button-quot ( target command -- quot ) : command-button-quot ( target command -- quot )
[ invoke-command drop ] 2curry ; [ invoke-command drop ] 2curry ;
@ -221,9 +225,9 @@ M: radio-control model-changed
<bevel-button> ; <bevel-button> ;
: <toolbar> ( target -- toolbar ) : <toolbar> ( target -- toolbar )
[ <shelf>
"toolbar" over class command-map commands>> swap swap
[ -rot <command-button> gadget, ] curry assoc-each "toolbar" over class command-map commands>> swap
] make-shelf ; [ -rot <command-button> add-gadget ] curry assoc-each ;
: toolbar, ( -- ) g <toolbar> f track, ; : toolbar, ( -- ) g <toolbar> f track, ;