From 2e920d624345739bdeb16d993176aa317af7ef03 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Thu, 6 Aug 2009 16:46:48 -0500
Subject: [PATCH] Revert basis UI gadget changes

---
 {extra => basis}/models/illusion/authors.txt  |  0
 .../models/illusion/illusion.factor           |  0
 {extra => basis}/models/illusion/summary.txt  |  0
 basis/ui/gadgets/buttons/buttons.factor       | 37 ++-------
 basis/ui/gadgets/editors/editors-tests.factor |  2 +-
 basis/ui/gadgets/editors/editors.factor       | 35 +++-----
 basis/ui/gadgets/gadgets.factor               |  3 -
 basis/ui/gadgets/scrollers/scrollers.factor   | 23 ++---
 basis/ui/gadgets/sliders/sliders.factor       |  9 +-
 basis/ui/gadgets/tables/tables.factor         | 38 +--------
 extra/file-trees/file-trees.factor            |  7 +-
 extra/recipes/recipes.factor                  | 35 ++++----
 extra/sudokus/sudokus.factor                  | 14 ++--
 extra/ui/gadgets/alerts/alerts.factor         |  6 +-
 extra/ui/gadgets/comboboxes/comboboxes.factor | 13 +--
 extra/ui/gadgets/controls/authors.txt         |  1 +
 .../ui/gadgets/controls/controls-docs.factor  | 71 ++++++++++++++++
 extra/ui/gadgets/controls/controls.factor     | 83 +++++++++++++++++++
 extra/ui/gadgets/controls/summary.txt         |  1 +
 extra/ui/gadgets/layout/layout.factor         |  2 +-
 extra/ui/gadgets/poppers/poppers.factor       | 27 +++---
 21 files changed, 239 insertions(+), 168 deletions(-)
 rename {extra => basis}/models/illusion/authors.txt (100%)
 rename {extra => basis}/models/illusion/illusion.factor (100%)
 rename {extra => basis}/models/illusion/summary.txt (100%)
 create mode 100644 extra/ui/gadgets/controls/authors.txt
 create mode 100644 extra/ui/gadgets/controls/controls-docs.factor
 create mode 100644 extra/ui/gadgets/controls/controls.factor
 create mode 100644 extra/ui/gadgets/controls/summary.txt

diff --git a/extra/models/illusion/authors.txt b/basis/models/illusion/authors.txt
similarity index 100%
rename from extra/models/illusion/authors.txt
rename to basis/models/illusion/authors.txt
diff --git a/extra/models/illusion/illusion.factor b/basis/models/illusion/illusion.factor
similarity index 100%
rename from extra/models/illusion/illusion.factor
rename to basis/models/illusion/illusion.factor
diff --git a/extra/models/illusion/summary.txt b/basis/models/illusion/summary.txt
similarity index 100%
rename from extra/models/illusion/summary.txt
rename to basis/models/illusion/summary.txt
diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index ed2b1d930b..ec11bac2d3 100644
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -1,13 +1,12 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs classes classes.tuple colors
-colors.constants combinators combinators.smart fry kernel lexer
-locals math math.rectangles math.vectors models namespaces
-opengl opengl.gl quotations sequences strings ui.commands
-ui.gadgets ui.gadgets.borders ui.gadgets.labels
-ui.gadgets.packs ui.gadgets.tracks ui.gadgets.worlds
-ui.gestures ui.images ui.pens ui.pens.image ui.pens.solid
-ui.pens.tile vocabs.parser ;
+USING: accessors arrays kernel math models namespaces sequences
+strings quotations assocs combinators classes colors colors.constants
+classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
+ui.gadgets.borders ui.gadgets.labels ui.gadgets.tracks
+ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.pens ui.pens.solid
+ui.pens.image ui.pens.tile math.rectangles locals fry
+combinators.smart ;
 FROM: models => change-model ;
 IN: ui.gadgets.buttons
 
@@ -49,14 +48,11 @@ button H{
 } set-gestures
 
 : new-button ( label quot class -- button )
-    [ swap >label ] dip new-border swap >>quot
-    f <model> >>model ; inline
+    [ swap >label ] dip new-border swap >>quot ; inline
 
 : <button> ( label quot -- button )
     button new-button ;
 
-: button-text ( button -- string ) children>> first text>> ;
-
 TUPLE: button-pen
 plain rollover
 pressed selected pressed-selected ;
