Mercurial > urweb
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 _), _), |