Mercurial > urweb
changeset 2012:2b2d07946e65
Fix dynClass for non-<body> contexts
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sun, 04 May 2014 12:33:44 -0400 |
| parents | cfd604842006 |
| children | 77cc9169d6e0 |
| files | lib/js/urweb.js src/monoize.sml tests/dynClass.ur tests/dynList.ur tests/dynList.urp tests/dynList.urs |
| diffstat | 6 files changed, 61 insertions(+), 29 deletions(-) [+] |
line wrap: on
line diff
--- a/lib/js/urweb.js Sat May 03 07:59:45 2014 -0400 +++ b/lib/js/urweb.js Sun May 04 12:33:44 2014 -0400 @@ -1113,7 +1113,7 @@ return x; } -function dynClass(html, s_class, s_style) { +function dynClass(pnode, html, s_class, s_style) { if (suspendScripts) return; @@ -1121,7 +1121,7 @@ html = flatten(htmlCls, html); htmlCls = htmlCls.v; - var dummy = document.createElement("body"); + var dummy = document.createElement(pnode); suspendScripts = true; dummy.innerHTML = html; suspendScripts = false; @@ -1152,23 +1152,23 @@ if (s_style) { var htmlCls2 = s_class ? null : htmlCls; - var x = document.createElement("script"); - x.dead = false; - x.signal = s_style; - x.sources = null; - x.closures = htmlCls2; + var y = document.createElement("script"); + y.dead = false; + y.signal = s_style; + y.sources = null; + y.closures = htmlCls2; - x.recreate = function(v) { - for (var ls = x.closures; ls != htmlCls2; ls = ls.next) + y.recreate = function(v) { + for (var ls = y.closures; ls != htmlCls2; ls = ls.next) freeClosure(ls.data); var cls = {v : null}; html.style.cssText = flatten(cls, v); - x.closures = concat(cls.v, htmlCls2); + y.closures = concat(cls.v, htmlCls2); } - html.appendChild(x); - populate(x); + html.appendChild(y); + populate(y); } }
--- a/src/monoize.sml Sat May 03 07:59:45 2014 -0400 +++ b/src/monoize.sml Sun May 04 12:33:44 2014 -0400 @@ -3230,7 +3230,7 @@ (L.ECApp ( (L.ECApp ( (L.EFfi ("Basis", "tag"), - _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), + _), (L.CRecord (_, attrsGiven), _)), _), _), _), ctxOuter), _), _), _), _), _), _), _), _), _), _), _), class), _), dynClass), _), style), _), @@ -3581,6 +3581,19 @@ (L'.EPrim (Prim.String ")"), loc)), loc)), loc) end + fun inTag tag' = case ctxOuter of + (L.CRecord (_, ctx), _) => + List.exists (fn ((L.CName tag'', _), _) => tag'' = tag' + | _ => false) ctx + | _ => false + + fun pnode () = if inTag "Tr" then + "tr" + else if inTag "Table" then + "table" + else + "span" + val baseAll as (base, fm) = case tag of "body" => let @@ -3603,24 +3616,12 @@ | "dyn" => let - fun inTag tag = case targs of - (L.CRecord (_, ctx), _) :: _ => - List.exists (fn ((L.CName tag', _), _) => tag' = tag - | _ => false) ctx - | _ => false - - val tag = if inTag "Tr" then - "tr" - else if inTag "Table" then - "table" - else - "span" in case attrs of [("Signal", e, _)] => ((L'.EStrcat ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">dyn(\"" - ^ tag ^ "\", execD(")), loc), + ^ pnode () ^ "\", execD(")), loc), (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc), (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc), fm) @@ -3834,7 +3835,9 @@ L'.ENone _ => (case #1 dynStyle of L'.ENone _ => baseAll - | L'.ESome (_, ds) => (strcat [str "<script type=\"text/javascript\">dynClass(execD(", + | L'.ESome (_, ds) => (strcat [str "<script type=\"text/javascript\">dynClass(\"", + str (pnode ()), + str "\",execD(", (L'.EJavaScript (L'.Script, base), loc), str "),null,execD(", (L'.EJavaScript (L'.Script, ds), loc), @@ -3852,7 +3855,9 @@ | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown"; str "null") in - (strcat [str "<script type=\"text/javascript\">dynClass(execD(", + (strcat [str "<script type=\"text/javascript\">dynClass(\"", + str (pnode ()), + str "\",execD(", (L'.EJavaScript (L'.Script, base), loc), str "),execD(", (L'.EJavaScript (L'.Script, dc), loc),
--- a/tests/dynClass.ur Sat May 03 07:59:45 2014 -0400 +++ b/tests/dynClass.ur Sun May 04 12:33:44 2014 -0400 @@ -15,7 +15,7 @@ STYLE "width: 500px" else STYLE "width: 200px")} - onclick={b <- get toggle; set toggle (not b)}/> + onclick={fn _ => b <- get toggle; set toggle (not b)}/> <button dynStyle={b <- signal toggle; return (if b then
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/dynList.ur Sun May 04 12:33:44 2014 -0400 @@ -0,0 +1,22 @@ +fun main () = + b <- source True; + let + fun textboxList xs = <xml> + <table> + {List.mapX (fn src => <xml><tr> + <td dynClass={return null} dynStyle={b <- signal b; + if b then + return (STYLE "width: 500px") + else + return (STYLE "width: 100px")}> + <ctextbox source={src}/> + </td></tr></xml>) xs} + </table> + </xml> + in + s <- source "foo"; + return <xml><body> + <ccheckbox source={b}/> + {textboxList (s :: s :: [])} + </body></xml> + end