From eb86dffeeec897d17905f3adff84e6acfd018330 Mon Sep 17 00:00:00 2001
From: Denis Redozubov <denis.redozubov@gmail.com>
Date: Wed, 22 Aug 2018 15:11:32 +0300
Subject: Rough same page anchors

---
 include/urweb/urweb_cpp.h | 1 +
 lib/js/urweb.js           | 4 ++++
 lib/ur/basis.urs          | 1 +
 src/c/urweb.c             | 4 ++++
 src/settings.sml          | 1 +
 5 files changed, 11 insertions(+)

diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h
index 5f1144b8..1351cfbc 100644
--- a/include/urweb/urweb_cpp.h
+++ b/include/urweb/urweb_cpp.h
@@ -242,6 +242,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 ff4c7b7e..cd1b7005 100644
--- a/lib/js/urweb.js
+++ b/lib/js/urweb.js
@@ -2278,5 +2278,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 3b67946f..a416ba48 100644
--- a/lib/ur/basis.urs
+++ b/lib/ur/basis.urs
@@ -803,6 +803,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 e7efae38..ce6f4dfb 100644
--- a/src/c/urweb.c
+++ b/src/c/urweb.c
@@ -4407,6 +4407,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 cfbe98a5..c023a851 100644
--- a/src/settings.sml
+++ b/src/settings.sml
@@ -321,6 +321,7 @@ val jsFuncsBase = basisM [("alert", "alert"),
                           ("ord", "ord"),
 
                           ("checkUrl", "checkUrl"),
+                          ("anchorUrl", "anchorUrl"),
                           ("bless", "bless"),
                           ("blessData", "blessData"),
 
-- 
cgit v1.2.3