New mouse events oncontextmenu, onmouseenter, and onmouseleave.

4 files changed, 30 insertions, 5 deletions

diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index b599393b..335cb525 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -537,6 +537,10 @@ function uw_onClick(f) {
     uw_handler("onclick", f);
 }
 
+function uw_onContextmenu(f) {
+    uw_handler("oncontextmenu", f);
+}
+
 function uw_onDblclick(f) {
     uw_handler("ondblclick", f);
 }
@@ -545,6 +549,14 @@ function uw_onMousedown(f) {
     uw_handler("onmousedown", f);
 }
 
+function uw_onMouseenter(f) {
+    uw_handler("onmouseenter", f);
+}
+
+function uw_onMouseleave(f) {
+    uw_handler("onmouseleave", f);
+}
+
 function uw_onMousemove(f) {
     uw_handler("onmousemove", f);
 }
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index b8e52582..28384c2c 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -833,7 +833,7 @@ type mouseEvent = { ScreenX : int, ScreenY : int, ClientX : int, ClientY : int,
                     Button : mouseButton }
 
 con mouseEvents = map (fn _ :: Unit => mouseEvent -> transaction unit)
-                          [Onclick, Ondblclick, Onmousedown, Onmousemove, Onmouseout, Onmouseover, Onmouseup]
+                          [Onclick, Oncontextmenu, Ondblclick, Onmousedown, Onmouseenter, Onmouseleave, Onmousemove, Onmouseout, Onmouseover, Onmouseup]
 
 type keyEvent = { KeyCode : int,
                   CtrlKey : bool, ShiftKey : bool, AltKey : bool, MetaKey : bool }
@@ -1120,10 +1120,13 @@ val onServerError : (string -> transaction unit) -> transaction unit
 (* More standard document-level JavaScript handlers *)
 val onClick : (mouseEvent -> transaction unit) -> transaction unit
 val onDblclick : (mouseEvent -> transaction unit) -> transaction unit
+val onContextmenu : (mouseEvent -> transaction unit) -> transaction unit
 val onKeydown : (keyEvent -> transaction unit) -> transaction unit
 val onKeypress : (keyEvent -> transaction unit) -> transaction unit
 val onKeyup : (keyEvent -> transaction unit) -> transaction unit
 val onMousedown : (mouseEvent -> transaction unit) -> transaction unit
+val onMouseenter : (mouseEvent -> transaction unit) -> transaction unit
+val onMouseleave : (mouseEvent -> transaction unit) -> transaction unit
 val onMousemove : (mouseEvent -> transaction unit) -> transaction unit
 val onMouseout : (mouseEvent -> transaction unit) -> transaction unit
 val onMouseover : (mouseEvent -> transaction unit) -> transaction unit
diff --git a/src/settings.sml b/src/settings.sml
index c9b022fd..b61759c1 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -176,10 +176,13 @@ val benignBase = basis ["get_cookie",
                         "spawn",
                         "onClick",
                         "onDblclick",
+                        "onContextmenu",
                         "onKeydown",
                         "onKeypress",
                         "onKeyup",
                         "onMousedown",
+                        "onMouseenter",
+                        "onMouseleave",
                         "onMousemove",
                         "onMouseout",
                         "onMouseover",
@@ -212,11 +215,14 @@ val clientBase = basis ["get_client_source",
                         "mouseEvent",
                         "keyEvent",
                         "onClick",
+                        "onContextmenu",
                         "onDblclick",
                         "onKeydown",
                         "onKeypress",
                         "onKeyup",
                         "onMousedown",
+                        "onMouseenter",
+                        "onMouseleave",
                         "onMousemove",
                         "onMouseout",
                         "onMouseover",
@@ -349,11 +355,14 @@ val jsFuncsBase = basisM [("alert", "alert"),
 
 
                           ("onClick", "uw_onClick"),
+                          ("onContextmenu", "uw_onContextmenu"),
                           ("onDblclick", "uw_onDblclick"),
                           ("onKeydown", "uw_onKeydown"),
                           ("onKeypress", "uw_onKeypress"),
                           ("onKeyup", "uw_onKeyup"),
                           ("onMousedown", "uw_onMousedown"),
+                          ("onMouseenter", "uw_onMouseenter"),
+                          ("onMouseleave", "uw_onMouseleave"),
                           ("onMousemove", "uw_onMousemove"),
                           ("onMouseout", "uw_onMouseout"),
                           ("onMouseover", "uw_onMouseover"),
@@ -764,7 +773,7 @@ fun mangleSqlTable s =
 fun mangleSql s =
     if #name (currentDbms ()) = "mysql" then
         if !mangle then
-            "uw_" ^ allLower s 
+            "uw_" ^ allLower s
         else
             allLower s
     else
diff --git a/tests/docevents.ur b/tests/docevents.ur
index eed38868..906afa2b 100644
--- a/tests/docevents.ur
+++ b/tests/docevents.ur
@@ -1,6 +1,7 @@
 fun main () : transaction page = return <xml>
-  <body onload={onDblclick (alert "Double click");
-                onKeypress (fn k => alert ("Keypress: " ^ show k))}>
+  <body onload={onDblclick (fn _ => alert "Double click");
+                onContextmenu (fn _ => alert "Context menu");
+                onKeypress (fn k => alert ("Keypress: " ^ show k.KeyCode))}>
     Nothing here.
-  </body>
+    </body>
 </xml>