From a707c42ce3773318f80ed78eea653a581639fdba Mon Sep 17 00:00:00 2001 From: Vladimir Shabanov Date: Tue, 5 Dec 2017 17:24:12 +0300 Subject: Added oninput event to inputs which support it. Added onscroll event to and title/sizes attributes to . --- lib/js/urweb.js | 8 +++++ lib/ur/basis.urs | 94 +++++++++++++++++++++++++++----------------------------- 2 files changed, 53 insertions(+), 49 deletions(-) (limited to 'lib') diff --git a/lib/js/urweb.js b/lib/js/urweb.js index ebe192ca..1a275451 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -1389,6 +1389,14 @@ function addOnChange(x, f) { x.onchange = function() { old(); f(); }; } +function addOnInput(x, f) { + var old = x.oninput; + if (old == null) + x.oninput = f; + else + x.oninput = function() { old(); f(); }; +} + function addOnKeyUp(x, f) { var old = x.onkeyup; if (old == null) diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 89a48d59..c354d784 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -830,7 +830,7 @@ val data_attrs : data_attr -> data_attr -> data_attr val head : unit -> tag [Data = data_attr] html head [] [] val title : unit -> tag [Data = data_attr] head [] [] [] -val link : unit -> tag [Data = data_attr, Id = id, Rel = string, Typ = string, Href = url, Media = string, Integrity = string, Crossorigin = string] head [] [] [] +val link : unit -> tag [Data = data_attr, Id = id, Rel = string, Title = string, Typ = string, Href = url, Media = string, Integrity = string, Crossorigin = string, Sizes = string] head [] [] [] val meta : unit -> tag [Nam = meta, Content = string, Id = id] head [] [] [] datatype mouseButton = Left | Right | Middle @@ -842,14 +842,26 @@ type mouseEvent = { ScreenX : int, ScreenY : int, ClientX : int, ClientY : int, con mouseEvents = map (fn _ :: Unit => mouseEvent -> transaction unit) [Onclick, Oncontextmenu, Ondblclick, Onmousedown, Onmouseenter, Onmouseleave, Onmousemove, Onmouseout, Onmouseover, Onmouseup] +(* Key arguments are character codes. *) type keyEvent = { KeyCode : int, CtrlKey : bool, ShiftKey : bool, AltKey : bool, MetaKey : bool } con keyEvents = map (fn _ :: Unit => keyEvent -> transaction unit) [Onkeydown, Onkeypress, Onkeyup] -val body : unit -> tag ([Data = data_attr, Onload = transaction unit, Onresize = transaction unit, Onunload = transaction unit, Onhashchange = transaction unit] - ++ mouseEvents ++ keyEvents) +con focusEvents = [Onblur = transaction unit, Onfocus = transaction unit] + +con resizeEvents = [Onresize = transaction unit] +con scrollEvents = [Onscroll = transaction unit] + +con boxEvents = focusEvents ++ mouseEvents ++ keyEvents ++ resizeEvents ++ scrollEvents +con tableEvents = focusEvents ++ mouseEvents ++ keyEvents + +con boxAttrs = [Data = data_attr, Id = id, Title = string, Role = string, Align = string] ++ boxEvents +con tableAttrs = [Data = data_attr, Id = id, Title = string, Align = string] ++ tableEvents + +val body : unit -> tag ([Data = data_attr, Id = id, Title = string, Onload = transaction unit, Onunload = transaction unit, Onhashchange = transaction unit] + ++ boxEvents) html body [] [] con bodyTag = fn (attrs :: {Type}) => @@ -863,19 +875,6 @@ con bodyTagStandalone = fn (attrs :: {Type}) => val br : bodyTagStandalone [Data = data_attr, Id = id] -con focusEvents = [Onblur = transaction unit, Onfocus = transaction unit] - - -(* Key arguments are character codes. *) -con resizeEvents = [Onresize = transaction unit] -con scrollEvents = [Onscroll = transaction unit] - -con boxEvents = focusEvents ++ mouseEvents ++ keyEvents ++ resizeEvents ++ scrollEvents -con tableEvents = focusEvents ++ mouseEvents ++ keyEvents - -con boxAttrs = [Data = data_attr, Id = id, Title = string, Role = string, Align = string] ++ boxEvents -con tableAttrs = [Data = data_attr, Id = id, Title = string, Align = string] ++ tableEvents - val span : bodyTag boxAttrs val div : bodyTag boxAttrs @@ -975,21 +974,20 @@ con formTag = fn (ty :: Type) (inner :: {Unit}) (attrs :: {Type}) => nm :: Name -> unit -> tag attrs ([Form] ++ ctx) inner [] [nm = ty] -con inputAttrs = [Required = bool, Autofocus = bool] - +con inputAttrs' = [Required = bool, Autofocus = bool, + Onchange = transaction unit] +con inputAttrs = inputAttrs' ++ [Oninput = transaction unit] val hidden : formTag string [] [Data = data_attr, Id = string, Value = string] -val textbox : formTag string [] ([Value = string, Size = int, Placeholder = string, Source = source string, Onchange = transaction unit, - Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) -val password : formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val textarea : formTag string [] ([Rows = int, Cols = int, Placeholder = string, Onchange = transaction unit, - Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) +val textbox : formTag string [] ([Value = string, Size = int, Placeholder = string, Source = source string] ++ boxAttrs ++ inputAttrs) +val password : formTag string [] ([Value = string, Size = int, Placeholder = string] ++ boxAttrs ++ inputAttrs) +val textarea : formTag string [] ([Rows = int, Cols = int, Placeholder = string] ++ boxAttrs ++ inputAttrs) -val checkbox : formTag bool [] ([Checked = bool, Onchange = transaction unit] ++ boxAttrs) +val checkbox : formTag bool [] ([Checked = bool] ++ boxAttrs ++ inputAttrs') (* HTML5 widgets galore! *) -type textWidget = formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) +type textWidget = formTag string [] ([Value = string, Size = int, Placeholder = string] ++ boxAttrs ++ inputAttrs) val email : textWidget val search : textWidget @@ -997,14 +995,14 @@ val url_ : textWidget val tel : textWidget val color : textWidget -val number : formTag float [] ([Value = float, Min = float, Max = float, Step = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val range : formTag float [] ([Value = float, Min = float, Max = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val date : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val datetime : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val datetime_local : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val month : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val week : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) -val timeInput : formTag string [] ([Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) +val number : formTag float [] ([Value = float, Min = float, Max = float, Step = float, Size = int] ++ boxAttrs ++ inputAttrs) +val range : formTag float [] ([Value = float, Min = float, Max = float, Size = int] ++ boxAttrs ++ inputAttrs) +val date : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) +val datetime : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) +val datetime_local : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) +val month : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) +val week : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) +val timeInput : formTag string [] ([Value = string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) @@ -1034,10 +1032,10 @@ val remainingFields : postField -> string con radio = [Body, Radio] val radio : formTag (option string) radio [Data = data_attr, Id = id] -val radioOption : unit -> tag ([Value = string, Checked = bool, Onchange = transaction unit] ++ boxAttrs) radio [] [] [] +val radioOption : unit -> tag ([Value = string, Checked = bool] ++ boxAttrs ++ inputAttrs') radio [] [] [] con select = [Select] -val select : formTag string select ([Onchange = transaction unit] ++ boxAttrs) +val select : formTag string select (boxAttrs ++ inputAttrs') val option : unit -> tag [Data = data_attr, Value = string, Selected = bool] select [] [] [] val submit : ctx ::: {Unit} -> use ::: {Type} @@ -1065,8 +1063,7 @@ con cformTag = fn (attrs :: {Type}) (inner :: {Unit}) => -> [[Body] ~ ctx] => [[Body] ~ inner] => unit -> tag attrs ([Body] ++ ctx) ([Body] ++ inner) [] [] -type ctext = cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, - Onchange = transaction unit, Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) [] +type ctext = cformTag ([Value = string, Size = int, Source = source string, Placeholder = string] ++ boxAttrs ++ inputAttrs) [] val ctextbox : ctext val cpassword : ctext @@ -1076,24 +1073,23 @@ val curl : ctext val ctel : ctext val ccolor : ctext -val cnumber : cformTag ([Source = source (option float), Min = float, Max = float, Step = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val crange : cformTag ([Source = source (option float), Min = float, Max = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val cdate : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val cdatetime : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val cdatetime_local : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val cmonth : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val cweek : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val ctime : cformTag ([Source = source string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] +val cnumber : cformTag ([Source = source (option float), Min = float, Max = float, Step = float, Size = int] ++ boxAttrs ++ inputAttrs) [] +val crange : cformTag ([Source = source (option float), Min = float, Max = float, Size = int] ++ boxAttrs ++ inputAttrs) [] +val cdate : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) [] +val cdatetime : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) [] +val cdatetime_local : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) [] +val cmonth : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) [] +val cweek : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) [] +val ctime : cformTag ([Source = source string, Min = string, Max = string, Size = int] ++ boxAttrs ++ inputAttrs) [] val button : cformTag ([Value = string, Disabled = bool] ++ boxAttrs) [] -val ccheckbox : cformTag ([Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] +val ccheckbox : cformTag ([Size = int, Source = source bool] ++ boxAttrs ++ inputAttrs') [] -val cselect : cformTag ([Source = source string, Onchange = transaction unit] ++ boxAttrs) [Cselect] +val cselect : cformTag ([Source = source string] ++ boxAttrs ++ inputAttrs') [Cselect] val coption : unit -> tag [Value = string, Selected = bool] [Cselect, Body] [] [] [] -val ctextarea : cformTag ([Rows = int, Cols = int, Placeholder = string, Source = source string, Onchange = transaction unit, - Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) [] +val ctextarea : cformTag ([Rows = int, Cols = int, Placeholder = string, Source = source string] ++ boxAttrs ++ inputAttrs) [] (*** Tables *) -- cgit v1.2.3 From 5d6b1ac92263d41c32e896603b4fa3e1790c9d71 Mon Sep 17 00:00:00 2001 From: Vladimir Shabanov Date: Wed, 13 Dec 2017 19:24:56 +0300 Subject: dynClass() now calculates and sets class and style attributes before adding node to DOM. --- lib/js/urweb.js | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) (limited to 'lib') diff --git a/lib/js/urweb.js b/lib/js/urweb.js index 1a275451..d8198ed0 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -1286,11 +1286,12 @@ function dynClass(pnode, html, s_class, s_style) { if (pnode == "table" && html.tagName == "TBODY") { html = html.firstChild; } - addNode(html); - runScripts(html); + + var x = null; + var y = null; if (s_class) { - var x = document.createElement("script"); + x = document.createElement("script"); x.dead = false; x.signal = s_class; x.sources = null; @@ -1305,13 +1306,12 @@ function dynClass(pnode, html, s_class, s_style) { x.closures = concat(cls.v, htmlCls); } - html.appendChild(x); populate(x); } if (s_style) { var htmlCls2 = s_class ? null : htmlCls; - var y = document.createElement("script"); + y = document.createElement("script"); y.dead = false; y.signal = s_style; y.sources = null; @@ -1326,9 +1326,16 @@ function dynClass(pnode, html, s_class, s_style) { y.closures = concat(cls.v, htmlCls2); } - html.appendChild(y); populate(y); } + + addNode(html); + runScripts(html); + + if (x) + html.appendChild(x); + if (y) + html.appendChild(y); } function bodyDynClass(s_class, s_style) { -- cgit v1.2.3 From 1fef19035d2f3388e9ab0dad1889a4cad5c1ca3e Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 14 Apr 2018 14:17:31 -0400 Subject: List.existsM --- lib/ur/list.ur | 15 +++++++++++++++ lib/ur/list.urs | 2 ++ 2 files changed, 17 insertions(+) (limited to 'lib') diff --git a/lib/ur/list.ur b/lib/ur/list.ur index cc533676..a7296552 100644 --- a/lib/ur/list.ur +++ b/lib/ur/list.ur @@ -204,6 +204,21 @@ fun exists [a] f = ex end +fun existsM [m] (_ : monad m) [a] f = + let + fun ex ls = + case ls of + [] => return False + | x :: ls => + b <- f x; + if b then + return True + else + ex ls + in + ex + end + fun foldlMap [a] [b] [c] f = let fun fold ls' st ls = diff --git a/lib/ur/list.urs b/lib/ur/list.urs index fd56679d..37cbe442 100644 --- a/lib/ur/list.urs +++ b/lib/ur/list.urs @@ -42,6 +42,8 @@ val filter : a ::: Type -> (a -> bool) -> t a -> t a val exists : a ::: Type -> (a -> bool) -> t a -> bool +val existsM : m ::: (Type -> Type) -> monad m -> a ::: Type -> (a -> m bool) -> t a -> m bool + val foldlM : m ::: (Type -> Type) -> monad m -> a ::: Type -> b ::: Type -> (a -> b -> m b) -> b -> t a -> m b -- cgit v1.2.3 From 0cadb1a719bc515af2449ac966e545a6599aee4d Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 14 Apr 2018 15:15:07 -0400 Subject: List.findM --- lib/ur/list.ur | 15 +++++++++++++++ lib/ur/list.urs | 2 ++ 2 files changed, 17 insertions(+) (limited to 'lib') diff --git a/lib/ur/list.ur b/lib/ur/list.ur index a7296552..95d6fbc8 100644 --- a/lib/ur/list.ur +++ b/lib/ur/list.ur @@ -255,6 +255,21 @@ fun find [a] f = find' end +fun findM [m] (_ : monad m) [a] f = + let + fun find' ls = + case ls of + [] => return None + | x :: ls => + b <- f x; + if b then + return (Some x) + else + find' ls + in + find' + end + fun search [a] [b] f = let fun search' ls = diff --git a/lib/ur/list.urs b/lib/ur/list.urs index 37cbe442..fe730152 100644 --- a/lib/ur/list.urs +++ b/lib/ur/list.urs @@ -60,6 +60,8 @@ val mem : a ::: Type -> eq a -> a -> t a -> bool val find : a ::: Type -> (a -> bool) -> t a -> option a +val findM : m ::: (Type -> Type) -> monad m -> a ::: Type -> (a -> m bool) -> t a -> m (option a) + val search : a ::: Type -> b ::: Type -> (a -> option b) -> t a -> option b val all : a ::: Type -> (a -> bool) -> t a -> bool -- cgit v1.2.3 From 2bc51bd866b52bc738f259ffe6e9fb8f6068a6b6 Mon Sep 17 00:00:00 2001 From: "majorseitan@blockfreie.org" Date: Sat, 14 Apr 2018 21:56:09 -0400 Subject: Handling of JSON escape characters 1. Handle escape sequence chars \t \n \r 2. Fail on unsupported escape characters. Instead of skipping \ on unsupported sequences it now fails. --- lib/ur/json.ur | 22 +++++++++++++++++----- tests/jsonTest.ur | 1 + 2 files changed, 18 insertions(+), 5 deletions(-) (limited to 'lib') diff --git a/lib/ur/json.ur b/lib/ur/json.ur index 9288a6dd..1e3e3f39 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -46,10 +46,14 @@ fun escape s = let val ch = String.sub s 0 in - (if ch = #"\"" || ch = #"\\" then - "\\" ^ String.str ch - else - String.str ch) ^ esc (String.suffix s 1) + (case ch of + #"\n" => "\\n" + | #"\r" => "\\r" + | #"\t" => "\\t" + | #"\"" => "\\\"" + | #"\'" => "\\\'" + | x => String.str ch + ) ^ esc (String.suffix s 1) end in "\"" ^ esc s @@ -90,7 +94,15 @@ fun unescape s = if i+1 >= len then error JSON unescape: Bad escape sequence: {[s]} else - String.str (String.sub s (i+1)) ^ unesc (i+2) + (case String.sub s (i+1) of + #"n" => "\n" + | #"r" => "\r" + | #"t" => "\t" + | #"\"" => "\"" + | #"\'" => "\'" + | x => error JSON unescape: Bad escape char: {[x]}) + ^ + unesc (i+2) | _ => String.str ch ^ unesc (i+1) end in diff --git a/tests/jsonTest.ur b/tests/jsonTest.ur index 97898de8..1be6e7b5 100644 --- a/tests/jsonTest.ur +++ b/tests/jsonTest.ur @@ -1,6 +1,7 @@ open Json fun main () : transaction page = return +

{[ fromJson "\"line 1\\nline 2\"" : string ]}

{[fromJson "[1, 2, 3]" : list int]}
{[toJson ("hi" :: "bye\"" :: "hehe" :: [])]} -- cgit v1.2.3 From e2552a79ed87721a81c246b9cfd053701d665f25 Mon Sep 17 00:00:00 2001 From: "majorseitan@blockfreie.org" Date: Sun, 15 Apr 2018 16:20:31 -0400 Subject: Handling of JSON escape characters 1. Handle the escape character \\ --- lib/ur/json.ur | 2 ++ tests/jsonTest.ur | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/ur/json.ur b/lib/ur/json.ur index 1e3e3f39..7ebb010f 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -52,6 +52,7 @@ fun escape s = | #"\t" => "\\t" | #"\"" => "\\\"" | #"\'" => "\\\'" + | #"\\" => "\\\\" | x => String.str ch ) ^ esc (String.suffix s 1) end @@ -100,6 +101,7 @@ fun unescape s = | #"t" => "\t" | #"\"" => "\"" | #"\'" => "\'" + | #"\\" => "\\" | x => error JSON unescape: Bad escape char: {[x]}) ^ unesc (i+2) diff --git a/tests/jsonTest.ur b/tests/jsonTest.ur index 1be6e7b5..071cf34b 100644 --- a/tests/jsonTest.ur +++ b/tests/jsonTest.ur @@ -1,7 +1,7 @@ open Json fun main () : transaction page = return -

{[ fromJson "\"line 1\\nline 2\"" : string ]}

{[ fromJson "\"\\\\line 1\\nline 2\"" : string ]}

{[fromJson "[1, 2, 3]" : list int]}
{[toJson ("hi" :: "bye\"" :: "hehe" :: [])]} -- cgit v1.2.3 From f993a516913883eda783bbe7cae80dfd42e2b428 Mon Sep 17 00:00:00 2001 From: "majorseitan@blockfreie.org" Date: Sat, 26 May 2018 12:46:56 -0400 Subject: Handling of JSON escape characters 1. Handle the escape character \/ --- lib/ur/json.ur | 2 ++ tests/jsonTest.ur | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/ur/json.ur b/lib/ur/json.ur index 7ebb010f..817ec16e 100644 --- a/lib/ur/json.ur +++ b/lib/ur/json.ur @@ -53,6 +53,7 @@ fun escape s = | #"\"" => "\\\"" | #"\'" => "\\\'" | #"\\" => "\\\\" + | #"/" => "\\/" | x => String.str ch ) ^ esc (String.suffix s 1) end @@ -102,6 +103,7 @@ fun unescape s = | #"\"" => "\"" | #"\'" => "\'" | #"\\" => "\\" + | #"/" => "/" | x => error JSON unescape: Bad escape char: {[x]}) ^ unesc (i+2) diff --git a/tests/jsonTest.ur b/tests/jsonTest.ur index 071cf34b..715e225d 100644 --- a/tests/jsonTest.ur +++ b/tests/jsonTest.ur @@ -1,7 +1,7 @@ open Json fun main () : transaction page = return -

{[ fromJson "\"\\\\line 1\\nline 2\"" : string ]}

{[ fromJson "\"\\\\line \/ 1\\nline 2\"" : string ]}

{[fromJson "[1, 2, 3]" : list int]}
{[toJson ("hi" :: "bye\"" :: "hehe" :: [])]} -- cgit v1.2.3 From 7f6f6045c0c1cc9bd8323e3e7de905e0e46fe82d Mon Sep 17 00:00:00 2001 From: Artyom Shalkhakov Date: Mon, 28 May 2018 21:34:07 +0600 Subject: Adding: cradio (support for client-side radio box). --- lib/js/urweb.js | 13 +++++++++++++ lib/ur/basis.urs | 5 ++++- src/css.sml | 1 + src/monoize.sml | 4 +++- tests/cradio.py | 27 +++++++++++++++++++++++++++ tests/cradio.ur | 13 +++++++++++++ tests/cradio.urp | 3 +++ tests/cradio.urs | 1 + 8 files changed, 65 insertions(+), 2 deletions(-) create mode 100644 tests/cradio.py create mode 100644 tests/cradio.ur create mode 100644 tests/cradio.urp create mode 100644 tests/cradio.urs (limited to 'lib') diff --git a/lib/js/urweb.js b/lib/js/urweb.js index d8198ed0..99b45ec9 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -1205,6 +1205,19 @@ function time(s, name) { return inpt("time", s, name); } +function crad(s) { + if (suspendScripts) + return; + + var x = input(document.createElement("input"), s, + function(x) { return function(v) { x.checked = (x.value === v); }; }, "radio"); + x.onclick = x.onkeyup = x.oninput = x.onchange = x.onpropertychange = function() { sv(s, x.value) }; + setTimeout(function() { + x.defaultChecked = x.checked = (s.data === x.value); + }, 10); + + return x; +} function selectValue(x) { if (x.options.length == 0) diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index c354d784..6d71d00a 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -1086,10 +1086,13 @@ val button : cformTag ([Value = string, Disabled = bool] ++ boxAttrs) [] val ccheckbox : cformTag ([Size = int, Source = source bool] ++ boxAttrs ++ inputAttrs') [] +val cradio : cformTag ([Source = source (option string), Value = string] ++ boxAttrs ++ inputAttrs') [] + val cselect : cformTag ([Source = source string] ++ boxAttrs ++ inputAttrs') [Cselect] val coption : unit -> tag [Value = string, Selected = bool] [Cselect, Body] [] [] [] -val ctextarea : cformTag ([Rows = int, Cols = int, Placeholder = string, Source = source string] ++ boxAttrs ++ inputAttrs) [] +val ctextarea : cformTag ([Rows = int, Cols = int, Placeholder = string, Source = source string, + Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) [] (*** Tables *) diff --git a/src/css.sml b/src/css.sml index 9e50686f..5bf4ea7b 100644 --- a/src/css.sml +++ b/src/css.sml @@ -104,6 +104,7 @@ val tags = [("span", inline), ("cpassword", replaced), ("button", replaced), ("ccheckbox", replaced), + ("cradio", replaced), ("cselect", replaced), ("ctextarea", replaced), ("tabl", table), diff --git a/src/monoize.sml b/src/monoize.sml index 85a66e87..11c6ea31 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3070,7 +3070,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | _ => (attrs, NONE) - val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script", "cemail", "csearch", "curl", "ctel", "ccolor"] + val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cradio", "cselect", "coption", "ctextarea", "active", "script", "cemail", "csearch", "curl", "ctel", "ccolor"] fun isSome (e, _) = case e of @@ -3560,6 +3560,8 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | "ctime" => cinput ("time", "time") | "ccheckbox" => cinput ("checkbox", "chk") + | "cradio" => cinput ("radio", "crad") + | "cselect" => (case List.find (fn ("Source", _, _) => true | _ => false) attrs of NONE => diff --git a/tests/cradio.py b/tests/cradio.py new file mode 100644 index 00000000..b70b2ef1 --- /dev/null +++ b/tests/cradio.py @@ -0,0 +1,27 @@ +import unittest +import base + +# issue: initialization doesn't quite work + +class Suite(base.Base): +# test case: +# initially the source is EMPTY +# then we pick SECOND variant and check the source +# then we pick the FIRST variant and check the source + def test_1(self): + """Test case 1""" + self.start("Cradio/main") + txt = self.body_text() + self.assertEqual("Wilbur Walbur Hello, I'm B. I'll be your waiter for this evening.", txt) + el1 = self.xpath('label[1]/input') + el2 = self.xpath('label[2]/input') + self.assertEqual(False, el1.is_selected()) + self.assertEqual(True, el2.is_selected()) + el1.click() + alert = self.driver.switch_to.alert + self.assertEqual("Now it's A", alert.text) + alert.accept() + self.assertEqual(True, el1.is_selected()) + self.assertEqual(False, el2.is_selected()) + txt = self.body_text() + self.assertEqual("Wilbur Walbur Hello, I'm A. I'll be your waiter for this evening.", txt) diff --git a/tests/cradio.ur b/tests/cradio.ur new file mode 100644 index 00000000..5b6e9d22 --- /dev/null +++ b/tests/cradio.ur @@ -0,0 +1,13 @@ +fun main () = +s <- source (Some "B"); +let + val onc = v <- get s; alert ("Now it's " ^ show v) +in + return + Wilbur + Walbur + + Hello, I'm {[s]}}/>. + I'll be your waiter for this evening. + +end diff --git a/tests/cradio.urp b/tests/cradio.urp new file mode 100644 index 00000000..0681ab21 --- /dev/null +++ b/tests/cradio.urp @@ -0,0 +1,3 @@ +debug + +cradio diff --git a/tests/cradio.urs b/tests/cradio.urs new file mode 100644 index 00000000..6ac44e0b --- /dev/null +++ b/tests/cradio.urs @@ -0,0 +1 @@ +val main : unit -> transaction page -- cgit v1.2.3 From 1c493e9ec47f4754dd7237078e8c4f3300925ce3 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Tue, 29 May 2018 09:49:22 -0400 Subject: Remove insecure crypto function (closes #114) --- include/urweb/urweb_cpp.h | 2 -- lib/ur/basis.urs | 5 ----- src/c/urweb.c | 5 ----- 3 files changed, 12 deletions(-) (limited to 'lib') diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index 0d5f5e0e..2c60a781 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -358,8 +358,6 @@ uw_Basis_string uw_Basis_timef(struct uw_context *, const char *fmt, uw_Basis_ti uw_Basis_time uw_Basis_stringToTimef(struct uw_context *, const char *fmt, uw_Basis_string); uw_Basis_time uw_Basis_stringToTimef_error(struct uw_context *, const char *fmt, uw_Basis_string); -uw_Basis_string uw_Basis_crypt(struct uw_context *, uw_Basis_string key, uw_Basis_string salt); - uw_Basis_bool uw_Basis_eq_time(struct uw_context *, uw_Basis_time, uw_Basis_time); uw_Basis_bool uw_Basis_lt_time(struct uw_context *, uw_Basis_time, uw_Basis_time); uw_Basis_bool uw_Basis_le_time(struct uw_context *, uw_Basis_time, uw_Basis_time); diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index c354d784..dc1b9b76 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -192,11 +192,6 @@ val datetimeSecond : time -> int val datetimeDayOfWeek : time -> int -(** * Encryption *) - -val crypt : string -> string -> string - - (** HTTP operations *) con http_cookie :: Type -> Type diff --git a/src/c/urweb.c b/src/c/urweb.c index 504597ef..283efcdd 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4490,11 +4490,6 @@ failure_kind uw_runCallback(uw_context ctx, void (*callback)(uw_context)) { return r; } -uw_Basis_string uw_Basis_crypt(uw_context ctx, uw_Basis_string key, uw_Basis_string salt) { - char buf[14]; - return uw_strdup(ctx, DES_fcrypt(key, salt, buf)); -} - uw_Basis_bool uw_Basis_eq_time(uw_context ctx, uw_Basis_time t1, uw_Basis_time t2) { (void)ctx; return !!(t1.seconds == t2.seconds && t1.microseconds == t2.microseconds); -- cgit v1.2.3