From f5b539bb00f67337ca8a434611fdfab83d1969a3 Mon Sep 17 00:00:00 2001
From: Sam Anklesaria <sam@Tintin.local>
Date: Sat, 23 May 2009 08:30:41 -0500
Subject: [PATCH] ui.gadgets.alerts: "ask-buttons" added

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

diff --git a/extra/ui/frp/frp.factor b/extra/ui/frp/frp.factor
index 0508107a22..ccae6fe4b0 100644
--- a/extra/ui/frp/frp.factor
+++ b/extra/ui/frp/frp.factor
@@ -85,8 +85,8 @@ M: action (model-changed) [ [ value>> ] [ quot>> ] bi* call( a -- b ) ] keep val
 ! Gadgets
 TUPLE: frp-button < button hook ;
 : <frp-button> ( text -- button ) [
-      [ t swap set-control-value ] keep
-      dup hook>> [ call( button -- ) ] [ drop ] if*
+      [ dup hook>> [ call( button -- ) ] [ drop ] if* ] keep
+      t swap set-control-value
    ] 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 ;
diff --git a/extra/ui/gadgets/alerts/alerts.factor b/extra/ui/gadgets/alerts/alerts.factor
index 38a3f539a7..265c0fdc74 100644
--- a/extra/ui/gadgets/alerts/alerts.factor
+++ b/extra/ui/gadgets/alerts/alerts.factor
@@ -1,10 +1,10 @@
-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 ;
+USING: accessors models macros generalizations kernel ui ui.frp
+ui.gadgets ui.gadgets.labels ui.gadgets.editors ui.gadgets.buttons
+ui.gadgets.packs locals sequences fonts io.styles wrap.strings ;
 
 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 
+   string 22 wrap-lines <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* ( model string -- model' )
@@ -15,4 +15,12 @@ IN: ui.gadgets.alerts
                 [ [ drop lbl close-window ] $> , ] bi
    ] ] <vbox> { 161 86 } >>pref-dim "" open-window ;
 
-: ask-user ( string -- model ) f <model> swap ask-user* ;
\ No newline at end of file
+: ask-user ( string -- model ) f <model> swap ask-user* ;
+
+MACRO: ask-buttons ( buttons -- quot ) dup length [
+      [ swap
+         [ 22 wrap-lines <label> T{ font { name "sans-serif" } { size 18 } } >>font ,
+         [ [ <frp-button> [ close-window ] >>hook -> ] map ] <hbox> , ] <vbox>
+         { 200 110 } >>pref-dim "" open-window
+      ] dip firstn
+   ] 2curry ;
\ No newline at end of file