Textual HTML5 AJAX widgets

5 files changed, 98 insertions, 82 deletions

diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 5cc49fec..c62670e7 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -1038,28 +1038,44 @@ function input(x, s, recreate, type, name) {
     return x;
 }
 
-function inp(s, name) {
+function inpt(type, s, name) {
     if (suspendScripts)
         return;
 
     var x = input(document.createElement("input"), s,
-                  function(x) { return function(v) { if (x.value != v) x.value = v; }; }, "text", name);
+                  function(x) { return function(v) { if (x.value != v) x.value = v; }; }, type, name);
     x.value = s.data;
     x.onkeyup = x.oninput = x.onchange = x.onpropertychange = function() { sv(s, x.value) };
 
     return x;
 }
 
+function inp(s, name) {
+    return inpt("text", s, name);
+}
+
 function password(s, name) {
-    if (suspendScripts)
-        return;
+    return inpt("password", s, name);
+}
 
-    var x = input(document.createElement("input"), s,
-                  function(x) { return function(v) { if (x.value != v) x.value = v; }; }, "password", name);
-    x.value = s.data;
-    x.onkeyup = x.oninput = x.onchange = x.onpropertychange = function() { sv(s, x.value) };
+function email(s, name) {
+    return inpt("email", s, name);
+}
 
-    return x;
+function search(s, name) {
+    return inpt("search", s, name);
+}
+
+function url(s, name) {
+    return inpt("url", s, name);
+}
+
+function tel(s, name) {
+    return inpt("tel", s, name);
+}
+
+function color(s, name) {
+    return inpt("color", s, name);
 }
 
 function selectValue(x) {
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 9fb04484..1ee5be50 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -1036,10 +1036,17 @@ con cformTag = fn (attrs :: {Type}) (inner :: {Unit}) =>
                   -> [[Body] ~ ctx] => [[Body] ~ inner] =>
                         unit -> tag attrs ([Body] ++ ctx) ([Body] ++ inner) [] []
 
-val ctextbox : cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, Onchange = transaction unit,
-                          Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) []
-val cpassword : cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, Onchange = transaction unit,
-                          Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) []
+type ctext = cformTag ([Value = string, Size = int, Source = source string, Placeholder = string,
+                        Onchange = transaction unit, Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) []
+
+val ctextbox : ctext
+val cpassword : ctext
+val cemail : ctext
+val csearch : ctext
+val curl : ctext
+val ctel : ctext
+val ccolor : ctext
+
 val button : cformTag ([Value = string] ++ boxAttrs) []
 
 val ccheckbox : cformTag ([Value = bool, Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) []
diff --git a/src/monoize.sml b/src/monoize.sml
index 9ca21058..63ae0b31 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3283,7 +3283,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 val (style, fm) = monoExp (env, st, fm) style
                 val (dynStyle, fm) = monoExp (env, st, fm) dynStyle
 
-                val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script"]
+                val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script", "cemail", "csearch", "curl", "ctel", "ccolor"]
 
                 fun isSome (e, _) =
                     case e of
@@ -3583,6 +3583,29 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                else
 			           "span"
 
+                fun cinput (fallback, dynamic) =
+		    case List.find (fn ("Source", _, _) => true | _ => false) attrs of
+                        NONE =>
+                        let
+			    val (ts, fm) = tagStart "input"
+                        in
+			    ((L'.EStrcat (ts,
+                                          strH (" type=\"" ^ fallback ^ "\" />")),
+                              loc), fm)
+                        end
+                      | SOME (_, src, _) =>
+                        let
+			    val sc = strcat [str (dynamic ^ "(exec("),
+					     (L'.EJavaScript (L'.Script, src), loc),
+					     str "))"]
+			    val sc = setAttrs sc
+                        in
+			    (strcat [str "<script type=\"text/javascript\">",
+				     sc,
+				     str "</script>"],
+			     fm)
+                        end
+
 		val baseAll as (base, fm) =
                     case tag of
 			"body" => let
@@ -3726,75 +3749,15 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                            | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
                                    raise Fail "No name passed to lselect tag"))
 
