From a621e381e31ebd9252c89a8a74260de39baada54 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 6 Aug 2009 15:19:28 -0500
Subject: [PATCH 1/7] merged control extras into basis

---
 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   | 29 ++++---
 basis/ui/gadgets/sliders/sliders.factor       |  9 +-
 basis/ui/gadgets/tables/tables.factor         | 38 ++++++++-
 extra/file-trees/file-trees.factor            |  7 +-
 {basis => extra}/models/illusion/authors.txt  |  0
 .../models/illusion/illusion.factor           |  0
 {basis => extra}/models/illusion/summary.txt  |  0
 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, 171 insertions(+), 242 deletions(-)
 rename {basis => extra}/models/illusion/authors.txt (100%)
 rename {basis => extra}/models/illusion/illusion.factor (100%)
 rename {basis => extra}/models/illusion/summary.txt (100%)
 delete mode 100644 extra/ui/gadgets/controls/authors.txt
 delete mode 100644 extra/ui/gadgets/controls/controls-docs.factor
 delete mode 100644 extra/ui/gadgets/controls/controls.factor
 delete mode 100644 extra/ui/gadgets/controls/summary.txt

diff --git a/basis/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor
index ec11bac2d3..ed2b1d930b 100644
--- a/basis/ui/gadgets/buttons/buttons.factor
+++ b/basis/ui/gadgets/buttons/buttons.factor
@@ -1,12 +1,13 @@
 ! Copyright (C) 2005, 2009 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 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 ;
+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 ;
 FROM: models => change-model ;
 IN: ui.gadgets.buttons
 
@@ -48,11 +49,14 @@ button H{
 } set-gestures
 
 : new-button ( label quot class -- button )
-    [ swap >label ] dip new-border swap >>quot ; inline
+    [ swap >label ] dip new-border swap >>quot
+    f <model> >>model ; inline
 
 : <button> ( label quot -- button )
     button new-button ;
 
+: button-text ( button -- string ) children>> first text>> ;
+
 TUPLE: button-pen
 plain rollover
 pressed selected pressed-selected ;
@@ -160,6 +164,14 @@ 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 )
@@ -250,3 +262,12 @@ 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 3ba32dc3c2..7b7e52507e 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 field-model>> value>> ] unit-test
+    [ "hello" ] [ "field" get 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 aa2b9ca58c..33d28fa17d 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 -- gadget )
-    [ <editor> ] dip new-border
+: new-field ( class editor-class -- gadget )
+    new-editor swap new-border
         dup gadget-child >>editor
-        field-theme ; inline
+        field-theme { 1 0 } >>align ; inline
 
 ! For line-gadget-width
 M: field font>> editor>> font>> ;
@@ -594,26 +594,33 @@ M: field pref-dim*
     [ line-gadget-width ] [ drop second ] 2bi 2array
     border-pref-dim ;
 
-TUPLE: model-field < field field-model ;
+TUPLE: model-field < field ;
+
+: init-model ( object -- object ) [ [ ] [ "" ] if* ] change-value ;
 
 : <model-field> ( model -- gadget )
-    model-field new-field swap >>field-model ;
+    model-field editor new-field swap
+    init-model >>model ;
+
+: <model-field*> ( -- gadget ) "" <model> <model-field> ;
 
 M: model-field graft*
-    [ [ field-model>> value>> ] [ editor>> ] bi set-editor-string ]
+    [ [ model>> value>> ] [ editor>> ] bi set-editor-string ]
     [ dup editor>> model>> add-connection ]
-    bi ;
+    [ dup model>> add-connection ] tri ;
 
 M: model-field ungraft*
-    dup editor>> model>> remove-connection ;
+    [ dup editor>> model>> remove-connection ]
+    [ dup model>> remove-connection ] bi ;
 
-M: model-field model-changed
-    nip [ editor>> editor-string ] [ field-model>> ] bi set-model ;
+M: model-field model-changed 2dup model>> =
+    [ [ value>> ] [ editor>> ] bi* set-editor-string ]
+    [ nip [ editor>> editor-string ] [ model>> ] bi set-model ] if ;
 
-TUPLE: action-field < field quot ;
+TUPLE: action-field < field { quot initial: [ dup set-control-value ] } ;
 
 : <action-field> ( quot -- gadget )
