# HG changeset patch # User Adam Chlipala # Date 1282520707 14400 # Node ID 6791454653c55afab3475672e2b382fcaec053ff # Parent 3b22c3c67f35cc9ac1f3147beb9946b0bd953375 Confirm boxes; proper event handler setting for ctags diff -r 3b22c3c67f35 -r 6791454653c5 lib/js/urweb.js --- a/lib/js/urweb.js Sun Aug 22 13:43:46 2010 -0400 +++ b/lib/js/urweb.js Sun Aug 22 19:45:07 2010 -0400 @@ -512,7 +512,18 @@ function addOnChange(x, f) { var old = x.onchange; - x.onchange = function() { old(); f (); }; + if (old == null) + x.onchange = f; + else + x.onchange = function() { old(); f(); }; +} + +function addOnKeyUp(x, f) { + var old = x.onkeyup; + if (old == null) + x.onkeyup = f; + else + x.onkeyup = function(x) { old(x); f(x); }; } @@ -893,7 +904,7 @@ var uw_event = null; function kc() { - return window.event ? uw_event.keyCode : uw_event.which; + return window.event ? event.keyCode : (uw_event ? uw_event.keyCode : 0); } @@ -1164,5 +1175,12 @@ } +// Wrappers + +function confrm(s) { + return confirm(s) ? true : false; +} + + // App-specific code diff -r 3b22c3c67f35 -r 6791454653c5 lib/ur/basis.urs --- a/lib/ur/basis.urs Sun Aug 22 13:43:46 2010 -0400 +++ b/lib/ur/basis.urs Sun Aug 22 19:45:07 2010 -0400 @@ -158,6 +158,7 @@ (** JavaScript-y gadgets *) val alert : string -> transaction unit +val confirm : string -> transaction bool val spawn : transaction unit -> transaction unit val sleep : int -> transaction unit diff -r 3b22c3c67f35 -r 6791454653c5 src/monoize.sml --- a/src/monoize.sml Sun Aug 22 13:43:46 2010 -0400 +++ b/src/monoize.sml Sun Aug 22 19:45:07 2010 -0400 @@ -2958,7 +2958,7 @@ L'.TRecord [] => ((L'.EApp (e, (L'.ERecord [], loc)), loc), s') | _ => ((L'.EApp ((L'.EApp (e, (L'.EFfiApp ("Basis", "kc", []), loc)), loc), (L'.ERecord [], loc)), loc), - s' ^ "uwe=event;") + s' ^ "uw_event=event;") val s' = s' ^ "exec(" in ((L'.EStrcat (s, @@ -3068,10 +3068,27 @@ SOME (strcat [str "addOnChange(d,exec(", (L'.EJavaScript (L'.Script, e), loc), str "))"]) - | (x, e, _) => + | (x, e, (L'.TFun ((L'.TRecord [], _), _), _)) => SOME (strcat [str ("d." ^ lowercaseFirst x ^ "=exec("), (L'.EJavaScript (L'.Script, e), loc), - str ");"])) + str ");"]) + | (x, e, _) => + let + val e = (L'.EAbs ("_", (L'.TRecord [], loc), (L'.TRecord [], loc), + (L'.EApp ((L'.EApp (liftExpInExp 0 e, + (L'.EFfiApp ("Basis", "kc", []), loc)), + loc), (L'.ERecord [], loc)), loc)), loc) + in + case x of + "Onkeyup" => + SOME (strcat [str ("((function(c){addOnKeyUp(d,function(){window.uw_event=window.event;return c();});})(exec("), + (L'.EJavaScript (L'.Script, e), loc), + str ")));"]) + | _ => + SOME (strcat [str ("((function(c){d." ^ lowercaseFirst x ^ "=function(){window.uw_event=window.event;return c();};})(exec("), + (L'.EJavaScript (L'.Script, e), loc), + str ")));"]) + end) attrs val t = (L'.TFfi ("Basis", "string"), loc) diff -r 3b22c3c67f35 -r 6791454653c5 src/settings.sml --- a/src/settings.sml Sun Aug 22 13:43:46 2010 -0400 +++ b/src/settings.sml Sun Aug 22 19:45:07 2010 -0400 @@ -110,6 +110,7 @@ "set_client_source", "current", "alert", + "confirm", "onError", "onFail", "onConnectFail", @@ -127,6 +128,7 @@ "set", "current", "alert", + "confirm", "recv", "sleep", "spawn", @@ -154,6 +156,7 @@ val basisM = foldl (fn ((k, v : string), m) => M.insert (m, ("Basis", k), v)) M.empty val jsFuncsBase = basisM [("alert", "alert"), + ("confirm", "confrm"), ("get_client_source", "sg"), ("current", "scur"), ("htmlifyBool", "bs"),