summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--include/lacweb.h1
-rw-r--r--lib/basis.lig2
-rw-r--r--src/c/lacweb.c23
-rw-r--r--src/cjr_print.sml8
-rw-r--r--src/lacweb.grm8
-rw-r--r--src/lacweb.lex3
-rw-r--r--src/monoize.sml2
-rw-r--r--tests/checkbox.lac10
8 files changed, 46 insertions, 11 deletions
diff --git a/include/lacweb.h b/include/lacweb.h
index 0a425a31..3ca2a966 100644
--- a/include/lacweb.h
+++ b/include/lacweb.h
@@ -21,6 +21,7 @@ int lw_send(lw_context, int sock);
void lw_set_input(lw_context, char *name, char *value);
char *lw_get_input(lw_context, int name);
+char *lw_get_optional_input(lw_context, int name);
void lw_write(lw_context, const char*);
diff --git a/lib/basis.lig b/lib/basis.lig
index 72a8ddf8..7c934780 100644
--- a/lib/basis.lig
+++ b/lib/basis.lig
@@ -71,6 +71,8 @@ val textbox : lformTag string [] []
val password : lformTag string [] []
val ltextarea : lformTag string [] []
+val checkbox : lformTag bool [] []
+
con radio = [Body, Radio]
val radio : lformTag string radio []
val radioOption : unit -> tag [Value = string] radio [] [] []
diff --git a/src/c/lacweb.c b/src/c/lacweb.c
index 123a5a8f..12985b4f 100644
--- a/src/c/lacweb.c
+++ b/src/c/lacweb.c
@@ -18,7 +18,6 @@ struct lw_context {
jmp_buf jmp_buf;
- failure_kind failure_kind;
char error_message[ERROR_BUF_LEN];
};
@@ -35,7 +34,6 @@ lw_context lw_init(size_t page_len, size_t heap_len) {
ctx->inputs = calloc(lw_inputs_len, sizeof(char *));
- ctx->failure_kind = SUCCESS;
ctx->error_message[0] = 0;
return ctx;
@@ -52,15 +50,12 @@ void lw_reset_keep_request(lw_context ctx) {
ctx->page_front = ctx->page;
ctx->heap_front = ctx->heap;
- ctx->failure_kind = SUCCESS;
ctx->error_message[0] = 0;
}
void lw_reset_keep_error_message(lw_context ctx) {
ctx->page_front = ctx->page;
ctx->heap_front = ctx->heap;
-
- ctx->failure_kind = SUCCESS;
}
void lw_reset(lw_context ctx) {
@@ -71,20 +66,21 @@ void lw_reset(lw_context ctx) {
void lw_handle(lw_context, char *);
failure_kind lw_begin(lw_context ctx, char *path) {
- if (!setjmp(ctx->jmp_buf))
+ int r = setjmp(ctx->jmp_buf);
+
+ if (r == 0)
lw_handle(ctx, path);
- return ctx->failure_kind;
+ return r;
}
void lw_error(lw_context ctx, failure_kind fk, const char *fmt, ...) {
va_list ap;
va_start(ap, fmt);
- ctx->failure_kind = fk;
vsnprintf(ctx->error_message, ERROR_BUF_LEN, fmt, ap);
- longjmp(ctx->jmp_buf, 1);
+ longjmp(ctx->jmp_buf, fk);
}
char *lw_error_message(lw_context ctx) {
@@ -116,6 +112,15 @@ char *lw_get_input(lw_context ctx, int n) {
return ctx->inputs[n];
}
+char *lw_get_optional_input(lw_context ctx, int n) {
+ if (n < 0)
+ lw_error(ctx, FATAL, "Negative input index %d", n);
+ if (n >= lw_inputs_len)
+ lw_error(ctx, FATAL, "Out-of-bounds input index %d", n);
+ printf("[%d] = %s\n", n, ctx->inputs[n]);
+ return (ctx->inputs[n] == NULL ? "" : ctx->inputs[n]);
+}
+
static void lw_check_heap(lw_context ctx, size_t extra) {
if (ctx->heap_back - ctx->heap_front < extra) {
size_t desired = ctx->heap_back - ctx->heap_front + extra, next;
diff --git a/src/cjr_print.sml b/src/cjr_print.sml
index 749f56ab..2189a436 100644
--- a/src/cjr_print.sml
+++ b/src/cjr_print.sml
@@ -893,8 +893,14 @@ fun p_file env (ds, ps) =
val n = case SM.find (fnums, x) of
NONE => raise Fail "CjrPrint: Can't find in fnums"
| SOME n => n
+
+ val f = case t of
+ (TFfi ("Basis", "bool"), _) => "optional_"
+ | _ => ""
in
- box [string "request = lw_get_input(ctx, ",
+ box [string "request = lw_get_",
+ string f,
+ string "input(ctx, ",
string (Int.toString n),
string ");",
newline,
diff --git a/src/lacweb.grm b/src/lacweb.grm
index cc68d380..3c3b87d5 100644
--- a/src/lacweb.grm
+++ b/src/lacweb.grm
@@ -51,7 +51,7 @@ fun uppercaseFirst "" = ""
| FN | PLUSPLUS | MINUSMINUS | DOLLAR | TWIDDLE
| STRUCTURE | SIGNATURE | STRUCT | SIG | END | FUNCTOR | WHERE | EXTERN
| INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT
- | CASE
+ | CASE | IF | THEN | ELSE
| XML_BEGIN of string | XML_END
| NOTAGS of string
@@ -318,6 +318,12 @@ eexp : eapps (eapps)
| LPAREN eexp RPAREN DCOLON cexp (EAnnot (eexp, cexp), s (LPARENleft, cexpright))
| eexp MINUSMINUS cexp (ECut (eexp, cexp), s (eexpleft, cexpright))
| CASE eexp OF barOpt branch branchs (ECase (eexp, branch :: branchs), s (CASEleft, branchsright))
+ | IF eexp THEN eexp ELSE eexp (let
+ val loc = s (IFleft, eexp3right)
+ in
+ (ECase (eexp1, [((PCon (["Basis"], "True", NONE), loc), eexp2),
+ ((PCon (["Basis"], "False", NONE), loc), eexp3)]), loc)
+ end)
eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright))
diff --git a/src/lacweb.lex b/src/lacweb.lex
index b62edcc6..45c9410c 100644
--- a/src/lacweb.lex
+++ b/src/lacweb.lex
@@ -261,6 +261,9 @@ notags = [^<{\n]+;
<INITIAL> "fn" => (Tokens.FN (pos yypos, pos yypos + size yytext));
<INITIAL> "fold" => (Tokens.FOLD (pos yypos, pos yypos + size yytext));
<INITIAL> "case" => (Tokens.CASE (pos yypos, pos yypos + size yytext));
+<INITIAL> "if" => (Tokens.IF (pos yypos, pos yypos + size yytext));
+<INITIAL> "then" => (Tokens.THEN (pos yypos, pos yypos + size yytext));
+<INITIAL> "else" => (Tokens.ELSE (pos yypos, pos yypos + size yytext));
<INITIAL> "structure" => (Tokens.STRUCTURE (pos yypos, pos yypos + size yytext));
<INITIAL> "signature" => (Tokens.SIGNATURE (pos yypos, pos yypos + size yytext));
diff --git a/src/monoize.sml b/src/monoize.sml
index f6e5be6e..4b45ff44 100644
--- a/src/monoize.sml
+++ b/src/monoize.sml
@@ -519,6 +519,8 @@ 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 ltextarea tag"))
+ | "checkbox" => input "checkbox"
+
| "radio" =>
(case targs of
[_, (L.CName name, _)] =>
diff --git a/tests/checkbox.lac b/tests/checkbox.lac
new file mode 100644
index 00000000..6d7ee34c
--- /dev/null
+++ b/tests/checkbox.lac
@@ -0,0 +1,10 @@
+val handler = fn x => <html><body>
+ {if x.A then cdata "Yes" else cdata "No"}
+</body></html>
+
+val main = fn () => <html><body>
+ <lform>
+ <checkbox{#A}/> How about it?<br/>
+ <submit action={handler}/>
+ </lform>
+</body></html>
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-02 19:56:13 +0000