diff --git a/extra/ui/commands/commands-docs.factor b/extra/ui/commands/commands-docs.factor
index 134488fa8f..804236dadc 100644
--- a/extra/ui/commands/commands-docs.factor
+++ b/extra/ui/commands/commands-docs.factor
@@ -73,7 +73,7 @@ HELP: command-word
HELP: command-map
{ $values { "group" string } { "class" "a class word" } { "command-map" "a " { $link command-map } " or " { $link f } } }
{ $description "Outputs a named command map defined on a class." }
-{ $class-description "A command map stores a group of related commands. Instances of this class delegate to arrays so behave like sequences; additionally the " { $link command-map-blurb } " slot stores a string description of the command group, or " { $link f } "."
+{ $class-description "A command map stores a group of related commands. The " { $snippet "commands" } " slot stores an association list mapping gestures to commands, and the " { $snippet "blurb" } " slot stores an optional one-line description string of this command map."
$nl
"Command maps are created by calling " { $link <command-map> } " or " { $link define-command-map } "." } ;
diff --git a/extra/ui/gadgets/buttons/buttons-docs.factor b/extra/ui/gadgets/buttons/buttons-docs.factor
index 02ddcc3d8a..64cc7bd1c8 100755
--- a/extra/ui/gadgets/buttons/buttons-docs.factor
+++ b/extra/ui/gadgets/buttons/buttons-docs.factor
@@ -11,7 +11,7 @@ $nl
HELP: <button>
{ $values { "gadget" gadget } { "quot" "a quotation with stack effect " { $snippet "( button -- )" } } { "button" "a new " { $link button } } }
-{ $description "Creates a new " { $link button } " which calls the quotation when clicked. The given gadget becomes the button's delegate." } ;
+{ $description "Creates a new " { $link button } " which calls the quotation when clicked. The given gadget becomes the button's only child." } ;
HELP: <roll-button>
{ $values { "label" "a label specifier" } { "quot" "a quotation with stack effect " { $snippet "( button -- )" } } { "button" button } }
diff --git a/extra/ui/gadgets/editors/editors.factor b/extra/ui/gadgets/editors/editors.factor
index 8cdc65b388..1732d404ca 100755
--- a/extra/ui/gadgets/editors/editors.factor
+++ b/extra/ui/gadgets/editors/editors.factor
@@ -480,7 +480,7 @@ multiline-editor "general" f {
{ T{ key-down f f "ENTER" } insert-newline }
} define-command-map
-TUPLE: source-editor < editor ;
+TUPLE: source-editor < multiline-editor ;
: <source-editor> ( -- editor )
source-editor new-editor ;
diff --git a/extra/ui/gadgets/frames/frames-docs.factor b/extra/ui/gadgets/frames/frames-docs.factor
index 26f72bcc57..bb759cf92e 100755
--- a/extra/ui/gadgets/frames/frames-docs.factor
+++ b/extra/ui/gadgets/frames/frames-docs.factor
@@ -3,7 +3,7 @@ quotations classes.tuple ui.gadgets.grids ;
IN: ui.gadgets.frames
ARTICLE: "ui-frame-layout" "Frame layouts"
-"Frames resemble " { $link "ui-grid-layout" } " except the size of grid is fixed at 3x3, and the center gadget fills up any available space. Because frames delegate to grids, grid layout words can be used to add and remove children."
+"Frames resemble " { $link "ui-grid-layout" } " except the size of grid is fixed at 3x3, and the center gadget fills up any available space. Because frames inherit from grids, grid layout words can be used to add and remove children."
{ $subsection frame }
"Creating empty frames:"
{ $subsection <frame> }
@@ -38,7 +38,7 @@ HELP: @bottom-right $ui-frame-constant ;
HELP: frame
{ $class-description "A frame is a gadget which lays out its children in a 3x3 grid. If the frame is enlarged past its preferred size, the center gadget fills up available room."
$nl
-"Frames are constructed by calling " { $link <frame> } " and since they delegate to " { $link grid } " instances, children can be managed with " { $link grid-add } " and " { $link grid-remove } "." } ;
+"Frames are constructed by calling " { $link <frame> } " and since they inherit from " { $link grid } ", children can be managed with " { $link grid-add } " and " { $link grid-remove } "." } ;
HELP: <frame>
{ $values { "frame" frame } }
diff --git a/extra/ui/gadgets/frames/frames.factor b/extra/ui/gadgets/frames/frames.factor
index df1b7aa654..096d916a9b 100644
--- a/extra/ui/gadgets/frames/frames.factor
+++ b/extra/ui/gadgets/frames/frames.factor
@@ -39,7 +39,7 @@ M: frame layout*
grid-layout ;
: make-frame ( quot -- frame )
- <frame> make-gadget ; inline
+ <frame> swap make-gadget ; inline
: frame, ( gadget i j -- )
- \ make-gadget get -rot grid-add ;
+ gadget get -rot grid-add ;
diff --git a/extra/ui/gadgets/gadgets-docs.factor b/extra/ui/gadgets/gadgets-docs.factor
index f05126fec3..8093aa5dc5 100755
--- a/extra/ui/gadgets/gadgets-docs.factor
+++ b/extra/ui/gadgets/gadgets-docs.factor
@@ -235,8 +235,8 @@ HELP: 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 { "quot" quotation } { "gadget" gadget } }
-{ $description "Calls the quotation in a new scope with the gadget stored in the " { $link make-gadget } " variable." } ;
+{ $values { "gadget" gadget } { "quot" quotation } }
+{ $description "Calls the quotation in a new scope with the gadget stored in the " { $link gadget } " variable." } ;
HELP: with-gadget
{ $values { "gadget" gadget } { "quot" quotation } }
diff --git a/extra/ui/gadgets/gadgets-tests.factor b/extra/ui/gadgets/gadgets-tests.factor
index 3afe98ad2c..dbb2919277 100755
--- a/extra/ui/gadgets/gadgets-tests.factor
+++ b/extra/ui/gadgets/gadgets-tests.factor
@@ -1,8 +1,8 @@
IN: ui.gadgets.tests
-USING: ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test
-namespaces models kernel dlists dequeues math sets
-math.parser ui sequences hashtables assocs io arrays
-prettyprint io.streams.string ;
+USING: accessors ui.gadgets ui.gadgets.packs ui.gadgets.worlds
+tools.test namespaces models kernel dlists dequeues math sets
+math.parser ui sequences hashtables assocs io arrays prettyprint
+io.streams.string ;
[ T{ rect f { 10 10 } { 20 20 } } ]
[
@@ -104,10 +104,10 @@ prettyprint io.streams.string ;
[ t ] [ { 25 25 } "g1" get pick-up "g4" get eq? ] unit-test
-TUPLE: mock-gadget graft-called ungraft-called ;
+TUPLE: mock-gadget < gadget graft-called ungraft-called ;
: <mock-gadget> ( -- gadget )
- 0 0 mock-gadget boa <gadget> over set-delegate ;
+ mock-gadget new-gadget 0 >>graft-called 0 >>ungraft-called ;
M: mock-gadget graft*
dup mock-gadget-graft-called 1+
diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor
index 58b58d4fdc..5bfb5a1b05 100755
--- a/extra/ui/gadgets/gadgets.factor
+++ b/extra/ui/gadgets/gadgets.factor
@@ -391,19 +391,17 @@ M: f request-focus-on 2drop ;
: focus-path ( world -- seq )
[ gadget-focus ] follow ;
-: make-gadget ( quot gadget -- gadget )
- [ \ make-gadget rot with-variable ] keep ; inline
-
-: gadget, ( gadget -- ) \ make-gadget get add-gadget ;
+: gadget, ( gadget -- ) gadget get add-gadget ;
: g ( -- gadget ) gadget get ;
: g-> ( x -- x x gadget ) dup g ;
: with-gadget ( gadget quot -- )
- [
- swap dup \ make-gadget set gadget set call
- ] with-scope ; inline
+ gadget swap with-variable ; inline
+
+: make-gadget ( gadget quot -- gadget )
+ [ with-gadget ] [ drop ] 2bi ; inline
! Deprecated
: set-gadget-delegate ( gadget tuple -- )
diff --git a/extra/ui/gadgets/incremental/incremental-docs.factor b/extra/ui/gadgets/incremental/incremental-docs.factor
index cbeb34bf74..83b007a99f 100755
--- a/extra/ui/gadgets/incremental/incremental-docs.factor
+++ b/extra/ui/gadgets/incremental/incremental-docs.factor
@@ -2,7 +2,7 @@ USING: ui.gadgets help.markup help.syntax ui.gadgets.packs ;
IN: ui.gadgets.incremental
HELP: incremental
-{ $class-description "An incremental layout gadget delegates to a " { $link pack } " and implements an optimization which the relayout operation after adding a child to be done in constant time."
+{ $class-description "Incremental layout gadgets inherit from " { $link pack } " and implement an optimization where the relayout operation after adding a child to be done in constant time."
$nl
"Incremental layout gadgets are created by calling " { $link <incremental> } "."
$nl
diff --git a/extra/ui/gadgets/labelled/labelled.factor b/extra/ui/gadgets/labelled/labelled.factor
index ee27620273..2cb69d6061 100755
--- a/extra/ui/gadgets/labelled/labelled.factor
+++ b/extra/ui/gadgets/labelled/labelled.factor
@@ -13,11 +13,9 @@ TUPLE: labelled-gadget < track content ;
: <labelled-gadget> ( gadget title -- newgadget )
{ 0 1 } labelled-gadget new-track
[
- [
- <label> reverse-video-theme f track,
- g-> set-labelled-gadget-content 1 track,
- ] with-gadget
- ] keep ;
+ <label> reverse-video-theme f track,
+ g-> set-labelled-gadget-content 1 track,
+ ] make-gadget ;
M: labelled-gadget focusable-child* labelled-gadget-content ;
@@ -54,10 +52,8 @@ TUPLE: closable-gadget < frame content ;
: <closable-gadget> ( gadget title quot -- gadget )
closable-gadget new-frame
[
- [
- <title-bar> @top frame,
- g-> set-closable-gadget-content @center frame,
- ] with-gadget
- ] keep ;
+ <title-bar> @top frame,
+ g-> set-closable-gadget-content @center frame,
+ ] make-gadget ;
M: closable-gadget focusable-child* closable-gadget-content ;
diff --git a/extra/ui/gadgets/packs/packs-docs.factor b/extra/ui/gadgets/packs/packs-docs.factor
index cd82e9054c..d44c9fa87d 100755
--- a/extra/ui/gadgets/packs/packs-docs.factor
+++ b/extra/ui/gadgets/packs/packs-docs.factor
@@ -34,13 +34,13 @@ HELP: pack
{ { $link pack-fill } " a rational number between 0 and 1, where 0 gives each gadget its preferred size and 1 fills the dimension perpendicular to the pack's orientation" }
{ { $link pack-gap } " a pair of integers, the horizontal and vertical gap between children" }
}
-"Gadgets can delegate to packs and implement their own " { $link pref-dim* } " and " { $link layout* } " methods, reusing pack layout logic by calling " { $link pack-pref-dim } " and " { $link pack-layout } "." } ;
+"Custom gadgets can inherit from the " { $link pack } " class and implement their own " { $link pref-dim* } " and " { $link layout* } " methods, reusing pack layout logic by calling " { $link pack-pref-dim } " and " { $link pack-layout } "." } ;
HELP: pack-layout
{ $values { "pack" "a new " { $link pack } } { "sizes" "a sequence of pairs of integers" } }
{ $description "Lays out the pack's children along the " { $link gadget-orientation } " of the pack, with each gadget receiving its size from the corresponding index of the " { $snippet "sizes" } " sequence." }
{ $notes
- "This word is useful if you are writing your own layout gadget which delegates to a " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure."
+ "This word is useful if you are writing your own layout gadget which inherits from " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure."
} ;
HELP: <pack>
@@ -61,7 +61,7 @@ HELP: pack-pref-dim
{ $values { "gadget" gadget } { "sizes" "a sequence of pairs of integers" } { "dim" "a pair of integers" } }
{ $description "Computes the preferred size of a pack, with each gadget receiving its size from the corresponding index of the " { $snippet "sizes" } " sequence." }
{ $notes
- "This word is useful if you are writing your own layout gadget which delegates to a " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure."
+ "This word is useful if you are writing your own layout gadget which inherits from " { $link pack } ". This allows you to reuse layout logic while computing gadget sizes using a custom procedure."
} ;
HELP: make-pile
diff --git a/extra/ui/gadgets/packs/packs.factor b/extra/ui/gadgets/packs/packs.factor
index 3503d8e530..00f27af270 100755
--- a/extra/ui/gadgets/packs/packs.factor
+++ b/extra/ui/gadgets/packs/packs.factor
@@ -62,10 +62,10 @@ M: pack children-on ( rect gadget -- seq )
[ fast-children-on ] keep <slice> ;
: make-pile ( quot -- pack )
- <pile> make-gadget ; inline
+ <pile> swap make-gadget ; inline
: make-filled-pile ( quot -- pack )
- <filled-pile> make-gadget ; inline
+ <filled-pile> swap make-gadget ; inline
: make-shelf ( quot -- pack )
- <shelf> make-gadget ; inline
+ <shelf> swap make-gadget ; inline
diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor
index 7f8e5044eb..8cac3f4400 100755
--- a/extra/ui/gadgets/scrollers/scrollers.factor
+++ b/extra/ui/gadgets/scrollers/scrollers.factor
@@ -30,15 +30,15 @@ scroller H{
} set-gestures
: viewport, ( child -- )
- g gadget-model <viewport>
+ g model>> <viewport>
g-> set-scroller-viewport @center frame, ;
: <scroller-model> ( -- model )
0 0 0 0 <range> 0 0 0 0 <range> 2array <compose> ;
-: x-model ( -- model ) g gadget-model model-dependencies first ;
+: x-model ( -- model ) g model>> dependencies>> first ;
-: y-model ( -- model ) g gadget-model model-dependencies second ;
+: y-model ( -- model ) g model>> dependencies>> second ;
: new-scroller ( gadget class -- scroller )
new-frame
@@ -46,12 +46,10 @@ scroller H{
<scroller-model> >>model
faint-boundary
[
- [
- x-model <x-slider> g-> set-scroller-x @bottom frame,
- y-model <y-slider> g-> set-scroller-y @right frame,
- viewport,
- ] with-gadget
- ] keep ;
+ x-model <x-slider> g-> set-scroller-x @bottom frame,
+ y-model <y-slider> g-> set-scroller-y @right frame,
+ viewport,
+ ] make-gadget ;
: <scroller> ( gadget -- scroller )
scroller new-scroller ;
@@ -78,7 +76,7 @@ scroller H{
] keep dup scroller-value rot v+ swap scroll ;
: relative-scroll-rect ( rect gadget scroller -- newrect )
- scroller-viewport gadget-child relative-loc offset-rect ;
+ viewport>> gadget-child relative-loc offset-rect ;
: find-scroller* ( gadget -- scroller )
dup find-scroller dup [
@@ -121,13 +119,15 @@ scroller H{
: scroll>top ( gadget -- )
<zero-rect> swap scroll>rect ;
-: update-scroller ( scroller follows -- )
- {
- { [ dup t eq? ] [ drop (scroll>bottom) ] }
- { [ dup rect? ] [ swap (scroll>rect) ] }
- { [ dup ] [ swap (scroll>gadget) ] }
- [ drop dup scroller-value swap scroll ]
- } cond ;
+GENERIC: update-scroller ( scroller follows -- )
+
+M: t update-scroller drop (scroll>bottom) ;
+
+M: gadget update-scroller swap (scroll>gadget) ;
+
+M: rect update-scroller swap (scroll>rect) ;
+
+M: f update-scroller drop dup scroller-value swap scroll ;
M: scroller layout*
dup call-next-method
diff --git a/extra/ui/gadgets/sliders/sliders.factor b/extra/ui/gadgets/sliders/sliders.factor
index 56bfb0bc80..da18dea142 100755
--- a/extra/ui/gadgets/sliders/sliders.factor
+++ b/extra/ui/gadgets/sliders/sliders.factor
@@ -149,12 +149,12 @@ M: elevator layout*
: <right-button> ( -- button )
{ 0 1 } arrow-right 1 <slide-button> ;
-: build-x-slider ( slider -- )
+: build-x-slider ( slider -- slider )
[
<left-button> @left frame,
{ 0 1 } elevator,
<right-button> @right frame,
- ] with-gadget ;
+ ] make-gadget ; inline
: <up-button> ( -- button )
{ 1 0 } arrow-up -1 <slide-button> ;
@@ -162,12 +162,12 @@ M: elevator layout*
: <down-button> ( -- button )
{ 1 0 } arrow-down 1 <slide-button> ;
-: build-y-slider ( slider -- )
+: build-y-slider ( slider -- slider )
[
<up-button> @top frame,
{ 1 0 } elevator,
<down-button> @bottom frame,
- ] with-gadget ;
+ ] make-gadget ; inline
: <slider> ( range orientation -- slider )
slider new-frame
@@ -176,10 +176,10 @@ M: elevator layout*
32 >>line ;
: <x-slider> ( range -- slider )
- { 1 0 } <slider> dup build-x-slider ;
+ { 1 0 } <slider> build-x-slider ;
: <y-slider> ( range -- slider )
- { 0 1 } <slider> dup build-y-slider ;
+ { 0 1 } <slider> build-y-slider ;
M: slider pref-dim*
dup call-next-method
diff --git a/extra/ui/gadgets/slots/slots.factor b/extra/ui/gadgets/slots/slots.factor
index 1b101e5bf7..2c2831a2ee 100755
--- a/extra/ui/gadgets/slots/slots.factor
+++ b/extra/ui/gadgets/slots/slots.factor
@@ -72,12 +72,10 @@ M: value-ref finish-editing
{ 0 1 } slot-editor new-track
swap >>ref
[
- [
- toolbar,
- <source-editor> g-> set-slot-editor-text
- <scroller> 1 track,
- ] with-gadget
- ] keep
+ toolbar,
+ <source-editor> g-> set-slot-editor-text
+ <scroller> 1 track,
+ ] make-gadget
dup revert ;
M: slot-editor pref-dim* call-next-method { 600 200 } vmin ;
diff --git a/extra/ui/gadgets/tabs/tabs.factor b/extra/ui/gadgets/tabs/tabs.factor
index 18542f1089..1b4f633609 100755
--- a/extra/ui/gadgets/tabs/tabs.factor
+++ b/extra/ui/gadgets/tabs/tabs.factor
@@ -4,11 +4,11 @@
USING: accessors kernel fry math math.vectors sequences arrays vectors assocs
hashtables models models.range models.compose combinators
ui ui.gadgets ui.gadgets.buttons ui.gadgets.frames ui.gadgets.packs
- ui.gadgets.incremental ui.gadgets.viewports ui.gadgets.books ;
+ ui.gadgets.grids ui.gadgets.viewports ui.gadgets.books ;
IN: ui.gadgets.tabs
-TUPLE: tabbed names model toggler content ;
+TUPLE: tabbed < frame names toggler content ;
DEFER: (del-page)
@@ -48,8 +48,9 @@ DEFER: (del-page)
[ names>> index ] 2keep (del-page) ;
: <tabbed> ( assoc -- tabbed )
- tabbed new
- [ <pile> 1 >>fill g-> (>>toggler) @left frame,
- [ keys >vector g (>>names) ]
- [ values 0 <model> [ <book> g-> (>>content) @center frame, ] keep ] bi
- g swap >>model redo-toggler ] build-frame ;
+ tabbed new-frame
+ [ g 0 <model> >>model
+ <pile> 1 >>fill [ >>toggler ] keep swap @left grid-add
+ [ keys g swap >>names ]
+ [ values g model>> <book> [ >>content ] keep swap @center grid-add ] bi
+ g redo-toggler g ] with-gadget ;
diff --git a/extra/ui/gadgets/tracks/tracks.factor b/extra/ui/gadgets/tracks/tracks.factor
index d2d4275750..f9276fd1a1 100644
--- a/extra/ui/gadgets/tracks/tracks.factor
+++ b/extra/ui/gadgets/tracks/tracks.factor
@@ -50,10 +50,10 @@ M: track pref-dim*
over track-sizes push add-gadget ;
: track, ( gadget constraint -- )
- \ make-gadget get swap track-add ;
+ gadget get swap track-add ;
: make-track ( quot orientation -- track )
- <track> make-gadget ; inline
+ <track> swap make-gadget ; inline
: track-remove ( gadget track -- )
over [
diff --git a/extra/ui/gadgets/worlds/worlds-docs.factor b/extra/ui/gadgets/worlds/worlds-docs.factor
index 75a4f4ff12..50b100bee7 100755
--- a/extra/ui/gadgets/worlds/worlds-docs.factor
+++ b/extra/ui/gadgets/worlds/worlds-docs.factor
@@ -27,7 +27,7 @@ HELP: focus-path
{ $notes "This word is used to avoid sending " { $link gain-focus } " gestures to a gadget which requests focus on an unfocused top-level window, so that, for instance, a text editing caret does not appear in this case." } ;
HELP: world
-{ $class-description "A gadget which appears at the top of the gadget hieararchy, and in turn may be displayed in a native window. Worlds delegate to " { $link gadget } " instances and have the following slots:"
+{ $class-description "A gadget which appears at the top of the gadget hieararchy, and in turn may be displayed in a native window. Worlds have the following slots:"
{ $list
{ { $snippet "active?" } " - if set to " { $link f } ", the world will not be drawn. This slot is set to " { $link f } " if an error is thrown while drawing the world; this prevents multiple debugger windows from being shown." }
{ { $snippet "glass" } " - a glass pane in front of the primary gadget, used to implement behaviors such as popup menus which are hidden when the mouse is clicked outside the menu." }
diff --git a/extra/ui/render/render-docs.factor b/extra/ui/render/render-docs.factor
index 98adf379df..d48d7c99d9 100755
--- a/extra/ui/render/render-docs.factor
+++ b/extra/ui/render/render-docs.factor
@@ -5,21 +5,21 @@ IN: ui.render
HELP: gadget
{ $class-description "An object which displays itself on the screen and acts on user input gestures. Gadgets have the following slots:"
{ $list
- { { $link gadget-pref-dim } " - a cached value for " { $link pref-dim } "; do not read or write this slot directly." }
- { { $link gadget-parent } " - the gadget containing this one, or " { $link f } " if this gadget is not part of the visible gadget hierarchy." }
- { { $link gadget-children } " - a vector of child gadgets. Do not modify this vector directly, instead use " { $link add-gadget } ", " { $link add-gadgets } ", " { $link unparent } " or " { $link clear-gadget } "." }
- { { $link gadget-orientation } " - an orientation specifier. This slot is used by layout gadgets." }
- { { $link gadget-layout-state } " - stores the layout state of the gadget. Do not read or write this slot directly, instead call " { $link relayout } " and " { $link relayout-1 } " if the gadget needs to be re-laid out." }
- { { $link gadget-visible? } " - a boolean indicating if the gadget should display and receive user input." }
- { { $link gadget-root? } " - if set to " { $link t } ", layout changes in this gadget will not propagate to the gadget's parent." }
- { { $link gadget-clipped? } " - a boolean indicating if clipping will be enabled when drawing this gadget's children." }
- { { $link gadget-interior } " - an object whose class implements the " { $link draw-interior } " generic word." }
- { { $link gadget-boundary } " - an object whose class implements the " { $link draw-boundary } " generic word." }
- { { $link gadget-model } " - a " { $link model } " or " { $link f } "; see " { $link "ui-control-impl" } }
+ { { $link "pref-dim" } " - a cached value for " { $link pref-dim } "; do not read or write this slot directly." }
+ { { $link "parent" } " - the gadget containing this one, or " { $link f } " if this gadget is not part of the visible gadget hierarchy." }
+ { { $link "children" } " - a vector of child gadgets. Do not modify this vector directly, instead use " { $link add-gadget } ", " { $link add-gadgets } ", " { $link unparent } " or " { $link clear-gadget } "." }
+ { { $link "orientation" } " - an orientation specifier. This slot is used by layout gadgets." }
+ { { $link "layout-state" } " - stores the layout state of the gadget. Do not read or write this slot directly, instead call " { $link relayout } " and " { $link relayout-1 } " if the gadget needs to be re-laid out." }
+ { { $link "visible?" } " - a boolean indicating if the gadget should display and receive user input." }
+ { { $link "root?" } " - if set to " { $link t } ", layout changes in this gadget will not propagate to the gadget's parent." }
+ { { $link "clipped?" } " - a boolean indicating if clipping will be enabled when drawing this gadget's children." }
+ { { $link "interior" } " - an object whose class implements the " { $link draw-interior } " generic word." }
+ { { $link "boundary" } " - an object whose class implements the " { $link draw-boundary } " generic word." }
+ { { $link "model" } " - a " { $link model } " or " { $link f } "; see " { $link "ui-control-impl" } }
}
"Gadgets subclass the " { $link rect } " class, and thus all instances have " { $snippet "loc" } " and " { $snippet "dim" } " instances holding their location and dimensions." }
{ $notes
-"Other classes may delegate to " { $link gadget } " in order to re-implement generic words such as " { $link draw-gadget* } " and " { $link user-input* } ", or to define gestures with " { $link set-gestures } "." } ;
+"Other classes may inherit from " { $link gadget } " in order to re-implement generic words such as " { $link draw-gadget* } " and " { $link user-input* } ", or to define gestures with " { $link set-gestures } "." } ;
HELP: clip
{ $var-description "The current clipping rectangle." } ;
diff --git a/extra/ui/tools/browser/browser.factor b/extra/ui/tools/browser/browser.factor
index d8d2ac0104..421ffdbaaf 100755
--- a/extra/ui/tools/browser/browser.factor
+++ b/extra/ui/tools/browser/browser.factor
@@ -23,12 +23,10 @@ TUPLE: browser-gadget < track pane history ;
{ 0 1 } browser-gadget new-track
dup init-history
[
- [
- toolbar,
- g <help-pane> g-> set-browser-gadget-pane
- <scroller> 1 track,
- ] with-gadget
- ] keep ;
+ toolbar,
+ g <help-pane> g-> set-browser-gadget-pane
+ <scroller> 1 track,
+ ] make-gadget ;
M: browser-gadget call-tool* show-help ;
diff --git a/extra/ui/tools/debugger/debugger.factor b/extra/ui/tools/debugger/debugger.factor
index ddf4b0106f..fbf9b28937 100644
--- a/extra/ui/tools/debugger/debugger.factor
+++ b/extra/ui/tools/debugger/debugger.factor
@@ -23,12 +23,10 @@ TUPLE: debugger < track restarts ;
: <debugger> ( error restarts restart-hook -- gadget )
{ 0 1 } debugger new-track
[
- [
- toolbar,
- <restart-list> g-> set-debugger-restarts
- swap <debugger-display> <scroller> 1 track,
- ] with-gadget
- ] keep ;
+ toolbar,
+ <restart-list> g-> set-debugger-restarts
+ swap <debugger-display> <scroller> 1 track,
+ ] make-gadget ;
M: debugger focusable-child* debugger-restarts ;
diff --git a/extra/ui/tools/deploy/deploy.factor b/extra/ui/tools/deploy/deploy.factor
index d6b6683e29..3395c95663 100755
--- a/extra/ui/tools/deploy/deploy.factor
+++ b/extra/ui/tools/deploy/deploy.factor
@@ -109,12 +109,10 @@ deploy-gadget "toolbar" f {
swap >>vocab
{ 0 1 } >>orientation
[
- [
- g vocab>> <deploy-settings>
- g-> set-deploy-gadget-settings gadget,
- buttons,
- ] with-gadget
- ] keep
+ g vocab>> <deploy-settings>
+ g-> set-deploy-gadget-settings gadget,
+ buttons,
+ ] make-gadget
dup deploy-settings-theme
dup com-revert ;
diff --git a/extra/ui/tools/inspector/inspector.factor b/extra/ui/tools/inspector/inspector.factor
index bdb5c4d985..4aaf31881e 100644
--- a/extra/ui/tools/inspector/inspector.factor
+++ b/extra/ui/tools/inspector/inspector.factor
@@ -16,11 +16,9 @@ TUPLE: inspector-gadget < track object pane ;
: <inspector-gadget> ( -- gadget )
{ 0 1 } inspector-gadget new-track
[
- [
- toolbar,
- <pane> g-> set-inspector-gadget-pane <scroller> 1 track,
- ] with-gadget
- ] keep ;
+ toolbar,
+ <pane> g-> set-inspector-gadget-pane <scroller> 1 track,
+ ] make-gadget ;
: inspect-object ( obj inspector -- )
[ set-inspector-gadget-object ] keep refresh ;
diff --git a/extra/ui/tools/listener/listener.factor b/extra/ui/tools/listener/listener.factor
index 9b668142e8..3331999cc1 100755
--- a/extra/ui/tools/listener/listener.factor
+++ b/extra/ui/tools/listener/listener.factor
@@ -124,12 +124,10 @@ TUPLE: stack-display < track ;
g workspace-listener
{ 0 1 } stack-display new-track
[
- [
- dup <toolbar> f track,
- stack>> [ [ stack. ] curry try ]
- t "Data stack" <labelled-pane> 1 track,
- ] with-gadget
- ] keep ;
+ dup <toolbar> f track,
+ stack>> [ [ stack. ] curry try ]
+ t "Data stack" <labelled-pane> 1 track,
+ ] make-gadget ;
M: stack-display tool-scroller
find-workspace workspace-listener tool-scroller ;
@@ -174,7 +172,7 @@ M: stack-display tool-scroller
: <listener-gadget> ( -- gadget )
{ 0 1 } listener-gadget new-track
dup init-listener
- [ [ listener-output, listener-input, ] with-gadget ] keep ;
+ [ listener-output, listener-input, ] make-gadget ;
: listener-help ( -- ) "ui-listener" help-window ;
diff --git a/extra/ui/tools/profiler/profiler.factor b/extra/ui/tools/profiler/profiler.factor
index c86a0660a5..eca93cd8e1 100755
--- a/extra/ui/tools/profiler/profiler.factor
+++ b/extra/ui/tools/profiler/profiler.factor
@@ -10,12 +10,10 @@ TUPLE: profiler-gadget < track pane ;
: <profiler-gadget> ( -- gadget )
{ 0 1 } profiler-gadget new-track
[
- [
- toolbar,
- <pane> g-> set-profiler-gadget-pane
- <scroller> 1 track,
- ] with-gadget
- ] keep ;
+ toolbar,
+ <pane> g-> set-profiler-gadget-pane
+ <scroller> 1 track,
+ ] make-gadget ;
: with-profiler-pane ( gadget quot -- )
>r profiler-gadget-pane r> with-pane ;
diff --git a/extra/ui/tools/search/search.factor b/extra/ui/tools/search/search.factor
index 3a48655a78..1d8f16de5a 100755
--- a/extra/ui/tools/search/search.factor
+++ b/extra/ui/tools/search/search.factor
@@ -62,12 +62,10 @@ search-field H{
: <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,
- ] with-gadget
- ] keep
+ <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 ;
diff --git a/extra/ui/tools/tools.factor b/extra/ui/tools/tools.factor
index 9107454fa7..9b8affc649 100755
--- a/extra/ui/tools/tools.factor
+++ b/extra/ui/tools/tools.factor
@@ -30,15 +30,13 @@ IN: ui.tools
{ 0 1 } workspace new-track
0 <model> >>model
[
- [
- <listener-gadget> g set-workspace-listener
- <workspace-book> g set-workspace-book
- <workspace-tabs> f track,
- g workspace-book 1/5 track,
- g workspace-listener 4/5 track,
- toolbar,
- ] with-gadget
- ] keep ;
+ <listener-gadget> g set-workspace-listener
+ <workspace-book> g set-workspace-book
+ <workspace-tabs> f track,
+ g workspace-book 1/5 track,
+ g workspace-listener 4/5 track,
+ toolbar,
+ ] make-gadget ;
: resize-workspace ( workspace -- )
dup track-sizes over control-value zero? [
diff --git a/extra/ui/tools/traceback/traceback.factor b/extra/ui/tools/traceback/traceback.factor
index fa24d8c37d..e1743a4bc8 100755
--- a/extra/ui/tools/traceback/traceback.factor
+++ b/extra/ui/tools/traceback/traceback.factor
@@ -27,15 +27,17 @@ M: traceback-gadget pref-dim* drop { 550 600 } ;
{ 0 1 } traceback-gadget new-track
swap >>model
[
+ g model>>
[
[
- g gadget-model <datastack-display> 1/2 track,
- g gadget-model <retainstack-display> 1/2 track,
+ [ <datastack-display> 1/2 track, ]
+ [ <retainstack-display> 1/2 track, ]
+ bi
] { 1 0 } make-track 1/3 track,
- g gadget-model <callstack-display> 2/3 track,
- toolbar,
- ] with-gadget
- ] keep ;
+ ]
+ [ <callstack-display> 2/3 track, ] bi
+ toolbar,
+ ] make-gadget ;
: <namestack-display> ( model -- gadget )
[ [ continuation-name namestack. ] when* ]
diff --git a/extra/ui/tools/walker/walker.factor b/extra/ui/tools/walker/walker.factor
index 59aa644505..3588b44644 100755
--- a/extra/ui/tools/walker/walker.factor
+++ b/extra/ui/tools/walker/walker.factor
@@ -60,13 +60,12 @@ M: walker-gadget focusable-child*
swap >>thread
swap >>continuation
swap >>status
+ dup continuation>> <traceback-gadget> >>traceback
[
- [
- toolbar,
- g status>> self <thread-status> f track,
- g continuation>> <traceback-gadget> 1 track,
- ] with-gadget
- ] keep ;
+ toolbar,
+ g status>> self <thread-status> f track,
+ g traceback>> 1 track,
+ ] make-gadget ;
: walker-help ( -- ) "ui-walker" help-window ;
diff --git a/extra/ui/ui-docs.factor b/extra/ui/ui-docs.factor
index 3567ff6311..1a541090c5 100755
--- a/extra/ui/ui-docs.factor
+++ b/extra/ui/ui-docs.factor
@@ -74,14 +74,14 @@ ARTICLE: "ui-glossary" "UI glossary"
}
}
}
- { "gadget" { "a graphical element which responds to user input. Gadgets are tuples which (directly or indirectly) delegate to " { $link gadget } " instances." } }
+ { "gadget" { "a graphical element which responds to user input. Gadgets are tuples which (directly or indirectly) inherit from " { $link gadget } "." } }
{ "label specifier" { "a string, " { $link f } " or a gadget. See " { $link "ui.gadgets.buttons" } } }
{ "orientation specifier" { "one of " { $snippet "{ 0 1 }" } " or " { $snippet "{ 1 0 }" } ", with the former denoting vertical orientation and the latter denoting horizontal. Using a vector instead of symbolic constants allows these values to be directly useful in co-ordinate calculations" } }
{ "point" "a pair of integers denoting a pixel location on screen" }
} ;
ARTICLE: "building-ui" "Building user interfaces"
-"A gadget is a graphical element which responds to user input. Gadgets are implemented as tuples which (directly or indirectly) delegate to instances of " { $link gadget } ", which in turn delegates to " { $link rect } "."
+"A gadget is a graphical element which responds to user input. Gadgets are implemented as tuples which (directly or indirectly) inherit from " { $link gadget } ", which in turn inherits from " { $link rect } "."
{ $subsection gadget }
"Gadgets are arranged in a hierarchy, and all visible gadgets except for instances of " { $link world } " are contained in a parent gadget, stored in the " { $link gadget-parent } " slot."
{ $subsection "ui-geometry" }
@@ -104,7 +104,7 @@ ARTICLE: "gadgets" "Pre-made UI gadgets"
{ $subsection "ui.gadgets.lists" } ;
ARTICLE: "ui-geometry" "Gadget geometry"
-"Instances of " { $link gadget } " (and thus all gadgets) delegate to rectangles which specify the gadget's bounding box:"
+"The " { $link gadget } " class inherits from the " { $link rect } " class, and thus all gadgets have a bounding box:"
{ $subsection rect }
"Rectangles can be taken apart:"
{ $subsection rect-loc }
@@ -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 make-gadget } " variable."
+"Words such as " { $link gadget, } " and " { $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 }
@@ -261,7 +261,7 @@ ARTICLE: "ui-layout-impl" "Implementing layout gadgets"
{ $subsection max-dim }
{ $subsection dim-sum }
{ $warning
- "When implementing the " { $link layout* } " generic word for a gadget which intends to delegate to another layout, the " { $link children-on } " word might have to be re-implemented as well."
+ "When implementing the " { $link layout* } " generic word for a gadget which inherits from another layout, the " { $link children-on } " word might have to be re-implemented as well."
$nl
"For example, suppose you want a " { $link grid } " layout which also displays a popup gadget on top. The implementation of " { $link children-on } " for the " { $link grid } " class determines which children of the grid are visible at one time, and this will never include your popup, so it will not be rendered, nor will it respond to gestures. The solution is to re-implement " { $link children-on } " on your class."
} ;