# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1247936006 14400
# Node ID ae9e22822ec5f33bfcd25ade510148a854e190f5
# Parent  a3f58978ff32cfcc810ce320f2ceb94f606bcb4b
Key events get key code input

diff -r a3f58978ff32 -r ae9e22822ec5 lib/js/urweb.js
--- a/lib/js/urweb.js	Sat Jul 18 12:37:19 2009 -0400
+++ b/lib/js/urweb.js	Sat Jul 18 12:53:26 2009 -0400
@@ -648,5 +648,12 @@
 }
 
 
+// Key events
+
+function kc(e) {
+  return window.event ? e.keyCode : e.which;
+}
+
+
 // App-specific code
 
diff -r a3f58978ff32 -r ae9e22822ec5 lib/ur/basis.urs
--- a/lib/ur/basis.urs	Sat Jul 18 12:37:19 2009 -0400
+++ b/lib/ur/basis.urs	Sat Jul 18 12:53:26 2009 -0400
@@ -555,8 +555,9 @@
                    Onmousedown = transaction unit, Onmousemove = transaction unit,
                    Onmouseout = transaction unit, Onmouseover = transaction unit,
                    Onmouseup = transaction unit]
-con keyEvents = [Onkeydown = transaction unit, Onkeypress = transaction unit,
-                 Onkeyup = transaction unit]
+con keyEvents = [Onkeydown = int -> transaction unit, Onkeypress = int -> transaction unit,
+                 Onkeyup = int -> transaction unit]
+(* Key arguments are character codes. *)
 con resizeEvents = [Onresize = transaction unit]
 
 con boxEvents = focusEvents ++ mouseEvents ++ keyEvents ++ resizeEvents
diff -r a3f58978ff32 -r ae9e22822ec5 src/jscomp.sml
--- a/src/jscomp.sml	Sat Jul 18 12:37:19 2009 -0400
+++ b/src/jscomp.sml	Sat Jul 18 12:53:26 2009 -0400
@@ -768,6 +768,7 @@
                             in
                                 (str name, st)
                             end
+                          | EFfiApp ("Basis", "kc", []) => (str "kc(event)", st)
                           | EFfiApp (m, x, args) =>
                             let
                                 val name = case Settings.jsFunc (m, x) of
diff -r a3f58978ff32 -r ae9e22822ec5 src/monoize.sml
--- a/src/monoize.sml	Sat Jul 18 12:37:19 2009 -0400
+++ b/src/monoize.sml	Sat Jul 18 12:53:26 2009 -0400
@@ -2505,10 +2505,13 @@
                                                        result = (L'.TFfi ("Basis", "string"), loc)}), loc),
                                            fm)
                                       end
-                                    | (L'.TFun _, _) =>
+                                    | (L'.TFun (dom, _), _) =>
                                       let
                                           val s' = " " ^ lowercaseFirst x ^ "='"
-                                          val e = (L'.EApp (e, (L'.ERecord [], loc)), loc)
+                                          val e = case #1 dom of
+                                                      L'.TRecord [] => (L'.EApp (e, (L'.ERecord [], loc)), loc)
+                                                    | _ => (L'.EApp ((L'.EApp (e, (L'.EFfiApp ("Basis", "kc", []), loc)),
+                                                                      loc), (L'.ERecord [], loc)), loc)
                                       in
                                           ((L'.EStrcat (s,
                                                         (L'.EStrcat (
diff -r a3f58978ff32 -r ae9e22822ec5 src/settings.sml
--- a/src/settings.sml	Sat Jul 18 12:37:19 2009 -0400
+++ b/src/settings.sml	Sat Jul 18 12:53:26 2009 -0400
@@ -91,7 +91,8 @@
                            "onFail",
                            "onConnectFail",
                            "onDisconnect",
-                           "onServerError"]
+                           "onServerError",
+                           "kc"]
 
 val effectful = ref effectfulBase
 fun setEffectful ls = effectful := S.addList (effectfulBase, ls)
@@ -108,7 +109,8 @@
                         "onFail",
                         "onConnectFail",
                         "onDisconnect",
-                        "onServerError"]
+                        "onServerError",
+                        "kc"]
 val client = ref clientBase
 fun setClientOnly ls = client := S.addList (clientBase, ls)
 fun isClientOnly x = S.member (!client, x)
@@ -162,7 +164,8 @@
                           ("strindex", "sidx"),
                           ("strchr", "schr"),
                           ("substring", "ssub"),
-                          ("strcspn", "sspn")]
+                          ("strcspn", "sspn"),
+                          ("kc", "kc")]
 val jsFuncs = ref jsFuncsBase
 fun setJsFuncs ls = jsFuncs := foldl (fn ((k, v), m) => M.insert (m, k, v)) jsFuncsBase ls
 fun jsFunc x = M.find (!jsFuncs, x)
diff -r a3f58978ff32 -r ae9e22822ec5 tests/event.ur
--- a/tests/event.ur	Sat Jul 18 12:37:19 2009 -0400
+++ b/tests/event.ur	Sat Jul 18 12:53:26 2009 -0400
@@ -7,8 +7,8 @@
       <span onmousedown={set s "Mouse down"} onmouseup={set s "Mouse up"}>SPAN</span>
       <span onmouseout={set s "Mouse out"} onmouseover={set s "Mouse over"}>SPAN</span>
       <span onmousemove={set s "Mouse move"}>SPAN</span>
-      <button onkeydown={set s "Key down"} onkeyup={set s "Key up"}/>
-      <button onkeypress={set s "Key press"}/>
+      <button onkeydown={fn k => set s ("Key down: " ^ show k)} onkeyup={fn _ => set s "Key up"}/>
+      <button onkeypress={fn _ => set s "Key press"}/>
       <br/>
       <br/>