Mercurial > urweb

comparison src/monoize.sml @ 1751:acadf9d1214a

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
'dynStyle' pseudo-attribute
author Adam Chlipala <adam@chlipala.net>
date Sun, 06 May 2012 15:15:46 -0400
parents 277480862cef
children a1380fc15cb5
comparison
equal deleted inserted replaced
1750:277480862cef 1751:acadf9d1214a
3031 (L.EApp ( 3031 (L.EApp (
3032 (L.EApp ( 3032 (L.EApp (
3033 (L.EApp ( 3033 (L.EApp (
3034 (L.EApp ( 3034 (L.EApp (
3035 (L.EApp ( 3035 (L.EApp (
3036 (L.ECApp ( 3036 (L.EApp (
3037 (L.ECApp ( 3037 (L.ECApp (
3038 (L.ECApp ( 3038 (L.ECApp (
3039 (L.ECApp ( 3039 (L.ECApp (
3040 (L.ECApp ( 3040 (L.ECApp (
3041 (L.ECApp ( 3041 (L.ECApp (
3042 (L.ECApp ( 3042 (L.ECApp (
3043 (L.ECApp ( 3043 (L.ECApp (
3044 (L.EFfi ("Basis", "tag"), 3044 (L.ECApp (
3045 _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _), 3045 (L.EFfi ("Basis", "tag"),
3046 class), _), 3046 _), (L.CRecord (_, attrsGiven), _)), _), _), _), _), _), _), _), _), _), _), _), _), _), _), _),
3047 dynClass), _), 3047 class), _),
3048 style), _), 3048 dynClass), _),
3049 style), _),
3050 dynStyle), _),
3049 attrs), _), 3051 attrs), _),
3050 tag), _), 3052 tag), _),
3051 xml) => 3053 xml) =>
3052 let 3054 let
3053 fun getTag' (e, _) = 3055 fun getTag' (e, _) =
3102 (NONE, NONE, attrs) 3104 (NONE, NONE, attrs)
3103 3105
3104 val (class, fm) = monoExp (env, st, fm) class 3106 val (class, fm) = monoExp (env, st, fm) class
3105 val (dynClass, fm) = monoExp (env, st, fm) dynClass 3107 val (dynClass, fm) = monoExp (env, st, fm) dynClass
3106 val (style, fm) = monoExp (env, st, fm) style 3108 val (style, fm) = monoExp (env, st, fm) style
3109 val (dynStyle, fm) = monoExp (env, st, fm) dynStyle
3107 3110
3108 val dynamics = ["dyn", "ctextbox", "ccheckbox", "cselect", "coption", "ctextarea"] 3111 val dynamics = ["dyn", "ctextbox", "ccheckbox", "cselect", "coption", "ctextarea"]
3109 3112
3110 val () = case #1 dynClass of 3113 fun isSome (e, _) =
3111 L'.ENone _ => () 3114 case e of
3112 | _ => if List.exists (fn x => x = tag) dynamics then 3115 L'.ESome _ => true
3113 E.errorAt loc ("Dynamic tag <" ^ tag ^ "> cannot be combined with 'dynClass' attribute; an additional <span> may be useful") 3116 | _ => false
3114 else 3117
3115 () 3118 val () = if isSome dynClass orelse isSome dynStyle then
3119 if List.exists (fn x => x = tag) dynamics then
3120 E.errorAt loc ("Dynamic tag <" ^ tag ^ "> cannot be combined with 'dynClass' or 'dynStyle' attribute; an additional <span> may be useful")
3121 else
3122 ()
3123 else
3124 ()
3116 3125
3117 fun tagStart tag' = 3126 fun tagStart tag' =
3118 let 3127 let
3119 val t = (L'.TFfi ("Basis", "string"), loc) 3128 val t = (L'.TFfi ("Basis", "string"), loc)
3120 val s = (L'.EPrim (Prim.String (String.concat ["<", tag'])), loc) 3129 val s = (L'.EPrim (Prim.String (String.concat ["<", tag'])), loc)
3585 3594
3586 | "tabl" => normal ("table", NONE) 3595 | "tabl" => normal ("table", NONE)
3587 | _ => normal (tag, NONE) 3596 | _ => normal (tag, NONE)
3588 in 3597 in
3589 case #1 dynClass of 3598 case #1 dynClass of
3590 L'.ENone _ => baseAll 3599 L'.ENone _ =>
3591 | L'.ESome (_, dc) => (strcat [str "<script type=\"text/javascript\">dynClass(execD(", 3600 (case #1 dynStyle of
3592 (L'.EJavaScript (L'.Script, base), loc), 3601 L'.ENone _ => baseAll
3593 str "),execD(", 3602 | L'.ESome (_, ds) => (strcat [str "<script type=\"text/javascript\">dynClass(execD(",
3594 (L'.EJavaScript (L'.Script, dc), loc), 3603 (L'.EJavaScript (L'.Script, base), loc),
3595 str "))</script>"], 3604 str "),null,execD(",
3596 fm) 3605 (L'.EJavaScript (L'.Script, ds), loc),
3606 str "))</script>"],
3607 fm)
3608 | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown";
3609 baseAll))
3610 | L'.ESome (_, dc) =>
3611 let
3612 val e = case #1 dynStyle of
3613 L'.ENone _ => str "null"
3614 | L'.ESome (_, ds) => strcat [str "execD(",
3615 (L'.EJavaScript (L'.Script, ds), loc),
3616 str ")"]
3617 | _ => (E.errorAt loc "Absence/presence of 'dynStyle' unknown";
3618 str "null")
3619 in
3620 (strcat [str "<script type=\"text/javascript\">dynClass(execD(",
3621 (L'.EJavaScript (L'.Script, base), loc),
3622 str "),execD(",
3623 (L'.EJavaScript (L'.Script, dc), loc),
3624 str "),",
3625 e,
3626 str ")</script>"],
3627 fm)
3628 end
3597 | _ => (E.errorAt loc "Absence/presence of 'dynClass' unknown"; 3629 | _ => (E.errorAt loc "Absence/presence of 'dynClass' unknown";
3598 baseAll) 3630 baseAll)
3599 end 3631 end
3600 3632
3601 | L.EApp ( 3633 | L.EApp (