aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adam@chlipala.net>2015-03-03 15:55:00 -0500
committerGravatar Adam Chlipala <adam@chlipala.net>2015-03-03 15:55:00 -0500
commit4906733e1c12fd167a4236c63201a8f4e6daad63 (patch)
treee556192545ac6b5bcf12babc0de45bf8124ff011
parentedc47c5a3cc1e717c45229ca674d5337771fd5e1 (diff)
Support 'dynClass' and 'dynStyle' for <body>
Diffstat
-rw-r--r--lib/js/urweb.js52
-rw-r--r--src/monoize.sml44
-rw-r--r--tests/dynClassB.ur17
-rw-r--r--tests/dynClassB.urp5
-rw-r--r--tests/style.css7
5 files changed, 116 insertions, 9 deletions
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 3bf21dd2..bd5109c3 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -1200,7 +1200,7 @@ function dynClass(pnode, html, s_class, s_style) {
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 dynClass(pnode, html, s_class, s_style) {
}
}
+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)
diff --git a/src/monoize.sml b/src/monoize.sml
index 5727d997..59c5d2ea 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -3267,6 +3267,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" =>
@@ -3274,14 +3279,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, _) =
@@ -3825,10 +3847,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 ()),
@@ -3842,7 +3870,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),
diff --git a/tests/dynClassB.ur b/tests/dynClassB.ur
new file mode 100644
index 00000000..fc7aeb43
--- /dev/null
+++ b/tests/dynClassB.ur
@@ -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>
diff --git a/tests/dynClassB.urp b/tests/dynClassB.urp
new file mode 100644
index 00000000..e580b035
--- /dev/null
+++ b/tests/dynClassB.urp
@@ -0,0 +1,5 @@
+rewrite all DynClassB/*
+file /style.css style.css
+allow url /style.css
+
+dynClassB
diff --git a/tests/style.css b/tests/style.css
new file mode 100644
index 00000000..78b33fc2
--- /dev/null
+++ b/tests/style.css
@@ -0,0 +1,7 @@
+body.style1 {
+ background-color: blue;
+}
+
+body.style2 {
+ background-color: green;
+}
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-24 07:07:15 +0000