'dynClass' pseudo-attribute

7 files changed, 334 insertions, 248 deletions

diff --git a/doc/manual.tex b/doc/manual.tex
index 82bd5244..5b0ef6ec 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -1933,12 +1933,15 @@ $$\begin{array}{l}
   \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 @@ $$\begin{array}{l}
 
 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.
 
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index a3976fef..ba73e744 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -47,7 +47,7 @@ function cons(v, ls) {
 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 @@ function flattenLocal(s) {
 }
 
 
-
 // Dynamic tree management
 
 function populate(node) {
@@ -899,6 +898,37 @@ function tbx(s) {
     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)
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 17e969ef..08585546 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -645,6 +645,7 @@ val tag : attrsGiven ::: {Type} -> attrsAbsent ::: {Type}
              [useOuter ~ useInner] =>
              [bindOuter ~ bindInner] =>
            option css_class
+	   -> option (signal css_class)
            -> $attrsGiven
            -> tag (attrsGiven ++ attrsAbsent)
                   ctxOuter ctxInner useOuter bindOuter
diff --git a/src/monoize.sml b/src/monoize.sml
index b1cccb81..3d3b0395 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -2967,17 +2967,19 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
             (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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                 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 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
                                          (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 (
diff --git a/src/urweb.grm b/src/urweb.grm
index 22616c79..167e841d 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -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 @@ fun tagIn bt =
 
 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 @@ fun tnamesOf (e, _) =
  | 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 @@ fun tnamesOf (e, _) =
  | 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 @@ xmlOne : NOTAGS                         (EApp ((EVar (["Basis"], "cdata", Infer)
                                                                 (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 @@ xmlOne : NOTAGS                         (EApp ((EVar (["Basis"], "cdata", Infer)
                                                          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 @@ xmlOne : NOTAGS                         (EApp ((EVar (["Basis"], "cdata", Infer)
                                                      (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 @@ tag    : tagHead attrs                  (let
                                                         | 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 @@ tagHead: BEGIN_TAG                      (let
                                          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 @@ attrs  :                                (NONE, [])
                                                  (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
diff --git a/tests/dynClass.ur b/tests/dynClass.ur
new file mode 100644
index 00000000..2c7068c8
--- /dev/null
+++ b/tests/dynClass.ur
@@ -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>
diff --git a/tests/dynClass.urp b/tests/dynClass.urp
new file mode 100644
index 00000000..4358782b
--- /dev/null
+++ b/tests/dynClass.urp
@@ -0,0 +1,4 @@
+rewrite all DynClass/*
+allow url http://localhost/*
+
+dynClass