summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--include/urweb.h1
-rw-r--r--src/c/urweb.c77
-rw-r--r--src/monoize.sml26
-rw-r--r--tests/headDyn.ur10
4 files changed, 65 insertions, 49 deletions
diff --git a/include/urweb.h b/include/urweb.h
index 9cdc7e8a..c506985d 100644
--- a/include/urweb.h
+++ b/include/urweb.h
@@ -76,7 +76,6 @@ uw_unit uw_Basis_set_client_source(uw_context, uw_Basis_source, uw_Basis_string)
void uw_set_script_header(uw_context, const char*);
char *uw_Basis_get_settings(uw_context, uw_unit);
-char *uw_Basis_get_script(uw_context, uw_unit);
char *uw_get_real_script(uw_context);
uw_Basis_string uw_Basis_maybe_onload(uw_context, uw_Basis_string);
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 2d26d0b2..ab14144d 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -1312,10 +1312,6 @@ void uw_write_script(uw_context ctx, uw_Basis_string s) {
ctx->script.front += len;
}
-const char *uw_Basis_get_script(uw_context ctx, uw_unit u) {
- return "<sc>";
-}
-
const char *uw_get_real_script(uw_context ctx) {
if (strstr(ctx->outHeaders.start, "Set-Cookie: ")) {
uw_write_script(ctx, "sig=\"");
@@ -3157,6 +3153,8 @@ int uw_rollback(uw_context ctx, int will_retry) {
return ctx->app ? ctx->app->db_rollback(ctx) : 0;
}
+static const char begin_xhtml[] = "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">";
+
void uw_commit(uw_context ctx) {
int i;
@@ -3210,36 +3208,53 @@ void uw_commit(uw_context ctx) {
uw_check(ctx, 1);
*ctx->page.front = 0;
- // Splice script data into appropriate part of page
- if (ctx->returning_indirectly || ctx->script_header[0] == 0) {
- char *start = strstr(ctx->page.start, "<sc>");
- if (start) {
- memmove(start, start + 4, uw_buffer_used(&ctx->page) - (start - ctx->page.start) - 4);
- ctx->page.front -= 4;
- }
- } else if (uw_buffer_used(&ctx->script) == 0) {
- size_t len = strlen(ctx->script_header);
- char *start = strstr(ctx->page.start, "<sc>");
- if (start) {
- ctx_uw_buffer_check(ctx, "page", &ctx->page, uw_buffer_used(&ctx->page) - 4 + len);
- start = strstr(ctx->page.start, "<sc>");
- memmove(start + len, start + 4, uw_buffer_used(&ctx->page) - (start - ctx->page.start) - 3);
- ctx->page.front += len - 4;
- memcpy(start, ctx->script_header, len);
- }
- } else {
- size_t lenH = strlen(ctx->script_header), len = uw_buffer_used(&ctx->script);
- size_t lenP = lenH + 40 + len;
- char *start = strstr(ctx->page.start, "<sc>");
- if (start) {
- ctx_uw_buffer_check(ctx, "page", &ctx->page, uw_buffer_used(&ctx->page) - 4 + lenP);
- start = strstr(ctx->page.start, "<sc>");
- memmove(start + lenP, start + 4, uw_buffer_used(&ctx->page) - (start - ctx->page.start) - 3);
- ctx->page.front += lenP - 4;
+ if (!ctx->returning_indirectly && !strncmp(ctx->page.start, begin_xhtml, sizeof begin_xhtml - 1)) {
+ char *s;
+
+ // Splice script data into appropriate part of page, also adding <head> if needed.
+ s = ctx->page.start + sizeof begin_xhtml - 1;
+ s = strchr(s, '<');
+ if (s == NULL) {
+ // Weird. Document has no tags!
+
+ uw_write(ctx, "<head></head><body></body>");
+ uw_check(ctx, 1);
+ *ctx->page.front = 0;
+ } else if (!strncmp(s, "<head>", 6)) {
+ // <head> is present. Let's add the <script> tags immediately after it.
+
+ size_t lenH = strlen(ctx->script_header), len = uw_buffer_used(&ctx->script);
+ size_t lenP = lenH + 40 + len;
+ char *start = s + 6, *oldPage = ctx->page.start;
+
+ ctx_uw_buffer_check(ctx, "page", &ctx->page, uw_buffer_used(&ctx->page) + lenP);
+ start += ctx->page.start - oldPage;
+ memmove(start + lenP, start, uw_buffer_used(&ctx->page) - (start - ctx->page.start) + 1);
+ ctx->page.front += lenP;
memcpy(start, ctx->script_header, lenH);
memcpy(start + lenH, "<script type=\"text/javascript\">", 31);
memcpy(start + lenH + 31, ctx->script.start, len);
memcpy(start + lenH + 31 + len, "</script>", 9);
+ } else {
+ // No <head>. At this point, add it, with <script> tags inside.
+
+ size_t lenH = strlen(ctx->script_header), len = uw_buffer_used(&ctx->script);
+ size_t lenP = lenH + 53 + len;
+ char *start = s, *oldPage = ctx->page.start;
+
+ printf("start = %ld\n", start - ctx->page.start);
+
+ ctx_uw_buffer_check(ctx, "page", &ctx->page, uw_buffer_used(&ctx->page) + lenP);
+ start += ctx->page.start - oldPage;
+ printf("page1 = %s\n", ctx->page.start);
+ memmove(start + lenP, start, uw_buffer_used(&ctx->page) - (start - ctx->page.start) + 1);
+ printf("page2 = %s\n", ctx->page.start);
+ ctx->page.front += lenP;
+ memcpy(start, "<head>", 6);
+ memcpy(start + 6, ctx->script_header, lenH);
+ memcpy(start + 6 + lenH, "<script type=\"text/javascript\">", 31);
+ memcpy(start + 6 + lenH + 31, ctx->script.start, len);
+ memcpy(start + 6 + lenH + 31 + len, "</script></head>", 16);
}
}
}
@@ -3919,8 +3934,6 @@ uw_Basis_time *uw_Basis_readUtc(uw_context ctx, uw_Basis_string s) {
return NULL;
}
-static const char begin_xhtml[] = "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">\n<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">";
-
failure_kind uw_begin_onError(uw_context ctx, char *msg) {
int r = setjmp(ctx->jmp_buf);
diff --git a/src/monoize.sml b/src/monoize.sml
index 50bc2060..99d93ff9 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -1,4 +1,4 @@
-(* Copyright (c) 2008-2011, Adam Chlipala
+(* Copyright (c) 2008-2012, Adam Chlipala
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -3179,7 +3179,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
| _ => (Print.prefaces "Targs" (map (fn t => ("T", CorePrint.p_con env t)) targs);
raise Fail "No name passed to input tag")
- fun normal (tag, extra, extraInner) =
+ fun normal (tag, extra) =
let
val (tagStart, fm) = tagStart tag
val tagStart = case extra of
@@ -3189,10 +3189,6 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
fun normal () =
let
val (xml, fm) = monoExp (env, st, fm) xml
-
- val xml = case extraInner of
- NONE => xml
- | SOME ei => (L'.EStrcat (ei, xml), loc)
in
((L'.EStrcat ((L'.EStrcat (tagStart, (L'.EPrim (Prim.String ">"), loc)), loc),
(L'.EStrcat (xml,
@@ -3316,8 +3312,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
loc),
(L'.EFfiApp ("Basis", "maybe_onunload",
[(onunload, s)]),
- loc)), loc),
- SOME (L'.EFfiApp ("Basis", "get_script", [((L'.ERecord [], loc), (L'.TRecord [], loc))]), loc))
+ loc)), loc))
end
| "dyn" =>
@@ -3346,9 +3341,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
| _ => raise Fail "Monoize: Bad dyn attributes"
end
- | "submit" => normal ("input type=\"submit\"", NONE, NONE)
- | "image" => normal ("input type=\"image\"", NONE, NONE)
- | "button" => normal ("input type=\"submit\"", NONE, NONE)
+ | "submit" => normal ("input type=\"submit\"", NONE)
+ | "image" => normal ("input type=\"image\"", NONE)
+ | "button" => normal ("input type=\"submit\"", NONE)
| "hidden" => input "hidden"
| "textbox" =>
@@ -3404,8 +3399,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
NONE => raise Fail "No name for radioGroup"
| SOME name =>
normal ("input",
- SOME (L'.EPrim (Prim.String (" type=\"radio\" name=\"" ^ name ^ "\"")), loc),
- NONE))
+ SOME (L'.EPrim (Prim.String (" type=\"radio\" name=\"" ^ name ^ "\"")), loc)))
| "select" =>
(case targs of
@@ -3502,7 +3496,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
fm)
end)
- | "coption" => normal ("option", NONE, NONE)
+ | "coption" => normal ("option", NONE)
| "ctextarea" =>
(case List.find (fn ("Source", _, _) => true | _ => false) attrs of
@@ -3527,8 +3521,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) =
fm)
end)
- | "tabl" => normal ("table", NONE, NONE)
- | _ => normal (tag, NONE, NONE)
+ | "tabl" => normal ("table", NONE)
+ | _ => normal (tag, NONE)
in
case #1 dynClass of
L'.ENone _ => baseAll
diff --git a/tests/headDyn.ur b/tests/headDyn.ur
new file mode 100644
index 00000000..3ad0ea2a
--- /dev/null
+++ b/tests/headDyn.ur
@@ -0,0 +1,10 @@
+fun main () : transaction page =
+ x <- source <xml/>;
+ return <xml>
+ <head>
+ <title>Test</title>
+ </head>
+ <body onload={set x <xml>boo</xml>}>
+ <dyn signal={signal x}/>
+ </body>
+ </xml>
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-28 07:12:40 +0000