textarea

4 files changed, 43 insertions, 15 deletions

diff --git a/lib/basis.lig b/lib/basis.lig
index 64dee2a3..445ebc85 100644
--- a/lib/basis.lig
+++ b/lib/basis.lig
@@ -66,6 +66,7 @@ con lformTag = fn ty :: Type => fn attrs :: {Type} =>
         -> nm :: Name -> unit
         -> tag attrs ([LForm] ++ ctx) [] [] [nm = ty]
 val textbox : lformTag string []
+val ltextarea : lformTag string []
 
 val submit : ctx ::: {Unit} -> [LForm] ~ ctx
         -> use ::: {Type} -> unit
diff --git a/src/elaborate.sml b/src/elaborate.sml
index dd0b7187..c7b5bcf3 100644
--- a/src/elaborate.sml
+++ b/src/elaborate.sml
@@ -1915,8 +1915,9 @@ fun elabDecl ((d, loc), (env, denv, gs)) =
                                                      ((L'.CApp (tf, arg1), _), []) =>
                                                      (case (hnormCon (env, denv) tf,
                                                             hnormCon (env, denv) domR,
+                                                            hnormCon (env, denv) arg1,
                                                             hnormCon (env, denv) arg2) of
-                                                          ((tf, []), (domR, []),
+                                                          ((tf, []), (domR, []), (arg1, []),
                                                            ((L'.CRecord (_, []), _), [])) =>
                                                           let
                                                               val t = (L'.CApp (tf, arg1), loc)
diff --git a/src/monoize.sml b/src/monoize.sml
index b31613c1..33e1eba3 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -244,23 +244,14 @@ fun monoExp env (all as (e, loc)) =
                                       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 @@ fun monoExp env (all as (e, loc)) =
                                 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 (
diff --git a/tests/textarea.lac b/tests/textarea.lac
new file mode 100644
index 00000000..708c9b03
--- /dev/null
+++ b/tests/textarea.lac
@@ -0,0 +1,10 @@
+val handler = fn x => <html><body>
+        You entered: {cdata x.A}
+</body></html>
+
+val main = fn () => <html><body>
+        <lform>
+                <ltextarea{#A}/>
+                <submit action={handler}/>
+        </lform>
+</body></html>