-    action-field new-field swap >>quot ;
+    action-field editor new-field swap >>quot ;
 
 : invoke-action-field ( field -- )
     [ editor>> editor-string ]
@@ -624,3 +631,7 @@ TUPLE: action-field < field quot ;
 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 0295012584..e9845ed2dc 100644
--- a/basis/ui/gadgets/gadgets.factor
+++ b/basis/ui/gadgets/gadgets.factor
@@ -43,6 +43,9 @@ 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 8c73226639..79a8348918 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,22 +129,29 @@ M: scroller model-changed
     <scroller-model> >>model
     swap >>column-header ; inline
 
-: build-children ( gadget scroller -- scroller )
-    dup model>> dependencies>>
-    [ first horizontal <slider> >>x ]
-    [ second vertical <slider> >>y ] bi
-    [ nip ] [ model>> <viewport> ] 2bi >>viewport ; inline
-
 PRIVATE>
 
-: <scroller> ( gadget -- scroller )
-    dup viewport-column-header
-    dup [ 2 3 ] [ 2 2 ] if scroller new-frame
+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
+    [ 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
         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
@@ -165,3 +172,5 @@ 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 b98a0d152e..cd5513008c 100644
--- a/basis/ui/gadgets/sliders/sliders.factor
+++ b/basis/ui/gadgets/sliders/sliders.factor
@@ -231,8 +231,8 @@ M: slider pref-dim*
 
 PRIVATE>
 
-: <slider> ( range orientation -- slider )
-    slider new-track
+: new-slider ( range orientation class -- slider )
+    new-track
         swap >>model
         32 >>line
         dup orientation>> {
@@ -245,3 +245,8 @@ 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 bb70173455..081e5267b9 100644
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -50,6 +50,8 @@ mouse-index
 focused?
 multiple-selection? ;
 
+M: table output-model selection>> ;
+
 <PRIVATE
 
 : push-selected-index ( table n -- table ) swap
@@ -74,6 +76,8 @@ PRIVATE>
 
 : <table> ( rows renderer -- table ) table new-table ;
 
+: <table*> ( renderer -- table ) { } <model> swap <table> ;
+
 <PRIVATE
 
 GENERIC: cell-width ( font cell -- x )
@@ -478,4 +482,36 @@ M: table viewport-column-header
     dup renderer>> column-titles
     [ <column-headers> ] [ drop f ] if ;
 
-PRIVATE>
\ No newline at end of file
+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
diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor
index b253ef0c96..4016208d26 100644
--- a/extra/file-trees/file-trees.factor
+++ b/extra/file-trees/file-trees.factor
@@ -1,7 +1,6 @@
 USING: accessors arrays delegate delegate.protocols
-io.pathnames kernel locals sequences
-vectors make strings models.combinators ui.gadgets.controls
-sequences.extras ;
+io.pathnames kernel locals make models.combinators sequences
+sequences.extras strings ui.gadgets.tables vectors ;
 IN: file-trees
 
 TUPLE: walkable-vector vector father ;
@@ -45,5 +44,5 @@ DEFER: (tree-insert)
 
 : <dir-table> ( tree-model -- table )
    <list*> [ node>> 1array ] >>quot
-   [ selected-value>> [ file? not ] filter-model swap switch-models ]
+   [ selection>> [ file? not ] filter-model swap switch-models ]
    [ swap >>model ] bi ;
\ No newline at end of file
diff --git a/basis/models/illusion/authors.txt b/extra/models/illusion/authors.txt
similarity index 100%
rename from basis/models/illusion/authors.txt
rename to extra/models/illusion/authors.txt
diff --git a/basis/models/illusion/illusion.factor b/extra/models/illusion/illusion.factor
similarity index 100%
rename from basis/models/illusion/illusion.factor
rename to extra/models/illusion/illusion.factor
diff --git a/basis/models/illusion/summary.txt b/extra/models/illusion/summary.txt
similarity index 100%
rename from basis/models/illusion/summary.txt
rename to extra/models/illusion/summary.txt
diff --git a/extra/recipes/recipes.factor b/extra/recipes/recipes.factor
index d546859589..a64693cd33 100644
--- a/extra/recipes/recipes.factor
+++ b/extra/recipes/recipes.factor
@@ -1,8 +1,9 @@
-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 ;
+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 ;
 FROM: sets => prune ;
 IN: recipes
 
@@ -23,34 +24,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
-      <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
+      <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
       <spacer> <model-field*> ->% 1 :> search
       submit ok [ [ drop ] ] <$ 2array merge [ drop ] >>value :> quot
-      viewed 0 [ + ] fold search ok t <basic> "all" <model-btn> ALL ->
+      viewed 0 [ + ] fold search ok t <basic> "all" <button*> 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 [ <model-btn> GENRES -> ] map merge ] bind*
-        [ text>> T{ recipe } swap >>genre get-tuples ] fmap
+      ups [ top-genres [ <button*> GENRES -> ] map merge ] bind*
+        [ button-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 <model-editor> BODY ->% 1 ]
+          [ [ txt>> ] fmap <multiline-field> BODY ->% 1 ]
         } cleave
         [ <recipe> ] 3fmap
       [ [ 1 ] <$ ]
