Mercurial > urweb

changeset 1290:6791454653c5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Confirm boxes; proper event handler setting for ctags
author Adam Chlipala <adam@chlipala.net>
date Sun, 22 Aug 2010 19:45:07 -0400
parents 3b22c3c67f35
children be6e2cd8d9a9
files lib/js/urweb.js lib/ur/basis.urs src/monoize.sml src/settings.sml
diffstat 4 files changed, 44 insertions(+), 5 deletions(-) [+]
line wrap: on
line diff
--- 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
 
--- 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
 
--- 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)
--- 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"),