diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c/urweb.c | 43 | ||||
| -rw-r--r-- | src/mono_opt.sml | 1 | ||||
| -rw-r--r-- | src/settings.sml | 6 |
3 files changed, 49 insertions, 1 deletions
diff --git a/src/c/urweb.c b/src/c/urweb.c index 93635fd1..2e16743c 100644 --- a/src/c/urweb.c +++ b/src/c/urweb.c @@ -4021,3 +4021,46 @@ uw_Basis_int uw_Basis_trunc(uw_context ctx, uw_Basis_float n) { uw_Basis_int uw_Basis_round(uw_context ctx, uw_Basis_float n) { return round(n); } + +uw_Basis_string uw_Basis_atom(uw_context ctx, uw_Basis_string s) { + char *p; + + for (p = s; *p; ++p) { + char c = *p; + if (!isalnum(c) && c != '+' && c != '-' && c != '.' && c != '%' && c != '#') + uw_error(ctx, FATAL, "Disallowed character in CSS atom"); + } + + return s; +} + +uw_Basis_string uw_Basis_css_url(uw_context ctx, uw_Basis_string s) { + char *p; + + for (p = s; *p; ++p) { + char c = *p; + if (!isalnum(c) && c != ':' && c != '/' && c != '.' && c != '_' && c != '+' + && c != '-' && c != '%' && c != '?' && c != '&' && c != '=' && c != '#') + uw_error(ctx, FATAL, "Disallowed character in CSS URL"); + } + + return s; +} + +uw_Basis_string uw_Basis_property(uw_context ctx, uw_Basis_string s) { + char *p; + + if (!*s) + uw_error(ctx, FATAL, "Empty CSS property"); + + if (!islower(s[0]) && s[0] != '_') + uw_error(ctx, FATAL, "Bad initial character in CSS property"); + + for (p = s; *p; ++p) { + char c = *p; + if (!islower(c) && !isdigit(c) && c != '_' && c != '-') + uw_error(ctx, FATAL, "Disallowed character in CSS property"); + } + + return s; +} diff --git a/src/mono_opt.sml b/src/mono_opt.sml index af9e9a9c..17d23cc2 100644 --- a/src/mono_opt.sml +++ b/src/mono_opt.sml @@ -129,6 +129,7 @@ val checkCssUrl = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"/" orelse ch = #"." orelse ch = #"_" + orelse ch = #"+" orelse ch = #"-" orelse ch = #"%" orelse ch = #"?" diff --git a/src/settings.sml b/src/settings.sml index a9c2315c..246be88b 100644 --- a/src/settings.sml +++ b/src/settings.sml @@ -315,7 +315,11 @@ val jsFuncsBase = basisM [("alert", "alert"), ("preventDefault", "uw_preventDefault"), ("stopPropagation", "uw_stopPropagation"), - ("fresh", "fresh")] + ("fresh", "fresh"), + + ("atom", "atom"), + ("css_url", "css_url"), + ("property", "property")] val jsFuncs = ref jsFuncsBase fun setJsFuncs ls = jsFuncs := foldl (fn ((k, v), m) => M.insert (m, k, v)) jsFuncsBase ls fun jsFunc x = M.find (!jsFuncs, x) |