Mercurial > urweb
changeset 190:3eb53c957d10
Checkboxes
| author | Adam Chlipala <adamc@hcoop.net> |
|---|---|
| date | Thu, 07 Aug 2008 13:09:26 -0400 |
| parents | 20bf7487c370 |
| children | aa54250f58ac |
| files | include/lacweb.h lib/basis.lig src/c/lacweb.c src/cjr_print.sml src/lacweb.grm src/lacweb.lex src/monoize.sml tests/checkbox.lac |
| diffstat | 8 files changed, 46 insertions(+), 11 deletions(-) [+] |
line wrap: on
line diff
--- a/include/lacweb.h Sun Aug 03 19:52:37 2008 -0400 +++ b/include/lacweb.h Thu Aug 07 13:09:26 2008 -0400 @@ -21,6 +21,7 @@ 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*);
--- a/lib/basis.lig Sun Aug 03 19:52:37 2008 -0400 +++ b/lib/basis.lig Thu Aug 07 13:09:26 2008 -0400 @@ -71,6 +71,8 @@ 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 [] [] []
--- a/src/c/lacweb.c Sun Aug 03 19:52:37 2008 -0400 +++ b/src/c/lacweb.c Thu Aug 07 13:09:26 2008 -0400 @@ -18,7 +18,6 @@ jmp_buf jmp_buf; - failure_kind failure_kind; char error_message[ERROR_BUF_LEN]; }; @@ -35,7 +34,6 @@ ctx->inputs = calloc(lw_inputs_len, sizeof(char *)); - ctx->failure_kind = SUCCESS; ctx->error_message[0] = 0; return ctx; @@ -52,15 +50,12 @@ 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_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 @@ 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;
--- a/src/cjr_print.sml Sun Aug 03 19:52:37 2008 -0400 +++ b/src/cjr_print.sml Thu Aug 07 13:09:26 2008 -0400 @@ -893,8 +893,14 @@ 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,
--- a/src/lacweb.grm Sun Aug 03 19:52:37 2008 -0400 +++ b/src/lacweb.grm Thu Aug 07 13:09:26 2008 -0400 @@ -51,7 +51,7 @@ | 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 @@ | 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))
--- a/src/lacweb.lex Sun Aug 03 19:52:37 2008 -0400 +++ b/src/lacweb.lex Thu Aug 07 13:09:26 2008 -0400 @@ -261,6 +261,9 @@ <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));
--- a/src/monoize.sml Sun Aug 03 19:52:37 2008 -0400 +++ b/src/monoize.sml Thu Aug 07 13:09:26 2008 -0400 @@ -519,6 +519,8 @@ | _ => (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, _)] =>
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/checkbox.lac Thu Aug 07 13:09:26 2008 -0400 @@ -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>