aboutsummaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
authorGravatar Ziv Scully <ziv@mit.edu>2014-11-24 20:47:38 -0500
committerGravatar Ziv Scully <ziv@mit.edu>2014-11-24 20:47:38 -0500
commitb59e6e96601c09bd97a4cce881c9b9f8bf8816a3 (patch)
treec2714306eb85c1e0d144089bbc3f6ed51e58cdda /src
parenta413fc1a42bf0fbee27c2f22cc8e9ca9b17b9edf (diff)
parentf3e50f123c33c26038b601475eeaa619526ad7ab (diff)
Merge.
Diffstat (limited to 'src')
-rw-r--r--src/c/http.c2
-rw-r--r--src/c/urweb.c13
-rw-r--r--src/monoize.sml125
-rw-r--r--src/urweb.grm9
-rw-r--r--src/urweb.lex8
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));