# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1242308028 14400
# Node ID 2c463eee89fa3162e19970f100157e67cf7b28e5
# Parent  6271f0e3c2720d542b84578a65ac771af049ccea
cselect

diff -r 6271f0e3c272 -r 2c463eee89fa lib/js/urweb.js
--- a/lib/js/urweb.js	Thu May 14 09:11:58 2009 -0400
+++ b/lib/js/urweb.js	Thu May 14 09:33:48 2009 -0400
@@ -281,7 +281,7 @@
   populate(x);
 }
 
-function inp(t, s) {
+function inp(t, s, content) {
   var x = document.createElement(t);
   x.dead = false;
   x.signal = ss(s);
@@ -289,7 +289,13 @@
   x.recreate = function(v) { if (x.value != v) x.value = v; };
   populate(x);
   addNode(x);
-  x.onkeyup = function() { sv(s, x.value) };
+  if (t == "select") {
+    x.onchange = function() { sv(s, x.value) };
+    x.innerHTML = content;
+    sv(s, x.value);
+  } else
+    x.onkeyup = function() { sv(s, x.value) };
+
   return x;
 }
 
diff -r 6271f0e3c272 -r 2c463eee89fa lib/ur/basis.urs
--- a/lib/ur/basis.urs	Thu May 14 09:11:58 2009 -0400
+++ b/lib/ur/basis.urs	Thu May 14 09:33:48 2009 -0400
@@ -623,13 +623,17 @@
 
 (*** AJAX-oriented widgets *)
 
-con cformTag = fn (attrs :: {Type}) =>
+con cformTag = fn (attrs :: {Type}) (inner :: {Unit}) =>
                   ctx ::: {Unit}
                   -> [[Body] ~ ctx] =>
-                        unit -> tag attrs ([Body] ++ ctx) [] [] []
+                        unit -> tag attrs ([Body] ++ ctx) inner [] []
 
-val ctextbox : cformTag [Value = string, Size = int, Source = source string]
-val button : cformTag [Value = string, Onclick = transaction unit]
+val ctextbox : cformTag [Value = string, Size = int, Source = source string] []
+val button : cformTag [Value = string, Onclick = transaction unit] []
+
+con cselect = [Cselect]
+val cselect : cformTag [Source = source string] cselect
+val coption : unit -> tag [Value = string, Selected = bool] cselect [] [] []
 
 (*** Tables *)
 
diff -r 6271f0e3c272 -r 2c463eee89fa src/monoize.sml
--- a/src/monoize.sml	Thu May 14 09:11:58 2009 -0400
+++ b/src/monoize.sml	Thu May 14 09:33:48 2009 -0400
@@ -2563,7 +2563,7 @@
                             | SOME (_, src, _) =>
                               (strcat [str "<span><script type=\"text/javascript\">inp(\"input\",",
                                        (L'.EJavaScript (L'.Script, src, NONE), loc),
-                                       str ")</script></span>"],
+                                       str ",\"\")</script></span>"],
                                fm))
                        | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
                                raise Fail "No name passed to textbox tag"))
@@ -2635,6 +2635,33 @@
                          let
                              val sc = strcat [str "inp(\"input\",",
                                               (L'.EJavaScript (L'.Script, src, NONE), loc),
+                                              str ",\"\")"]
+                             val sc = setAttrs sc
+                         in
+                             (strcat [str "<span><script type=\"text/javascript\">",
+                                      sc,
+                                      str "</script></span>"],
+                              fm)
+                         end)
+
+                  | "cselect" =>
+                    (case List.find (fn ("Source", _, _) => true | _ => false) attrs of
+                         NONE =>
+                         let
+                             val (ts, fm) = tagStart "select"
+                         in
+                             ((L'.EStrcat (ts,
+                                           (L'.EPrim (Prim.String "/>"), loc)),
+                               loc), fm)
+                         end
+                       | SOME (_, src, _) =>
+                         let
+                             val (xml, fm) = monoExp (env, st, fm) xml
+
+                             val sc = strcat [str "inp(\"select\",",
+                                              (L'.EJavaScript (L'.Script, src, NONE), loc),
+                                              str ",",
+                                              (L'.EJavaScript (L'.Script, xml, NONE), loc),
                                               str ")"]
                              val sc = setAttrs sc
                          in
@@ -2644,6 +2671,8 @@
                               fm)
                          end)
 
+                  | "coption" => normal ("option", NONE, NONE)
+
                   | "tabl" => normal ("table", NONE, NONE)
                   | _ => normal (tag, NONE, NONE)
             end
diff -r 6271f0e3c272 -r 2c463eee89fa tests/cselect.ur
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cselect.ur	Thu May 14 09:33:48 2009 -0400
@@ -0,0 +1,11 @@
+fun main () =
+    s <- source "";
+    return <xml><body>
+      <cselect source={s}>
+        <coption>Wilbur</coption>
+        <coption>Walbur</coption>
+      </cselect>
+
+      Hello, I'm <dyn signal={s <- signal s; return <xml>{[s]}</xml>}/>.
+      I'll be your waiter for this evening.
+    </body></xml>
diff -r 6271f0e3c272 -r 2c463eee89fa tests/cselect.urp
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cselect.urp	Thu May 14 09:33:48 2009 -0400
@@ -0,0 +1,3 @@
+debug
+
+cselect
diff -r 6271f0e3c272 -r 2c463eee89fa tests/cselect.urs
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/cselect.urs	Thu May 14 09:33:48 2009 -0400
@@ -0,0 +1,1 @@
+val main : unit -> transaction page