Mercurial > urweb
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), |