From 40fc26556d7f96344ad1091f8071c7c5401d5277 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Tue, 19 May 2009 16:40:39 -0500
Subject: [PATCH] manual models for alert buttons

---
 extra/ui/frp/frp.factor               |  7 ++++---
 extra/ui/gadgets/alerts/alerts.factor | 15 +++++++++------
 2 files changed, 13 insertions(+), 9 deletions(-)

diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor
index f59361a0ec..459d52983f 100644
--- a/extra/ui/frp/frp.factor
+++ b/extra/ui/frp/frp.factor
@@ -77,9 +77,10 @@ M: frp-product model-activated dup model-changed ;
 
 ! Gadgets
 TUPLE: frp-button < button hook ;
-: <frp-button> ( text -- button ) [ [ t swap set-control-value ] keep
-   dup hook>> [ call( button -- ) ] [ drop ] if* ]
-   frp-button new-button border-button-theme f <basic> >>model ;
+: <frp-button> ( text -- button ) [
+      [ t swap set-control-value ] keep
+      dup hook>> [ call( button -- ) ] [ drop ] if*
+   ] frp-button new-button border-button-theme f <basic> >>model ;
 
 TUPLE: frp-table < table { quot initial: [ ] } { val-quot initial: [ ] } color-quot column-titles column-alignment ;
 M: frp-table column-titles column-titles>> ;
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index 0c4a4fbd67..8cb6a3fd08 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -1,15 +1,18 @@
-USING: accessors kernel ui ui.frp ui.gadgets ui.gadgets.labels
-ui.gadgets.buttons ui.gadgets.packs locals sequences fonts io.styles ;
+USING: accessors models kernel ui ui.frp ui.gadgets ui.gadgets.labels
+ui.gadgets.editors ui.gadgets.buttons ui.gadgets.packs
+locals sequences fonts io.styles ;
 
 IN: ui.gadgets.alerts
 :: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align
    string <label> T{ font { name "sans-serif" } { size 18 } } >>font { 200 100 } >>pref-dim add-gadget 
    "okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;
 
-: ask-user ( string -- model )
-   [ [let | lbl  [ <label>  T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
+:: ask-user* ( model string -- model' )
+   [ [let | lbl  [ string <label>  T{ font { name "sans-serif" } { size 14 } } >>font dup , ]
             fldm [ <frp-field> ->% 1 ]
-            btn  [ "okay" <frp-button> ] |
+            btn  [ "okay" <frp-button> model >>model ] |
          btn -> [ fldm swap <updates> ]
                 [ [ drop lbl close-window ] <$ , ] bi
-   ] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
\ No newline at end of file
+   ] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
+
+: ask-user ( string -- model ) f <model> swap ask-user* ;
\ No newline at end of file