Mercurial > urweb
diff src/monoize.sml @ 2079:e1879ded8095
Textual HTML5 AJAX widgets
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sun, 16 Nov 2014 15:03:29 -0500 |
parents | 6d126af2e1cb |
children | f05fcb206571 |
line wrap: on
line diff
--- a/src/monoize.sml Sun Nov 16 14:39:38 2014 -0500 +++ b/src/monoize.sml Sun Nov 16 15:03:29 2014 -0500 @@ -3283,7 +3283,7 @@ 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 @@ 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 @@ | _ => (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 =>