Mercurial > urweb
comparison src/monoize.sml @ 2026:73e54a6aba79
Treat <button> 'value' attribute as content of tag
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Fri, 13 Jun 2014 10:57:02 -0400 |
parents | 924e2ef31f5a |
children | dfa35ca83d92 |
comparison
equal
deleted
inserted
replaced
2025:afeeabdcce77 | 2026:73e54a6aba79 |
---|---|
3288 if tag = "body" then | 3288 if tag = "body" then |
3289 findOnload (attrs, NONE, NONE, []) | 3289 findOnload (attrs, NONE, NONE, []) |
3290 else | 3290 else |
3291 (NONE, NONE, attrs) | 3291 (NONE, NONE, attrs) |
3292 | 3292 |
3293 (* Special case for <button value=""> *) | |
3294 val (attrs, extraString) = case tag of | |
3295 "button" => | |
3296 (case List.partition (fn (x, _, _) => x = "Value") attrs of | |
3297 ([(_, value, _)], rest) => | |
3298 (rest, SOME value) | |
3299 | _ => (attrs, NONE)) | |
3300 | _ => (attrs, NONE) | |
3301 | |
3302 | |
3293 val (class, fm) = monoExp (env, st, fm) class | 3303 val (class, fm) = monoExp (env, st, fm) class |
3294 val (dynClass, fm) = monoExp (env, st, fm) dynClass | 3304 val (dynClass, fm) = monoExp (env, st, fm) dynClass |
3295 val (style, fm) = monoExp (env, st, fm) style | 3305 val (style, fm) = monoExp (env, st, fm) style |
3296 val (dynStyle, fm) = monoExp (env, st, fm) dynStyle | 3306 val (dynStyle, fm) = monoExp (env, st, fm) dynStyle |
3297 | 3307 |
3462 | SOME extra => (L'.EStrcat (tagStart, extra), loc) | 3472 | SOME extra => (L'.EStrcat (tagStart, extra), loc) |
3463 | 3473 |
3464 fun normal () = | 3474 fun normal () = |
3465 let | 3475 let |
3466 val (xml, fm) = monoExp (env, st, fm) xml | 3476 val (xml, fm) = monoExp (env, st, fm) xml |
3477 | |
3478 val xml = case extraString of | |
3479 NONE => xml | |
3480 | SOME extra => (L'.EStrcat (extra, xml), loc) | |
3467 in | 3481 in |
3468 ((L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc), | 3482 ((L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc), |
3469 (L'.EStrcat (xml, | 3483 (L'.EStrcat (xml, |
3470 (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])), | 3484 (L'.EPrim (Prim.String (String.concat ["</", tag, ">"])), |
3471 loc)), loc)), | 3485 loc)), loc)), |
3481 tag | 3495 tag |
3482 else | 3496 else |
3483 Substring.string bef) | 3497 Substring.string bef) |
3484 end | 3498 end |
3485 in | 3499 in |
3486 case xml of | 3500 case (xml, extraString) of |
3487 (L.EApp ((L.ECApp ( | 3501 ((L.EApp ((L.ECApp ( |
3488 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), | 3502 (L.ECApp ((L.EFfi ("Basis", "cdata"), _), |
3489 _), _), | 3503 _), _), |
3490 _), _), | 3504 _), _), |
3491 (L.EPrim (Prim.String s), _)), _) => | 3505 (L.EPrim (Prim.String s), _)), _), NONE) => |
3492 if CharVector.all Char.isSpace s andalso isSingleton () then | 3506 if CharVector.all Char.isSpace s andalso isSingleton () then |
3493 ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String " />"), loc)), loc), fm) | 3507 ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String " />"), loc)), loc), fm) |
3494 else | 3508 else |
3495 normal () | 3509 normal () |
3496 | _ => normal () | 3510 | _ => normal () |