diff options
| -rw-r--r-- | include/urweb.h | 1 | ||||
| -rw-r--r-- | lib/js/urweb.js | 25 | ||||
| -rw-r--r-- | src/c/urweb.c | 10 | ||||
| -rw-r--r-- | src/monoize.sml | 48 |
4 files changed, 62 insertions, 22 deletions
diff --git a/include/urweb.h b/include/urweb.h index 0f753b71..55068966 100644 --- a/include/urweb.h +++ b/include/urweb.h @@ -69,6 +69,7 @@ const char *uw_Basis_get_settings(uw_context, uw_unit); const char *uw_Basis_get_script(uw_context, uw_unit); uw_Basis_string uw_Basis_maybe_onload(uw_context, uw_Basis_string); +uw_Basis_string uw_Basis_maybe_onunload(uw_context, uw_Basis_string); void uw_set_needs_push(uw_context, int); void uw_set_needs_sig(uw_context, int); diff --git a/lib/js/urweb.js b/lib/js/urweb.js index c37ff07d..98b615c0 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -627,7 +627,20 @@ function getXHR(uri) var sig = null; +var unloading = false, inFlight = null; + +function unload() { + unloading = true; + + for (; inFlight; inFlight = inFlight.next) { + inFlight.data.abort(); + } +} + function requestUri(xhr, uri, needsSig) { + if (unloading) + return; + xhr.open("POST", uri, true); if (client_id != null) { @@ -642,9 +655,15 @@ function requestUri(xhr, uri, needsSig) { xhr.setRequestHeader("UrWeb-Sig", sig); } + inFlight = cons(xhr, inFlight); xhr.send(null); } +function xhrFinished(xhr) { + xhr.abort(); + inFlight = remove(xhr, inFlight); +} + function rc(prefix, uri, parse, k, needsSig) { uri = cat(prefix, uri); uri = flattenLocal(uri); @@ -668,6 +687,8 @@ function rc(prefix, uri, parse, k, needsSig) { } else { conn(); } + + xhrFinished(xhr); } }; @@ -772,7 +793,7 @@ function listener() { } } - xhr.abort(); + xhrFinished(xhr); connect(); } @@ -786,7 +807,7 @@ function listener() { }; onTimeout = function() { - xhr.abort(); + xhrFinished(xhr); connect(); }; diff --git a/src/c/urweb.c b/src/c/urweb.c index e75d0c66..344ef2ad 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -1173,6 +1173,16 @@ uw_Basis_string uw_Basis_maybe_onload(uw_context ctx, uw_Basis_string s) { } } +uw_Basis_string uw_Basis_maybe_onunload(uw_context ctx, uw_Basis_string s) { + if (ctx->script_header[0] == 0) + return ""; + else { + char *r = uw_malloc(ctx, 22 + strlen(s)); + sprintf(r, " onunload='unload();%s'", s); + return r; + } +} + extern uw_Basis_string uw_cookie_sig(uw_context); const char *uw_Basis_get_settings(uw_context ctx, uw_unit u) { diff --git a/src/monoize.sml b/src/monoize.sml index 4e337388..7effa885 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -2483,13 +2483,14 @@ fun monoExp (env, st, fm) (all as (e, loc)) = else attrs - fun findOnload (attrs, acc) = + fun findOnload (attrs, onload, onunload, acc) = case attrs of - [] => (NONE, acc) - | ("Onload", e, _) :: rest => (SOME e, List.revAppend (acc, rest)) - | x :: rest => findOnload (rest, x :: acc) + [] => (onload, onunload, acc) + | ("Onload", e, _) :: rest => findOnload (rest, SOME e, onunload, acc) + | ("Onunload", e, _) :: rest => findOnload (rest, onload, SOME e, acc) + | x :: rest => findOnload (rest, onload, onunload, x :: acc) - val (onload, attrs) = findOnload (attrs, []) + val (onload, onunload, attrs) = findOnload (attrs, NONE, NONE, []) val (class, fm) = monoExp (env, st, fm) class @@ -2669,26 +2670,33 @@ fun monoExp (env, st, fm) (all as (e, loc)) = :: str ";" :: assgns) end + + fun execify e = + case e of + NONE => (L'.EPrim (Prim.String ""), loc) + | SOME e => + let + val e = (L'.EApp (e, (L'.ERecord [], loc)), loc) + in + (L'.EStrcat ((L'.EPrim (Prim.String "exec("), loc), + (L'.EStrcat ((L'.EJavaScript (L'.Attribute, e), loc), + (L'.EPrim (Prim.String ")"), loc)), loc)), loc) + end in case tag of "body" => let - val onload = case onload of - NONE => (L'.EPrim (Prim.String ""), loc) - | SOME e => - let - val e = (L'.EApp (e, (L'.ERecord [], loc)), loc) - in - (L'.EStrcat ((L'.EPrim (Prim.String "exec("), loc), - (L'.EStrcat ((L'.EJavaScript (L'.Attribute, e), loc), - (L'.EPrim (Prim.String ")"), loc)), loc)), loc) - end + val onload = execify onload + val onunload = execify onunload in normal ("body", - SOME (L'.EFfiApp ("Basis", "maybe_onload", - [(L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings", - [(L'.ERecord [], loc)]), loc), - onload), loc)]), - loc), + SOME (L'.EStrcat ((L'.EFfiApp ("Basis", "maybe_onload", + [(L'.EStrcat ((L'.EFfiApp ("Basis", "get_settings", + [(L'.ERecord [], loc)]), loc), + onload), loc)]), + loc), + (L'.EFfiApp ("Basis", "maybe_onunload", + [onunload]), + loc)), loc), SOME (L'.EFfiApp ("Basis", "get_script", [(L'.ERecord [], loc)]), loc)) end |