From b3f6f1c94a001205dd77ac2e5074e6cc4c300ffd Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 16 Nov 2014 13:39:18 -0500 Subject: uw_remoteSock() --- include/urweb/urweb_cpp.h | 3 +++ src/c/http.c | 2 ++ src/c/urweb.c | 13 +++++++++++++ 3 files changed, 18 insertions(+) diff --git a/include/urweb/urweb_cpp.h b/include/urweb/urweb_cpp.h index d83b2cbb..637cddfc 100644 --- a/include/urweb/urweb_cpp.h +++ b/include/urweb/urweb_cpp.h @@ -393,4 +393,7 @@ uw_Basis_string uw_Basis_blessData(struct uw_context *, uw_Basis_string); extern const char uw_begin_xhtml[], uw_begin_html5[]; +int uw_remoteSock(struct uw_context *); +void uw_set_remoteSock(struct uw_context *, int sock); + #endif diff --git a/src/c/http.c b/src/c/http.c index 9651a216..e6c7b1af 100644 --- a/src/c/http.c +++ b/src/c/http.c @@ -89,6 +89,8 @@ static void *worker(void *data) { sock = uw_dequeue(); } + uw_set_remoteSock(ctx, sock); + qprintf("Handling connection with thread #%d.\n", me); while (1) { diff --git a/src/c/urweb.c b/src/c/urweb.c index 09514afa..1f2c8b3c 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -476,6 +476,8 @@ struct uw_context { char *output_buffer; size_t output_buffer_size; + + int remoteSock; }; size_t uw_headers_max = SIZE_MAX; @@ -559,6 +561,8 @@ uw_context uw_init(int id, uw_loggers *lg) { ctx->output_buffer = malloc(1); ctx->output_buffer_size = 1; + ctx->remoteSock = -1; + return ctx; } @@ -646,6 +650,7 @@ void uw_reset_keep_error_message(uw_context ctx) { ctx->amInitializing = 0; ctx->usedSig = 0; ctx->needsResig = 0; + ctx->remoteSock = -1; } void uw_reset_keep_request(uw_context ctx) { @@ -4458,3 +4463,11 @@ uw_Basis_string uw_Basis_blessData(uw_context ctx, uw_Basis_string s) { return s; } + +int uw_remoteSock(uw_context ctx) { + return ctx->remoteSock; +} + +void uw_set_remoteSock(uw_context ctx, int sock) { + ctx->remoteSock = sock; +} -- cgit v1.2.3 From ff35b4cbd8c62fed584b48f660e4274c6e357893 Mon Sep 17 00:00:00 2001 From: Sergey Mironov Date: Sun, 12 Oct 2014 10:03:36 +0000 Subject: HTML5 input attributes: placeholder, required, autofocus; email input type (without cformTag equivalent) --- lib/ur/basis.urs | 21 +++++++++++++-------- src/monoize.sml | 1 + 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 5d0a0c8a..170df50c 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -948,14 +948,19 @@ con formTag = fn (ty :: Type) (inner :: {Unit}) (attrs :: {Type}) => -> [[Form] ~ ctx] => nm :: Name -> unit -> tag attrs ([Form] ++ ctx) inner [] [nm = ty] + +con inputAttrs = [Required = string, Autofocus = string] + + 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) -val password : formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs) + Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) +val password : formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) +val email : formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) val textarea : formTag string [] ([Rows = int, Cols = int, Onchange = transaction unit, - Ontext = transaction unit] ++ boxAttrs) + Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) -val checkbox : formTag bool [] ([Checked = bool, Onchange = transaction unit] ++ boxAttrs) +val checkbox : formTag bool [] ([Checked = bool, Onchange = transaction unit, Value = string] ++ boxAttrs) type file val fileName : file -> option string @@ -1012,18 +1017,18 @@ con cformTag = fn (attrs :: {Type}) (inner :: {Unit}) => unit -> tag attrs ([Body] ++ ctx) ([Body] ++ inner) [] [] val ctextbox : cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, Onchange = transaction unit, - Ontext = transaction unit] ++ boxAttrs) [] + Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) [] val cpassword : cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, Onchange = transaction unit, - Ontext = transaction unit] ++ boxAttrs) [] + Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) [] val button : cformTag ([Value = string] ++ boxAttrs) [] -val ccheckbox : cformTag ([Value = bool, Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs) [] +val ccheckbox : cformTag ([Value = bool, Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] val cselect : cformTag ([Source = source string, Onchange = transaction unit] ++ boxAttrs) [Cselect] val coption : unit -> tag [Value = string, Selected = bool] [Cselect, Body] [] [] [] val ctextarea : cformTag ([Value = string, Rows = int, Cols = int, Source = source string, Onchange = transaction unit, - Ontext = transaction unit] ++ boxAttrs) [] + Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) [] (*** Tables *) diff --git a/src/monoize.sml b/src/monoize.sml index 6073a21f..cc5395f0 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3663,6 +3663,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 textbox tag")) | "password" => input "password" + | "email" => input "email" | "textarea" => (case targs of [_, (L.CName name, _)] => -- cgit v1.2.3 From cd1df17a1dac04f2a353fbc49284b775e78817a5 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 16 Nov 2014 14:02:17 -0500 Subject: Make 'required' and 'autofocus' attributes Boolean; add a syntax extension for parsing their usual HTML syntax --- doc/manual.tex | 4 +++- lib/ur/basis.urs | 2 +- src/urweb.grm | 6 ++++++ tests/html5_forms.ur | 12 ++++++++++++ tests/html5_forms.urs | 1 + 5 files changed, 23 insertions(+), 2 deletions(-) create mode 100644 tests/html5_forms.ur create mode 100644 tests/html5_forms.urs diff --git a/doc/manual.tex b/doc/manual.tex index 0550d081..5935ccbf 100644 --- a/doc/manual.tex +++ b/doc/manual.tex @@ -2348,13 +2348,15 @@ $$\begin{array}{rrcll} &&& \texttt{<}g\texttt{>}l^*\texttt{} & \textrm{tag with children} \\ &&& \{e\} & \textrm{computed XML fragment} \\ &&& \{[e]\} & \textrm{injection of an Ur expression, via the $\mt{Top}.\mt{txt}$ function} \\ - \textrm{Tag} & g &::=& h \; (x = v)^* \\ + \textrm{Tag} & g &::=& h \; (x [= v])^* \\ \textrm{Tag head} & h &::=& x & \textrm{tag name} \\ &&& h\{c\} & \textrm{constructor parameter} \\ \textrm{Attribute value} & v &::=& \ell & \textrm{literal value} \\ &&& \{e\} & \textrm{computed value} \\ \end{array}$$ +When the optional $= v$ is omitted in an XML attribute, the attribute is assigned value $\mt{True}$ in Ur/Web, and it is rendered to HTML merely as including the attribute name without a value. If such a Boolean attribute is manually set to value $\mt{False}$, then it is omitted altogether in generating HTML. + Further, there is a special convenience and compatibility form for setting CSS classes of tags. If a \cd{class} attribute has a value that is a string literal, the literal is parsed in the usual HTML way and replaced with calls to appropriate Ur/Web combinators. Any dashes in the text are replaced with underscores to determine Ur identifiers. The same desugaring can be accessed in a normal expression context by calling the pseudo-function \cd{CLASS} on a string literal. Similar support is provided for \cd{style} attributes. Normal CSS syntax may be used in string literals that are \cd{style} attribute values, and the desugaring may be accessed elsewhere with the pseudo-function \cd{STYLE}. diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 170df50c..049d1864 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -949,7 +949,7 @@ con formTag = fn (ty :: Type) (inner :: {Unit}) (attrs :: {Type}) => nm :: Name -> unit -> tag attrs ([Form] ++ ctx) inner [] [nm = ty] -con inputAttrs = [Required = string, Autofocus = string] +con inputAttrs = [Required = bool, Autofocus = bool] val hidden : formTag string [] [Data = data_attr, Id = string, Value = string] diff --git a/src/urweb.grm b/src/urweb.grm index edac345f..240f64cb 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -1747,6 +1747,12 @@ attr : SYMBOL EQ attrv (case SYMBOL of else attrv) end) + | SYMBOL (let + val loc = s (SYMBOLleft, SYMBOLright) + in + Normal ((CName (makeAttr SYMBOL), loc), + (EVar (["Basis"], "True", Infer), loc)) + end) attrv : INT (EPrim (Prim.Int INT), s (INTleft, INTright)) | FLOAT (EPrim (Prim.Float FLOAT), s (FLOATleft, FLOATright)) diff --git a/tests/html5_forms.ur b/tests/html5_forms.ur new file mode 100644 index 00000000..2fa5c5c2 --- /dev/null +++ b/tests/html5_forms.ur @@ -0,0 +1,12 @@ +fun handler r = return + + +fun main () = + return +
+ + + + + +
diff --git a/tests/html5_forms.urs b/tests/html5_forms.urs new file mode 100644 index 00000000..6ac44e0b --- /dev/null +++ b/tests/html5_forms.urs @@ -0,0 +1 @@ +val main : unit -> transaction page -- cgit v1.2.3 From 17a277b007b8e545760837b1871d36df0e9deaea Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 16 Nov 2014 14:06:24 -0500 Subject: Remove 'value' attribute of --- lib/ur/basis.urs | 2 +- tests/html5_forms.ur | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 049d1864..2f523a20 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -960,7 +960,7 @@ val email : formTag string [] ([Value = string, Size = int, Placeholder = string val textarea : formTag string [] ([Rows = int, Cols = int, Onchange = transaction unit, Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) -val checkbox : formTag bool [] ([Checked = bool, Onchange = transaction unit, Value = string] ++ boxAttrs) +val checkbox : formTag bool [] ([Checked = bool, Onchange = transaction unit] ++ boxAttrs) type file val fileName : file -> option string diff --git a/tests/html5_forms.ur b/tests/html5_forms.ur index 2fa5c5c2..435e4ada 100644 --- a/tests/html5_forms.ur +++ b/tests/html5_forms.ur @@ -1,4 +1,7 @@ fun handler r = return + A: {[r.A]}
+ B: {[r.B]}
+ C: {[r.C]}
 fun main () = @@ -6,6 +9,7 @@ fun main () =
+ -- cgit v1.2.3 From 5f984d18d62f3290103540552a82b13c69e364df Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 16 Nov 2014 14:16:11 -0500 Subject: More simple textual HTML5 input types --- lib/ur/basis.urs | 11 ++++++++++- src/monoize.sml | 3 +++ src/urweb.grm | 1 + tests/html5_forms.ur | 8 ++++++++ 4 files changed, 22 insertions(+), 1 deletion(-) diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 2f523a20..7691cdce 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -956,12 +956,21 @@ 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 email : formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) val textarea : formTag string [] ([Rows = int, Cols = int, Onchange = transaction unit, Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) val checkbox : formTag bool [] ([Checked = bool, Onchange = transaction unit] ++ boxAttrs) +(* HTML5 widgets galore! *) + +type textWidget = formTag string [] ([Value = string, Size = int, Placeholder = string, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) + +val email : textWidget +val search : textWidget +val url_ : textWidget +val tel : textWidget + + type file val fileName : file -> option string val fileMimeType : file -> string diff --git a/src/monoize.sml b/src/monoize.sml index cc5395f0..96323c9e 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3664,6 +3664,9 @@ fun monoExp (env, st, fm) (all as (e, loc)) = raise Fail "No name passed to textbox tag")) | "password" => input "password" | "email" => input "email" + | "search" => input "search" + | "url_" => input "url" + | "tel" => input "tel" | "textarea" => (case targs of [_, (L.CName name, _)] => diff --git a/src/urweb.grm b/src/urweb.grm index 240f64cb..85e5f092 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -221,6 +221,7 @@ val inDml = ref false fun tagIn bt = case bt of "table" => "tabl" + | "url" => "url_" | _ => bt datatype prop_kind = Delete | Update diff --git a/tests/html5_forms.ur b/tests/html5_forms.ur index 435e4ada..a9bf7f77 100644 --- a/tests/html5_forms.ur +++ b/tests/html5_forms.ur @@ -2,6 +2,10 @@ fun handler r = return A: {[r.A]}
B: {[r.B]}
C: {[r.C]}
+ D: {[r.D]}
+ E: {[r.E]}
+ F: {[r.F]}
+ G: {[r.G]}
 fun main () = @@ -10,6 +14,10 @@ fun main () = + + + + -- cgit v1.2.3 From 86df1742d90c9ae13843188c0772554ed2eaa666 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 16 Nov 2014 14:39:38 -0500 Subject: Some more HTML5 input types --- lib/ur/basis.urs | 11 +++++++++++ src/monoize.sml | 9 +++++++++ src/urweb.grm | 1 + src/urweb.lex | 8 ++++---- tests/html5_forms.ur | 21 +++++++++++++++++++++ 5 files changed, 46 insertions(+), 4 deletions(-) diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 7691cdce..9fb04484 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -969,6 +969,17 @@ val email : textWidget val search : textWidget 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) + type file diff --git a/src/monoize.sml b/src/monoize.sml index 96323c9e..9ca21058 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3667,6 +3667,15 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | "search" => input "search" | "url_" => input "url" | "tel" => input "tel" + | "color" => input "color" + | "number" => input "number" + | "range" => input "range" + | "date" => input "date" + | "datetime" => input "datetime" + | "datetime_local" => input "datetime-local" + | "month" => input "month" + | "week" => input "week" + | "timeInput" => input "time" | "textarea" => (case targs of [_, (L.CName name, _)] => diff --git a/src/urweb.grm b/src/urweb.grm index 85e5f092..5b568a8c 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -222,6 +222,7 @@ fun tagIn bt = case bt of "table" => "tabl" | "url" => "url_" + | "datetime-local" => "datetime_local" | _ => bt datatype prop_kind = Delete | Update diff --git a/src/urweb.lex b/src/urweb.lex index 15ae448e..0d316ed2 100644 --- a/src/urweb.lex +++ b/src/urweb.lex @@ -277,19 +277,19 @@ xint = x[0-9a-fA-F][0-9a-fA-F]; continue ()) end); - "<" {id} "/>"=>(let + "<" {xmlid} "/>"=>(let val tag = String.substring (yytext, 1, size yytext - 3) in Tokens.XML_BEGIN_END (tag, yypos, yypos + size yytext) end); - "<" {id} ">"=> (let + "<" {xmlid} ">"=> (let val tag = String.substring (yytext, 1, size yytext - 2) in YYBEGIN XML; xmlTag := tag :: (!xmlTag); Tokens.XML_BEGIN (tag, yypos, yypos + size yytext) end); - "" => (let + "" => (let val id = String.substring (yytext, 2, size yytext - 3) in case !xmlTag of @@ -304,7 +304,7 @@ xint = x[0-9a-fA-F][0-9a-fA-F]; Tokens.END_TAG (id, yypos, yypos + size yytext) end); - "<" {id} => (YYBEGIN XMLTAG; + "<" {xmlid} => (YYBEGIN XMLTAG; Tokens.BEGIN_TAG (String.extract (yytext, 1, NONE), yypos, yypos + size yytext)); diff --git a/tests/html5_forms.ur b/tests/html5_forms.ur index a9bf7f77..507ea3cf 100644 --- a/tests/html5_forms.ur +++ b/tests/html5_forms.ur @@ -6,6 +6,15 @@ fun handler r = return E: {[r.E]}
F: {[r.F]}
G: {[r.G]}
+ H: {[r.H]}
+ I: {[r.I]}
+ J: {[r.J]}
+ K: {[r.K]}
+ L: {[r.L]}
+ M: {[r.M]}
+ N: {[r.N]}
+ O: {[r.O]}
+ P: {[r.P]}
 fun main () = @@ -19,6 +28,18 @@ fun main () = +
+ + + + + + + + + + + -- cgit v1.2.3 From 049d3500132b56ac2429a8a6ee0cc5ba1fbaae5a Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 16 Nov 2014 15:03:29 -0500 Subject: Textual HTML5 AJAX widgets --- lib/js/urweb.js | 34 ++++++++++++----- lib/ur/basis.urs | 15 ++++++-- src/monoize.sml | 101 ++++++++++++++++---------------------------------- tests/ctextbox.urp | 1 + tests/html5_cforms.ur | 29 +++++++++++++++ 5 files changed, 98 insertions(+), 82 deletions(-) create mode 100644 tests/html5_cforms.ur diff --git a/lib/js/urweb.js b/lib/js/urweb.js index 5cc49fec..c62670e7 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -1038,28 +1038,44 @@ function input(x, s, recreate, type, name) { return x; } -function inp(s, name) { +function inpt(type, s, name) { if (suspendScripts) return; var x = input(document.createElement("input"), s, - function(x) { return function(v) { if (x.value != v) x.value = v; }; }, "text", name); + function(x) { return function(v) { if (x.value != v) x.value = v; }; }, type, name); x.value = s.data; x.onkeyup = x.oninput = x.onchange = x.onpropertychange = function() { sv(s, x.value) }; return x; } +function inp(s, name) { + return inpt("text", s, name); +} + function password(s, name) { - if (suspendScripts) - return; + return inpt("password", s, name); +} - var x = input(document.createElement("input"), s, - function(x) { return function(v) { if (x.value != v) x.value = v; }; }, "password", name); - x.value = s.data; - x.onkeyup = x.oninput = x.onchange = x.onpropertychange = function() { sv(s, x.value) }; +function email(s, name) { + return inpt("email", s, name); +} - return x; +function search(s, name) { + return inpt("search", s, name); +} + +function url(s, name) { + return inpt("url", s, name); +} + +function tel(s, name) { + return inpt("tel", s, name); +} + +function color(s, name) { + return inpt("color", s, name); } function selectValue(x) { diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 9fb04484..1ee5be50 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -1036,10 +1036,17 @@ con cformTag = fn (attrs :: {Type}) (inner :: {Unit}) => -> [[Body] ~ ctx] => [[Body] ~ inner] => unit -> tag attrs ([Body] ++ ctx) ([Body] ++ inner) [] [] -val ctextbox : cformTag ([Value = string, Size = int, Source = source string, Placeholder = string, Onchange = transaction unit, - Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) [] -val cpassword : 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, + Onchange = transaction unit, Ontext = transaction unit] ++ boxAttrs ++ inputAttrs) [] + +val ctextbox : ctext +val cpassword : ctext +val cemail : ctext +val csearch : ctext +val curl : ctext +val ctel : ctext +val ccolor : ctext + val button : cformTag ([Value = string] ++ boxAttrs) [] val ccheckbox : cformTag ([Value = bool, Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] diff --git a/src/monoize.sml b/src/monoize.sml index 9ca21058..63ae0b31 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3283,7 +3283,7 @@ fun monoExp (env, st, fm) (all as (e, loc)) = val (style, fm) = monoExp (env, st, fm) style val (dynStyle, fm) = monoExp (env, st, fm) dynStyle - val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script"] + val dynamics = ["dyn", "ctextbox", "cpassword", "ccheckbox", "cselect", "coption", "ctextarea", "active", "script", "cemail", "csearch", "curl", "ctel", "ccolor"] fun isSome (e, _) = case e of @@ -3583,6 +3583,29 @@ fun monoExp (env, st, fm) (all as (e, loc)) = else "span" + fun cinput (fallback, dynamic) = + case List.find (fn ("Source", _, _) => true | _ => false) attrs of + NONE => + let + val (ts, fm) = tagStart "input" + in + ((L'.EStrcat (ts, + strH (" type=\"" ^ fallback ^ "\" />")), + loc), fm) + end + | SOME (_, src, _) => + let + val sc = strcat [str (dynamic ^ "(exec("), + (L'.EJavaScript (L'.Script, src), loc), + str "))"] + val sc = setAttrs sc + in + (strcat [str ""], + fm) + end + val baseAll as (base, fm) = case tag of "body" => let @@ -3726,75 +3749,15 @@ 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 lselect tag")) - | "ctextbox" => - (case List.find (fn ("Source", _, _) => true | _ => false) attrs of - NONE => - let - val (ts, fm) = tagStart "input" - in - ((L'.EStrcat (ts, - strH " type=\"text\" />"), - loc), fm) - end - | SOME (_, src, _) => - let - val sc = strcat [str "inp(exec(", - (L'.EJavaScript (L'.Script, src), loc), - str "))"] - val sc = setAttrs sc - in - (strcat [str ""], - fm) - end) - - | "cpassword" => - (case List.find (fn ("Source", _, _) => true | _ => false) attrs of - NONE => - let - val (ts, fm) = tagStart "input" - in - ((L'.EStrcat (ts, - strH " type=\"password\" />"), - loc), fm) - end - | SOME (_, src, _) => - let - val sc = strcat [str "password(exec(", - (L'.EJavaScript (L'.Script, src), loc), - str "))"] - val sc = setAttrs sc - in - (strcat [str ""], - fm) - end) - - | "ccheckbox" => - (case List.find (fn ("Source", _, _) => true | _ => false) attrs of - NONE => - let - val (ts, fm) = tagStart "input type=\"checkbox\"" - in - ((L'.EStrcat (ts, - strH " />"), - loc), fm) - end - | SOME (_, src, _) => - let - val sc = strcat [str "chk(exec(", - (L'.EJavaScript (L'.Script, src), loc), - str "))"] - val sc = setAttrs sc - in - (strcat [str ""], - fm) - end) + | "ctextbox" => cinput ("text", "inp") + | "cpassword" => cinput ("password", "password") + | "cemail" => cinput ("email", "email") + | "csearch" => cinput ("search", "search") + | "curl" => cinput ("url", "url") + | "ctel" => cinput ("tel", "tel") + | "ccolor" => cinput ("color", "color") + | "ccheckbox" => cinput ("checkbox", "chk") | "cselect" => (case List.find (fn ("Source", _, _) => true | _ => false) attrs of NONE => diff --git a/tests/ctextbox.urp b/tests/ctextbox.urp index d5cb5e9f..5c6c5df8 100644 --- a/tests/ctextbox.urp +++ b/tests/ctextbox.urp @@ -1,4 +1,5 @@ debug allow url http://localhost/* +rewrite url Ctextbox/* ctextbox diff --git a/tests/html5_cforms.ur b/tests/html5_cforms.ur new file mode 100644 index 00000000..a62dbf23 --- /dev/null +++ b/tests/html5_cforms.ur @@ -0,0 +1,29 @@ +fun dn [a] (_ : show a) (x : source a) : xbody = + + + +fun main () : transaction page = + a <- source ""; + b <- source True; + c <- source "a@b"; + d <- source ""; + e <- source ""; + f <- source ""; + + return + + + + + + + +
+ + {dn a}; + {dn b}; + {dn c}; + {dn d}; + {dn e}; + {dn f} + -- cgit v1.2.3 From f3e50f123c33c26038b601475eeaa619526ad7ab Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 16 Nov 2014 15:20:13 -0500 Subject: More HTML5 AJAX widgets --- lib/js/urweb.js | 33 +++++++++++++++++++++++++++++++++ lib/ur/basis.urs | 9 +++++++++ src/monoize.sml | 9 +++++++++ src/urweb.grm | 1 + tests/html5_cforms.ur | 29 ++++++++++++++++++++++++++++- 5 files changed, 80 insertions(+), 1 deletion(-) diff --git a/lib/js/urweb.js b/lib/js/urweb.js index c62670e7..342dc943 100644 --- a/lib/js/urweb.js +++ b/lib/js/urweb.js @@ -1078,6 +1078,39 @@ function color(s, name) { return inpt("color", s, name); } +function number(s, name) { + return inpt("number", s, name); +} + +function range(s, name) { + return inpt("range", s, name); +} + +function date(s, name) { + return inpt("date", s, name); +} + +function datetime(s, name) { + return inpt("datetime", s, name); +} + +function datetime_local(s, name) { + return inpt("datetime-local", s, name); +} + +function month(s, name) { + return inpt("month", s, name); +} + +function week(s, name) { + return inpt("week", s, name); +} + +function time(s, name) { + return inpt("time", s, name); +} + + function selectValue(x) { if (x.options.length == 0) return ""; diff --git a/lib/ur/basis.urs b/lib/ur/basis.urs index 1ee5be50..326563d6 100644 --- a/lib/ur/basis.urs +++ b/lib/ur/basis.urs @@ -1047,6 +1047,15 @@ val curl : ctext val ctel : ctext val ccolor : ctext +val cnumber : cformTag ([Source = source float, Value = float, Min = float, Max = float, Step = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] +val crange : cformTag ([Source = source float, Value = float, Min = float, Max = float, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] +val cdate : cformTag ([Source = source string, Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] +val cdatetime : cformTag ([Source = source string, Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] +val cdatetime_local : cformTag ([Source = source string, Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] +val cmonth : cformTag ([Source = source string, Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] +val cweek : cformTag ([Source = source string, Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] +val ctime : cformTag ([Source = source string, Value = string, Min = string, Max = string, Size = int, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] + val button : cformTag ([Value = string] ++ boxAttrs) [] val ccheckbox : cformTag ([Value = bool, Size = int, Source = source bool, Onchange = transaction unit] ++ boxAttrs ++ inputAttrs) [] diff --git a/src/monoize.sml b/src/monoize.sml index 63ae0b31..0829abc9 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3757,6 +3757,15 @@ fun monoExp (env, st, fm) (all as (e, loc)) = | "ctel" => cinput ("tel", "tel") | "ccolor" => cinput ("color", "color") + | "cnumber" => cinput ("number", "number") + | "crange" => cinput ("range", "range") + | "cdate" => cinput ("date", "date") + | "cdatetime" => cinput ("datetime", "datetime") + | "cdatetime_local" => cinput ("datetime-local", "datetime_local") + | "cmonth" => cinput ("month", "month") + | "cweek" => cinput ("week", "week") + | "ctime" => cinput ("time", "time") + | "ccheckbox" => cinput ("checkbox", "chk") | "cselect" => (case List.find (fn ("Source", _, _) => true | _ => false) attrs of diff --git a/src/urweb.grm b/src/urweb.grm index 5b568a8c..995d1329 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -223,6 +223,7 @@ fun tagIn bt = "table" => "tabl" | "url" => "url_" | "datetime-local" => "datetime_local" + | "cdatetime-local" => "cdatetime_local" | _ => bt datatype prop_kind = Delete | Update diff --git a/tests/html5_cforms.ur b/tests/html5_cforms.ur index a62dbf23..be07d07e 100644 --- a/tests/html5_cforms.ur +++ b/tests/html5_cforms.ur @@ -9,6 +9,15 @@ fun main () : transaction page = d <- source ""; e <- source ""; f <- source ""; + g <- source 1.0; + h <- source 1.0; + i <- source "#CCCCCC"; + j <- source "2014/11/16"; + k <- source "2014/11/16 12:30:45"; + l <- source "2014/11/16 12:30:45"; + m <- source "2014/11"; + n <- source "2014-W7"; + o <- source "12:30:45"; return @@ -17,6 +26,15 @@ fun main () : transaction page = + + + + + + + + +
@@ -25,5 +43,14 @@ fun main () : transaction page = {dn c}; {dn d}; {dn e}; - {dn f} + {dn f}; + {dn g}; + {dn h}; + {dn i}; + {dn j}; + {dn k}; + {dn l}; + {dn m}; + {dn n}; + {dn o} -- cgit v1.2.3