Mercurial > urweb

comparison src/monoize.sml @ 1479:f561025bb68e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Workaround for old IE handling of <option> with no 'value' attribute
author Adam Chlipala <adam@chlipala.net>
date Sun, 26 Jun 2011 19:45:21 -0400
parents d65387bdc557
children 27b8c0a460cf
comparison
equal deleted inserted replaced
1478:a10d080123ec 1479:f561025bb68e
2975 2975
2976 val (onload, onunload, attrs) = findOnload (attrs, NONE, NONE, []) 2976 val (onload, onunload, attrs) = findOnload (attrs, NONE, NONE, [])
2977 2977
2978 val (class, fm) = monoExp (env, st, fm) class 2978 val (class, fm) = monoExp (env, st, fm) class
2979 2979
2980 fun tagStart tag = 2980 fun tagStart tag' =
2981 let 2981 let
2982 val t = (L'.TFfi ("Basis", "string"), loc) 2982 val t = (L'.TFfi ("Basis", "string"), loc)
2983 val s = (L'.EPrim (Prim.String (String.concat ["<", tag])), loc) 2983 val s = (L'.EPrim (Prim.String (String.concat ["<", tag'])), loc)
2984 2984
2985 val s = (L'.ECase (class, 2985 val s = (L'.ECase (class,
2986 [((L'.PNone t, loc), 2986 [((L'.PNone t, loc),
2987 s), 2987 s),
2988 ((L'.PSome (t, (L'.PVar ("x", t), loc)), loc), 2988 ((L'.PSome (t, (L'.PVar ("x", t), loc)), loc),
2991 (L'.EStrcat ((L'.ERel 0, loc), 2991 (L'.EStrcat ((L'.ERel 0, loc),
2992 (L'.EPrim (Prim.String "\""), loc)), 2992 (L'.EPrim (Prim.String "\""), loc)),
2993 loc)), loc)), loc))], 2993 loc)), loc)), loc))],
2994 {disc = (L'.TOption t, loc), 2994 {disc = (L'.TOption t, loc),
2995 result = t}), loc) 2995 result = t}), loc)
2996
2997 val (s, fm) = foldl (fn (("Action", _, _), acc) => acc
2998 | (("Source", _, _), acc) => acc
2999 | ((x, e, t), (s, fm)) =>
3000 case t of
3001 (L'.TFfi ("Basis", "bool"), _) =>
3002 let
3003 val s' = " " ^ lowercaseFirst x
3004 in
3005 ((L'.ECase (e,
3006 [((L'.PCon (L'.Enum,
3007 L'.PConFfi {mod = "Basis",
3008 datatyp = "bool",
3009 con = "True",
3010 arg = NONE},
3011 NONE), loc),
3012 (L'.EStrcat (s,
3013 (L'.EPrim (Prim.String s'), loc)), loc)),
3014 ((L'.PCon (L'.Enum,
3015 L'.PConFfi {mod = "Basis",
3016 datatyp = "bool",
3017 con = "False",
3018 arg = NONE},
3019 NONE), loc),
3020 s)],
3021 {disc = (L'.TFfi ("Basis", "bool"), loc),
3022 result = (L'.TFfi ("Basis", "string"), loc)}), loc),
3023 fm)
3024 end
3025 | (L'.TFun (dom, _), _) =>
3026 let
3027 val s' = " " ^ lowercaseFirst x ^ "='"
3028 val (e, s') =
3029 case #1 dom of
3030 L'.TRecord [] => ((L'.EApp (e, (L'.ERecord [], loc)), loc), s')
3031 | _ => ((L'.EApp ((L'.EApp (e, (L'.EFfiApp ("Basis", "kc", []), loc)),
3032 loc), (L'.ERecord [], loc)), loc),
3033 s' ^ "uw_event=event;")
3034 val s' = s' ^ "exec("
3035 in
3036 ((L'.EStrcat (s,
3037 (L'.EStrcat (
3038 (L'.EPrim (Prim.String s'), loc),
3039 (L'.EStrcat (
3040 (L'.EJavaScript (L'.Attribute, e), loc),
3041 (L'.EPrim (Prim.String ");return false'"), loc)), loc)),
3042 loc)), loc),
3043 fm)
3044 end
3045 | _ =>
3046 let
3047 val fooify =
3048 case x of
3049 "Link" => urlifyExp
3050 | "Action" => urlifyExp
3051 | _ => attrifyExp
3052
3053 val x =
3054 case x of
3055 "Typ" => "Type"
3056 | "Link" => "Href"
3057 | _ => x
3058 val xp = " " ^ lowercaseFirst x ^ "=\""
3059
3060 val (e, fm) = fooify env fm (e, t)
3061 val e = case (tag, x) of
3062 ("coption", "Value") => (L'.EStrcat ((L'.EPrim (Prim.String "x"), loc), e), loc)
3063 | _ => e
3064 in
3065 ((L'.EStrcat (s,
3066 (L'.EStrcat ((L'.EPrim (Prim.String xp), loc),
3067 (L'.EStrcat (e,
3068 (L'.EPrim (Prim.String "\""),
3069 loc)),
3070 loc)),
3071 loc)), loc),
3072 fm)
3073 end)
3074 (s, fm) attrs
2996 in 3075 in
2997 foldl (fn (("Action", _, _), acc) => acc 3076 (if tag = "coption" andalso List.all (fn ("Value", _, _) => false | _ => true) attrs then
2998 | (("Source", _, _), acc) => acc 3077 (L'.EStrcat (s,
2999 | ((x, e, t), (s, fm)) => 3078 (L'.EPrim (Prim.String " value=\"\""), loc)), loc)
3000 case t of 3079 else
3001 (L'.TFfi ("Basis", "bool"), _) => 3080 s,
3002 let 3081 fm)
3003 val s' = " " ^ lowercaseFirst x
3004 in
3005 ((L'.ECase (e,
3006 [((L'.PCon (L'.Enum,
3007 L'.PConFfi {mod = "Basis",
3008 datatyp = "bool",
3009 con = "True",
3010 arg = NONE},
3011 NONE), loc),
3012 (L'.EStrcat (s,
3013 (L'.EPrim (Prim.String s'), loc)), loc)),
3014 ((L'.PCon (L'.Enum,
3015 L'.PConFfi {mod = "Basis",
3016 datatyp = "bool",
3017 con = "False",
3018 arg = NONE},
3019 NONE), loc),
3020 s)],
3021 {disc = (L'.TFfi ("Basis", "bool"), loc),
3022 result = (L'.TFfi ("Basis", "string"), loc)}), loc),
3023 fm)
3024 end
3025 | (L'.TFun (dom, _), _) =>
3026 let
3027 val s' = " " ^ lowercaseFirst x ^ "='"
3028 val (e, s') =
3029 case #1 dom of
3030 L'.TRecord [] => ((L'.EApp (e, (L'.ERecord [], loc)), loc), s')
3031 | _ => ((L'.EApp ((L'.EApp (e, (L'.EFfiApp ("Basis", "kc", []), loc)),
3032 loc), (L'.ERecord [], loc)), loc),
3033 s' ^ "uw_event=event;")
3034 val s' = s' ^ "exec("
3035 in
3036 ((L'.EStrcat (s,
3037 (L'.EStrcat (
3038 (L'.EPrim (Prim.String s'), loc),
3039 (L'.EStrcat (
3040 (L'.EJavaScript (L'.Attribute, e), loc),
3041 (L'.EPrim (Prim.String ");return false'"), loc)), loc)),
3042 loc)), loc),
3043 fm)
3044 end
3045 | _ =>
3046 let
3047 val fooify =
3048 case x of
3049 "Link" => urlifyExp
3050 | "Action" => urlifyExp
3051 | _ => attrifyExp
3052
3053 val x =
3054 case x of
3055 "Typ" => "Type"
3056 | "Link" => "Href"
3057 | _ => x
3058 val xp = " " ^ lowercaseFirst x ^ "=\""
3059
3060 val (e, fm) = fooify env fm (e, t)
3061 in
3062 ((L'.EStrcat (s,
3063 (L'.EStrcat ((L'.EPrim (Prim.String xp), loc),
3064 (L'.EStrcat (e,
3065 (L'.EPrim (Prim.String "\""),
3066 loc)),
3067 loc)),
3068 loc)), loc),
3069 fm)
3070 end)
3071 (s, fm) attrs
3072 end 3082 end
3073 3083
3074 fun input typ = 3084 fun input typ =
3075 case targs of 3085 case targs of
3076 [_, (L.CName name, _)] => 3086 [_, (L.CName name, _)] =>