Mercurial > urweb
comparison src/urweb.grm @ 1412:5f4fee8a4dcd
Allow CSS class specification for <form>
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Sun, 23 Jan 2011 11:18:24 -0500 |
parents | af501150678a |
children | 146b69c53304 |
comparison
equal
deleted
inserted
replaced
1411:38d950c06dce | 1412:5f4fee8a4dcd |
---|---|
309 | etuple of exp list | 309 | etuple of exp list |
310 | rexp of (con * exp) list | 310 | rexp of (con * exp) list |
311 | xml of exp | 311 | xml of exp |
312 | xmlOne of exp | 312 | xmlOne of exp |
313 | xmlOpt of exp | 313 | xmlOpt of exp |
314 | tag of (string * exp) * exp | 314 | tag of (string * exp) * exp option * exp |
315 | tagHead of string * exp | 315 | tagHead of string * exp |
316 | bind of string * con option * exp | 316 | bind of string * con option * exp |
317 | edecl of edecl | 317 | edecl of edecl |
318 | edecls of edecl list | 318 | edecls of edecl list |
319 | 319 |
1381 | 1381 |
1382 val cdata = (EApp (cdata, | 1382 val cdata = (EApp (cdata, |
1383 (EPrim (Prim.String ""), pos)), | 1383 (EPrim (Prim.String ""), pos)), |
1384 pos) | 1384 pos) |
1385 in | 1385 in |
1386 (EApp (#2 tag, cdata), pos) | 1386 (EApp (#3 tag, cdata), pos) |
1387 end) | 1387 end) |
1388 | 1388 |
1389 | tag GT xmlOpt END_TAG (let | 1389 | tag GT xmlOpt END_TAG (let |
1390 val pos = s (tagleft, GTright) | 1390 val pos = s (tagleft, GTright) |
1391 val et = tagIn END_TAG | 1391 val et = tagIn END_TAG |
1392 in | 1392 in |
1393 if #1 (#1 tag) = et then | 1393 if #1 (#1 tag) = et then |
1394 if et = "form" then | 1394 if et = "form" then |
1395 (EApp ((EVar (["Basis"], "form", Infer), pos), | 1395 let |
1396 xmlOpt), pos) | 1396 val e = (EVar (["Basis"], "form", Infer), pos) |
1397 val e = (EApp (e, case #2 tag of | |
1398 NONE => (EVar (["Basis"], "None", Infer), pos) | |
1399 | SOME c => (EApp ((EVar (["Basis"], "Some", Infer), pos), c), pos)), pos) | |
1400 in | |
1401 (EApp (e, xmlOpt), pos) | |
1402 end | |
1397 else if et = "subform" orelse et = "subforms" then | 1403 else if et = "subform" orelse et = "subforms" then |
1398 (EApp (#2 (#1 tag), | 1404 (EApp (#2 (#1 tag), |
1399 xmlOpt), pos) | 1405 xmlOpt), pos) |
1400 else if et = "entry" then | 1406 else if et = "entry" then |
1401 (EApp ((EVar (["Basis"], "entry", Infer), pos), | 1407 (EApp ((EVar (["Basis"], "entry", Infer), pos), |
1402 xmlOpt), pos) | 1408 xmlOpt), pos) |
1403 else | 1409 else |
1404 (EApp (#2 tag, xmlOpt), pos) | 1410 (EApp (#3 tag, xmlOpt), pos) |
1405 else | 1411 else |
1406 (if ErrorMsg.anyErrors () then | 1412 (if ErrorMsg.anyErrors () then |
1407 () | 1413 () |
1408 else | 1414 else |
1409 ErrorMsg.errorAt pos ("Begin tag <" | 1415 ErrorMsg.errorAt pos ("Begin tag <" |
1432 val e = (EApp (e, eo), pos) | 1438 val e = (EApp (e, eo), pos) |
1433 val e = (EApp (e, (ERecord (#2 attrs), pos)), pos) | 1439 val e = (EApp (e, (ERecord (#2 attrs), pos)), pos) |
1434 val e = (EApp (e, (EApp (#2 tagHead, | 1440 val e = (EApp (e, (EApp (#2 tagHead, |
1435 (ERecord [], pos)), pos)), pos) | 1441 (ERecord [], pos)), pos)), pos) |
1436 in | 1442 in |
1437 (tagHead, e) | 1443 (tagHead, #1 attrs, e) |
1438 end) | 1444 end) |
1439 | 1445 |
1440 tagHead: BEGIN_TAG (let | 1446 tagHead: BEGIN_TAG (let |
1441 val bt = tagIn BEGIN_TAG | 1447 val bt = tagIn BEGIN_TAG |
1442 val pos = s (BEGIN_TAGleft, BEGIN_TAGright) | 1448 val pos = s (BEGIN_TAGleft, BEGIN_TAGright) |