@@ -164,14 +160,6 @@ repeat-button H{
     #! the mouse is held down.
     repeat-button new-button border-button-theme ;
 
-<PRIVATE
-: image-prep ( -- image ) scan current-vocab name>>
-    "vocab:" "/icons/" surround ".tiff" surround
-    <image-name> dup cached-image drop ;
-PRIVATE>
-
-SYNTAX: IMG-BUTTON: image-prep [ swap <button> ] curry over push-all ;
-
 <PRIVATE
 
 : <checkmark-pen> ( -- pen )
@@ -262,12 +250,3 @@ PRIVATE>
 
 : add-toolbar ( track -- track )
     dup <toolbar> { 3 3 } <border> align-left f track-add ;
-
-TUPLE: button* < button value ;
-
-: <button*> ( label -- button )
-    [ [ dup value>> or ] keep set-control-value ] button* new-button ;
-
-: <border-button*> ( label -- button ) <button*> border-button-theme ;
-
-SYNTAX: IMG-BUTTON*: image-prep [ <button*> ] curry over push-all ;
diff --git a/basis/ui/gadgets/editors/editors-tests.factor b/basis/ui/gadgets/editors/editors-tests.factor
index 7b7e52507e..3ba32dc3c2 100644
--- a/basis/ui/gadgets/editors/editors-tests.factor
+++ b/basis/ui/gadgets/editors/editors-tests.factor
@@ -45,7 +45,7 @@ IN: ui.gadgets.editors.tests
 "hello" <model> <model-field> "field" set
 
 "field" get [
-    [ "hello" ] [ "field" get model>> value>> ] unit-test
+    [ "hello" ] [ "field" get field-model>> value>> ] unit-test
 ] with-grafted-gadget
 
 [ "Hello world." ] [ "Hello    \n    world." join-lines ] unit-test
diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 33d28fa17d..aa2b9ca58c 100755
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -580,10 +580,10 @@ TUPLE: field < border editor min-cols max-cols ;
         { 1 0 } >>fill
         field-theme ;
 
-: new-field ( class editor-class -- gadget )
-    new-editor swap new-border
+: new-field ( class -- gadget )
+    [ <editor> ] dip new-border
         dup gadget-child >>editor
-        field-theme { 1 0 } >>align ; inline
+        field-theme ; inline
 
 ! For line-gadget-width
 M: field font>> editor>> font>> ;
@@ -594,33 +594,26 @@ M: field pref-dim*
     [ line-gadget-width ] [ drop second ] 2bi 2array
     border-pref-dim ;
 
-TUPLE: model-field < field ;
-
-: init-model ( object -- object ) [ [ ] [ "" ] if* ] change-value ;
+TUPLE: model-field < field field-model ;
 
 : <model-field> ( model -- gadget )
-    model-field editor new-field swap
-    init-model >>model ;
-
-: <model-field*> ( -- gadget ) "" <model> <model-field> ;
+    model-field new-field swap >>field-model ;
 
 M: model-field graft*
-    [ [ model>> value>> ] [ editor>> ] bi set-editor-string ]
+    [ [ field-model>> value>> ] [ editor>> ] bi set-editor-string ]
     [ dup editor>> model>> add-connection ]
-    [ dup model>> add-connection ] tri ;
+    bi ;
 
 M: model-field ungraft*
-    [ dup editor>> model>> remove-connection ]
-    [ dup model>> remove-connection ] bi ;
+    dup editor>> model>> remove-connection ;
 
-M: model-field model-changed 2dup model>> =
-    [ [ value>> ] [ editor>> ] bi* set-editor-string ]
-    [ nip [ editor>> editor-string ] [ model>> ] bi set-model ] if ;
+M: model-field model-changed
+    nip [ editor>> editor-string ] [ field-model>> ] bi set-model ;
 
-TUPLE: action-field < field { quot initial: [ dup set-control-value ] } ;
+TUPLE: action-field < field quot ;
 
 : <action-field> ( quot -- gadget )
-    action-field editor new-field swap >>quot ;
+    action-field new-field swap >>quot ;
 
 : invoke-action-field ( field -- )
     [ editor>> editor-string ]
@@ -631,7 +624,3 @@ TUPLE: action-field < field { quot initial: [ dup set-control-value ] } ;
 action-field H{
     { T{ key-down f f "RET" } [ invoke-action-field ] }
 } set-gestures
-
-: <multiline-field> ( model -- gadget ) model-field multiline-editor new-field swap init-model >>model ;
-
-: <multiline-field*> ( -- editor ) "" <model> <multiline-field> ;
\ No newline at end of file
diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor
index e9845ed2dc..0295012584 100644
--- a/basis/ui/gadgets/gadgets.factor
+++ b/basis/ui/gadgets/gadgets.factor
@@ -43,9 +43,6 @@ M: gadget model-changed 2drop ;
 : control-value ( control -- value )
     model>> value>> ;
 
-GENERIC: output-model ( gadget -- model )
-M: gadget output-model model>> ;
-
 : set-control-value ( value control -- )
     model>> set-model ;
 
diff --git a/basis/ui/gadgets/scrollers/scrollers.factor b/basis/ui/gadgets/scrollers/scrollers.factor
index 79a8348918..8c73226639 100644
--- a/basis/ui/gadgets/scrollers/scrollers.factor
+++ b/basis/ui/gadgets/scrollers/scrollers.factor
@@ -99,7 +99,7 @@ M: scroller layout*
     [ call-next-method ] [
         dup follows>>
         [ update-scroller ] [ >>follows drop ] 2bi
-    ] bi ;
+    ] bi ; 
 
 M: scroller focusable-child*
     viewport>> ;
