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

gadgets.controls.refactoring

db4
Sam Anklesaria 2009-08-04 21:57:27 -05:00
parent c05e91a7a3
commit f9cc05e14a
1 changed files with 5 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
extra/ui/gadgets/controls/controls.factor
View File

@ -33,7 +33,7 @@ M: table tbl:row-color color-quot>> [ call( a -- b ) ] [ drop f ] if* ;
: indexed ( table -- table ) f >>val-quot ; : indexed ( table -- table ) f >>val-quot ;
TUPLE: model-field < field model* ; TUPLE: model-field < field model* ;
: init-field ( field -- field' ) [ [ ] [ "" ] if* ] change-value ; : init-field ( model -- model' ) [ [ ] [ "" ] if* ] change-value ;
: <model-field> ( model -- gadget ) model-field new-field swap init-field >>model* ; : <model-field> ( model -- gadget ) model-field new-field swap init-field >>model* ;
M: model-field graft* M: model-field graft*
[ [ model*>> value>> ] [ editor>> ] bi set-editor-string ] [ [ model*>> value>> ] [ editor>> ] bi set-editor-string ]
@ -46,12 +46,11 @@ M: model-field model-changed 2dup model*>> =
[ [ value>> ] [ editor>> ] bi* set-editor-string ] [ [ value>> ] [ editor>> ] bi* set-editor-string ]
[ nip [ editor>> editor-string ] [ model*>> ] bi set-model ] if ; [ nip [ editor>> editor-string ] [ model*>> ] bi set-model ] if ;
: (new-field) ( editor field -- gadget ) [ new-editor ] dip new-border dup gadget-child >>editor
field-theme { 1 0 } >>align ; inline
: <model-field*> ( -- field ) "" <model> <model-field> ; : <model-field*> ( -- field ) "" <model> <model-field> ;
: <empty-field> ( model -- field ) "" <model> switch-models <model-field> ; : <empty-field> ( model -- field ) "" <model> switch-models <model-field> ;
: (model-editor) ( model class -- gadget ) : <model-editor> ( model -- gadget ) multiline-editor model-field (new-field) swap init-field >>model* ;
model-field [ new-editor ] dip new-border dup gadget-child >>editor
field-theme swap init-field >>model* { 1 0 } >>align ;
: <model-editor> ( model -- gadget ) multiline-editor (model-editor) ;
: <model-editor*> ( -- editor ) "" <model> <model-editor> ; : <model-editor*> ( -- editor ) "" <model> <model-editor> ;
: <empty-editor> ( model -- editor ) "" <model> switch-models <model-editor> ; : <empty-editor> ( model -- editor ) "" <model> switch-models <model-editor> ;