From fe4f38b968cebbd2d1bd531b6fb3f5e3a4896b63 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adam@chlipala.net>
Date: Sun, 11 Sep 2011 14:14:49 -0400
Subject: New Basis functions: preventDefault and stopPropagation (code
 contributed by Vladimir Shabanov)

---
 doc/manual.tex   |  7 +++++++
 lib/js/urweb.js  | 21 +++++++++++++++++----
 lib/ur/basis.urs |  5 +++++
 src/settings.sml |  8 +++++++-
 4 files changed, 36 insertions(+), 5 deletions(-)

diff --git a/doc/manual.tex b/doc/manual.tex
index e6a96c05..00db43fb 100644
--- a/doc/manual.tex
+++ b/doc/manual.tex
@@ -1983,6 +1983,13 @@ $$\begin{array}{l}
  \mt{val} \; \mt{onMouseup} : \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.
+
+$$\begin{array}{l}
+  \mt{val} \; \mt{preventDefault} : \mt{transaction} \; \mt{unit} \\
+  \mt{val} \; \mt{stopPropagation} : \mt{transaction} \; \mt{unit}
+\end{array}$$
+
 \subsubsection{Node IDs}
 
 There is an abstract type of node IDs that may be assigned to \cd{id} attributes of most HTML tags.
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 7f636ef9..d7149eba 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -215,9 +215,9 @@ function kc() {
 function uw_handler(name, f) {
     var old = document[name];
     if (old == undefined)
-        document[name] = function() { execF(f); return false; };
+        document[name] = function(event) { uw_event = event; execF(f); };
     else
-        document[name] = function() { old(); execF(f); return false; };
+        document[name] = function(event) { uw_event = event; old(); execF(f); };
 }
 
 function uw_onClick(f) {
@@ -239,9 +239,9 @@ function uw_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; };
+        document[name] = function(event) { uw_event = event; execF(execF(f, kc())); };
     else
-        document[name] = function(event) { uw_event = event; old(); execF(execF(f, kc())); return false; };
+        document[name] = function(event) { uw_event = event; old(); execF(execF(f, kc())); };
 }
 
 function uw_onKeydown(f) {
@@ -256,6 +256,19 @@ function uw_onKeyup(f) {
     uw_keyHandler("onkeyup", f);
 }
 
+// Cancelling of further event processing
+
+function uw_preventDefault() {
+    var e = window.event ? window.event : uw_event;
+    e.returnValue = false;
+    if (e.preventDefault) e.preventDefault();
+}
+
+function uw_stopPropagation() {
+    var e = window.event ? window.event : uw_event;
+    e.cancelBubble = true;
+    if (e.stopPropagation) e.stopPropagation();
+}
 
 // Embedding closures in XML strings
 
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index 6657034f..03b4d4d1 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -870,6 +870,11 @@ val onKeyup : (int -> transaction unit) -> transaction unit
 val onMousedown : transaction unit -> transaction unit
 val onMouseup : transaction unit -> transaction unit
 
+(* Prevents default handling of current event *)
+val preventDefault : transaction unit
+(* Stops propagation of current event *)
+val stopPropagation : transaction unit
+
 val show_xml : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type} -> show (xml ctx use bind)
 
 
diff --git a/src/settings.sml b/src/settings.sml
index 9301e93e..ab1d7f88 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -156,6 +156,8 @@ val benignBase = basis ["get_cookie",
                         "onKeyup",
                         "onMousedown",
                         "onMouseup",
+                        "preventDefault",
+                        "stopPropagation",
                         "fresh"]
 
 val benign = ref benignBase
@@ -182,7 +184,9 @@ val clientBase = basis ["get",
                         "onKeypress",
                         "onKeyup",
                         "onMousedown",
-                        "onMouseup"]
+                        "onMouseup",
+                        "preventDefault",
+                        "stopPropagation"]
 val client = ref clientBase
 fun setClientOnly ls = client := S.addList (clientBase, ls)
 fun isClientOnly x = S.member (!client, x)
@@ -280,6 +284,8 @@ val jsFuncsBase = basisM [("alert", "alert"),
                           ("onKeyup", "uw_onKeyup"),
                           ("onMousedown", "uw_onMousedown"),
                           ("onMouseup", "uw_onMouseup"),
+                          ("preventDefault", "uw_preventDefault"),
+                          ("stopPropagation", "uw_stopPropagation"),
 
                           ("fresh", "fresh")]
 val jsFuncs = ref jsFuncsBase
-- 
cgit v1.2.3