changeset 2121:f89be9cd2087

Support 'dynClass' and 'dynStyle' for <body>
author Adam Chlipala <adam@chlipala.net>
date Tue, 03 Mar 2015 15:55:00 -0500
parents e3a79066380d
children 8cf40452c900
files lib/js/urweb.js src/monoize.sml tests/dynClassB.ur tests/dynClassB.urp tests/style.css
diffstat 5 files changed, 116 insertions(+), 9 deletions(-) [+]
line wrap: on
line diff
--- a/lib/js/urweb.js	Mon Feb 16 14:52:56 2015 -0500
+++ b/lib/js/urweb.js	Tue Mar 03 15:55:00 2015 -0500
@@ -1200,7 +1200,7 @@
         x.dead = false;
         x.signal = s_class;
         x.sources = null;
-        x.closures = htmlCls;
+        x.closures = null;
 
         x.recreate = function(v) {
             for (var ls = x.closures; ls != htmlCls; ls = ls.next)
@@ -1237,6 +1237,56 @@
     }
 }
 
+function bodyDynClass(s_class, s_style) {
+    if (suspendScripts)
+        return;
+
+    var htmlCls = null;
+
+    if (s_class) {
+        var x = document.createElement("script");
+        x.dead = false;
+        x.signal = s_class;
+        x.sources = null;
+        x.closures = htmlCls;
+
+        x.recreate = function(v) {
+            for (var ls = x.closures; ls != htmlCls; ls = ls.next)
+                freeClosure(ls.data);
+
+            var cls = {v : null};
+            document.body.className = flatten(cls, v);
+            console.log("className to + " + document.body.className);
+	    x.closures = concat(cls.v, htmlCls);
+        }
+
+        document.body.appendChild(x);
+        populate(x);
+    }
+
+    if (s_style) {
+        var htmlCls2 = s_class ? null : htmlCls;
+        var y = document.createElement("script");
+        y.dead = false;
+        y.signal = s_style;
+        y.sources = null;
+        y.closures = htmlCls2;
+
+        y.recreate = function(v) {
+            for (var ls = y.closures; ls != htmlCls2; ls = ls.next)
+                freeClosure(ls.data);
+
+            var cls = {v : null};
+            document.body.style.cssText = flatten(cls, v);
+            console.log("style to + " + document.body.style.cssText);
+	    y.closures = concat(cls.v, htmlCls2);
+        }
+
+        document.body.appendChild(y);
+        populate(y);
+    }
+}
+
 function addOnChange(x, f) {
     var old = x.onchange;
     if (old == null)
--- 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),
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/dynClassB.ur	Tue Mar 03 15:55:00 2015 -0500
@@ -0,0 +1,17 @@
+style style1
+style style2
+
+fun main () : transaction page =
+    toggle <- source False;
+    return <xml>
+      <head>
+	<link rel="stylesheet" type="text/css" href="/style.css"/>
+      </head>
+      <body dynClass={b <- signal toggle;
+                      return (if b then style1 else style2)}
+            dynStyle={b <- signal toggle;
+                      return (if b then STYLE "margin: 100px" else STYLE "")}>
+        Body
+	<button onclick={fn _ => b <- get toggle; set toggle (not b)}>TOGGLE</button>
+      </body>
+    </xml>
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/dynClassB.urp	Tue Mar 03 15:55:00 2015 -0500
@@ -0,0 +1,5 @@
+rewrite all DynClassB/*
+file /style.css style.css
+allow url /style.css
+
+dynClassB
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/style.css	Tue Mar 03 15:55:00 2015 -0500
@@ -0,0 +1,7 @@
+body.style1 {
+    background-color: blue;
+}
+
+body.style2 {
+     background-color: green;
+}