Mercurial > urweb

comparison src/monoize.sml @ 2012:2b2d07946e65

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix dynClass for non-<body> contexts
author Adam Chlipala <adam@chlipala.net>
date Sun, 04 May 2014 12:33:44 -0400
parents 93ff76058825
children 924e2ef31f5a
comparison
equal deleted inserted replaced
2011:cfd604842006 2012:2b2d07946e65
3228 (L.ECApp ( 3228 (L.ECApp (
3229 (L.ECApp ( 3229 (L.ECApp (
3230 (L.ECApp ( 3230 (L.ECApp (
3231 (L.ECApp ( 3231 (L.ECApp (
3232 (L.EFfi ("Basis", "tag"), 3232 (L.EFfi ("Basis", "tag"),
3233 _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), 3233 _), (L.CRecord (_, attrsGiven), _)), _), _), _), ctxOuter), _), _), _), _), _), _), _), _), _), _), _),
3234 class), _), 3234 class), _),
3235 dynClass), _), 3235 dynClass), _),
3236 style), _), 3236 style), _),
3237 dynStyle), _), 3237 dynStyle), _),
3238 attrs), _), 3238 attrs), _),
3579 (L'.EStrcat ((L'.EPrim (Prim.String "exec("), loc), 3579 (L'.EStrcat ((L'.EPrim (Prim.String "exec("), loc),
3580 (L'.EStrcat ((L'.EJavaScript (L'.Attribute, e), loc), 3580 (L'.EStrcat ((L'.EJavaScript (L'.Attribute, e), loc),
3581 (L'.EPrim (Prim.String ")"), loc)), loc)), loc) 3581 (L'.EPrim (Prim.String ")"), loc)), loc)), loc)
3582 end 3582 end
3583 3583
3584 fun inTag tag' = case ctxOuter of
3585 (L.CRecord (_, ctx), _) =>
3586 List.exists (fn ((L.CName tag'', _), _) => tag'' = tag'
3587 | _ => false) ctx
3588 | _ => false
3589
3590 fun pnode () = if inTag "Tr" then
3591 "tr"
3592 else if inTag "Table" then
3593 "table"
3594 else
3595 "span"
3596
3584 val baseAll as (base, fm) = 3597 val baseAll as (base, fm) =
3585 case tag of 3598 case tag of
3586 "body" => let 3599 "body" => let
3587 val onload = execify onload 3600 val onload = execify onload
3588 val onunload = execify onunload 3601 val onunload = execify onunload
3601 loc)), loc)) 3614 loc)), loc))
3602 end 3615 end
3603 3616
3604 | "dyn" => 3617 | "dyn" =>
3605 let 3618 let
3606 fun inTag tag = case targs of
3607 (L.CRecord (_, ctx), _) :: _ =>
3608 List.exists (fn ((L.CName tag', _), _) => tag' = tag
3609 | _ => false) ctx
3610 | _ => false
3611
3612 val tag = if inTag "Tr" then
3613 "tr"
3614 else if inTag "Table" then
3615 "table"
3616 else
3617 "span"
3618 in 3619 in
3619 case attrs of 3620 case attrs of
3620 [("Signal", e, _)] => 3621 [("Signal", e, _)] =>
3621 ((L'.EStrcat 3622 ((L'.EStrcat
3622 ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">dyn(\"" 3623 ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">dyn(\""
3623 ^ tag ^ "\", execD(")), loc), 3624 ^ pnode () ^ "\", execD(")), loc),
3624 (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc), 3625 (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc),
3625 (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc), 3626 (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc),
3626 fm) 3627 fm)
3627 | _ => raise Fail "Monoize: Bad <dyn> attributes" 3628 | _ => raise Fail "Monoize: Bad <dyn> attributes"
3628 end 3629 end
3832 in 3833 in
3833 case #1 dynClass of 3834 case #1 dynClass of
3834 L'.ENone _ => 3835 L'.ENone _ =>
3835 (case #1 dynStyle of 3836 (case #1 dynStyle of
3836 L'.ENone _ => baseAll 3837 L'.ENone _ => baseAll
3837 | L'.ESome (_, ds) => (strcat [str "<script type=\"text/javascript\">dynClass(execD(", 3838 | L'.ESome (_, ds) => (strcat [str "<script type=\"text/javascript\">dynClass(\"",
3839 str (pnode ()),
3840 str "\",execD(",
3838 (L'.EJavaScript (L'.Script, base), loc), 3841 (L'.EJavaScript (L'.Script, base), loc),
3839 str "),null,execD(", 3842 str "),null,execD(",
3840 (L'.EJavaScript (L'.Script, ds), loc), 3843 (L'.EJavaScript (L'.Script, ds), loc),
3841 str "))</script>"], 3844 str "))</script>"],
3842 fm) 3845 fm)
3850 (L'.EJavaScript (L'.Script, ds), loc), 3853 (L'.EJavaScript (L'.Script, ds), loc),
3851 str ")"] 3854 str ")"]
3852 | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown"; 3855 | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown";
3853 str "null") 3856 str "null")
3854 in 3857 in
3855 (strcat [str "<script type=\"text/javascript\">dynClass(execD(", 3858 (strcat [str "<script type=\"text/javascript\">dynClass(\"",
3859 str (pnode ()),
3860 str "\",execD(",
3856 (L'.EJavaScript (L'.Script, base), loc), 3861 (L'.EJavaScript (L'.Script, base), loc),
3857 str "),execD(", 3862 str "),execD(",
3858 (L'.EJavaScript (L'.Script, dc), loc), 3863 (L'.EJavaScript (L'.Script, dc), loc),
3859 str "),", 3864 str "),",
3860 e, 3865 e,