From b95811e4dab26d770c6d972a456ac0b31b39ca53 Mon Sep 17 00:00:00 2001 From: Fabrice Leal Date: Mon, 9 Jul 2018 22:34:11 +0100 Subject: offsetX, offsetY --- lib/js/urweb.js | 2 ++ lib/ur/basis.urs | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/js/urweb.js b/lib/js/urweb.js index 99b45ec9..ff4c7b7e 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -553,6 +553,8 @@ function uw_mouseEvent() { _ScreenY : firstGood(ev.screenY, 0), _ClientX : firstGood(ev.clientX, 0), _ClientY : firstGood(ev.clientY, 0), + _OffsetX : firstGood(ev.offsetX, 0), + _OffsetY : firstGood(ev.offsetY, 0), _CtrlKey : firstGood(ev.ctrlKey, false), _ShiftKey : firstGood(ev.shiftKey, false), _AltKey : firstGood(ev.altKey, false), diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 66cc0e50..3b67946f 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -830,7 +830,7 @@ val meta : unit -> tag [Nam = meta, Content = string, Id = id] head [] [] [] datatype mouseButton = Left | Right | Middle -type mouseEvent = { ScreenX : int, ScreenY : int, ClientX : int, ClientY : int, +type mouseEvent = { ScreenX : int, ScreenY : int, ClientX : int, ClientY : int, OffsetX : int, OffsetY : int, CtrlKey : bool, ShiftKey : bool, AltKey : bool, MetaKey : bool, Button : mouseButton } -- cgit v1.2.3 From 8bdd29f65c57570776f0c9f90d75f7818b0cdaa6 Mon Sep 17 00:00:00 2001 From: steinuil Date: Sat, 4 Aug 2018 18:04:32 +0200 Subject: removed invalid JSON escape character --- lib/ur/json.ur | 2 -- 1 file changed, 2 deletions(-) (limited to 'lib') diff --git a/lib/ur/json.ur b/lib/ur/json.ur index 817ec16e..589e81b0 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -51,7 +51,6 @@ fun escape s = | #"\r" => "\\r" | #"\t" => "\\t" | #"\"" => "\\\"" - | #"\'" => "\\\'" | #"\\" => "\\\\" | #"/" => "\\/" | x => String.str ch @@ -101,7 +100,6 @@ fun unescape s = | #"r" => "\r" | #"t" => "\t" | #"\"" => "\"" - | #"\'" => "\'" | #"\\" => "\\" | #"/" => "/" | x => error JSON unescape: Bad escape char: {[x]}) -- cgit v1.2.3 From eb86dffeeec897d17905f3adff84e6acfd018330 Mon Sep 17 00:00:00 2001 From: Denis Redozubov 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(+) (limited to 'lib') 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 From 7eec6f5c0d702323bd735e2184ff74f27ad37d17 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 25 Aug 2018 18:26:33 -0400 Subject: List.allM --- lib/ur/list.ur | 17 ++++++++++++++++- lib/ur/list.urs | 2 ++ 2 files changed, 18 insertions(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/ur/list.ur b/lib/ur/list.ur index 95d6fbc8..d28d2868 100644 --- a/lib/ur/list.ur +++ b/lib/ur/list.ur @@ -319,7 +319,7 @@ fun filterM [m] (_ : monad m) [a] (p : a -> m bool) = filterM' [] end -fun all [m] f = +fun all [a] f = let fun all' ls = case ls of @@ -329,6 +329,21 @@ fun all [m] f = all' end +fun allM [m] (_ : monad m) [a] f = + let + fun all' ls = + case ls of + [] => return True + | x :: ls => + b <- f x; + if b then + all' ls + else + return False + in + all' + end + fun app [m] (_ : monad m) [a] f = let fun app' ls = diff --git a/lib/ur/list.urs b/lib/ur/list.urs index fe730152..f4593dda 100644 --- a/lib/ur/list.urs +++ b/lib/ur/list.urs @@ -66,6 +66,8 @@ val search : a ::: Type -> b ::: Type -> (a -> option b) -> t a -> option b val all : a ::: Type -> (a -> bool) -> t a -> bool +val allM : m ::: (Type -> Type) -> monad m -> a ::: Type -> (a -> m bool) -> t a -> m bool + val app : m ::: (Type -> Type) -> monad m -> a ::: Type -> (a -> m unit) -> t a -> m unit -- cgit v1.2.3 From 5eaaa94db962bbc3e42578bce3463ff2f942d602 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 12 Oct 2018 10:57:26 -0400 Subject: Catch when a cselect has an unavailable value set --- lib/js/urweb.js | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'lib') diff --git a/lib/js/urweb.js b/lib/js/urweb.js index ff4c7b7e..199f5001 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -1230,11 +1230,14 @@ function selectValue(x) { function setSelectValue(x, v) { for (var i = 0; i < x.options.length; ++i) { - if(x.options[i].value == v) { + if (x.options[i].value == v) { x.selectedIndex = i; return; } } + + if (v != "") + er("Setting " + content + ""; - var x = input(dummy.firstChild, s, function(x) { return function(v) { if (selectValue(x) != v) setSelectValue(x, v); }; }); + var x = dummy.firstChild; for (var i = 0; i < x.options.length; ++i) { if (x.options[i].value == "") x.options[i].value = x.options[i].text; @@ -1252,6 +1255,8 @@ function sel(s, content) { x.options[i].value = x.options[i].value.substring(1); } + x = input(x, s, function(x) { return function(v) { if (selectValue(x) != v) setSelectValue(x, v); }; }); + setSelectValue(x, s.data); if (selectValue(x) != s.data) sv(s, selectValue(x)); -- cgit v1.2.3 From e798117b42c5df30d1b3778d6414467e8e7b1e04 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 19 Oct 2018 15:38:55 -0400 Subject: unsafeSerialized[To|From]String --- lib/ur/basis.urs | 2 ++ src/monoize.sml | 14 ++++++++++++++ 2 files changed, 16 insertions(+) (limited to 'lib') diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 3b67946f..878f2793 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -274,6 +274,8 @@ con serialized :: Type -> Type val serialize : t ::: Type -> t -> serialized t val deserialize : t ::: Type -> serialized t -> t val sql_serialized : t ::: Type -> sql_injectable_prim (serialized t) +val unsafeSerializedToString : t ::: Type -> serialized t -> string +val unsafeSerializedFromString : t ::: Type -> string -> serialized t con primary_key :: {Type} -> {{Unit}} -> Type val no_primary_key : fs ::: {Type} -> primary_key fs [] diff --git a/src/monoize.sml b/src/monoize.sml index 11c6ea31..dfa88be3 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3953,6 +3953,20 @@ fun monoExp (env, st, fm) (all as (e, loc)) = loc)), loc), fm) end + | L.ECApp ((L.EFfi ("Basis", "unsafeSerializedToString"), _), _) => + let + val t = (L'.TFfi ("Basis", "string"), loc) + in + ((L'.EAbs ("v", t, t, (L'.ERel 0, loc)), loc), + fm) + end + | L.ECApp ((L.EFfi ("Basis", "unsafeSerializedFromString"), _), _) => + let + val t = (L'.TFfi ("Basis", "string"), loc) + in + ((L'.EAbs ("v", t, t, (L'.ERel 0, loc)), loc), + fm) + end | L.EFfiApp ("Basis", "url", [(e, _)]) => let -- cgit v1.2.3 From 1a4a8b5ab8eb499ee2217c966f7fbb7716adf9e9 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 19 Oct 2018 16:03:57 -0400 Subject: Client-side escaping of HTML should be prepared for structured HTML trees, not just strings (closes #141) --- lib/js/urweb.js | 2 +- tests/a_case_of_the_splits.ur | 17 +++++++++++++++++ tests/a_case_of_the_splits.urp | 4 ++++ 3 files changed, 22 insertions(+), 1 deletion(-) create mode 100644 tests/a_case_of_the_splits.ur create mode 100644 tests/a_case_of_the_splits.urp (limited to 'lib') diff --git a/lib/js/urweb.js b/lib/js/urweb.js index 199f5001..bf20cfd4 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -1439,7 +1439,7 @@ function eh(x) { if (x == null) return "NULL"; else - return x.split("&").join("&").split("<").join("<").split(">").join(">"); + return flattenLocal(x).split("&").join("&").split("<").join("<").split(">").join(">"); } function ts(x) { return x.toString() } diff --git a/tests/a_case_of_the_splits.ur b/tests/a_case_of_the_splits.ur new file mode 100644 index 00000000..2029729e --- /dev/null +++ b/tests/a_case_of_the_splits.ur @@ -0,0 +1,17 @@ +fun newCounter () : transaction xbody = + x <- source 0; + return + {[n]}}/> + + +fun main () : transaction page = + ls <- source ([] : list xbody); + return + +