summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--include/urweb/urweb_cpp.h1
-rw-r--r--lib/js/urweb.js4
-rw-r--r--lib/ur/basis.urs1
-rw-r--r--src/c/urweb.c4
-rw-r--r--src/settings.sml1
5 files changed, 11 insertions, 0 deletions
diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h
index e4ad6e61..3209a9a6 100644
--- a/include/urweb/urweb_cpp.h
+++ b/include/urweb/urweb_cpp.h
@@ -245,6 +245,7 @@ uw_Basis_string uw_Basis_blessEnvVar(struct uw_context *, uw_Basis_string);
uw_Basis_string uw_Basis_blessMeta(struct uw_context *, uw_Basis_string);
uw_Basis_string uw_Basis_checkUrl(struct uw_context *, uw_Basis_string);
+uw_Basis_string uw_Basis_anchorUrl(struct uw_context *, uw_Basis_string);
uw_Basis_string uw_Basis_checkMime(struct uw_context *, uw_Basis_string);
uw_Basis_string uw_Basis_checkRequestHeader(struct uw_context *, uw_Basis_string);
uw_Basis_string uw_Basis_checkResponseHeader(struct uw_context *, uw_Basis_string);
diff --git a/lib/js/urweb.js b/lib/js/urweb.js
index 59e5ad2c..cb582788 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -3385,5 +3385,9 @@ function giveFocus(id) {
er("Tried to give focus to ID not used in document: " + id);
}
+function anchorUrl(id) {
+ return "#" + id;
+}
+
// App-specific code
diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs
index dda48d2b..9d6e56d5 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -816,6 +816,7 @@ type id
val fresh : transaction id
val giveFocus : id -> transaction unit
val show_id : show id
+val anchorUrl : id -> url
val dyn : ctx ::: {Unit} -> use ::: {Type} -> bind ::: {Type} -> [ctx ~ [Dyn]] => unit
-> tag [Signal = signal (xml ([Dyn] ++ ctx) use bind)] ([Dyn] ++ ctx) [] use bind
diff --git a/src/c/urweb.c b/src/c/urweb.c
index 8ffe7dd3..0db5fc80 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -4638,6 +4638,10 @@ uw_Basis_string uw_Basis_currentUrl(uw_context ctx) {
return ctx->current_url;
}
+uw_Basis_string uw_Basis_anchorUrl(uw_context ctx, uw_Basis_string s) {
+ return uw_Basis_strcat(ctx, uw_Basis_strcat(ctx, ctx->current_url, "#"), s);
+}
+
void uw_set_currentUrl(uw_context ctx, char *s) {
ctx->current_url = s;
}
diff --git a/src/settings.sml b/src/settings.sml
index c8cb049c..eeaf8145 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -325,6 +325,7 @@ val jsFuncsBase = basisM [("alert", "alert"),
("ord", "ord"),
("checkUrl", "checkUrl"),
+ ("anchorUrl", "anchorUrl"),
("bless", "bless"),
("blessData", "blessData"),
("currentUrl", "currentUrl"),