diff options
| -rw-r--r-- | lib/js/urweb.js | 12 | ||||
| -rw-r--r-- | lib/ur/basis.urs | 5 | ||||
| -rw-r--r-- | src/settings.sml | 11 | ||||
| -rw-r--r-- | tests/docevents.ur | 7 |
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> |