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),