Mercurial > urweb

comparison src/monoize.sml @ 1728:95d3b4f26f59

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Ensure proper ordering of <script> execution, to bring identifiers into scope in time
author Adam Chlipala <adam@chlipala.net>
date Fri, 27 Apr 2012 09:43:09 -0400
parents 1b3f82b09bb0
children 02533f681ad2
comparison
equal deleted inserted replaced
1727:318ba997a149 1728:95d3b4f26f59
1 (* Copyright (c) 2008-2011, Adam Chlipala 1 (* Copyright (c) 2008-2012, Adam Chlipala
2 * All rights reserved. 2 * All rights reserved.
3 * 3 *
4 * Redistribution and use in source and binary forms, with or without 4 * Redistribution and use in source and binary forms, with or without
5 * modification, are permitted provided that the following conditions are met: 5 * modification, are permitted provided that the following conditions are met:
6 * 6 *
3177 loc)), loc), fm) 3177 loc)), loc), fm)
3178 end 3178 end
3179 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs); 3179 | _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
3180 raise Fail "No name passed to input tag") 3180 raise Fail "No name passed to input tag")
3181 3181
3182 fun normal (tag, extra, extraInner) = 3182 fun normal (tag, extra) =
3183 let 3183 let
3184 val (tagStart, fm) = tagStart tag 3184 val (tagStart, fm) = tagStart tag
3185 val tagStart = case extra of 3185 val tagStart = case extra of
3186 NONE => tagStart 3186 NONE => tagStart
3187 | SOME extra => (L'.EStrcat (tagStart, extra), loc) 3187 | SOME extra => (L'.EStrcat (tagStart, extra), loc)
3188 3188
3189 fun normal () = 3189 fun normal () =
3190 let 3190 let
3191 val (xml, fm) = monoExp (env, st, fm) xml 3191 val (xml, fm) = monoExp (env, st, fm) xml
3192
3193 val xml = case extraInner of
3194 NONE => xml
3195 | SOME ei => (L'.EStrcat (ei, xml), loc)
3196 in 3192 in
3197 ((L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc), 3193 ((L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc),
3198 (L'.EStrcat (xml, 3194 (L'.EStrcat (xml,
3199 (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])), 3195 (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])),
3200 loc)), loc)), 3196 loc)), loc)),
3314 onload), loc), 3310 onload), loc),
3315 s)]), 3311 s)]),
3316 loc), 3312 loc),
3317 (L'.EFfiApp ("Basis", "maybe_onunload", 3313 (L'.EFfiApp ("Basis", "maybe_onunload",
3318 [(onunload, s)]), 3314 [(onunload, s)]),
3319 loc)), loc), 3315 loc)), loc))
3320 SOME (L'.EFfiApp ("Basis", "get_script", [((L'.ERecord [], loc), (L'.TRecord [], loc))]), loc))
3321 end 3316 end
3322 3317
3323 | "dyn" => 3318 | "dyn" =>
3324 let 3319 let
3325 fun inTag tag = case targs of 3320 fun inTag tag = case targs of
3344 (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc), 3339 (L'.EPrim (Prim.String ("))</script>")), loc)), loc)), loc),
3345 fm) 3340 fm)
3346 | _ => raise Fail "Monoize: Bad dyn attributes" 3341 | _ => raise Fail "Monoize: Bad dyn attributes"
3347 end 3342 end
3348 3343
3349 | "submit" => normal ("input type=\"submit\"", NONE, NONE) 3344 | "submit" => normal ("input type=\"submit\"", NONE)
3350 | "image" => normal ("input type=\"image\"", NONE, NONE) 3345 | "image" => normal ("input type=\"image\"", NONE)
3351 | "button" => normal ("input type=\"submit\"", NONE, NONE) 3346 | "button" => normal ("input type=\"submit\"", NONE)
3352 | "hidden" => input "hidden" 3347 | "hidden" => input "hidden"
3353 3348
3354 | "textbox" => 3349 | "textbox" =>
3355 (case targs of 3350 (case targs of
3356 [_, (L.CName name, _)] => 3351 [_, (L.CName name, _)] =>
3402 | "radioOption" => 3397 | "radioOption" =>
3403 (case St.radioGroup st of 3398 (case St.radioGroup st of
3404 NONE => raise Fail "No name for radioGroup" 3399 NONE => raise Fail "No name for radioGroup"
3405 | SOME name => 3400 | SOME name =>
3406 normal ("input", 3401 normal ("input",
3407 SOME (L'.EPrim (Prim.String (" type=\"radio\" name=\"" ^ name ^ "\"")), loc), 3402 SOME (L'.EPrim (Prim.String (" type=\"radio\" name=\"" ^ name ^ "\"")), loc)))
3408 NONE))
3409 3403
3410 | "select" => 3404 | "select" =>
3411 (case targs of 3405 (case targs of
3412 [_, (L.CName name, _)] => 3406 [_, (L.CName name, _)] =>
3413 let 3407 let
3500 sc, 3494 sc,
3501 str "</script>"], 3495 str "</script>"],
3502 fm) 3496 fm)
3503 end) 3497 end)
3504 3498
3505 | "coption" => normal ("option", NONE, NONE) 3499 | "coption" => normal ("option", NONE)
3506 3500
3507 | "ctextarea" => 3501 | "ctextarea" =>
3508 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of 3502 (case List.find (fn ("Source", _, _) => true | _ => false) attrs of
3509 NONE => 3503 NONE =>
3510 let 3504 let
3525 sc, 3519 sc,
3526 str "</script>"], 3520 str "</script>"],
3527 fm) 3521 fm)
3528 end) 3522 end)
3529 3523
3530 | "tabl" => normal ("table", NONE, NONE) 3524 | "tabl" => normal ("table", NONE)
3531 | _ => normal (tag, NONE, NONE) 3525 | _ => normal (tag, NONE)
3532 in 3526 in
3533 case #1 dynClass of 3527 case #1 dynClass of
3534 L'.ENone _ => baseAll 3528 L'.ENone _ => baseAll
3535 | L'.ESome (_, dc) => (strcat [str "<script type=\"text/javascript\">dynClass(execD(", 3529 | L'.ESome (_, dc) => (strcat [str "<script type=\"text/javascript\">dynClass(execD(",
3536 (L'.EJavaScript (L'.Script, base), loc), 3530 (L'.EJavaScript (L'.Script, base), loc),