summaryrefslogtreecommitdiff
path: root/src
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 /src
parent069c6e80005874abbc8d4f82a96c782cb8dda111 (diff)
Fix dynClass for non-<body> contexts
Diffstat (limited to 'src')
-rw-r--r--src/monoize.sml37
1 files changed, 21 insertions, 16 deletions
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),