Mercurial > urweb
comparison src/urweb.grm @ 1840:146ec8e90063
Add some name-mangling rules to allow XML attribute 'name' and attributes with dashes
author | Adam Chlipala <adam@chlipala.net> |
---|---|
date | Thu, 27 Dec 2012 15:34:11 -0500 |
parents | be0c4e2e488a |
children | 1aa9629e3a4c |
comparison
equal
deleted
inserted
replaced
1839:d8c260bcc1f9 | 1840:146ec8e90063 |
---|---|
32 val s = ErrorMsg.spanOf | 32 val s = ErrorMsg.spanOf |
33 val dummy = ErrorMsg.dummySpan | 33 val dummy = ErrorMsg.dummySpan |
34 | 34 |
35 fun capitalize "" = "" | 35 fun capitalize "" = "" |
36 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE) | 36 | capitalize s = str (Char.toUpper (String.sub (s, 0))) ^ String.extract (s, 1, NONE) |
37 | |
38 fun makeAttr s = | |
39 case s of | |
40 "type" => "Typ" | |
41 | "name" => "Nam" | |
42 | _ => capitalize (String.translate (fn ch => if ch = #"-" then "_" else str ch) s) | |
37 | 43 |
38 fun entable t = | 44 fun entable t = |
39 case #1 t of | 45 case #1 t of |
40 TRecord c => c | 46 TRecord c => c |
41 | _ => t | 47 | _ => t |
1646 | "dynClass" => DynClass attrv | 1652 | "dynClass" => DynClass attrv |
1647 | "style" => Style attrv | 1653 | "style" => Style attrv |
1648 | "dynStyle" => DynStyle attrv | 1654 | "dynStyle" => DynStyle attrv |
1649 | _ => | 1655 | _ => |
1650 let | 1656 let |
1651 val sym = | 1657 val sym = makeAttr SYMBOL |
1652 case SYMBOL of | |
1653 "type" => "Typ" | |
1654 | x => capitalize x | |
1655 in | 1658 in |
1656 Normal ((CName sym, s (SYMBOLleft, SYMBOLright)), | 1659 Normal ((CName sym, s (SYMBOLleft, SYMBOLright)), |
1657 if (sym = "Href" orelse sym = "Src") | 1660 if (sym = "Href" orelse sym = "Src") |
1658 andalso (case #1 attrv of | 1661 andalso (case #1 attrv of |
1659 EPrim _ => true | 1662 EPrim _ => true |