comparison src/monoize.sml @ 1398:fe470db7feea

Fix for handling of some attributes to client-side input widgets, based on a patch from Vladimir Shabanov
author Adam Chlipala <adam@chlipala.net>
date Sun, 16 Jan 2011 10:57:59 -0500
parents d328983dc5a6
children 5f4fee8a4dcd
comparison
equal deleted inserted replaced
1397:a5bfed32d4f7 1398:fe470db7feea
3098 val assgns = List.mapPartial 3098 val assgns = List.mapPartial
3099 (fn ("Source", _, _) => NONE 3099 (fn ("Source", _, _) => NONE
3100 | ("Onchange", e, _) => 3100 | ("Onchange", e, _) =>
3101 SOME (strcat [str "addOnChange(d,exec(", 3101 SOME (strcat [str "addOnChange(d,exec(",
3102 (L'.EJavaScript (L'.Script, e), loc), 3102 (L'.EJavaScript (L'.Script, e), loc),
3103 str "))"]) 3103 str "));"])
3104 | (x, e, (L'.TFun ((L'.TRecord [], _), _), _)) => 3104 | (x, e, (L'.TFun ((L'.TRecord [], _), _), _)) =>
3105 SOME (strcat [str ("d." ^ lowercaseFirst x ^ "=exec("), 3105 SOME (strcat [str ("d." ^ lowercaseFirst x ^ "=exec("),
3106 (L'.EJavaScript (L'.Script, e), loc), 3106 (L'.EJavaScript (L'.Script, e), loc),
3107 str ");"]) 3107 str ");"])
3108 | (x, e, _) => 3108 | (x, e, _) =>
3109 let 3109 if String.isPrefix "On" x then
3110 val e = (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc), 3110 let
3111 (L'.EApp ((L'.EApp (liftExpInExp 0 e, 3111 val e = (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc),
3112 (L'.EFfiApp ("Basis", "kc", []), loc)), 3112 (L'.EApp ((L'.EApp (liftExpInExp 0 e,
3113 loc), (L'.ERecord [], loc)), loc)), loc) 3113 (L'.EFfiApp ("Basis", "kc", []), loc)),
3114 in 3114 loc), (L'.ERecord [], loc)), loc)), loc)
3115 case x of 3115 in
3116 "Onkeyup" => 3116 case x of
3117 SOME (strcat [str ("((function(c){addOnKeyUp(d,function(){window.uw_event=window.event;return c();});})(exec("), 3117 "Onkeyup" =>
3118 (L'.EJavaScript (L'.Script, e), loc), 3118 SOME (strcat [str ("((function(c){addOnKeyUp(d,function(){window.uw_event=window.event;return c();});})(exec("),
3119 str ")));"]) 3119 (L'.EJavaScript (L'.Script, e), loc),
3120 | _ => 3120 str ")));"])
3121 SOME (strcat [str ("((function(c){d." ^ lowercaseFirst x ^ "=function(){window.uw_event=window.event;return c();};})(exec("), 3121 | _ =>
3122 (L'.EJavaScript (L'.Script, e), loc), 3122 SOME (strcat [str ("((function(c){d." ^ lowercaseFirst x ^ "=function(){window.uw_event=window.event;return c();};})(exec("),
3123 str ")));"]) 3123 (L'.EJavaScript (L'.Script, e), loc),
3124 end) 3124 str ")));"])
3125 end
3126 else
3127 SOME (strcat [str ("d." ^ lowercaseFirst x ^ "=exec("),
3128 (L'.EJavaScript (L'.Script, e), loc),
3129 str ");"]))
3125 attrs 3130 attrs
3126 3131
3127 val t = (L'.TFfi ("Basis", "string"), loc) 3132 val t = (L'.TFfi ("Basis", "string"), loc)
3128 val setClass = (L'.ECase (class, 3133 val setClass = (L'.ECase (class,
3129 [((L'.PNone t, loc), 3134 [((L'.PNone t, loc),