summaryrefslogtreecommitdiff
path: root/src/monoize.sml
diff options
context:
space:
mode:
authorGravatar Adam Chlipala <adamc@hcoop.net>2008-07-24 10:41:53 -0400
committerGravatar Adam Chlipala <adamc@hcoop.net>2008-07-24 10:41:53 -0400
commita8d4408b6a68c27dc88d8f7e37326c19296808db (patch)
tree1a5e9d5f469c8e29d4c0106086d8a029f4dc476b /src/monoize.sml
parenta729c94d397dc7731a711eea990092c90fbd5460 (diff)
textarea
Diffstat (limited to 'src/monoize.sml')
-rw-r--r--src/monoize.sml44
1 files changed, 30 insertions, 14 deletions
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 (