diff src/monoize.sml @ 2121:f89be9cd2087

Support 'dynClass' and 'dynStyle' for <body>
author Adam Chlipala <adam@chlipala.net>
date Tue, 03 Mar 2015 15:55:00 -0500
parents 809bceab15a3
children e722bcc42eab e10881cd92da
line wrap: on
line diff
--- a/src/monoize.sml	Mon Feb 16 14:52:56 2015 -0500
+++ b/src/monoize.sml	Tue Mar 03 15:55:00 2015 -0500
@@ -3267,6 +3267,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" =>
@@ -3274,14 +3279,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, _) =
@@ -3825,10 +3847,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 ()),
@@ -3842,7 +3870,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),