# HG changeset patch
# User Adam Chlipala <adam@chlipala.net>
# Date 1295799504 18000
# Node ID 5f4fee8a4dcd88350a90532de4678f6458931950
# Parent  38d950c06dce7480ae38f3533be5022c72a166c6
Allow CSS class specification for <form>

diff -r 38d950c06dce -r 5f4fee8a4dcd lib/ur/basis.urs
--- a/lib/ur/basis.urs	Sat Jan 22 12:55:48 2011 -0500
+++ b/lib/ur/basis.urs	Sun Jan 23 11:18:24 2011 -0500
@@ -710,7 +710,8 @@
           
 val form : ctx ::: {Unit} -> bind ::: {Type}
            -> [[Body, Form, Table] ~ ctx] =>
-    xml ([Body, Form] ++ ctx) [] bind
+    option css_class
+    -> xml ([Body, Form] ++ ctx) [] bind
     -> xml ([Body] ++ ctx) [] []
        
 val subform : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type}
diff -r 38d950c06dce -r 5f4fee8a4dcd src/monoize.sml
--- a/src/monoize.sml	Sat Jan 22 12:55:48 2011 -0500
+++ b/src/monoize.sml	Sun Jan 23 11:18:24 2011 -0500
@@ -3390,10 +3390,12 @@
                    | _ => normal (tag, NONE, NONE))
             end
 
-          | L.EApp ((L.ECApp (
-                     (L.ECApp ((L.EFfi ("Basis", "form"), _), _), _),
-                     (L.CRecord (_, fields), _)), _),
-                    xml) =>
+          | L.EApp (
+            (L.EApp ((L.ECApp (
+                      (L.ECApp ((L.EFfi ("Basis", "form"), _), _), _),
+                      (L.CRecord (_, fields), _)), _),
+                     class), _),
+            xml) =>
             let
                 fun findSubmit (e, _) =
                     case e of
@@ -3518,6 +3520,18 @@
                              else
                                  action
 
+                val stt = (L'.TFfi ("Basis", "string"), loc)
+                val (class, fm) = monoExp (env, st, fm) class
+                val action = (L'.EStrcat (action,
+                                          (L'.ECase (class,
+                                                     [((L'.PNone stt, loc),
+                                                       (L'.EPrim (Prim.String ""), loc)),
+                                                      ((L'.PSome (stt, (L'.PVar ("x", stt), loc)), loc),
+                                                       (L'.EStrcat ((L'.EPrim (Prim.String " class=\""), loc),
+                                                                    (L'.EStrcat ((L'.ERel 0, loc),
+                                                                                 (L'.EPrim (Prim.String "\""), loc)), loc)), loc))],
+                                                     {disc = (L'.TOption stt, loc),
+                                                      result = stt}), loc)), loc)
             in
                 ((L'.EStrcat ((L'.EStrcat ((L'.EPrim (Prim.String "<form method=\"post\""), loc),
                                            (L'.EStrcat (action,
diff -r 38d950c06dce -r 5f4fee8a4dcd src/urweb.grm
--- a/src/urweb.grm	Sat Jan 22 12:55:48 2011 -0500
+++ b/src/urweb.grm	Sun Jan 23 11:18:24 2011 -0500
@@ -311,7 +311,7 @@
  | xml of exp
  | xmlOne of exp
  | xmlOpt of exp
- | tag of (string * exp) * exp
+ | tag of (string * exp) * exp option * exp
  | tagHead of string * exp
  | bind of string * con option * exp
  | edecl of edecl
@@ -1383,7 +1383,7 @@
                                                                 (EPrim (Prim.String ""), pos)),
                                                           pos)
                                          in
-                                             (EApp (#2 tag, cdata), pos)
+                                             (EApp (#3 tag, cdata), pos)
                                          end)
          
        | tag GT xmlOpt END_TAG          (let
@@ -1392,8 +1392,14 @@
                                          in
                                              if #1 (#1 tag) = et then
                                                  if et = "form" then
-                                                     (EApp ((EVar (["Basis"], "form", Infer), pos),
-                                                            xmlOpt), pos)
+                                                     let
+                                                         val e = (EVar (["Basis"], "form", Infer), pos)
+                                                         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)
+                                                     in
+                                                         (EApp (e, xmlOpt), pos)
+                                                     end
                                                  else if et = "subform" orelse et = "subforms" then
                                                      (EApp (#2 (#1 tag),
                                                             xmlOpt), pos)
@@ -1401,7 +1407,7 @@
                                                      (EApp ((EVar (["Basis"], "entry", Infer), pos),
                                                             xmlOpt), pos)
                                                  else
-                                                     (EApp (#2 tag, xmlOpt), pos)
+                                                     (EApp (#3 tag, xmlOpt), pos)
                                              else
                                                  (if ErrorMsg.anyErrors () then
                                                       ()
@@ -1434,7 +1440,7 @@
                                              val e = (EApp (e, (EApp (#2 tagHead,
                                                                       (ERecord [], pos)), pos)), pos)
                                          in
-                                             (tagHead, e)
+                                             (tagHead, #1 attrs, e)
                                          end)
 
 tagHead: BEGIN_TAG                      (let