comparison 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
comparison
equal deleted inserted replaced
151:6c14e78feb6d 152:67ab26888839
242 (L'.EStrcat (tagStart "input", 242 (L'.EStrcat (tagStart "input",
243 (L'.EPrim (Prim.String (" type=\"" ^ typ ^ "\" name=\"" ^ name ^ "\"/>")), 243 (L'.EPrim (Prim.String (" type=\"" ^ typ ^ "\" name=\"" ^ name ^ "\"/>")),
244 loc)), loc) 244 loc)), loc)
245 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); 245 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
246 raise Fail "No named passed to input tag") 246 raise Fail "No named passed to input tag")
247 in 247
248 case tag of 248 fun normal (tag, extra) =
249 "submit" => (L'.EPrim (Prim.String "<input type=\"submit\"/>"), loc)
250
251 | "textbox" =>
252 (case targs of
253 [_, (L.CName name, _)] =>
254 (L'.EStrcat (tagStart "input",
255 (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\"/>")),
256 loc)), loc)
257 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
258 raise Fail "No named passed to input tag"))
259
260 | _ =>
261 let 249 let
262 val tagStart = tagStart tag 250 val tagStart = tagStart tag
263 251 val tagStart = case extra of
252 NONE => tagStart
253 | SOME extra => (L'.EStrcat (tagStart, extra), loc)
254
264 fun normal () = 255 fun normal () =
265 (L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc), 256 (L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc),
266 (L'.EStrcat (monoExp env xml, 257 (L'.EStrcat (monoExp env xml,
267 (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])), 258 (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])),
268 loc)), loc)), 259 loc)), loc)),
278 (L'.EStrcat (tagStart, (L'.EPrim (Prim.String "/>"), loc)), loc) 269 (L'.EStrcat (tagStart, (L'.EPrim (Prim.String "/>"), loc)), loc)
279 else 270 else
280 normal () 271 normal ()
281 | _ => normal () 272 | _ => normal ()
282 end 273 end
274 in
275 case tag of
276 "submit" => (L'.EPrim (Prim.String "<input type=\"submit\"/>"), loc)
277
278 | "textbox" =>
279 (case targs of
280 [_, (L.CName name, _)] =>
281 (L'.EStrcat (tagStart "input",
282 (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\"/>")),
283 loc)), loc)
284 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
285 raise Fail "No named passed to textarea tag"))
286 | "ltextarea" =>
287 (case targs of
288 [_, (L.CName name, _)] =>
289 (L'.EStrcat ((L'.EStrcat (tagStart "textarea",
290 (L'.EPrim (Prim.String (" name=\"" ^ name ^ "\">")), loc)), loc),
291 (L'.EStrcat (monoExp env xml,
292 (L'.EPrim (Prim.String "</textarea>"),
293 loc)), loc)),
294 loc)
295 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
296 raise Fail "No named passed to ltextarea tag"))
297
298 | _ => normal (tag, NONE)
283 end 299 end
284 300
285 | L.EApp ((L.ECApp ( 301 | L.EApp ((L.ECApp (
286 (L.ECApp ((L.EFfi ("Basis", "lform"), _), _), _), 302 (L.ECApp ((L.EFfi ("Basis", "lform"), _), _), _),
287 _), _), 303 _), _),