Mercurial > urweb
changeset 1555:d5c961c709f9
New client-side, document-level event handlers
| author | Adam Chlipala <adam@chlipala.net> |
|---|---|
| date | Sat, 03 Sep 2011 11:48:12 -0400 |
| parents | 396e8d881205 |
| children | e1f5d9c4cc20 |
| files | doc/manual.tex lib/js/urweb.js lib/ur/basis.urs src/settings.sml tests/docevents.ur |
| diffstat | 5 files changed, 107 insertions(+), 12 deletions(-) [+] |
line wrap: on
line diff
--- a/doc/manual.tex Sat Sep 03 08:57:13 2011 -0400 +++ b/doc/manual.tex Sat Sep 03 11:48:12 2011 -0400 @@ -1971,6 +1971,18 @@ \mt{val} \; \mt{onServerError} : (\mt{string} \to \mt{transaction} \; \mt{unit}) \to \mt{transaction} \; \mt{unit} \end{array}$$ +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} +\end{array}$$ + \subsubsection{Functional-Reactive Page Generation} Most approaches to ``AJAX''-style coding involve imperative manipulation of the DOM tree representing an HTML document's structure. Ur/Web follows the \emph{functional-reactive} approach instead. Programs may allocate mutable \emph{sources} of arbitrary types, and an HTML page is effectively a pure function over the latest values of the sources. The page is not mutated directly, but rather it changes automatically as the sources are mutated.
--- a/lib/js/urweb.js Sat Sep 03 08:57:13 2011 -0400 +++ b/lib/js/urweb.js Sat Sep 03 11:48:12 2011 -0400 @@ -202,6 +202,60 @@ window.setTimeout(function () { runHandlers("Server", serverHandlers, s); }, 0); } +// Key events + +var uw_event = null; + +function kc() { + return window.event ? event.keyCode : (uw_event ? uw_event.which : 0); +} + +// Document events + +function uw_handler(name, f) { + var old = document[name]; + if (old == undefined) + document[name] = function() { execF(f); return false; }; + else + document[name] = function() { old(); execF(f); return false; }; +} + +function uw_onClick(f) { + uw_handler("onclick", f); +} + +function uw_onDblclick(f) { + uw_handler("ondblclick", f); +} + +function uw_onMousedown(f) { + uw_handler("onmousedown", f); +} + +function uw_onMouseup(f) { + uw_handler("onmouseup", f); +} + +function uw_keyHandler(name, f) { + var old = document[name]; + if (old == undefined) + document[name] = function(event) { uw_event = event; execF(execF(f, kc())); return false; }; + else + document[name] = function(event) { uw_event = event; old(); execF(execF(f, kc())); return false; }; +} + +function uw_onKeydown(f) { + uw_keyHandler("onkeydown", f); +} + +function uw_onKeypress(f) { + uw_keyHandler("onkeypress", f); +} + +function uw_onKeyup(f) { + uw_keyHandler("onkeyup", f); +} + // Embedding closures in XML strings @@ -1025,15 +1079,6 @@ } -// Key events - -var uw_event = null; - -function kc() { - return window.event ? event.keyCode : (uw_event ? uw_event.keyCode : 0); -} - - // The Ur interpreter var urfuncs = [];
--- a/lib/ur/basis.urs Sat Sep 03 08:57:13 2011 -0400 +++ b/lib/ur/basis.urs Sat Sep 03 11:48:12 2011 -0400 @@ -858,6 +858,15 @@ val onDisconnect : transaction unit -> transaction unit 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 show_xml : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type} -> show (xml ctx use bind)
--- a/src/settings.sml Sat Sep 03 08:57:13 2011 -0400 +++ b/src/settings.sml Sat Sep 03 11:48:12 2011 -0400 @@ -147,7 +147,15 @@ "rand", "now", "getHeader", - "setHeader"] + "setHeader", + "spawn", + "onClick", + "onDblclick", + "onKeydown", + "onKeypress", + "onKeyup", + "onMousedown", + "onMouseup"] val benign = ref benignBase fun setBenignEffectful ls = benign := S.addList (benignBase, ls) @@ -166,7 +174,14 @@ "onConnectFail", "onDisconnect", "onServerError", - "kc"] + "kc", + "onClick", + "onDblclick", + "onKeydown", + "onKeypress", + "onKeyup", + "onMousedown", + "onMouseup"] val client = ref clientBase fun setClientOnly ls = client := S.addList (clientBase, ls) fun isClientOnly x = S.member (!client, x) @@ -255,7 +270,15 @@ ("htmlifyTime", "showTime"), ("toSeconds", "toSeconds"), ("addSeconds", "addSeconds"), - ("diffInSeconds", "diffInSeconds")] + ("diffInSeconds", "diffInSeconds"), + + ("onClick", "uw_onClick"), + ("onDblclick", "uw_onDblclick"), + ("onKeydown", "uw_onKeydown"), + ("onKeypress", "uw_onKeypress"), + ("onKeyup", "uw_onKeyup"), + ("onMousedown", "uw_onMousedown"), + ("onMouseup", "uw_onMouseup")] 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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/docevents.ur Sat Sep 03 11:48:12 2011 -0400 @@ -0,0 +1,6 @@ +fun main () : transaction page = return <xml> + <body onload={onDblclick (alert "Double click"); + onKeypress (fn k => alert ("Keypress: " ^ show k))}> + Nothing here. + </body> +</xml>