diff src/monoize.sml @ 152:67ab26888839

textarea
author Adam Chlipala <adamc@hcoop.net>
date Thu, 24 Jul 2008 10:41:53 -0400
parents 7420fa18d657
children cfe6f9db74aa
line wrap: on
line diff
--- a/src/monoize.sml	Thu Jul 24 10:26:18 2008 -0400
+++ b/src/monoize.sml	Thu Jul 24 10:41:53 2008 -0400
@@ -244,23 +244,14 @@
                                       loc)), loc)
                       | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
                               raise Fail "No named passed to input tag")
-            in
-                case tag of
-                    "submit" => (L'.EPrim (Prim.String "<input type=\"submit\"/>"), loc)
 
-                  | "textbox" =>
-                    (case targs of
-                         [_, (L.CName name, _)] =>
-                         (L'.EStrcat (tagStart "input",
-                                      (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\"/>")),
-                                       loc)), loc)
-                       | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
-                               raise Fail "No named passed to input tag"))
-
-                  | _ =>
+                fun normal (tag, extra) =
                     let
                         val tagStart = tagStart tag
-                                       
+                        val tagStart = case extra of
+                                           NONE => tagStart
+                                         | SOME extra => (L'.EStrcat (tagStart, extra), loc)
+
                         fun normal () =
                             (L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc),
                                          (L'.EStrcat (monoExp env xml,
@@ -280,6 +271,31 @@
                                 normal ()
                           | _ => normal ()
                     end
+            in
+                case tag of
+                    "submit" => (L'.EPrim (Prim.String "<input type=\"submit\"/>"), loc)
+
+                  | "textbox" =>
+                    (case targs of
+                         [_, (L.CName name, _)] =>
+                         (L'.EStrcat (tagStart "input",
+                                      (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\"/>")),
+                                       loc)), loc)
+                       | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
+                               raise Fail "No named passed to textarea tag"))
+                  | "ltextarea" =>
+                    (case targs of
+                         [_, (L.CName name, _)] =>
+                         (L'.EStrcat ((L'.EStrcat (tagStart "textarea",
+                                                   (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\">")), loc)), loc),
+                                      (L'.EStrcat (monoExp env xml,
+                                                   (L'.EPrim (Prim.String "</textarea>"),
+                                                    loc)), loc)),
+                          loc)
+                       | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
+                               raise Fail "No named passed to ltextarea tag"))
+
+                  | _ => normal (tag, NONE)
             end
 
           | L.EApp ((L.ECApp (