diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/c/http.c | 2 | ||||
-rw-r--r-- | src/c/urweb.c | 13 | ||||
-rw-r--r-- | src/monoize.sml | 125 | ||||
-rw-r--r-- | src/urweb.grm | 9 | ||||
-rw-r--r-- | src/urweb.lex | 8 |
5 files changed, 83 insertions, 74 deletions
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 8ecef7c5..4cd347b2 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -479,6 +479,8 @@ struct uw_context { // For caching. char *recording; + + int remoteSock; }; size_t uw_headers_max = SIZE_MAX; @@ -564,6 +566,8 @@ uw_context uw_init(int id, uw_loggers *lg) { ctx->recording = 0; + ctx->remoteSock = -1; + return ctx; } @@ -651,6 +655,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) { @@ -4471,3 +4476,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; +} diff --git a/src/monoize.sml b/src/monoize.sml index d609a67d..2d225813 100644 --- a/src/monoize.sml +++ b/src/monoize.sml @@ -3289,7 +3289,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 @@ -3589,6 +3589,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 "<script type=\"text/javascript\">", + sc, + str "</script>"], + fm) + end + val baseAll as (base, fm) = case tag of "body" => let @@ -3669,6 +3692,19 @@ 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" + | "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, _)] => @@ -3719,75 +3755,24 @@ 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 "<script type=\"text/javascript\">", - sc, - str "</script>"], - 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 "<script type=\"text/javascript\">", - sc, - str "</script>"], - 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 "<script type=\"text/javascript\">", - sc, - str "</script>"], - 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") + + | "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 NONE => diff --git a/src/urweb.grm b/src/urweb.grm index edac345f..995d1329 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -221,6 +221,9 @@ val inDml = ref false fun tagIn bt = case bt of "table" => "tabl" + | "url" => "url_" + | "datetime-local" => "datetime_local" + | "cdatetime-local" => "cdatetime_local" | _ => bt datatype prop_kind = Delete | Update @@ -1747,6 +1750,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/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); -<INITIAL> "<" {id} "/>"=>(let +<INITIAL> "<" {xmlid} "/>"=>(let val tag = String.substring (yytext, 1, size yytext - 3) in Tokens.XML_BEGIN_END (tag, yypos, yypos + size yytext) end); -<INITIAL> "<" {id} ">"=> (let +<INITIAL> "<" {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); -<XML> "</" {id} ">" => (let +<XML> "</" {xmlid} ">" => (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); -<XML> "<" {id} => (YYBEGIN XMLTAG; +<XML> "<" {xmlid} => (YYBEGIN XMLTAG; Tokens.BEGIN_TAG (String.extract (yytext, 1, NONE), yypos, yypos + size yytext)); |