diff options
Diffstat (limited to 'src/monoize.sml')
| -rw-r--r-- | src/monoize.sml | 49 |
1 files changed, 39 insertions, 10 deletions
diff --git a/src/monoize.sml b/src/monoize.sml index 4034e3ed..d1513ea6 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -89,7 +89,6 @@ val singletons = SS.addList (SS.empty, "p", "hr", "input", - "button", "img", "base", "meta", @@ -3279,6 +3278,11 @@ fun monoExp (env, st, fm) (all as (e, loc)) = else (NONE, NONE, attrs) + val (class, fm) = monoExp (env, st, fm) class + val (dynClass, fm) = monoExp (env, st, fm) dynClass + val (style, fm) = monoExp (env, st, fm) style + val (dynStyle, fm) = monoExp (env, st, fm) dynStyle + (* Special case for <button value=""> *) val (attrs, extraString) = case tag of "button" => @@ -3286,14 +3290,31 @@ fun monoExp (env, st, fm) (all as (e, loc)) = ([(_, value, _)], rest) => (rest, SOME value) | _ => (attrs, NONE)) + | "body" => + (attrs, + if (case (#1 dynClass, #1 dynStyle) of + (L'.ESome _, _) => true + | (_, L'.ESome _) => true + | _ => false) then + let + fun jsify (e : L'.exp) = + case #1 e of + L'.ESome (_, ds) => strcat [str "execD(", + (L'.EJavaScript (L'.Script, ds), loc), + str ")"] + | _ => str "null" + in + SOME (strcat [str "<script type=\"text/javascript\">bodyDynClass(", + jsify dynClass, + str ",", + jsify dynStyle, + str ")</script>"]) + end + else + NONE) | _ => (attrs, NONE) - val (class, fm) = monoExp (env, st, fm) class - val (dynClass, fm) = monoExp (env, st, fm) dynClass - 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", "cemail", "csearch", "curl", "ctel", "ccolor"] fun isSome (e, _) = @@ -3458,6 +3479,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) = NONE => tagStart | SOME extra => (L'.EStrcat (tagStart, extra), loc) + val firstWord = Substring.string o #1 o Substring.splitl (fn ch => not (Char.isSpace ch)) o Substring.full + fun normal () = let val (xml, fm) = monoExp (env, st, fm) xml @@ -3468,7 +3491,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = in ((L'.EStrcat ((L'.EStrcat (tagStart, strH ">"), loc), (L'.EStrcat (xml, - strH (String.concat ["</", tag, ">"])), loc)), + strH (String.concat ["</", firstWord tag, ">"])), loc)), loc), fm) end @@ -3835,10 +3858,16 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | "tabl" => normal ("table", NONE) | _ => normal (tag, NONE) + + val (dynClass', dynStyle') = + case tag of + "body" => ((L'.ENone dummyTyp, ErrorMsg.dummySpan), + (L'.ENone dummyTyp, ErrorMsg.dummySpan)) + | _ => (dynClass, dynStyle) in - case #1 dynClass of + case #1 dynClass' of L'.ENone _ => - (case #1 dynStyle of + (case #1 dynStyle' of L'.ENone _ => baseAll | L'.ESome (_, ds) => (strcat [str "<script type=\"text/javascript\">dynClass(\"", str (pnode ()), @@ -3852,7 +3881,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = baseAll)) | L'.ESome (_, dc) => let - val e = case #1 dynStyle of + val e = case #1 dynStyle' of L'.ENone _ => str "null" | L'.ESome (_, ds) => strcat [str "execD(", (L'.EJavaScript (L'.Script, ds), loc), |