Mercurial > urweb
changeset 1783:5bc4fbf9c0fe
New event records for key and mouse handlers
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sat, 21 Jul 2012 10:02:53 -0400 |
| parents | 61c7eb1d3867 |
| children | e6bc6bbd7a32 |
| files | doc/manual.tex lib/js/urweb.js lib/ur/basis.urs src/monoize.sml src/settings.sml tests/globalHandlers.ur tests/keyEvent.ur tests/mouseEvent.ur |
| diffstat | 8 files changed, 111 insertions(+), 32 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/manual.tex Wed Jul 18 17:29:13 2012 -0400 +++ b/doc/manual.tex Sat Jul 21 10:02:53 2012 -0400 @@ -2068,13 +2068,13 @@ There are also functions to register standard document-level event handlers. $$\begin{array}{l} - \mt{val} \; \mt{onClick} : \mt{transaction} \; \mt{unit} \to \mt{transaction} \; \mt{unit} \\ - \mt{val} \; \mt{onDblclick} : \mt{transaction} \; \mt{unit} \to \mt{transaction} \; \mt{unit} \\ - \mt{val} \; \mt{onKeydown} : (\mt{int} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\ - \mt{val} \; \mt{onKeypress} : (\mt{int} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\ - \mt{val} \; \mt{onKeyup} : (\mt{int} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\ - \mt{val} \; \mt{onMousedown} : \mt{transaction} \; \mt{unit} \to \mt{transaction} \; \mt{unit} \\ - \mt{val} \; \mt{onMouseup} : \mt{transaction} \; \mt{unit} \to \mt{transaction} \; \mt{unit} + \mt{val} \; \mt{onClick} : (\mt{mouseEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\ + \mt{val} \; \mt{onDblclick} : (\mt{mouseEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\ + \mt{val} \; \mt{onKeydown} : (\mt{keyEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\ + \mt{val} \; \mt{onKeypress} : (\mt{keyEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\ + \mt{val} \; \mt{onKeyup} : (\mt{keyEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\ + \mt{val} \; \mt{onMousedown} : (\mt{mouseEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \\ + \mt{val} \; \mt{onMouseup} : (\mt{mouseEvent} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \end{array}$$ Versions of standard JavaScript functions are provided that event handlers may call to mask default handling or prevent bubbling of events up to parent DOM nodes, respectively.
--- a/lib/js/urweb.js Wed Jul 18 17:29:13 2012 -0400 +++ b/lib/js/urweb.js Sat Jul 21 10:02:53 2012 -0400 @@ -441,22 +441,55 @@ window.setTimeout(function () { runHandlers("Server", serverHandlers, s); }, 0); } -// Key events +// Key and mouse events var uw_event = null; -function kc() { - return window.event ? event.keyCode : (uw_event ? uw_event.which : 0); +function uw_getEvent() { + return window.event ? window.event : uw_event; } +function firstGood(x, y) { + if (x == undefined || x == 0) + return y; + else + return x; +} + +function uw_mouseEvent() { + var ev = uw_getEvent(); + + return {_ScreenX : firstGood(ev.screenX, 0), + _ScreenY : firstGood(ev.screenY, 0), + _ClientX : firstGood(ev.clientX, 0), + _ClientY : firstGood(ev.clientY, 0), + _CtrlKey : firstGood(ev.ctrlKey, false), + _ShiftKey : firstGood(ev.shiftKey, false), + _AltKey : firstGood(ev.altKey, false), + _MetaKey : firstGood(ev.metaKey, false), + _Button : ev.button == 2 ? "Right" : ev.button == 1 ? "Middle" : "Left"}; +} + +function uw_keyEvent() { + var ev = uw_getEvent(); + + return {_KeyCode : firstGood(ev.keyCode, ev.which), + _CtrlKey : firstGood(ev.ctrlKey, false), + _ShiftKey : firstGood(ev.shiftKey, false), + _AltKey : firstGood(ev.altKey, false), + _MetaKey : firstGood(ev.metaKey, false)}; +} + + + // Document events function uw_handler(name, f) { var old = document[name]; if (old == undefined) - document[name] = function(event) { uw_event = event; execF(f); }; + document[name] = function(event) { uw_event = event; execF(execF(f, uw_mouseEvent())); }; else - document[name] = function(event) { uw_event = event; old(); execF(f); }; + document[name] = function(event) { uw_event = event; old(); execF(execF(f, uw_mouseEvent())); }; } function uw_onClick(f) { @@ -478,9 +511,9 @@ function uw_keyHandler(name, f) { var old = document[name]; if (old == undefined) - document[name] = function(event) { uw_event = event; execF(execF(f, kc())); }; + document[name] = function(event) { uw_event = event; execF(execF(f, uw_keyEvent())); }; else - document[name] = function(event) { uw_event = event; old(); execF(execF(f, kc())); }; + document[name] = function(event) { uw_event = event; old(); execF(execF(f, uw_keyEvent())); }; } function uw_onKeydown(f) {
--- a/lib/ur/basis.urs Wed Jul 18 17:29:13 2012 -0400 +++ b/lib/ur/basis.urs Sat Jul 21 10:02:53 2012 -0400 @@ -784,12 +784,22 @@ val br : bodyTagStandalone [Id = id] con focusEvents = [Onblur = transaction unit, Onfocus = transaction unit] -con mouseEvents = [Onclick = transaction unit, Ondblclick = transaction unit, - Onmousedown = transaction unit, Onmousemove = transaction unit, - Onmouseout = transaction unit, Onmouseover = transaction unit, - Onmouseup = transaction unit] -con keyEvents = [Onkeydown = int -> transaction unit, Onkeypress = int -> transaction unit, - Onkeyup = int -> transaction unit] + +datatype mouseButton = Left | Right | Middle + +type mouseEvent = { ScreenX : int, ScreenY : int, ClientX : int, ClientY : int, + CtrlKey : bool, ShiftKey : bool, AltKey : bool, MetaKey : bool, + Button : mouseButton } + +con mouseEvents = map (fn _ :: Unit => mouseEvent -> transaction unit) + [Onclick, Ondblclick, Onmousedown, Onmousemove, Onmouseout, Onmouseover, Onmouseup] + +type keyEvent = { KeyCode : int, + CtrlKey : bool, ShiftKey : bool, AltKey : bool, MetaKey : bool } + +con keyEvents = map (fn _ :: Unit => keyEvent -> transaction unit) + [Onkeydown, Onkeypress, Onkeyup] + (* Key arguments are character codes. *) con resizeEvents = [Onresize = transaction unit] con scrollEvents = [Onscroll = transaction unit] @@ -955,13 +965,13 @@ val onServerError : (string -> transaction unit) -> transaction unit (* More standard document-level JavaScript handlers *) -val onClick : transaction unit -> transaction unit -val onDblclick : transaction unit -> transaction unit -val onKeydown : (int -> transaction unit) -> transaction unit -val onKeypress : (int -> transaction unit) -> transaction unit -val onKeyup : (int -> transaction unit) -> transaction unit -val onMousedown : transaction unit -> transaction unit -val onMouseup : transaction unit -> transaction unit +val onClick : (mouseEvent -> transaction unit) -> transaction unit +val onDblclick : (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 onMouseup : (mouseEvent -> transaction unit) -> transaction unit (* Prevents default handling of current event *) val preventDefault : transaction unit
--- a/src/monoize.sml Wed Jul 18 17:29:13 2012 -0400 +++ b/src/monoize.sml Sat Jul 21 10:02:53 2012 -0400 @@ -3311,8 +3311,14 @@ 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) + | _ => + if String.isPrefix "Onkey" x then + (L'.EApp ((L'.EApp (e, (L'.EFfiApp ("Basis", "keyEvent", []), loc)), + loc), (L'.ERecord [], loc)), loc) + else + (L'.EApp ((L'.EApp (e, (L'.EFfiApp ("Basis", "mouseEvent", []), loc)), + loc), (L'.ERecord [], loc)), loc) + val s' = " " ^ lowercaseFirst x ^ "='uw_event=event;exec(" in ((L'.EStrcat (s,
--- a/src/settings.sml Wed Jul 18 17:29:13 2012 -0400 +++ b/src/settings.sml Sat Jul 21 10:02:53 2012 -0400 @@ -160,7 +160,8 @@ "onConnectFail", "onDisconnect", "onServerError", - "kc", + "mouseEvent", + "keyEvent", "debug", "rand", "now", @@ -194,7 +195,8 @@ "onConnectFail", "onDisconnect", "onServerError", - "kc", + "mouseEvent", + "keyEvent", "onClick", "onDblclick", "onKeydown", @@ -267,7 +269,8 @@ ("substring", "ssub"), ("strcspn", "sspn"), ("strlenGe", "strlenGe"), - ("kc", "kc"), + ("mouseEvent", "uw_mouseEvent"), + ("keyEvent", "uw_keyEvent"), ("minTime", "0"), ("islower", "isLower"),
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/globalHandlers.ur Sat Jul 21 10:02:53 2012 -0400 @@ -0,0 +1,4 @@ +fun main () : transaction page = return <xml> + <body onload={onDblclick (fn ev => alert ("ScreenX = " ^ show ev.ScreenX ^ "\nShiftKey = " ^ show ev.ShiftKey)); + onKeypress (fn ev => alert ("KeyCode = " ^ show ev.KeyCode ^ "\nShiftKey = " ^ show ev.ShiftKey))}/> +</xml>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/keyEvent.ur Sat Jul 21 10:02:53 2012 -0400 @@ -0,0 +1,7 @@ +fun main () : transaction page = return <xml><body> + <ctextbox onkeypress={fn ev => alert ("KeyCode = " ^ show ev.KeyCode + ^ "\nCtrlKey = " ^ show ev.CtrlKey + ^ "\nShiftKey = " ^ show ev.ShiftKey + ^ "\nAltKey = " ^ show ev.AltKey + ^ "\nMetaKey = " ^ show ev.MetaKey)}/> +</body></xml>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/mouseEvent.ur Sat Jul 21 10:02:53 2012 -0400 @@ -0,0 +1,16 @@ +val show_mouseButton = mkShow (fn b => case b of + Left => "Left" + | Middle => "Middle" + | Right => "Right") + +fun main () : transaction page = return <xml><body> + <button onclick={fn ev => alert ("ScreenX = " ^ show ev.ScreenX + ^ "\nScreenY = " ^ show ev.ScreenY + ^ "\nClientX = " ^ show ev.ClientX + ^ "\nClientY = " ^ show ev.ClientY + ^ "\nCtrlKey = " ^ show ev.CtrlKey + ^ "\nShiftKey = " ^ show ev.ShiftKey + ^ "\nAltKey = " ^ show ev.AltKey + ^ "\nMetaKey = " ^ show ev.MetaKey + ^ "\nButton = " ^ show ev.Button)}/> +</body></xml>