summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2014-05-04 12:33:44 -0400
committerGravatar Adam Chlipala <adam@chlipala.net>2014-05-04 12:33:44 -0400
commit71296da029e4ad2b4b39a762137f5432290934cd (patch)
tree3afebbab38c1bef5a1f8774e3032365283ba985e
parent069c6e80005874abbc8d4f82a96c782cb8dda111 (diff)
Fix dynClass for non-<body> contexts
Diffstat
-rw-r--r--lib/js/urweb.js26
-rw-r--r--src/monoize.sml37
-rw-r--r--tests/dynClass.ur2
-rw-r--r--tests/dynList.ur22
-rw-r--r--tests/dynList.urp4
-rw-r--r--tests/dynList.urs1
6 files changed, 62 insertions, 30 deletions
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index ac9e9771..c3cab50a 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -1113,7 +1113,7 @@ function tbx(s) {
return x;
}
-function dynClass(html, s_class, s_style) {
+function dynClass(pnode, html, s_class, s_style) {
if (suspendScripts)
return;
@@ -1121,7 +1121,7 @@ function dynClass(html, s_class, s_style) {
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 @@ function dynClass(html, s_class, s_style) {
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;
-
- x.recreate = function(v) {
- for (var ls = x.closures; ls != htmlCls2; ls = ls.next)
+ var y = document.createElement("script");
+ y.dead = false;
+ y.signal = s_style;
+ y.sources = null;
+ y.closures = htmlCls2;
+
+ 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);
}
}
diff --git a/src/monoize.sml b/src/monoize.sml
index cdcd2bec..f7344fed 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3230,7 +3230,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(L.ECApp (
(L.ECApp (
(L.EFfi ("Basis", "tag"),
- _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
+ _), (L.CRecord (_, attrsGiven), _)), _), _), _), ctxOuter), _), _), _), _), _), _), _), _), _), _), _),
class), _),
dynClass), _),
style), _),
@@ -3581,6 +3581,19 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
(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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
| "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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
| _ => (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),
diff --git a/tests/dynClass.ur b/tests/dynClass.ur
index 37f931a2..7cb94d28 100644
--- a/tests/dynClass.ur
+++ b/tests/dynClass.ur
@@ -15,7 +15,7 @@ fun main () : transaction page =
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
diff --git a/tests/dynList.ur b/tests/dynList.ur
new file mode 100644
index 00000000..09b3ee4c
--- /dev/null
+++ b/tests/dynList.ur
@@ -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
diff --git a/tests/dynList.urp b/tests/dynList.urp
new file mode 100644
index 00000000..dc33cb28
--- /dev/null
+++ b/tests/dynList.urp
@@ -0,0 +1,4 @@
+rewrite all DynList/*
+
+$/list
+dynList
diff --git a/tests/dynList.urs b/tests/dynList.urs
new file mode 100644
index 00000000..6ac44e0b
--- /dev/null
+++ b/tests/dynList.urs
@@ -0,0 +1 @@
+val main : unit -> transaction page
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-25 03:59:56 +0000