Mercurial > urweb
diff src/monoize.sml @ 2226:e10881cd92da
Merge.
author | Ziv Scully <ziv@mit.edu> |
---|---|
date | Fri, 27 Mar 2015 11:26:06 -0400 |
parents | 5709482a2afd f89be9cd2087 |
children | a07b91fa71db |
line wrap: on
line diff
--- a/src/monoize.sml Fri Mar 27 11:19:15 2015 -0400 +++ b/src/monoize.sml Fri Mar 27 11:26:06 2015 -0400 @@ -89,7 +89,6 @@ "p", "hr", "input", - "button", "img", "base", "meta", @@ -3279,6 +3278,11 @@ 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 @@ ([(_, 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 @@ 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 @@ 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 @@ | "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 @@ 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),