1 ! Copyright (C) 2007, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors namespaces kernel parser prettyprint
4 sequences arrays io math definitions math.vectors assocs refs
5 ui.gadgets ui.gestures ui.commands ui.gadgets.scrollers
6 ui.gadgets.buttons ui.gadgets.borders ui.gadgets.tracks
7 ui.gadgets.editors eval ;
10 TUPLE: update-object ;
16 TUPLE: slot-editor < track ref text ;
18 : revert ( slot-editor -- )
19 dup ref>> get-ref unparse-use
20 swap text>> set-editor-string ;
23 { +description+ "Revert any uncomitted changes." }
26 GENERIC: finish-editing ( slot-editor ref -- )
28 M: key-ref finish-editing
29 drop T{ update-object } swap send-gesture drop ;
31 M: value-ref finish-editing
32 drop T{ update-slot } swap send-gesture drop ;
34 : slot-editor-value ( slot-editor -- object )
35 text>> control-value parse-fresh ;
37 : commit ( slot-editor -- )
38 dup text>> control-value parse-fresh first
40 dup ref>> finish-editing ;
43 { +description+ "Parse the object being edited, and store the result back into the edited slot." }
46 : com-eval ( slot-editor -- )
47 [ text>> editor-string eval ] keep
48 [ ref>> set-ref ] keep
49 dup ref>> finish-editing ;
53 { +description+ "Parse code which evaluates to an object, and store the result back into the edited slot." }
56 : delete ( slot-editor -- )
58 T{ update-object } swap send-gesture drop ;
61 { +description+ "Delete the slot and close the slot editor." }
64 : close ( slot-editor -- )
65 T{ update-slot } swap send-gesture drop ;
68 { +description+ "Close the slot editor without saving changes." }
71 : <slot-editor> ( ref -- gadget )
72 { 0 1 } slot-editor new-track
74 dup <toolbar> f track-add
75 <source-editor> >>text
76 dup text>> <scroller> 1 track-add
79 M: slot-editor pref-dim* call-next-method { 600 200 } vmin ;
81 M: slot-editor focusable-child* text>> ;
83 slot-editor "toolbar" f {
84 { T{ key-down f { C+ } "RET" } commit }
85 { T{ key-down f { S+ C+ } "RET" } com-eval }
88 { T{ key-down f f "ESC" } close }
91 TUPLE: editable-slot < track printer ref ;
93 : <edit-button> ( -- gadget )
95 [ T{ edit-slot } swap send-gesture drop ]
98 : display-slot ( gadget editable-slot -- )
101 <edit-button> f track-add
104 : update-slot ( editable-slot -- )
105 [ [ ref>> get-ref ] [ printer>> ] bi call ] keep
108 : edit-slot ( editable-slot -- )
111 dup ref>> <slot-editor>
113 [ [ scroll>gadget ] [ request-focus ] bi* ] 2bi
117 { T{ update-slot } [ update-slot ] }
118 { T{ edit-slot } [ edit-slot ] }
121 : <editable-slot> ( gadget ref -- editable-slot )
122 { 1 0 } editable-slot new-track
124 [ drop <gadget> ] >>printer
125 [ display-slot ] keep ;