Mercurial > urweb
changeset 1643:b0720700c36e
'dynClass' pseudo-attribute
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Tue, 27 Dec 2011 16:20:48 -0500 |
| parents | c3627f317bfd |
| children | b71cc5ec59b3 |
| files | doc/manual.tex lib/js/urweb.js lib/ur/basis.urs src/monoize.sml src/urweb.grm tests/dynClass.ur tests/dynClass.urp |
| diffstat | 7 files changed, 335 insertions(+), 249 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/manual.tex Tue Dec 20 21:06:25 2011 -0500 +++ b/doc/manual.tex Tue Dec 27 16:20:48 2011 -0500 @@ -1933,12 +1933,15 @@ \hspace{.1in} \to \mt{useOuter} ::: \{\mt{Type}\} \to \mt{useInner} ::: \{\mt{Type}\} \to \mt{bindOuter} ::: \{\mt{Type}\} \to \mt{bindInner} ::: \{\mt{Type}\} \\ \hspace{.1in} \to [\mt{attrsGiven} \sim \mt{attrsAbsent}] \Rightarrow [\mt{useOuter} \sim \mt{useInner}] \Rightarrow [\mt{bindOuter} \sim \mt{bindInner}] \\ \hspace{.1in} \Rightarrow \mt{option} \; \mt{css\_class} \\ + \hspace{.1in} \to \mt{option} \; (\mt{signal} \; \mt{css\_class}) \\ \hspace{.1in} \to \$\mt{attrsGiven} \\ \hspace{.1in} \to \mt{tag} \; (\mt{attrsGiven} \rc \mt{attrsAbsent}) \; \mt{ctxOuter} \; \mt{ctxInner} \; \mt{useOuter} \; \mt{bindOuter} \\ \hspace{.1in} \to \mt{xml} \; \mt{ctxInner} \; \mt{useInner} \; \mt{bindInner} \to \mt{xml} \; \mt{ctxOuter} \; (\mt{useOuter} \rc \mt{useInner}) \; (\mt{bindOuter} \rc \mt{bindInner}) \end{array}$$ Note that any tag may be assigned a CSS class. This is the sole way of making use of the values produced by $\mt{style}$ declarations. Ur/Web itself doesn't deal with the syntax or semantics of style sheets; they can be linked via URLs with \texttt{link} tags. However, Ur/Web does make it easy to calculate upper bounds on usage of CSS classes through program analysis. The function $\mt{Basis.classes}$ can be used to specify a list of CSS classes for a single tag. +Also note that two different arguments are available for setting CSS classes: the first, associated with the \texttt{class} pseudo-attribute syntactic sugar, fixes the class of a tag for the duration of the tag's life; while the second, associated with the \texttt{dynClass} pseudo-attribute, allows the class to vary over the tag's life. See Section \ref{signals} for an introduction to the $\mt{signal}$ type family. + Two XML fragments may be concatenated. $$\begin{array}{l} \mt{val} \; \mt{join} : \mt{ctx} ::: \{\mt{Unit}\} \to \mt{use_1} ::: \{\mt{Type}\} \to \mt{bind_1} ::: \{\mt{Type}\} \to \mt{bind_2} ::: \{\mt{Type}\} \\ @@ -2023,7 +2026,7 @@ The \cd{fresh} function is allowed on both server and client, but there is no other way to create IDs, which includes lack of a way to force an ID to match a particular string. The only semantic importance of IDs within Ur/Web is in uses of the HTML \cd{<label>} tag. IDs play a much more central role in mainstream JavaScript programming, but Ur/Web uses a very different model to enable changes to particular nodes of a page tree, as the next manual subsection explains. IDs may still be useful in interfacing with JavaScript code (for instance, through Ur/Web's FFI). -\subsubsection{Functional-Reactive Page Generation} +\subsubsection{\label{signals}Functional-Reactive Page Generation} Most approaches to ``AJAX''-style coding involve imperative manipulation of the DOM tree representing an HTML document's structure. Ur/Web follows the \emph{functional-reactive} approach instead. Programs may allocate mutable \emph{sources} of arbitrary types, and an HTML page is effectively a pure function over the latest values of the sources. The page is not mutated directly, but rather it changes automatically as the sources are mutated.
--- a/lib/js/urweb.js Tue Dec 20 21:06:25 2011 -0500 +++ b/lib/js/urweb.js Tue Dec 27 16:20:48 2011 -0500 @@ -47,7 +47,7 @@ function rev(ls) { var acc = null; for (; ls; ls = ls.next) - acc = cons(ls.data, acc); + acc = cons(ls.data, acc); return acc; } function concat(ls1, ls2) { @@ -562,7 +562,6 @@ } - // Dynamic tree management function populate(node) { @@ -899,6 +898,37 @@ return x; } +function dynClass(html, s) { + var htmlCls = {v : null}; + html = flatten(htmlCls, html); + htmlCls = htmlCls.v; + + var dummy = document.createElement("body"); + dummy.innerHTML = html; + runScripts(dummy); + var html = dummy.firstChild; + dummy.removeChild(html); + addNode(html); + + var x = document.createElement("script"); + x.dead = false; + x.signal = s; + 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}; + html.className = flatten(cls, v); + x.closures = concat(cls.v, htmlCls); + }; + + addNode(x); + populate(x); +} + function addOnChange(x, f) { var old = x.onchange; if (old == null)
--- a/lib/ur/basis.urs Tue Dec 20 21:06:25 2011 -0500 +++ b/lib/ur/basis.urs Tue Dec 27 16:20:48 2011 -0500 @@ -645,6 +645,7 @@ [useOuter ~ useInner] => [bindOuter ~ bindInner] => option css_class + -> option (signal css_class) -> $attrsGiven -> tag (attrsGiven ++ attrsAbsent) ctxOuter ctxInner useOuter bindOuter
--- a/src/monoize.sml Tue Dec 20 21:06:25 2011 -0500 +++ b/src/monoize.sml Tue Dec 27 16:20:48 2011 -0500 @@ -2967,17 +2967,19 @@ (L.EApp ( (L.EApp ( (L.EApp ( - (L.ECApp ( - (L.ECApp ( + (L.EApp ( + (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( (L.ECApp ( - (L.EFfi ("Basis", "tag"), - _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), - class), _), + (L.ECApp ( + (L.EFfi ("Basis", "tag"), + _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), + class), _), + dynClass), _), attrs), _), tag), _), xml) => @@ -3030,6 +3032,7 @@ val (onload, onunload, attrs) = findOnload (attrs, NONE, NONE, []) val (class, fm) = monoExp (env, st, fm) class + val (dynClass, fm) = monoExp (env, st, fm) dynClass fun tagStart tag' = let @@ -3267,233 +3270,243 @@ (L'.EStrcat ((L'.EJavaScript (L'.Attribute, e), loc), (L'.EPrim (Prim.String ")"), loc)), loc)), loc) end - in - (case tag of - "body" => let - val onload = execify onload - val onunload = execify onunload - in - normal ("body", - SOME (L'.EStrcat ((L'.EFfiApp ("Basis", "maybe_onload", - [(L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings", - [(L'.ERecord [], loc)]), loc), - onload), loc)]), - loc), - (L'.EFfiApp ("Basis", "maybe_onunload", - [onunload]), - loc)), loc), - SOME (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), loc)) - end - - | "dyn" => - let - fun inTag tag = case targs of - (L.CRecord (_, ctx), _) :: _ => - List.exists (fn ((L.CName tag', _), _) => tag' = tag - | _ => false) ctx - | _ => false - - val tag = if inTag "Tr" then - "tr" - else if inTag "Table" then - "table" - else - "span" - in - case attrs of - [("Signal", e, _)] => - ((L'.EStrcat - ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">dyn(\"" - ^ tag ^ "\", execD(")), loc), - (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc), - (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc), - fm) - | _ => raise Fail "Monoize: Bad dyn attributes" - end - - | "submit" => normal ("input type=\"submit\"", NONE, NONE) - | "image" => normal ("input type=\"image\"", NONE, NONE) - | "button" => normal ("input type=\"submit\"", NONE, NONE) - | "hidden" => input "hidden" - - | "textbox" => - (case targs of - [_, (L.CName name, _)] => - (case List.find (fn ("Source", _, _) => true | _ => false) attrs of - NONE => - let - val (ts, fm) = tagStart "input" - in - ((L'.EStrcat (ts, - (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\" />")), - loc)), loc), fm) - end - | SOME (_, src, _) => - (strcat [str "<script type=\"text/javascript\">inp(exec(", - (L'.EJavaScript (L'.Script, src), loc), - str "), \"", - str name, - str "\")</script>"], - fm)) - | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); - raise Fail "No name passed to textbox tag")) - | "password" => input "password" - | "textarea" => - (case targs of - [_, (L.CName name, _)] => - let - val (ts, fm) = tagStart "textarea" - val (xml, fm) = monoExp (env, st, fm) xml - in - ((L'.EStrcat ((L'.EStrcat (ts, - (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\">")), loc)), loc), - (L'.EStrcat (xml, - (L'.EPrim (Prim.String "</textarea>"), - loc)), loc)), - loc), fm) - end - | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); - raise Fail "No name passed to ltextarea tag")) - - | "checkbox" => input "checkbox" - | "upload" => input "file" - - | "radio" => - (case targs of - [_, (L.CName name, _)] => - monoExp (env, St.setRadioGroup (st, name), fm) xml - | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); - raise Fail "No name passed to radio tag")) - | "radioOption" => - (case St.radioGroup st of - NONE => raise Fail "No name for radioGroup" - | SOME name => - normal ("input", - SOME (L'.EPrim (Prim.String (" type=\"radio\" name=\"" ^ name ^ "\"")), loc), - NONE)) - - | "select" => - (case targs of - [_, (L.CName name, _)] => - let - val (ts, fm) = tagStart "select" - val (xml, fm) = monoExp (env, st, fm) xml - in - ((L'.EStrcat ((L'.EStrcat (ts, - (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\">")), - loc)), loc), - (L'.EStrcat (xml, - (L'.EPrim (Prim.String "</select>"), - loc)), loc)), - loc), - fm) - end - | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); - raise Fail "No name passed to lselect tag")) - - | "ctextbox" => - (case List.find (fn ("Source", _, _) => true | _ => false) attrs of - NONE => - let - val (ts, fm) = tagStart "input" - in - ((L'.EStrcat (ts, - (L'.EPrim (Prim.String " />"), loc)), - loc), fm) - end - | SOME (_, src, _) => - let - val sc = strcat [str "inp(exec(", - (L'.EJavaScript (L'.Script, src), loc), - str "))"] - val sc = setAttrs sc - in - (strcat [str "<script type=\"text/javascript\">", - sc, - str "</script>"], - fm) - end) - - | "ccheckbox" => - (case List.find (fn ("Source", _, _) => true | _ => false) attrs of - NONE => - let - val (ts, fm) = tagStart "input type=\"checkbox\"" - in - ((L'.EStrcat (ts, - (L'.EPrim (Prim.String " />"), loc)), - loc), fm) - end - | SOME (_, src, _) => - let - val sc = strcat [str "chk(exec(", - (L'.EJavaScript (L'.Script, src), loc), - str "))"] - val sc = setAttrs sc - in - (strcat [str "<script type=\"text/javascript\">", - sc, - str "</script>"], - fm) - end) - - | "cselect" => - (case List.find (fn ("Source", _, _) => true | _ => false) attrs of - NONE => - let - val (xml, fm) = monoExp (env, st, fm) xml - val (ts, fm) = tagStart "select" - in - (strcat [ts, - str ">", - xml, - str "</select>"], - fm) - end - | SOME (_, src, _) => - let - val (xml, fm) = monoExp (env, st, fm) xml - - val sc = strcat [str "sel(exec(", - (L'.EJavaScript (L'.Script, src), loc), - str "),exec(", - (L'.EJavaScript (L'.Script, xml), loc), - str "))"] - val sc = setAttrs sc - in - (strcat [str "<script type=\"text/javascript\">", - sc, - str "</script>"], - fm) - end) - - | "coption" => normal ("option", NONE, NONE) - - | "ctextarea" => - (case List.find (fn ("Source", _, _) => true | _ => false) attrs of - NONE => - let - val (ts, fm) = tagStart "textarea" - in - ((L'.EStrcat (ts, - (L'.EPrim (Prim.String " />"), loc)), - loc), fm) - end - | SOME (_, src, _) => - let - val sc = strcat [str "tbx(exec(", - (L'.EJavaScript (L'.Script, src), loc), - str "))"] - val sc = setAttrs sc - in - (strcat [str "<script type=\"text/javascript\">", - sc, - str "</script>"], - fm) - end) - - | "tabl" => normal ("table", NONE, NONE) - | _ => normal (tag, NONE, NONE)) + + val baseAll as (base, fm) = + case tag of + "body" => let + val onload = execify onload + val onunload = execify onunload + in + normal ("body", + SOME (L'.EStrcat ((L'.EFfiApp ("Basis", "maybe_onload", + [(L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings", + [(L'.ERecord [], loc)]), loc), + onload), loc)]), + loc), + (L'.EFfiApp ("Basis", "maybe_onunload", + [onunload]), + loc)), loc), + SOME (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), loc)) + end + + | "dyn" => + let + fun inTag tag = case targs of + (L.CRecord (_, ctx), _) :: _ => + List.exists (fn ((L.CName tag', _), _) => tag' = tag + | _ => false) ctx + | _ => false + + val tag = if inTag "Tr" then + "tr" + else if inTag "Table" then + "table" + else + "span" + in + case attrs of + [("Signal", e, _)] => + ((L'.EStrcat + ((L'.EPrim (Prim.String ("<script type=\"text/javascript\">dyn(\"" + ^ tag ^ "\", execD(")), loc), + (L'.EStrcat ((L'.EJavaScript (L'.Script, e), loc), + (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc), + fm) + | _ => raise Fail "Monoize: Bad dyn attributes" + end + + | "submit" => normal ("input type=\"submit\"", NONE, NONE) + | "image" => normal ("input type=\"image\"", NONE, NONE) + | "button" => normal ("input type=\"submit\"", NONE, NONE) + | "hidden" => input "hidden" + + | "textbox" => + (case targs of + [_, (L.CName name, _)] => + (case List.find (fn ("Source", _, _) => true | _ => false) attrs of + NONE => + let + val (ts, fm) = tagStart "input" + in + ((L'.EStrcat (ts, + (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\" />")), + loc)), loc), fm) + end + | SOME (_, src, _) => + (strcat [str "<script type=\"text/javascript\">inp(exec(", + (L'.EJavaScript (L'.Script, src), loc), + str "), \"", + str name, + str "\")</script>"], + fm)) + | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); + raise Fail "No name passed to textbox tag")) + | "password" => input "password" + | "textarea" => + (case targs of + [_, (L.CName name, _)] => + let + val (ts, fm) = tagStart "textarea" + val (xml, fm) = monoExp (env, st, fm) xml + in + ((L'.EStrcat ((L'.EStrcat (ts, + (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\">")), loc)), loc), + (L'.EStrcat (xml, + (L'.EPrim (Prim.String "</textarea>"), + loc)), loc)), + loc), fm) + end + | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); + raise Fail "No name passed to ltextarea tag")) + + | "checkbox" => input "checkbox" + | "upload" => input "file" + + | "radio" => + (case targs of + [_, (L.CName name, _)] => + monoExp (env, St.setRadioGroup (st, name), fm) xml + | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); + raise Fail "No name passed to radio tag")) + | "radioOption" => + (case St.radioGroup st of + NONE => raise Fail "No name for radioGroup" + | SOME name => + normal ("input", + SOME (L'.EPrim (Prim.String (" type=\"radio\" name=\"" ^ name ^ "\"")), loc), + NONE)) + + | "select" => + (case targs of + [_, (L.CName name, _)] => + let + val (ts, fm) = tagStart "select" + val (xml, fm) = monoExp (env, st, fm) xml + in + ((L'.EStrcat ((L'.EStrcat (ts, + (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\">")), + loc)), loc), + (L'.EStrcat (xml, + (L'.EPrim (Prim.String "</select>"), + loc)), loc)), + loc), + fm) + end + | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); + raise Fail "No name passed to lselect tag")) + + | "ctextbox" => + (case List.find (fn ("Source", _, _) => true | _ => false) attrs of + NONE => + let + val (ts, fm) = tagStart "input" + in + ((L'.EStrcat (ts, + (L'.EPrim (Prim.String " />"), loc)), + loc), fm) + end + | SOME (_, src, _) => + let + val sc = strcat [str "inp(exec(", + (L'.EJavaScript (L'.Script, src), loc), + str "))"] + val sc = setAttrs sc + in + (strcat [str "<script type=\"text/javascript\">", + sc, + str "</script>"], + fm) + end) + + | "ccheckbox" => + (case List.find (fn ("Source", _, _) => true | _ => false) attrs of + NONE => + let + val (ts, fm) = tagStart "input type=\"checkbox\"" + in + ((L'.EStrcat (ts, + (L'.EPrim (Prim.String " />"), loc)), + loc), fm) + end + | SOME (_, src, _) => + let + val sc = strcat [str "chk(exec(", + (L'.EJavaScript (L'.Script, src), loc), + str "))"] + val sc = setAttrs sc + in + (strcat [str "<script type=\"text/javascript\">", + sc, + str "</script>"], + fm) + end) + + | "cselect" => + (case List.find (fn ("Source", _, _) => true | _ => false) attrs of + NONE => + let + val (xml, fm) = monoExp (env, st, fm) xml + val (ts, fm) = tagStart "select" + in + (strcat [ts, + str ">", + xml, + str "</select>"], + fm) + end + | SOME (_, src, _) => + let + val (xml, fm) = monoExp (env, st, fm) xml + + val sc = strcat [str "sel(exec(", + (L'.EJavaScript (L'.Script, src), loc), + str "),exec(", + (L'.EJavaScript (L'.Script, xml), loc), + str "))"] + val sc = setAttrs sc + in + (strcat [str "<script type=\"text/javascript\">", + sc, + str "</script>"], + fm) + end) + + | "coption" => normal ("option", NONE, NONE) + + | "ctextarea" => + (case List.find (fn ("Source", _, _) => true | _ => false) attrs of + NONE => + let + val (ts, fm) = tagStart "textarea" + in + ((L'.EStrcat (ts, + (L'.EPrim (Prim.String " />"), loc)), + loc), fm) + end + | SOME (_, src, _) => + let + val sc = strcat [str "tbx(exec(", + (L'.EJavaScript (L'.Script, src), loc), + str "))"] + val sc = setAttrs sc + in + (strcat [str "<script type=\"text/javascript\">", + sc, + str "</script>"], + fm) + end) + + | "tabl" => normal ("table", NONE, NONE) + | _ => normal (tag, NONE, NONE) + in + case #1 dynClass of + L'.ENone _ => baseAll + | _ => (strcat [str "<script type=\"text/javascript\">dynClass(execD(", + (L'.EJavaScript (L'.Script, base), loc), + str "),execD(", + (L'.EJavaScript (L'.Script, dynClass), loc), + str "))</script>"], + fm) end | L.EApp (
--- a/src/urweb.grm Tue Dec 20 21:06:25 2011 -0500 +++ b/src/urweb.grm Tue Dec 27 16:20:48 2011 -0500 @@ -1,4 +1,4 @@ -(* Copyright (c) 2008-2010, Adam Chlipala +(* Copyright (c) 2008-2011, Adam Chlipala * All rights reserved. * * Redistribution and use in source and binary forms, with or without @@ -219,7 +219,7 @@ datatype prop_kind = Delete | Update -datatype attr = Class of exp | Normal of con * exp +datatype attr = Class of exp | DynClass of exp | Normal of con * exp fun patType loc (p : pat) = case #1 p of @@ -355,7 +355,7 @@ | xml of exp | xmlOne of exp | xmlOpt of exp - | tag of (string * exp) * exp option * exp + | tag of (string * exp) * exp option * exp option * exp | tagHead of string * exp | bind of string * con option * exp | edecl of edecl @@ -376,7 +376,7 @@ | rpat of (string * pat) list * bool | ptuple of pat list - | attrs of exp option * (con * exp) list + | attrs of exp option * exp option * (con * exp) list | attr of attr | attrv of exp @@ -1442,7 +1442,7 @@ (EPrim (Prim.String ""), pos)), pos) in - (EApp (#3 tag, cdata), pos) + (EApp (#4 tag, cdata), pos) end) | tag GT xmlOpt END_TAG (let @@ -1461,6 +1461,9 @@ val e = (EApp (e, case #2 tag of NONE => (EVar (["Basis"], "None", Infer), pos) | SOME c => (EApp ((EVar (["Basis"], "Some", Infer), pos), c), pos)), pos) + val e = (EApp (e, case #3 tag of + NONE => (EVar (["Basis"], "None", Infer), pos) + | SOME c => (EApp ((EVar (["Basis"], "Some", Infer), pos), c), pos)), pos) in (EApp (e, xmlOpt), pos) end @@ -1471,7 +1474,7 @@ (EApp ((EVar (["Basis"], "entry", Infer), pos), xmlOpt), pos) else - (EApp (#3 tag, xmlOpt), pos) + (EApp (#4 tag, xmlOpt), pos) else (if ErrorMsg.anyErrors () then () @@ -1500,11 +1503,16 @@ | SOME e => (EApp ((EVar (["Basis"], "Some", Infer), pos), e), pos) val e = (EApp (e, eo), pos) - val e = (EApp (e, (ERecord (#2 attrs), pos)), pos) + val eo = case #2 attrs of + NONE => (EVar (["Basis"], "None", Infer), pos) + | SOME e => (EApp ((EVar (["Basis"], "Some", Infer), pos), + e), pos) + val e = (EApp (e, eo), pos) + val e = (EApp (e, (ERecord (#3 attrs), pos)), pos) val e = (EApp (e, (EApp (#2 tagHead, (ERecord [], pos)), pos)), pos) in - (tagHead, #1 attrs, e) + (tagHead, #1 attrs, #2 attrs, e) end) tagHead: BEGIN_TAG (let @@ -1516,7 +1524,7 @@ end) | tagHead LBRACE cexp RBRACE (#1 tagHead, (ECApp (#2 tagHead, cexp), s (tagHeadleft, RBRACEright))) -attrs : (NONE, []) +attrs : (NONE, NONE, []) | attr attrs (let val loc = s (attrleft, attrsright) in @@ -1525,14 +1533,20 @@ (case #1 attrs of NONE => () | SOME _ => ErrorMsg.errorAt loc "Multiple classes specified for tag"; - (SOME e, #2 attrs)) + (SOME e, #2 attrs, #3 attrs)) + | DynClass e => + (case #2 attrs of + NONE => () + | SOME _ => ErrorMsg.errorAt loc "Multiple dynamic classes specified for tag"; + (#1 attrs, SOME e, #3 attrs)) | Normal xe => - (#1 attrs, xe :: #2 attrs) + (#1 attrs, #2 attrs, xe :: #3 attrs) end) -attr : SYMBOL EQ attrv (if SYMBOL = "class" then - Class attrv - else +attr : SYMBOL EQ attrv (case SYMBOL of + "class" => Class attrv + | "dynClass" => DynClass attrv + | _ => let val sym = case SYMBOL of
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/dynClass.ur Tue Dec 27 16:20:48 2011 -0500 @@ -0,0 +1,21 @@ +style s1 +style s2 + +fun main () : transaction page = + src <- source s1; + s <- source ""; + toggle <- source False; + return <xml> + <head> + <link rel="stylesheet" type="text/css" href="http://localhost/test.css"/> + </head> + <body> + <button dynClass={signal src} onclick={set src s2}/> + + <hr/> + + <ctextbox source={s} dynClass={t <- signal toggle; + return (if t then s1 else s2)} + onkeyup={fn _ => t <- get toggle; set toggle (not t)}/> + </body> + </xml>