@@ -129,29 +129,22 @@ M: scroller model-changed
     <scroller-model> >>model
     swap >>column-header ; inline
 
-PRIVATE>
-
-GENERIC# (build-children) 2 ( gadget range orientation -- gadget slider )
-M: scroller (build-children) <slider> ;
-
-<PRIVATE
 : build-children ( gadget scroller -- scroller )
     dup model>> dependencies>>
-    [ first horizontal (build-children) >>x ]
-    [ second vertical (build-children) >>y ] bi
+    [ first horizontal <slider> >>x ]
+    [ second vertical <slider> >>y ] bi
     [ nip ] [ model>> <viewport> ] 2bi >>viewport ; inline
+
 PRIVATE>
 
-: new-scroller ( gadget class -- scroller )
-    [ dup viewport-column-header
-    dup [ 2 3 ] [ 2 2 ] if ] dip new-frame
+: <scroller> ( gadget -- scroller )
+    dup viewport-column-header
+    dup [ 2 3 ] [ 2 2 ] if scroller new-frame
         init-scroller
         build-children
         dup column-header>>
         [ build-header-scroller ] [ build-scroller ] if ;
 
-: <scroller> ( gadget -- scroller ) scroller new-scroller ;
-
 : scroll>rect ( rect gadget -- )
     dup find-scroller* dup [
         [ relative-scroll-rect ] keep
@@ -172,5 +165,3 @@ PRIVATE>
 
 : scroll>top ( gadget -- )
     <zero-rect> swap scroll>rect ;
-
-M: scroller output-model viewport>> children>> first output-model ;
\ No newline at end of file
diff --git a/basis/ui/gadgets/sliders/sliders.factor b/basis/ui/gadgets/sliders/sliders.factor
index cd5513008c..b98a0d152e 100644
--- a/basis/ui/gadgets/sliders/sliders.factor
+++ b/basis/ui/gadgets/sliders/sliders.factor
@@ -231,8 +231,8 @@ M: slider pref-dim*
 
 PRIVATE>
 
-: new-slider ( range orientation class -- slider )
-    new-track
+: <slider> ( range orientation -- slider )
+    slider new-track
         swap >>model
         32 >>line
         dup orientation>> {
@@ -245,8 +245,3 @@ PRIVATE>
             [ drop <gadget> { 1 1 } >>dim f track-add ]
         } cleave ;
 
-: <slider> ( range orientation -- slider ) slider new-slider ;
-
-: <slider*> ( init min max step -- slider ) 0 -roll <range> horizontal <slider> ; ! most common case
-
-M: slider output-model model>> range-model ;
\ No newline at end of file
diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor
index 8c400dc68c..504427827f 100644
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -49,8 +49,6 @@ mouse-index
 focused?
 multiple-selection? ;
 
-M: table output-model selection>> ;
-
 <PRIVATE
 
 : add-selected-index ( table n -- table )
@@ -84,8 +82,6 @@ PRIVATE>
 
 : <table> ( rows renderer -- table ) table new-table ;
 
-: <table*> ( renderer -- table ) { } <model> swap <table> ;
-
 <PRIVATE
 
 GENERIC: cell-width ( font cell -- x )
@@ -507,36 +503,4 @@ M: table viewport-column-header
     dup renderer>> column-titles
     [ <column-headers> ] [ drop f ] if ;
 
-PRIVATE>
-
-! Using quots gives functional flavor
-! No reason to force an object oriented style
-TUPLE: quot-table < table
-{ quot initial: [ ] }
-{ val-quot initial: [ ] }
-{ color-quot initial: [ drop f ] }
-column-titles column-alignment actions hooks ;
-
-M: quot-table column-titles column-titles>> ;
-M: quot-table column-alignment column-alignment>> ;
-M: quot-table row-columns quot>> call( a -- b ) ;
-M: quot-table row-value val-quot>> call( a -- b ) ;
-M: quot-table row-color color-quot>> call( a -- b ) ;
-
-M: quot-table output-model dup val-quot>> [ selection>> ] [ selection-index>> ] if ;
-
-: indexed ( table -- table ) f >>val-quot ;
-
-: new-quot-table ( model class -- table )
-    f swap new-table dup >>renderer
-    f <model> >>actions f <model> >>hooks
-    dup actions>> [ set-model ] curry >>action
-    dup hooks>> [ set-model ] curry >>hook ;
-
-: <quot-table> ( model -- table ) quot-table new-quot-table ;
-
-: <quot-table*> ( -- table ) { } <model> <quot-table> ;
-
-: <list> ( model -- table ) <quot-table> [ 1array ] >>quot ;
-
-: <list*> ( -- table ) { } <model> <list> ;
\ No newline at end of file
+PRIVATE>
\ No newline at end of file
diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor
index 4016208d26..b253ef0c96 100644
--- a/extra/file-trees/file-trees.factor
+++ b/extra/file-trees/file-trees.factor
@@ -1,6 +1,7 @@
 USING: accessors arrays delegate delegate.protocols
-io.pathnames kernel locals make models.combinators sequences
-sequences.extras strings ui.gadgets.tables vectors ;
+io.pathnames kernel locals sequences
+vectors make strings models.combinators ui.gadgets.controls
+sequences.extras ;
 IN: file-trees
 
 TUPLE: walkable-vector vector father ;
@@ -44,5 +45,5 @@ DEFER: (tree-insert)
 
 : <dir-table> ( tree-model -- table )
    <list*> [ node>> 1array ] >>quot
-   [ selection>> [ file? not ] filter-model swap switch-models ]
+   [ selected-value>> [ file? not ] filter-model swap switch-models ]
    [ swap >>model ] bi ;
\ No newline at end of file
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index a64693cd33..d546859589 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -1,9 +1,8 @@
-USING: accessors arrays colors.constants combinators db.sqlite
-db.tuples db.types io.files.temp kernel locals math
-models.combinators monads persistency sequences
-sequences.extras ui ui.gadgets.buttons ui.gadgets.editors
-ui.gadgets.labels ui.gadgets.layout ui.gadgets.scrollers
-ui.gadgets.tables ui.pens.solid ;
+USING: accessors arrays colors.constants combinators
+db.sqlite db.tuples db.types kernel locals math
+monads persistency sequences sequences.extras ui ui.gadgets.controls
+ui.gadgets.layout models.combinators ui.gadgets.labels
+ui.gadgets.scrollers ui.pens.solid io.files.temp ;
 FROM: sets => prune ;
 IN: recipes
 
@@ -24,34 +23,34 @@ STORED-TUPLE: recipe { title { VARCHAR 100 } } { votes INTEGER } { txt TEXT } {
      [
         [ "Title:" <label> , $ TITLE $ "Genre:" <label> , $ GENRE $ ] <hbox> ,
         $ BODY $
-        $ BUTTON* $
+        $ BUTTON $
      ] <vbox> ,
   ] <book*> { 350 245 } >>pref-dim ;
   
 :: recipe-browser ( -- ) [ [
     interface
-      <quot-table*> :> tbl
-      "okay" <border-button*> BUTTON* -> :> ok
-      IMG-BUTTON*: submit [ store-tuple ] >>value TOOLBAR -> :> submit
-      IMG-BUTTON*: love 1 >>value TOOLBAR ->
-      IMG-BUTTON*: hate -1 >>value -> 2array merge :> votes
-      IMG-BUTTON*: back -> [ -30 ] <$
-      IMG-BUTTON*: more -> [ 30 ] <$ 2array merge :> viewed
+      <table*> :> tbl
+      "okay" <model-border-btn> BUTTON -> :> ok
+      IMG-MODEL-BTN: submit [ store-tuple ] >>value TOOLBAR -> :> submit
+      IMG-MODEL-BTN: love 1 >>value TOOLBAR ->
+      IMG-MODEL-BTN: hate -1 >>value -> 2array merge :> votes
+      IMG-MODEL-BTN: back -> [ -30 ] <$
+      IMG-MODEL-BTN: more -> [ 30 ] <$ 2array merge :> viewed
       <spacer> <model-field*> ->% 1 :> search
       submit ok [ [ drop ] ] <$ 2array merge [ drop ] >>value :> quot
-      viewed 0 [ + ] fold search ok t <basic> "all" <button*> ALL ->
+      viewed 0 [ + ] fold search ok t <basic> "all" <model-btn> ALL ->
       tbl selection>> votes [ [ + ] curry change-votes modify-tuple ] 2$>
         4array merge
         [ drop [ f ] [ "%" dup surround <pattern> ] if-empty top-recipes ] 3fmap :> ups
-      ups [ top-genres [ <button*> GENRES -> ] map merge ] bind*
-        [ button-text T{ recipe } swap >>genre get-tuples ] fmap
+      ups [ top-genres [ <model-btn> GENRES -> ] map merge ] bind*
+        [ text>> T{ recipe } swap >>genre get-tuples ] fmap
       tbl swap ups 2merge >>model
         [ [ title>> ] [ genre>> ] bi 2array ] >>quot
         { "Title" "Genre" } >>column-titles dup <scroller> RECIPES ,% 1 actions>>
       submit [ "" dup dup <recipe> ] <$ 2array merge
         { [ [ title>> ] fmap <model-field> TITLE ->% .5 ]
           [ [ genre>> ] fmap <model-field> GENRE ->% .5 ]
-          [ [ txt>> ] fmap <multiline-field> BODY ->% 1 ]
+          [ [ txt>> ] fmap <model-editor> BODY ->% 1 ]
         } cleave
         [ <recipe> ] 3fmap
       [ [ 1 ] <$ ]
diff --git a/extra/sudokus/sudokus.factor b/extra/sudokus/sudokus.factor
index bdc4943c53..9de9a6fe7c 100644
--- a/extra/sudokus/sudokus.factor
+++ b/extra/sudokus/sudokus.factor
@@ -1,8 +1,8 @@
-USING: accessors arrays combinators.short-circuit fry grouping
-kernel lists lists.lazy locals math math.functions math.parser
-math.ranges models.combinators models.product monads random
-sequences sets ui ui.gadgets.alerts ui.gadgets.buttons
-ui.gadgets.editors ui.gadgets.labels ui.gadgets.layout vectors ;
+USING: accessors arrays combinators.short-circuit grouping kernel lists
+lists.lazy locals math math.functions math.parser math.ranges
+models.product monads random sequences sets ui ui.gadgets.controls
+ui.gadgets.layout models.combinators ui.gadgets.alerts vectors fry
+ui.gadgets.labels ;
 IN: sudokus
 
 : row ( index -- row ) 1 + 9 / ceiling ;
@@ -29,8 +29,8 @@ IN: sudokus
                [ [ [ <spacer> [ [ <model-field> ->% 2 [ string>number ] fmap ]
                     map <spacer> ] map concat ] <hbox> , ] map concat <spacer> ] map concat <product>
                [ "Difficulty:" <label> , "1" <basic> <model-field> -> [ string>number 1 or 1 + 10 * ] fmap
-               "Generate" <border-button*> -> updates [ create ] fmap <spacer>
-               "Hint" <border-button*> -> "Solve" <border-button*> -> ] <hbox> ,
+               "Generate" <model-border-btn> -> updates [ create ] fmap <spacer>
+               "Hint" <model-border-btn> -> "Solve" <model-border-btn> -> ] <hbox> ,
                roll [ swap updates ] curry bi@
                [ [ hint ] fmap ] [ [ f solution ] fmap ] bi* 3array merge [ [ [ number>string ] [ "" ] if* ] map ] fmap
            ] bind
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index 03599df6d8..254e282139 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -1,5 +1,5 @@
 USING: accessors models monads macros generalizations kernel
-ui models.combinators ui.gadgets.layout ui.gadgets
+ui ui.gadgets.controls models.combinators ui.gadgets.layout ui.gadgets
 ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
 ui.gadgets.packs locals sequences fonts io.styles
 wrap.strings ;
@@ -14,7 +14,7 @@ IN: ui.gadgets.alerts
 :: ask-user ( string -- model' )
    [ [let | lbl  [ string <label>  T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
             fldm [ <model-field*> ->% 1 ]
-            btn  [ "okay" <border-button*> ] |
+            btn  [ "okay" <model-border-btn> ] |
          btn -> [ fldm swap updates ]
                 [ [ drop lbl close-window ] $> , ] bi
    ] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
@@ -22,7 +22,7 @@ IN: ui.gadgets.alerts
 MACRO: ask-buttons ( buttons -- quot ) dup length [
       [ swap
          [ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
-         [ [ <border-button*> [ [ dup close-window ] prepend ] change-quot -> ] map ] <hbox> , ] <vbox>
+         [ [ <model-border-btn> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
          "" open-window
       ] dip firstn
    ] 2curry ;
\ No newline at end of file
diff --git a/extra/ui/gadgets/comboboxes/comboboxes.factor b/extra/ui/gadgets/comboboxes/comboboxes.factor
index 16d5727446..3eb118050e 100644
--- a/extra/ui/gadgets/comboboxes/comboboxes.factor
+++ b/extra/ui/gadgets/comboboxes/comboboxes.factor
@@ -1,14 +1,15 @@
-USING: accessors arrays kernel math.rectangles
-models.combinators sequences ui.gadgets ui.gadgets.glass
-ui.gadgets.labels ui.gadgets.tables ui.gestures ;
+USING: accessors arrays kernel math.rectangles sequences
+ui.gadgets.controls models.combinators ui.gadgets ui.gadgets.glass
+ui.gadgets.labels ui.gestures ;
+QUALIFIED-WITH: ui.gadgets.tables tbl
 IN: ui.gadgets.comboboxes
 
-TUPLE: combo-table < quot-table spawner ;
+TUPLE: combo-table < table spawner ;
 
 M: combo-table handle-gesture [ call-next-method drop ] 2keep swap
    T{ button-up } = [
       [ spawner>> ]
-      [ selected-row [ swap set-control-value ] [ 2drop ] if ]
+      [ tbl:selected-row [ swap set-control-value ] [ 2drop ] if ]
       [ hide-glass ] tri
    ] [ drop ] if t ;
 
@@ -18,4 +19,4 @@ combobox H{
 } set-gestures
 
 : <combobox> ( options -- combobox ) [ first [ combobox new-label ] keep <basic> >>model ] keep
-    <basic> combo-table new-quot-table [ 1array ] >>quot >>table ;
\ No newline at end of file
+    <basic> combo-table new-table [ 1array ] >>quot >>table ;
\ No newline at end of file
diff --git a/extra/ui/gadgets/controls/authors.txt b/extra/ui/gadgets/controls/authors.txt
new file mode 100644
index 0000000000..2300f69f11
--- /dev/null
+++ b/extra/ui/gadgets/controls/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
diff --git a/extra/ui/gadgets/controls/controls-docs.factor b/extra/ui/gadgets/controls/controls-docs.factor
new file mode 100644
index 0000000000..1df6005656
--- /dev/null
+++ b/extra/ui/gadgets/controls/controls-docs.factor
@@ -0,0 +1,71 @@
+USING: accessors help.markup help.syntax ui.gadgets.buttons
+ui.gadgets.editors models ui.gadgets ;
+IN: ui.gadgets.controls
+
+HELP: <model-btn>
+{ $values { "gadget" "the button's label" } { "button" button } }
+{ $description "Creates an button whose signal updates on clicks.  " } ;
+
+HELP: <model-border-btn>
+{ $values { "text" "the button's label" } { "button" button } }
+{ $description "Creates an button whose signal updates on clicks.  " } ;
+
+HELP: <table>
+{ $values { "model" "values the table is to display" } { "table" table } }
+{ $description "Creates an " { $link table } } ;
+
+HELP: <table*>
+{ $values { "table" table } }
+{ $description "Creates an " { $link table } " with no initial values to display" } ;
+
+HELP: <list>
+{ $values { "column-model" "values the table is to display" } { "table" table } }
+{ $description "Creates an " { $link table } " with a val-quot that renders each element as its own row" } ;
+
+HELP: <list*>
+{ $values { "table" table } }
+{ $description "Creates an model-list with no initial values to display" } ;
+
+HELP: indexed
+{ $values { "table" table } }
+{ $description "Sets the output model of an table to the selected-index, rather than the selected-value" } ;
+
+HELP: <model-field>
+{ $values { "model" model } { "gadget" model-field } }
+{ $description "Creates a field with an initial value" } ;
+
+HELP: <model-field*>
+{ $values { "field" model-field } }
+{ $description "Creates a field with an empty initial value" } ;
+
+HELP: <empty-field>
+{ $values { "model" model } { "field" model-field } }
+{ $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
+
+HELP: <model-editor>
+{ $values { "model" model } { "gadget" model-field } }
+{ $description "Creates an editor with an initial value" } ;
+
+HELP: <model-editor*>
+{ $values { "editor" "an editor" } }
+{ $description "Creates a editor with an empty initial value" } ;
+
+HELP: <empty-editor>
+{ $values { "model" model } { "editor" "an editor" } }
+{ $description "Creates a field with an empty initial value that switches to another signal on its update" } ;
+
+HELP: <model-action-field>
+{ $values { "field" action-field } }
+{ $description "Field that updates its model with its contents when the user hits the return key" } ;
+
+HELP: IMG-MODEL-BTN:
+{ $syntax "IMAGE-MODEL-BTN: filename" }
+{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path" } ;
+
+HELP: IMG-BTN:
+{ $syntax "[ do-something ] IMAGE-BTN: filename" }
+{ $description "Creates a button using a tiff image named as specified found in the icons subdirectory of the vocabulary path, calling the specified quotation on click" } ;
+
+HELP: output-model
+{ $values { "gadget" gadget } { "model" model } }
+{ $description "Returns the model a gadget uses for output. Often the same as " { $link model>> } } ;
\ No newline at end of file
diff --git a/extra/ui/gadgets/controls/controls.factor b/extra/ui/gadgets/controls/controls.factor
new file mode 100644
index 0000000000..649c9052fd
--- /dev/null
+++ b/extra/ui/gadgets/controls/controls.factor
@@ -0,0 +1,83 @@
+USING: accessors assocs arrays kernel models monads sequences
+models.combinators ui.gadgets ui.gadgets.borders ui.gadgets.buttons
+ui.gadgets.buttons.private ui.gadgets.editors words images.loader
+ui.gadgets.scrollers ui.images vocabs.parser lexer
+models.range ui.gadgets.sliders ;
+QUALIFIED-WITH: ui.gadgets.sliders slider
+QUALIFIED-WITH: ui.gadgets.tables tbl
+EXCLUDE: ui.gadgets.editors => model-field ;
+IN: ui.gadgets.controls
+
+TUPLE: model-btn < button hook value ;
+: <model-btn> ( gadget -- button ) [
+      [ dup hook>> [ call( button -- ) ] [ drop ] if* ]
+      [ [ [ value>> ] [ ] bi or ] keep set-control-value ]
+      [ model>> f swap (>>value) ] tri
+   ] model-btn new-button f <basic> >>model ;
+: <model-border-btn> ( text -- button ) <model-btn> border-button-theme ;
+
+TUPLE: table < tbl:table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment actions ;
+M: table tbl:column-titles column-titles>> ;
+M: table tbl:column-alignment column-alignment>> ;
+M: table tbl:row-columns quot>> [ call( a -- b ) ] [ drop f ] if* ;
+M: table tbl:row-value val-quot>> [ call( a -- b ) ]  [ drop f ] if* ;
+M: table tbl:row-color color-quot>> [ call( a -- b ) ]  [ drop f ] if* ;
+
+: new-table ( model class -- table ) f swap tbl:new-table dup >>renderer
+   f <basic> >>actions dup actions>> [ set-model ] curry >>action ;
+: <table> ( model -- table ) table new-table ;
+: <table*> ( -- table ) V{ } clone <model> <table> ;
+: <list> ( column-model -- table ) <table> [ 1array ] >>quot ;
+: <list*> ( -- table ) V{ } clone <model> <list> ;
+: indexed ( table -- table ) f >>val-quot ;
+
+TUPLE: model-field < field model* ;
+: init-field ( model -- model' ) [ [ ] [ "" ] if* ] change-value ;
+: <model-field> ( model -- gadget ) model-field new-field swap init-field >>model* ;
+M: model-field graft*
+    [ [ model*>> value>> ] [ editor>> ] bi set-editor-string ]
+    [ dup editor>> model>> add-connection ]
+    [ dup model*>> add-connection ] tri ;
+M: model-field ungraft*
+   [ dup editor>> model>> remove-connection ]
+   [ dup model*>> remove-connection ] bi ;
+M: model-field model-changed 2dup model*>> =
+    [ [ value>> ] [ editor>> ] bi* set-editor-string ]
+    [ 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> ;
+: <empty-field> ( model -- field ) "" <model> switch-models <model-field> ;
+: <model-editor> ( model -- gadget ) multiline-editor model-field (new-field) swap init-field >>model* ;
+: <model-editor*> ( -- editor ) "" <model> <model-editor> ;
+: <empty-editor> ( model -- editor ) "" <model> switch-models <model-editor> ;
+
+: <model-action-field> ( -- field ) f <action-field> dup [ set-control-value ] curry >>quot
+    f <model> >>model ;
+
+: <slider> ( init page min max step -- slider ) <range> horizontal slider:<slider> ;
+
+: image-prep ( -- image ) scan current-vocab name>> "vocab:" "/icons/" surround ".tiff" surround <image-name> dup cached-image drop ;
+SYNTAX: IMG-MODEL-BTN: image-prep [ <model-btn> ] curry over push-all ;
+
+SYNTAX: IMG-BTN: image-prep [ swap <button> ] curry over push-all ;
+
+GENERIC: output-model ( gadget -- model )
+M: gadget output-model model>> ;
+M: table output-model dup val-quot>> [ selection>> ] [ selection-index>> ] if ;
+M: model-field output-model model*>> ;
+M: scroller output-model viewport>> children>> first output-model ;
+M: slider output-model model>> range-model ;
+
+IN: accessors
+M: model-btn text>> children>> first text>> ;
+
+IN: ui.gadgets.controls
+
+SINGLETON: gadget-monad
+INSTANCE: gadget-monad monad
+INSTANCE: gadget monad
+M: gadget monad-of drop gadget-monad ;
+M: gadget-monad return drop <gadget> swap >>model ;
+M: gadget >>= output-model [ swap call( x -- y ) ] curry ; 
\ No newline at end of file
diff --git a/extra/ui/gadgets/controls/summary.txt b/extra/ui/gadgets/controls/summary.txt
new file mode 100644
index 0000000000..eeef94d7be
--- /dev/null
+++ b/extra/ui/gadgets/controls/summary.txt
@@ -0,0 +1 @@
+Gadgets with expanded model usage
\ No newline at end of file
diff --git a/extra/ui/gadgets/layout/layout.factor b/extra/ui/gadgets/layout/layout.factor
index 037050e10f..bd3ab1dbc7 100644
--- a/extra/ui/gadgets/layout/layout.factor
+++ b/extra/ui/gadgets/layout/layout.factor
@@ -1,7 +1,7 @@
 USING: accessors assocs arrays fry kernel lexer make math.parser
 models monads namespaces parser sequences
 sequences.extras models.combinators ui.gadgets
-ui.gadgets.tracks words ;
+ui.gadgets.tracks words ui.gadgets.controls ;
 QUALIFIED: make
 QUALIFIED-WITH: ui.gadgets.books book
 IN: ui.gadgets.layout
diff --git a/extra/ui/gadgets/poppers/poppers.factor b/extra/ui/gadgets/poppers/poppers.factor
index 4ff52de9e4..1c815d5f3a 100644
--- a/extra/ui/gadgets/poppers/poppers.factor
+++ b/extra/ui/gadgets/poppers/poppers.factor
@@ -2,14 +2,14 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays accessors combinators kernel math
 models models.combinators namespaces sequences
-ui.gadgets ui.gadgets.layout ui.gadgets.tracks
-ui.gestures ui.gadgets.line-support
-ui.gadgets.editors ;
+ui.gadgets ui.gadgets.controls ui.gadgets.layout
+ui.gadgets.tracks ui.gestures ui.gadgets.line-support ;
+EXCLUDE: ui.gadgets.editors => model-field ;
 IN: ui.gadgets.poppers
 
 TUPLE: popped < model-field { fatal? initial: t } ;
 TUPLE: popped-editor < multiline-editor ;
-: <popped> ( text -- gadget ) <basic> init-model popped popped-editor new-field swap >>model t >>clipped? ;
+: <popped> ( text -- gadget ) <basic> init-field popped-editor popped (new-field) swap >>model* ;
 
 : set-expansion ( popped size -- ) over dup parent>> [ children>> index ] [ sizes>> ] bi set-nth relayout ;
 : new-popped ( popped -- ) insertion-point "" <popped>
@@ -25,27 +25,26 @@ TUPLE: popper < track { unfocus-hook initial: [ drop ] } ;
 ! list of strings is model (make shown objects implement sequence protocol)
 : <popper> ( model -- popper ) vertical popper new-track swap >>model ;
 
-popped H{
-    { gain-focus [ 1 set-expansion ] }
+M: popped handle-gesture swap {
+    { gain-focus [ 1 set-expansion f ] }
     { lose-focus [ dup parent>>
         [ [ unfocus-hook>> call( a -- ) ] curry [ f set-expansion ] bi ]
-        [ drop ] if*
+        [ drop ] if* f
     ] }
-    { T{ key-up f f "RET" } [ dup editor>> delete-previous-character new-popped ] }
+    { T{ key-up f f "RET" } [ dup editor>> delete-previous-character new-popped f ] }
     { T{ key-up f f "BACKSPACE" } [ dup editor>> editor-string "" =
         [ dup fatal?>> [ [ focus-prev ] [ unparent ] bi ] [ t >>fatal? drop ] if ]
-        [ f >>fatal? drop ] if
+        [ f >>fatal? drop ] if f
     ] }
-} set-gestures
+    [ swap call-next-method ]
+} case ;
 
 M: popper handle-gesture swap T{ button-down f f 1 } =
-[ hand-click# get 2 = [ initial-popped ] [ drop ] if ] [ drop ] if t ;
+    [ hand-click# get 2 = [ initial-popped ] [ drop ] if ] [ drop ] if f ;
 
 M: popper model-changed
     [ children>> [ unparent ] each ]
     [ [ value>> [ <popped> ] map ] dip [ f track-add ] reduce request-focus ] bi ;
 
-M: popped pref-dim* editor>>
-    [ pref-dim* first ] [ line-height ] bi 2array ;
-
+M: popped pref-dim* editor>> [ pref-dim* first ] [ line-height ] bi 2array ;
 M: popper focusable-child* children>> [ t ] [ first ] if-empty ;
\ No newline at end of file