diff --git a/extra/sudokus/sudokus.factor b/extra/sudokus/sudokus.factor
index 9de9a6fe7c..bdc4943c53 100644
--- a/extra/sudokus/sudokus.factor
+++ b/extra/sudokus/sudokus.factor
@@ -1,8 +1,8 @@
-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 ;
+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 ;
 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" <model-border-btn> -> updates [ create ] fmap <spacer>
-               "Hint" <model-border-btn> -> "Solve" <model-border-btn> -> ] <hbox> ,
+               "Generate" <border-button*> -> updates [ create ] fmap <spacer>
+               "Hint" <border-button*> -> "Solve" <border-button*> -> ] <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 254e282139..03599df6d8 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 ui.gadgets.controls models.combinators ui.gadgets.layout ui.gadgets
+ui 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" <model-border-btn> ] |
+            btn  [ "okay" <border-button*> ] |
          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 ,
-         [ [ <model-border-btn> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
+         [ [ <border-button*> [ [ dup close-window ] prepend ] change-quot -> ] 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 3eb118050e..16d5727446 100644
--- a/extra/ui/gadgets/comboboxes/comboboxes.factor
+++ b/extra/ui/gadgets/comboboxes/comboboxes.factor
@@ -1,15 +1,14 @@
-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
+USING: accessors arrays kernel math.rectangles
+models.combinators sequences ui.gadgets ui.gadgets.glass
+ui.gadgets.labels ui.gadgets.tables ui.gestures ;
 IN: ui.gadgets.comboboxes
 
-TUPLE: combo-table < table spawner ;
+TUPLE: combo-table < quot-table spawner ;
 
 M: combo-table handle-gesture [ call-next-method drop ] 2keep swap
    T{ button-up } = [
       [ spawner>> ]
-      [ tbl:selected-row [ swap set-control-value ] [ 2drop ] if ]
+      [ selected-row [ swap set-control-value ] [ 2drop ] if ]
       [ hide-glass ] tri
    ] [ drop ] if t ;
 
@@ -19,4 +18,4 @@ combobox H{
 } set-gestures
 
 : <combobox> ( options -- combobox ) [ first [ combobox new-label ] keep <basic> >>model ] keep
-    <basic> combo-table new-table [ 1array ] >>quot >>table ;
\ No newline at end of file
+    <basic> combo-table new-quot-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
deleted file mode 100644
index 2300f69f11..0000000000
--- a/extra/ui/gadgets/controls/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Sam Anklesaria
diff --git a/extra/ui/gadgets/controls/controls-docs.factor b/extra/ui/gadgets/controls/controls-docs.factor
deleted file mode 100644
index 1df6005656..0000000000
--- a/extra/ui/gadgets/controls/controls-docs.factor
+++ /dev/null
@@ -1,71 +0,0 @@
-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
deleted file mode 100644
index 649c9052fd..0000000000
--- a/extra/ui/gadgets/controls/controls.factor
+++ /dev/null
@@ -1,83 +0,0 @@
-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
deleted file mode 100644
index eeef94d7be..0000000000
--- a/extra/ui/gadgets/controls/summary.txt
+++ /dev/null
@@ -1 +0,0 @@
-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 bd3ab1dbc7..037050e10f 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.controls ;
+ui.gadgets.tracks words ;
 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 1c815d5f3a..4ff52de9e4 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.controls ui.gadgets.layout
-ui.gadgets.tracks ui.gestures ui.gadgets.line-support ;
-EXCLUDE: ui.gadgets.editors => model-field ;
+ui.gadgets ui.gadgets.layout ui.gadgets.tracks
+ui.gestures ui.gadgets.line-support
+ui.gadgets.editors ;
 IN: ui.gadgets.poppers
 
 TUPLE: popped < model-field { fatal? initial: t } ;
 TUPLE: popped-editor < multiline-editor ;
-: <popped> ( text -- gadget ) <basic> init-field popped-editor popped (new-field) swap >>model* ;
+: <popped> ( text -- gadget ) <basic> init-model popped popped-editor new-field swap >>model t >>clipped? ;
 
 : set-expansion ( popped size -- ) over dup parent>> [ children>> index ] [ sizes>> ] bi set-nth relayout ;
 : new-popped ( popped -- ) insertion-point "" <popped>
@@ -25,26 +25,27 @@ 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 ;
 
-M: popped handle-gesture swap {
-    { gain-focus [ 1 set-expansion f ] }
+popped H{
+    { gain-focus [ 1 set-expansion ] }
     { lose-focus [ dup parent>>
         [ [ unfocus-hook>> call( a -- ) ] curry [ f set-expansion ] bi ]
-        [ drop ] if* f
+        [ drop ] if*
     ] }
-    { T{ key-up f f "RET" } [ dup editor>> delete-previous-character new-popped f ] }
+    { T{ key-up f f "RET" } [ dup editor>> delete-previous-character new-popped ] }
     { 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
+        [ f >>fatal? drop ] if
     ] }
-    [ swap call-next-method ]
-} case ;
+} set-gestures
 
 M: popper handle-gesture swap T{ button-down f f 1 } =
-    [ hand-click# get 2 = [ initial-popped ] [ drop ] if ] [ drop ] if f ;
+[ hand-click# get 2 = [ initial-popped ] [ drop ] if ] [ drop ] if t ;
 
 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

From df371bd8bbb45937d66300f1a53b9bae20fed66b Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 6 Aug 2009 15:20:10 -0500
Subject: [PATCH 2/7] magic scrollers hide sliders when not needed

---
 extra/models/conditional/authors.txt          |  1 +
 extra/models/conditional/conditional.factor   | 21 +++++++++++++++++++
 extra/ui/gadgets/magic-scrollers/authors.txt  |  1 +
 .../magic-scrollers/magic-scrollers.factor    | 21 +++++++++++++++++++
 4 files changed, 44 insertions(+)
 create mode 100644 extra/models/conditional/authors.txt
 create mode 100644 extra/models/conditional/conditional.factor
 create mode 100644 extra/ui/gadgets/magic-scrollers/authors.txt
 create mode 100644 extra/ui/gadgets/magic-scrollers/magic-scrollers.factor

diff --git a/extra/models/conditional/authors.txt b/extra/models/conditional/authors.txt
new file mode 100644
index 0000000000..ce0899f16e
--- /dev/null
+++ b/extra/models/conditional/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file
diff --git a/extra/models/conditional/conditional.factor b/extra/models/conditional/conditional.factor
new file mode 100644
index 0000000000..37cf3d115e
--- /dev/null
+++ b/extra/models/conditional/conditional.factor
@@ -0,0 +1,21 @@
+! Copyright (C) 2009 Sam Anklesaria.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays accessors kernel models threads calendar ;
+IN: models.conditional
+
+TUPLE: conditional < model condition thread ;
+
+M: conditional model-changed
+    [
+        [ dup
+            [ condition>> call( -- ? ) ]
+            [ thread>> self = not ] bi or
+            [ [ value>> ] dip set-model f ]
+            [ 2drop t ] if 100 milliseconds sleep 
+        ] 2curry "models.conditional" spawn-server
+    ] keep (>>thread) ;
+
+: <conditional> ( condition -- model )
+    f conditional new-model swap >>condition ;
+
+M: conditional model-activated [ model>> ] keep model-changed ;
\ No newline at end of file
diff --git a/extra/ui/gadgets/magic-scrollers/authors.txt b/extra/ui/gadgets/magic-scrollers/authors.txt
new file mode 100644
index 0000000000..ce0899f16e
--- /dev/null
+++ b/extra/ui/gadgets/magic-scrollers/authors.txt
@@ -0,0 +1 @@
+Sam Anklesaria
\ No newline at end of file
diff --git a/extra/ui/gadgets/magic-scrollers/magic-scrollers.factor b/extra/ui/gadgets/magic-scrollers/magic-scrollers.factor
new file mode 100644
index 0000000000..53344979c4
--- /dev/null
+++ b/extra/ui/gadgets/magic-scrollers/magic-scrollers.factor
@@ -0,0 +1,21 @@
+! Copyright (C) 2009 Sam Anklesaria.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators kernel math models sequences
+ui.gadgets ui.gadgets.scrollers ui.gadgets.sliders ;
+IN: ui.gadgets.magic-scrollers
+
+TUPLE: magic-slider < slider ;
+: <magic-slider> ( range orientation -- slider ) magic-slider new-slider ;
+: get-dim ( orientation dims -- dim )
+    swap {
+        { horizontal [ first ] }
+        { vertical [ second ] }
+    } case ;
+
+! do this with pref-dim*, not draw-gadget
+M: magic-slider model-changed [ call-next-method ] 2keep swap value>>
+    [ second ] [ fourth ] bi < [ show-gadget ] [ hide-gadget ] if ;
+
+TUPLE: magic-scroller < scroller ;
+: <magic-scroller> ( gadget -- scroller ) magic-scroller new-scroller ;
+M: magic-scroller (build-children) <magic-slider> ;
\ No newline at end of file

From 6f607ed5a98df0f53b5981ae2f8e7472c9931862 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 6 Aug 2009 16:31:35 -0500
Subject: [PATCH 3/7] fixed ui.gadgets.tables multi-selection bug

---
 basis/ui/gadgets/tables/tables.factor | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/basis/ui/gadgets/tables/tables.factor b/basis/ui/gadgets/tables/tables.factor
index f548c10606..8c400dc68c 100644
--- a/basis/ui/gadgets/tables/tables.factor
+++ b/basis/ui/gadgets/tables/tables.factor
@@ -281,7 +281,7 @@ PRIVATE>
 <PRIVATE
 
 : set-table-model ( model value multiple? -- )
-    [ multiple>single drop ] unless swap set-model ;
+    [ values ] [ multiple>single drop ] if swap set-model ;
 
 : update-selected ( table -- )
     [

From 2e730380434350516305441eb0f582773520369e Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Thu, 6 Aug 2009 16:46:48 -0500
Subject: [PATCH 4/7] 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

From b06fe403c8177185c1aa5fa2f4a5b0f5c6125bfe Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Thu, 6 Aug 2009 16:49:02 -0500
Subject: [PATCH 5/7] file-trees: load fix

---
 extra/file-trees/file-trees.factor | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor
index b253ef0c96..cb6cbaf847 100644
--- a/extra/file-trees/file-trees.factor
+++ b/extra/file-trees/file-trees.factor
@@ -45,5 +45,5 @@ DEFER: (tree-insert)
 
 : <dir-table> ( tree-model -- table )
    <list*> [ node>> 1array ] >>quot
-   [ selected-value>> [ file? not ] filter-model swap switch-models ]
-   [ swap >>model ] bi ;
\ No newline at end of file
+   [ selected>> [ file? not ] filter-model swap switch-models ]
+   [ swap >>model ] bi ;

From cdd311b3d16e90b63a39c3ea3ec116ad0d8898f2 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Thu, 6 Aug 2009 21:01:51 -0500
Subject: [PATCH 6/7] removed basis dependent vocabs

---
 extra/file-trees/file-trees-tests.factor      |  4 --
 extra/file-trees/file-trees.factor            | 49 -------------------
 extra/ui/gadgets/magic-scrollers/authors.txt  |  1 -
 .../magic-scrollers/magic-scrollers.factor    | 21 --------
 4 files changed, 75 deletions(-)
 delete mode 100644 extra/file-trees/file-trees-tests.factor
 delete mode 100644 extra/file-trees/file-trees.factor
 delete mode 100644 extra/ui/gadgets/magic-scrollers/authors.txt
 delete mode 100644 extra/ui/gadgets/magic-scrollers/magic-scrollers.factor

diff --git a/extra/file-trees/file-trees-tests.factor b/extra/file-trees/file-trees-tests.factor
deleted file mode 100644
index dbb8f9f5d8..0000000000
--- a/extra/file-trees/file-trees-tests.factor
+++ /dev/null
@@ -1,4 +0,0 @@
-USING: kernel file-trees ;
-IN: file-trees.tests
-{ "/sample/1" "/sample/2" "/killer/1" "/killer/2/3"
-"/killer/2/4" "/killer/2/4/6" "/megakiller" } create-tree drop
\ No newline at end of file
diff --git a/extra/file-trees/file-trees.factor b/extra/file-trees/file-trees.factor
deleted file mode 100644
index cb6cbaf847..0000000000
--- a/extra/file-trees/file-trees.factor
+++ /dev/null
@@ -1,49 +0,0 @@
-USING: accessors arrays delegate delegate.protocols
-io.pathnames kernel locals sequences
-vectors make strings models.combinators ui.gadgets.controls
-sequences.extras ;
-IN: file-trees
-
-TUPLE: walkable-vector vector father ;
-CONSULT: sequence-protocol walkable-vector vector>> ;
-
-M: walkable-vector set-nth [ vector>> set-nth ] 3keep nip
-   father>> swap children>> vector>> push ;
-
-TUPLE: tree node comment children ;
-CONSULT: sequence-protocol tree children>> ;
-
-: file? ( tree -- ? ) children>> [ node>> ".." = not ] filter empty? ;
-
-: <dir-tree> ( {start,comment} -- tree ) first2 walkable-vector new vector new >>vector
-   [ tree boa dup children>> ] [ ".." -rot tree boa ] 2bi swap (>>father) ;
-
-DEFER: (tree-insert)
-
-: tree-insert ( path tree -- ) [ unclip <dir-tree> ] [ children>> ] bi* (tree-insert) ;
-:: (tree-insert) ( path-rest path-head tree-children -- )
-   tree-children [ node>> path-head node>> = ] find nip
-   [ path-rest swap tree-insert ]
-   [ 
-      path-head tree-children push
-      path-rest [ path-head tree-insert ] unless-empty
-   ] if* ;
-
-: add-paths ( pathseq -- {{name,path}} )
-   "" [ [ "/" glue dup ] keep swap 2array , ] [ reduce drop ] f make ;
-
-: go-to-path ( path tree -- tree' ) over empty? [ nip ]
-   [ [ unclip ] [ children>> ] bi* swap [ swap node>> = ] curry find nip go-to-path ] if ;
-
-: find-root ( pathseq -- root ) dup flip
-   [ [ dupd = [ ] [ drop f ] if ] reduce1 ] find-last drop
-      [ first ] dip head-slice >string path-components ;
-
-: create-tree ( file-list -- tree ) [ find-root ]
-   [ [ path-components add-paths ] map { "/" "/" } <dir-tree> [ [ tree-insert ] curry each ] keep ] bi
-   go-to-path ;
-
-: <dir-table> ( tree-model -- table )
-   <list*> [ node>> 1array ] >>quot
-   [ selected>> [ file? not ] filter-model swap switch-models ]
-   [ swap >>model ] bi ;
diff --git a/extra/ui/gadgets/magic-scrollers/authors.txt b/extra/ui/gadgets/magic-scrollers/authors.txt
deleted file mode 100644
index ce0899f16e..0000000000
--- a/extra/ui/gadgets/magic-scrollers/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Sam Anklesaria
\ No newline at end of file
diff --git a/extra/ui/gadgets/magic-scrollers/magic-scrollers.factor b/extra/ui/gadgets/magic-scrollers/magic-scrollers.factor
deleted file mode 100644
index 53344979c4..0000000000
--- a/extra/ui/gadgets/magic-scrollers/magic-scrollers.factor
+++ /dev/null
@@ -1,21 +0,0 @@
-! Copyright (C) 2009 Sam Anklesaria.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators kernel math models sequences
-ui.gadgets ui.gadgets.scrollers ui.gadgets.sliders ;
-IN: ui.gadgets.magic-scrollers
-
-TUPLE: magic-slider < slider ;
-: <magic-slider> ( range orientation -- slider ) magic-slider new-slider ;
-: get-dim ( orientation dims -- dim )
-    swap {
-        { horizontal [ first ] }
-        { vertical [ second ] }
-    } case ;
-
-! do this with pref-dim*, not draw-gadget
-M: magic-slider model-changed [ call-next-method ] 2keep swap value>>
-    [ second ] [ fourth ] bi < [ show-gadget ] [ hide-gadget ] if ;
-
-TUPLE: magic-scroller < scroller ;
-: <magic-scroller> ( gadget -- scroller ) magic-scroller new-scroller ;
-M: magic-scroller (build-children) <magic-slider> ;
\ No newline at end of file

From fb80f21d75cc64986419ba5da4e9e590d6cabfc7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@shill.local>
Date: Fri, 7 Aug 2009 14:54:51 -0500
Subject: [PATCH 7/7] help.tutorial: minor tweaks

---
 basis/help/tutorial/tutorial.factor | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/basis/help/tutorial/tutorial.factor b/basis/help/tutorial/tutorial.factor
index a46e577357..b49f06ef50 100644
--- a/basis/help/tutorial/tutorial.factor
+++ b/basis/help/tutorial/tutorial.factor
@@ -11,15 +11,13 @@ $nl
 { $code "USE: tools.scaffold" }
 "Then, ask the scaffold tool to create a new vocabulary named " { $snippet "palindrome" } ":"
 { $code "\"resource:work\" \"palindrome\" scaffold-vocab" }
-"If you look at the output, you will see that a few files were created in your “work” directory. The following phrase will print the full path of your work directory:"
+"If you look at the output, you will see that a few files were created in your “work” directory, and that the new source file was loaded."
+$nl
+"The following phrase will print the full path of your work directory:"
 { $code "\"work\" resource-path ." }
 "The work directory is one of several " { $link "vocabs.roots" } " where Factor searches for vocabularies. It is possible to define new vocabulary roots; see " { $link "add-vocab-roots" } ". To keep things simple in this tutorial, we'll just use the work directory, though."
 $nl
-"Open the work directory in your file manager, and open the subdirectory named " { $snippet "palindrome" } ". Inside this subdirectory you will see a file named " { $snippet "palindrome.factor" } ". We will be editing this file."
-$nl
-"Notice that the file ends with an " { $link POSTPONE: IN: } " form telling Factor that all definitions in this source file should go into the " { $snippet "palindrome" } " vocabulary using the " { $link POSTPONE: IN: } " word:"
-{ $code "IN: palindrome" }
-"We will add new definitions after the " { $link POSTPONE: IN: } " form."
+"Open the work directory in your file manager, and open the subdirectory named " { $snippet "palindrome" } ". Inside this subdirectory you will see a file named " { $snippet "palindrome.factor" } ". Open this file in your text editor."
 $nl
 "You are now ready to go on to the next section: " { $link "first-program-logic" } "." ;
 
@@ -30,6 +28,12 @@ ARTICLE: "first-program-logic" "Writing some logic in your first program"
     "! See http://factorcode.org/license.txt for BSD license."
     "IN: palindrome"
 }
+"Notice that the file ends with an " { $link POSTPONE: IN: } " form telling Factor that all definitions in this source file should go into the " { $snippet "palindrome" } " vocabulary using the " { $link POSTPONE: IN: } " word. We will add new definitions after the " { $link POSTPONE: IN: } " form."
+$nl
+"In order to be able to call the words defined in the " { $snippet "palindrome" } " vocabulary, you need to issue the following command in the listener:"
+{ $code "USE: palindrome" }
+"Now, wee will be making some additions to the file. Since the file was loaded by the scaffold tool in the previous step, you need to tell Factor to reload it if it changes. Factor has a handy feature for this; pressing " { $command tool "common" refresh-all } " in the listener window will reload any changed source files. You can also force a single vocabulary to reload:"
+{ $code "\"palindrome\" reload" }
 "We will now write our first word using " { $link POSTPONE: : } ". This word will test if a string is a palindrome; it will take a string as input, and give back a boolean as output. We will call this word " { $snippet "palindrome?" } ", following a naming convention that words returning booleans have names ending with " { $snippet "?" } "."
 $nl
 "Recall that a string is a palindrome if it is spelled the same forwards or backwards; that is, if the string is equal to its reverse. We can express this in Factor as follows:"