# HG changeset patch
# User Adam Chlipala <adamc@hcoop.net>
# Date 1218128966 14400
# Node ID 3eb53c957d102bbff41ea320793b13f6a863f926
# Parent  20bf7487c370249a91a8e8cbf8b90f8e40047eae
Checkboxes

diff -r 20bf7487c370 -r 3eb53c957d10 include/lacweb.h
--- 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*);
 
diff -r 20bf7487c370 -r 3eb53c957d10 lib/basis.lig
--- 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 [] [] []
diff -r 20bf7487c370 -r 3eb53c957d10 src/c/lacweb.c
--- 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;
diff -r 20bf7487c370 -r 3eb53c957d10 src/cjr_print.sml
--- 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,
diff -r 20bf7487c370 -r 3eb53c957d10 src/lacweb.grm
--- 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))
 
diff -r 20bf7487c370 -r 3eb53c957d10 src/lacweb.lex
--- 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));
diff -r 20bf7487c370 -r 3eb53c957d10 src/monoize.sml
--- 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, _)] =>
diff -r 20bf7487c370 -r 3eb53c957d10 tests/checkbox.lac
--- /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>