Merge branch 'master' of git://factorcode.org/git/factor
Doug Coleman
commit
40e901b8f2
|
|
@ -114,6 +114,8 @@ VARS: population-label cohesion-label alignment-label separation-label ;
|
|||
|
||||
<frame>
|
||||
|
||||
<shelf>
|
||||
|
||||
{
|
||||
[ "ESC - Pause" [ drop toggle-loop ] button* ]
|
||||
|
||||
|
|
@ -139,7 +141,7 @@ VARS: population-label cohesion-label alignment-label separation-label ;
|
|||
"e - +0.1" [ drop inc-separation-weight ] button* add-gadget
|
||||
"d - -0.1" [ drop dec-separation-weight ] button* add-gadget ]
|
||||
|
||||
} [ call ] map [ [ gadget, ] each ] make-shelf
|
||||
} [ call ] map [ add-gadget ] each
|
||||
1 over set-pack-fill
|
||||
over @top grid-add
|
||||
|
||||
|
|
|
|||
|
|
@ -15,7 +15,8 @@ TUPLE: color-preview < gadget ;
|
|||
|
||||
: <color-preview> ( model -- gadget )
|
||||
color-preview new-gadget
|
||||
{ 100 100 } over set-rect-dim ;
|
||||
swap >>model
|
||||
{ 100 100 } >>dim ;
|
||||
|
||||
M: color-preview model-changed
|
||||
swap model-value over set-gadget-interior relayout-1 ;
|
||||
|
|
@ -26,7 +27,10 @@ M: color-preview model-changed
|
|||
: <color-sliders> ( -- model gadget )
|
||||
3 [ 0 0 0 255 <range> ] replicate
|
||||
dup [ range-model ] map <compose>
|
||||
swap [ [ <color-slider> gadget, ] each ] make-filled-pile ;
|
||||
swap
|
||||
<filled-pile>
|
||||
swap
|
||||
[ <color-slider> add-gadget ] each ;
|
||||
|
||||
: <color-picker> ( -- gadget )
|
||||
[
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ USING: kernel namespaces threads math math.order math.vectors
|
|||
self pos ori turtle opengl.camera
|
||||
lsys.tortoise lsys.tortoise.graphics
|
||||
lsys.strings.rewrite lsys.strings.interpret
|
||||
combinators.short-circuit ;
|
||||
combinators.short-circuit accessors ;
|
||||
|
||||
! lsys.strings
|
||||
! lsys.strings.rewrite
|
||||
|
|
@ -99,6 +99,8 @@ DEFER: empty-model
|
|||
|
||||
: lsys-controller ( -- )
|
||||
|
||||
<pile>
|
||||
|
||||
{
|
||||
|
||||
[ "Load" <label> reverse-video-theme ]
|
||||
|
|
@ -145,9 +147,11 @@ DEFER: empty-model
|
|||
[ pos> norm reset-turtle 45 turn-left 45 pitch-up step-turtle 180 turn-left ]
|
||||
camera-action <bevel-button> ]
|
||||
|
||||
} make*
|
||||
[ [ gadget, ] curry ] map concat ! Hack
|
||||
make-pile 1 over set-pack-fill "L-system control" open-window ;
|
||||
}
|
||||
|
||||
[ call add-gadget ] each
|
||||
1 >>fill
|
||||
"L-system control" open-window ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
@ -469,7 +473,7 @@ H{ } >rules ;
|
|||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
: model-chooser ( -- )
|
||||
|
||||
<pile>
|
||||
{
|
||||
[ "abop-1" <label> [ drop abop-1 build-model ] closed-quot <bevel-button> ]
|
||||
[ "abop-2" <label> [ drop abop-2 build-model ] closed-quot <bevel-button> ]
|
||||
|
|
@ -481,18 +485,21 @@ H{ } >rules ;
|
|||
[ "airhorse" <label> [ drop airhorse build-model ] closed-quot <bevel-button> ]
|
||||
[ "spiral-0" <label> [ drop spiral-0 build-model ] closed-quot <bevel-button> ]
|
||||
[ "koch" <label> [ drop koch build-model ] closed-quot <bevel-button> ]
|
||||
} make*
|
||||
[ [ gadget, ] curry ] map concat ! Hack
|
||||
make-pile 1 over set-pack-fill "L-system models" open-window ;
|
||||
}
|
||||
[ call add-gadget ] each
|
||||
1 >>fill
|
||||
"L-system models" open-window ;
|
||||
|
||||
: scene-chooser ( -- )
|
||||
<pile>
|
||||
{
|
||||
[ "abop-1" <label> [ drop abop-1-scene ] closed-quot <bevel-button> ]
|
||||
[ "abop-2" <label> [ drop abop-2-scene ] closed-quot <bevel-button> ]
|
||||
[ "tree-5" <label> [ drop tree-5-scene ] closed-quot <bevel-button> ]
|
||||
} make*
|
||||
[ [ gadget, ] curry ] map concat ! Hack
|
||||
make-pile 1 over set-pack-fill "L-system scenes" open-window ;
|
||||
}
|
||||
[ call add-gadget ] each
|
||||
1 >>fill
|
||||
"L-system scenes" open-window ;
|
||||
|
||||
: lsys-window* ( -- )
|
||||
[ lsys-controller lsys-viewer ] with-ui ;
|
||||
|
|
|
|||
|
|
@ -4,12 +4,12 @@ IN: nehe
|
|||
|
||||
: nehe-window ( -- )
|
||||
[
|
||||
[
|
||||
"Nehe 2" [ drop run2 ] <bevel-button> gadget,
|
||||
"Nehe 3" [ drop run3 ] <bevel-button> gadget,
|
||||
"Nehe 4" [ drop run4 ] <bevel-button> gadget,
|
||||
"Nehe 5" [ drop run5 ] <bevel-button> gadget,
|
||||
] make-filled-pile "Nehe examples" open-window
|
||||
<filled-pile>
|
||||
"Nehe 2" [ drop run2 ] <bevel-button> add-gadget
|
||||
"Nehe 3" [ drop run3 ] <bevel-button> add-gadget
|
||||
"Nehe 4" [ drop run4 ] <bevel-button> add-gadget
|
||||
"Nehe 5" [ drop run5 ] <bevel-button> add-gadget
|
||||
"Nehe examples" open-window
|
||||
] with-ui ;
|
||||
|
||||
MAIN: nehe-window
|
||||
|
|
|
|||
|
|
@ -1,12 +1,13 @@
|
|||
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays kernel math models namespaces sequences
|
||||
strings quotations assocs combinators classes colors
|
||||
classes.tuple opengl math.vectors
|
||||
ui.commands ui.gadgets ui.gadgets.borders
|
||||
ui.gadgets.labels ui.gadgets.theme
|
||||
ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
|
||||
ui.render math.geometry.rect ;
|
||||
strings quotations assocs combinators classes colors
|
||||
classes.tuple opengl math.vectors
|
||||
ui.commands ui.gadgets ui.gadgets.borders
|
||||
ui.gadgets.labels ui.gadgets.theme
|
||||
ui.gadgets.tracks ui.gadgets.packs ui.gadgets.worlds ui.gestures
|
||||
ui.render math.geometry.rect ;
|
||||
|
||||
IN: ui.gadgets.buttons
|
||||
|
||||
TUPLE: button < border pressed? selected? quot ;
|
||||
|
|
@ -187,9 +188,9 @@ M: radio-control model-changed
|
|||
over set-button-selected?
|
||||
relayout-1 ;
|
||||
|
||||
: <radio-controls> ( model assoc quot -- )
|
||||
#! quot has stack effect ( value model label -- )
|
||||
swapd [ swapd call gadget, ] 2curry assoc-each ; inline
|
||||
: <radio-controls> ( parent model assoc quot -- parent )
|
||||
#! quot has stack effect ( value model label -- )
|
||||
swapd [ swapd call add-gadget ] 2curry assoc-each ; inline
|
||||
|
||||
: radio-button-theme ( gadget -- gadget )
|
||||
{ 5 5 } >>gap
|
||||
|
|
@ -202,14 +203,18 @@ M: radio-control model-changed
|
|||
{ 5 5 } >>gap drop ;
|
||||
|
||||
: <radio-buttons> ( model assoc -- gadget )
|
||||
[ [ <radio-button> ] <radio-controls> ] make-filled-pile
|
||||
dup radio-buttons-theme ;
|
||||
<filled-pile>
|
||||
-rot
|
||||
[ <radio-button> ] <radio-controls>
|
||||
dup radio-buttons-theme ;
|
||||
|
||||
: <toggle-button> ( value model label -- gadget )
|
||||
<radio-control> bevel-button-theme ;
|
||||
|
||||
: <toggle-buttons> ( model assoc -- gadget )
|
||||
[ [ <toggle-button> ] <radio-controls> ] make-shelf ;
|
||||
<shelf>
|
||||
-rot
|
||||
[ <toggle-button> ] <radio-controls> ;
|
||||
|
||||
: command-button-quot ( target command -- quot )
|
||||
[ invoke-command drop ] 2curry ;
|
||||
|
|
@ -221,9 +226,9 @@ M: radio-control model-changed
|
|||
<bevel-button> ;
|
||||
|
||||
: <toolbar> ( target -- toolbar )
|
||||
[
|
||||
"toolbar" over class command-map commands>> swap
|
||||
[ -rot <command-button> gadget, ] curry assoc-each
|
||||
] make-shelf ;
|
||||
<shelf>
|
||||
swap
|
||||
"toolbar" over class command-map commands>> swap
|
||||
[ -rot <command-button> add-gadget ] curry assoc-each ;
|
||||
|
||||
: toolbar, ( -- ) g <toolbar> f track, ;
|
||||
|
|
|
|||
|
|
@ -180,10 +180,6 @@ HELP: focusable-child
|
|||
{ $values { "gadget" gadget } { "child" gadget } }
|
||||
{ $description "Outputs the child of the gadget which would prefer to receive keyboard focus." } ;
|
||||
|
||||
HELP: gadget,
|
||||
{ $values { "gadget" gadget } }
|
||||
{ $description "Adds a new child to the gadget being constructed. This word can only be used from a quotation passed to " { $link make-gadget } "." } ;
|
||||
|
||||
HELP: make-gadget
|
||||
{ $values { "gadget" gadget } { "quot" quotation } }
|
||||
{ $description "Calls the quotation in a new scope with the gadget stored in the " { $link gadget } " variable." } ;
|
||||
|
|
|
|||
|
|
@ -357,8 +357,6 @@ M: f request-focus-on 2drop ;
|
|||
: focus-path ( world -- seq )
|
||||
[ focus>> ] follow ;
|
||||
|
||||
: gadget, ( gadget -- ) gadget get swap add-gadget drop ;
|
||||
|
||||
: g ( -- gadget ) gadget get ;
|
||||
|
||||
: g-> ( x -- x x gadget ) dup g ;
|
||||
|
|
|
|||
|
|
@ -48,6 +48,7 @@ M: menu-glass layout* gadget-child prefer ;
|
|||
faint-boundary ;
|
||||
|
||||
: <commands-menu> ( hook target commands -- gadget )
|
||||
[
|
||||
[ >r 2dup r> <menu-item> gadget, ] each 2drop
|
||||
] make-filled-pile 5 <border> menu-theme ;
|
||||
<filled-pile>
|
||||
-roll
|
||||
[ <menu-item> add-gadget ] with with each
|
||||
5 <border> menu-theme ;
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@ ARTICLE: "ui-pack-layout" "Pack layouts"
|
|||
{ $subsection make-pile }
|
||||
{ $subsection make-filled-pile }
|
||||
{ $subsection make-shelf }
|
||||
{ $subsection gadget, }
|
||||
|
||||
"For more control, custom layouts can reuse portions of pack layout logic:"
|
||||
{ $subsection pack-pref-dim }
|
||||
{ $subsection pack-layout } ;
|
||||
|
|
@ -66,14 +66,14 @@ HELP: pack-pref-dim
|
|||
|
||||
HELP: make-pile
|
||||
{ $values { "quot" quotation } { "pack" "a new " { $link pack } } }
|
||||
{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets vertically. The quotation can add children by calling the " { $link gadget, } " word." } ;
|
||||
{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets vertically. The quotation can add children by calling the gadget, word." } ;
|
||||
|
||||
HELP: make-filled-pile
|
||||
{ $values { "quot" quotation } { "pack" "a new " { $link pack } } }
|
||||
{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets vertically, such that all gadgets have the same width. The quotation can add children by calling the " { $link gadget, } " word." } ;
|
||||
{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets vertically, such that all gadgets have the same width. The quotation can add children by calling the gadget, word." } ;
|
||||
|
||||
HELP: make-shelf
|
||||
{ $values { "quot" quotation } { "pack" "a new " { $link pack } } }
|
||||
{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets horizontally. The quotation can add children by calling the " { $link gadget, } " word." } ;
|
||||
{ $description "Creates a new " { $link pack } " which lays out a sequence of gadgets horizontally. The quotation can add children by calling the gadget, word." } ;
|
||||
|
||||
ABOUT: "ui-pack-layout"
|
||||
|
|
|
|||
|
|
@ -49,6 +49,10 @@ M: track pref-dim*
|
|||
: track-add ( gadget track constraint -- )
|
||||
over track-sizes push swap add-gadget drop ;
|
||||
|
||||
: track-add* ( track gadget constraint -- track )
|
||||
pick sizes>> push
|
||||
add-gadget ;
|
||||
|
||||
: track, ( gadget constraint -- )
|
||||
gadget get swap track-add ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,12 +1,13 @@
|
|||
! Copyright (C) 2006, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays ui ui.commands ui.gestures ui.gadgets
|
||||
ui.gadgets.worlds ui.gadgets.packs ui.gadgets.buttons
|
||||
ui.gadgets.labels ui.gadgets.panes ui.gadgets.presentations
|
||||
ui.gadgets.viewports ui.gadgets.lists ui.gadgets.tracks
|
||||
ui.gadgets.scrollers ui.gadgets.panes hashtables io kernel math
|
||||
models namespaces sequences sequences words continuations
|
||||
debugger prettyprint ui.tools.traceback help editors ;
|
||||
ui.gadgets.worlds ui.gadgets.packs ui.gadgets.buttons
|
||||
ui.gadgets.labels ui.gadgets.panes ui.gadgets.presentations
|
||||
ui.gadgets.viewports ui.gadgets.lists ui.gadgets.tracks
|
||||
ui.gadgets.scrollers ui.gadgets.panes hashtables io kernel math
|
||||
models namespaces sequences sequences words continuations
|
||||
debugger prettyprint ui.tools.traceback help editors ;
|
||||
|
||||
IN: ui.tools.debugger
|
||||
|
||||
: <restart-list> ( restarts restart-hook -- gadget )
|
||||
|
|
@ -15,18 +16,18 @@ IN: ui.tools.debugger
|
|||
TUPLE: debugger < track restarts ;
|
||||
|
||||
: <debugger-display> ( restart-list error -- gadget )
|
||||
[
|
||||
<pane> [ [ print-error ] with-pane ] keep gadget,
|
||||
gadget,
|
||||
] make-filled-pile ;
|
||||
<filled-pile>
|
||||
<pane>
|
||||
swapd tuck [ print-error ] with-pane
|
||||
add-gadget
|
||||
|
||||
swap add-gadget ;
|
||||
|
||||
: <debugger> ( error restarts restart-hook -- gadget )
|
||||
{ 0 1 } debugger new-track
|
||||
[
|
||||
toolbar,
|
||||
<restart-list> g-> set-debugger-restarts
|
||||
swap <debugger-display> <scroller> 1 track,
|
||||
] make-gadget ;
|
||||
dup <toolbar> f track-add*
|
||||
-rot <restart-list> >>restarts
|
||||
dup restarts>> rot <debugger-display> <scroller> 1 track-add* ;
|
||||
|
||||
M: debugger focusable-child* debugger-restarts ;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,62 +1,65 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: ui.gadgets colors kernel ui.render namespaces
|
||||
models models.mapping sequences ui.gadgets.buttons
|
||||
ui.gadgets.packs ui.gadgets.labels tools.deploy.config
|
||||
namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures
|
||||
ui.commands assocs ui.gadgets.tracks ui ui.tools.listener
|
||||
tools.deploy vocabs ui.tools.workspace system accessors ;
|
||||
models models.mapping sequences ui.gadgets.buttons
|
||||
ui.gadgets.packs ui.gadgets.labels tools.deploy.config
|
||||
namespaces ui.gadgets.editors ui.gadgets.borders ui.gestures
|
||||
ui.commands assocs ui.gadgets.tracks ui ui.tools.listener
|
||||
tools.deploy vocabs ui.tools.workspace system accessors ;
|
||||
|
||||
IN: ui.tools.deploy
|
||||
|
||||
TUPLE: deploy-gadget < pack vocab settings ;
|
||||
|
||||
: bundle-name ( -- )
|
||||
: bundle-name ( parent -- parent )
|
||||
deploy-name get <field>
|
||||
"Executable name:" label-on-left gadget, ;
|
||||
"Executable name:" label-on-left add-gadget ;
|
||||
|
||||
: deploy-ui ( -- )
|
||||
: deploy-ui ( parent -- parent )
|
||||
deploy-ui? get
|
||||
"Include user interface framework" <checkbox> gadget, ;
|
||||
"Include user interface framework" <checkbox> add-gadget ;
|
||||
|
||||
: exit-when-windows-closed ( -- )
|
||||
: exit-when-windows-closed ( parent -- parent )
|
||||
"stop-after-last-window?" get
|
||||
"Exit when last UI window closed" <checkbox> gadget, ;
|
||||
"Exit when last UI window closed" <checkbox> add-gadget ;
|
||||
|
||||
: io-settings ( -- )
|
||||
"Input/output support:" <label> gadget,
|
||||
deploy-io get deploy-io-options <radio-buttons> gadget, ;
|
||||
: io-settings ( parent -- parent )
|
||||
"Input/output support:" <label> add-gadget
|
||||
deploy-io get deploy-io-options <radio-buttons> add-gadget ;
|
||||
|
||||
: reflection-settings ( -- )
|
||||
"Reflection support:" <label> gadget,
|
||||
deploy-reflection get deploy-reflection-options <radio-buttons> gadget, ;
|
||||
: reflection-settings ( parent -- parent )
|
||||
"Reflection support:" <label> add-gadget
|
||||
deploy-reflection get deploy-reflection-options <radio-buttons> add-gadget ;
|
||||
|
||||
: advanced-settings ( -- )
|
||||
"Advanced:" <label> gadget,
|
||||
deploy-compiler? get "Use optimizing compiler" <checkbox> gadget,
|
||||
deploy-math? get "Rational and complex number support" <checkbox> gadget,
|
||||
deploy-threads? get "Threading support" <checkbox> gadget,
|
||||
deploy-random? get "Random number generator support" <checkbox> gadget,
|
||||
deploy-word-props? get "Retain all word properties" <checkbox> gadget,
|
||||
deploy-word-defs? get "Retain all word definitions" <checkbox> gadget,
|
||||
deploy-c-types? get "Retain all C types" <checkbox> gadget, ;
|
||||
: advanced-settings ( parent -- parent )
|
||||
"Advanced:" <label> add-gadget
|
||||
deploy-compiler? get "Use optimizing compiler" <checkbox> add-gadget
|
||||
deploy-math? get "Rational and complex number support" <checkbox> add-gadget
|
||||
deploy-threads? get "Threading support" <checkbox> add-gadget
|
||||
deploy-random? get "Random number generator support" <checkbox> add-gadget
|
||||
deploy-word-props? get "Retain all word properties" <checkbox> add-gadget
|
||||
deploy-word-defs? get "Retain all word definitions" <checkbox> add-gadget
|
||||
deploy-c-types? get "Retain all C types" <checkbox> add-gadget ;
|
||||
|
||||
: deploy-settings-theme ( gadget -- )
|
||||
{ 10 10 } >>gap
|
||||
1 >>fill
|
||||
drop ;
|
||||
: deploy-settings-theme ( gadget -- gadget )
|
||||
{ 10 10 } >>gap
|
||||
1 >>fill ;
|
||||
|
||||
: <deploy-settings> ( vocab -- control )
|
||||
default-config [ <model> ] assoc-map [
|
||||
default-config [ <model> ] assoc-map
|
||||
[
|
||||
<pile>
|
||||
bundle-name
|
||||
deploy-ui
|
||||
os macosx? [ exit-when-windows-closed ] when
|
||||
io-settings
|
||||
reflection-settings
|
||||
advanced-settings
|
||||
] make-pile dup deploy-settings-theme
|
||||
namespace <mapping> over set-gadget-model
|
||||
] bind ;
|
||||
|
||||
deploy-settings-theme
|
||||
namespace <mapping> over set-gadget-model
|
||||
]
|
||||
bind ;
|
||||
|
||||
: find-deploy-gadget ( gadget -- deploy-gadget )
|
||||
[ deploy-gadget? ] find-parent ;
|
||||
|
|
@ -101,21 +104,16 @@ deploy-gadget "toolbar" f {
|
|||
{ T{ key-down f f "RET" } com-deploy }
|
||||
} define-command-map
|
||||
|
||||
: buttons, ( -- )
|
||||
g <toolbar> { 10 10 } over set-pack-gap gadget, ;
|
||||
|
||||
: <deploy-gadget> ( vocab -- gadget )
|
||||
deploy-gadget new-gadget
|
||||
swap >>vocab
|
||||
{ 0 1 } >>orientation
|
||||
[
|
||||
g vocab>> <deploy-settings>
|
||||
g-> set-deploy-gadget-settings gadget,
|
||||
buttons,
|
||||
] make-gadget
|
||||
dup deploy-settings-theme
|
||||
over >>vocab
|
||||
{ 0 1 } >>orientation
|
||||
swap <deploy-settings> >>settings
|
||||
dup settings>> add-gadget
|
||||
dup <toolbar> { 10 10 } >>gap add-gadget
|
||||
deploy-settings-theme
|
||||
dup com-revert ;
|
||||
|
||||
|
||||
: deploy-tool ( vocab -- )
|
||||
vocab-name dup <deploy-gadget> 10 <border>
|
||||
"Deploying \"" rot "\"" 3append open-window ;
|
||||
|
|
|
|||
|
|
@ -47,12 +47,12 @@ search-field H{
|
|||
{ T{ key-down f f "RET" } [ find-search-list invoke-value-action ] }
|
||||
} set-gestures
|
||||
|
||||
: <search-model> ( producer -- model )
|
||||
>r g live-search-field gadget-model
|
||||
: <search-model> ( live-search producer -- live-search filter )
|
||||
>r dup field>> model>> ! live-search model :: producer
|
||||
ui-running? [ 1/5 seconds <delay> ] when
|
||||
[ "\n" join ] r> append <filter> ;
|
||||
|
||||
: <search-list> ( seq limited? presenter -- gadget )
|
||||
: <search-list> ( live-search seq limited? presenter -- live-search list )
|
||||
>r
|
||||
[ limited-completions ] [ completions ] ? curry
|
||||
<search-model>
|
||||
|
|
@ -60,14 +60,15 @@ search-field H{
|
|||
swap <list> ;
|
||||
|
||||
: <live-search> ( string seq limited? presenter -- gadget )
|
||||
{ 0 1 } live-search new-track
|
||||
[
|
||||
<search-field> g-> set-live-search-field f track,
|
||||
<search-list> g-> set-live-search-list
|
||||
<scroller> 1 track,
|
||||
] make-gadget
|
||||
[ live-search-field set-editor-string ] keep
|
||||
[ live-search-field end-of-document ] keep ;
|
||||
{ 0 1 } live-search new-track
|
||||
<search-field> >>field
|
||||
dup field>> f track-add*
|
||||
-roll <search-list> >>list
|
||||
dup list>> <scroller> 1 track-add*
|
||||
|
||||
swap
|
||||
over field>> set-editor-string
|
||||
dup field>> end-of-document ;
|
||||
|
||||
M: live-search focusable-child* live-search-field ;
|
||||
|
||||
|
|
|
|||
|
|
@ -235,7 +235,7 @@ $nl
|
|||
$nl
|
||||
"Gadget construction combinators whose names are prefixed with " { $snippet "make-" } " construct new gadgets and push them on the stack. The primitive combinator used to define all combinators of this form:"
|
||||
{ $subsection make-gadget }
|
||||
"Words such as " { $link gadget, } " and " { $link track, } " access the gadget through the " { $link gadget } " variable."
|
||||
"Words such as " { $link track, } " access the gadget through the " { $link gadget } " variable."
|
||||
$nl
|
||||
"A combinator which stores a gadget in the " { $link gadget } " variable:"
|
||||
{ $subsection with-gadget }
|
||||
|
|
|
|||
Loading…
Reference in New Issue