-                      | "ctextbox" =>
-			(case List.find (fn ("Source", _, _) => true | _ => false) attrs of
-                             NONE =>
-                             let
-				 val (ts, fm) = tagStart "input"
-                             in
-				 ((L'.EStrcat (ts,
-                                               strH " type=\"text\" />"),
-                                   loc), fm)
-                             end
-                           | SOME (_, src, _) =>
-                             let
-				 val sc = strcat [str "inp(exec(",
-						  (L'.EJavaScript (L'.Script, src), loc),
-						  str "))"]
-				 val sc = setAttrs sc
-                             in
-				 (strcat [str "<script type=\"text/javascript\">",
-					  sc,
-					  str "</script>"],
-				  fm)
-                             end)
-
-                      | "cpassword" =>
-			(case List.find (fn ("Source", _, _) => true | _ => false) attrs of
-                             NONE =>
-                             let
-				 val (ts, fm) = tagStart "input"
-                             in
-				 ((L'.EStrcat (ts,
-                                               strH " type=\"password\" />"),
-                                   loc), fm)
-                             end
-                           | SOME (_, src, _) =>
-                             let
-				 val sc = strcat [str "password(exec(",
-						  (L'.EJavaScript (L'.Script, src), loc),
-						  str "))"]
-				 val sc = setAttrs sc
-                             in
-				 (strcat [str "<script type=\"text/javascript\">",
-					  sc,
-					  str "</script>"],
-				  fm)
-                             end)
-
-                      | "ccheckbox" =>
-			(case List.find (fn ("Source", _, _) => true | _ => false) attrs of
-                             NONE =>
-                             let
-				 val (ts, fm) = tagStart "input type=\"checkbox\""
-                             in
-				 ((L'.EStrcat (ts,
-                                               strH " />"),
-                                   loc), fm)
-                             end
-                           | SOME (_, src, _) =>
-                             let
-				 val sc = strcat [str "chk(exec(",
-						  (L'.EJavaScript (L'.Script, src), loc),
-						  str "))"]
-				 val sc = setAttrs sc
-                             in
-				 (strcat [str "<script type=\"text/javascript\">",
-					  sc,
-					  str "</script>"],
-				  fm)
-                             end)
+                      | "ctextbox" => cinput ("text", "inp")
+                      | "cpassword" => cinput ("password", "password")
+                      | "cemail" => cinput ("email", "email")
+                      | "csearch" => cinput ("search", "search")
+                      | "curl" => cinput ("url", "url")
+                      | "ctel" => cinput ("tel", "tel")
+                      | "ccolor" => cinput ("color", "color")
 
+                      | "ccheckbox" => cinput ("checkbox", "chk")
                       | "cselect" =>
 			(case List.find (fn ("Source", _, _) => true | _ => false) attrs of
                              NONE =>
diff --git a/tests/ctextbox.urp b/tests/ctextbox.urp
index d5cb5e9f..5c6c5df8 100644
--- a/tests/ctextbox.urp
+++ b/tests/ctextbox.urp
@@ -1,4 +1,5 @@
 debug
 allow url http://localhost/*
+rewrite url Ctextbox/*
 
 ctextbox
diff --git a/tests/html5_cforms.ur b/tests/html5_cforms.ur
new file mode 100644
index 00000000..a62dbf23
--- /dev/null
+++ b/tests/html5_cforms.ur
@@ -0,0 +1,29 @@
+fun dn [a] (_ : show a) (x : source a) : xbody = <xml>
+  <dyn signal={v <- signal x; return (txt v)}/>
+</xml>
+
+fun main () : transaction page =
+    a <- source "";
+    b <- source True;
+    c <- source "a@b";
+    d <- source "";
+    e <- source "";
+    f <- source "";
+
+    return <xml><body>
+      <ctextbox source={a}/>
+      <ccheckbox source={b}/>
+      <cemail source={c}/>
+      <curl source={d}/>
+      <ctel source={e}/>
+      <csearch source={f}/>
+
+      <hr/>
+        
+      {dn a};
+      {dn b};
+      {dn c};
+      {dn d};
+      {dn e};
+      {dn f}
+    </body></xml>