From 54eac9ca9c3e3979003d95a58ffb7f1289877b2b Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 23 Jan 2011 11:18:24 -0500
Subject: Allow CSS class specification for <form>

---
 src/urweb.grm | 18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

(limited to 'src/urweb.grm')

diff --git a/src/urweb.grm b/src/urweb.grm
index 37bddef7..75599235 100644
--- a/src/urweb.grm
+++ b/src/urweb.grm
@@ -311,7 +311,7 @@ fun tnamesOf (e, _) =
  | 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 @@ xmlOne : NOTAGS                         (EApp ((EVar (["Basis"], "cdata", Infer)
                                                                 (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 @@ xmlOne : NOTAGS                         (EApp ((EVar (["Basis"], "cdata", Infer)
                                          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 @@ xmlOne : NOTAGS                         (EApp ((EVar (["Basis"], "cdata", Infer)
                                                      (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 @@ tag    : tagHead attrs                  (let
                                              val e = (EApp (e, (EApp (#2 tagHead,
                                                                       (ERecord [], pos)), pos)), pos)
                                          in
-                                             (tagHead, e)
+                                             (tagHead, #1 attrs, e)
                                          end)
 
 tagHead: BEGIN_TAG                      (let
-- 
cgit v1.2.3