# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1216910513 14400
# Node ID 67ab2688883947365f1d6dd9ec3d8ba09ff2e7fd
# Parent  6c14e78feb6dcecf32b2ca1e7dddbcdaa908029c
textarea

diff -r 6c14e78feb6d -r 67ab26888839 lib/basis.lig
--- a/lib/basis.lig	Thu Jul 24 10:26:18 2008 -0400
+++ b/lib/basis.lig	Thu Jul 24 10:41:53 2008 -0400
@@ -66,6 +66,7 @@
         -> 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 -r 6c14e78feb6d -r 67ab26888839 src/elaborate.sml
--- a/src/elaborate.sml	Thu Jul 24 10:26:18 2008 -0400
+++ b/src/elaborate.sml	Thu Jul 24 10:41:53 2008 -0400
@@ -1915,8 +1915,9 @@
                                                      ((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 -r 6c14e78feb6d -r 67ab26888839 src/monoize.sml
--- 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 (
diff -r 6c14e78feb6d -r 67ab26888839 tests/textarea.lac
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/textarea.lac	Thu Jul 24 10:41:53 2008 -0400
@@ -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>