diff options
author | Adam Chlipala <adamc@hcoop.net> | 2008-10-14 16:37:43 -0400 |
---|---|---|
committer | Adam Chlipala <adamc@hcoop.net> | 2008-10-14 16:37:43 -0400 |
commit | 98c7a9c7a897d8a5f7a483aa15bf211c9769dad4 (patch) | |
tree | 106aa4e31f132174d78e175a25e5e3851a24c049 /src/urweb.grm | |
parent | cf62ed3325e024601d3d04d638b6a0aa383310ae (diff) |
Syntax highlighting for embedded XML
Diffstat (limited to 'src/urweb.grm')
-rw-r--r-- | src/urweb.grm | 37 |
1 files changed, 32 insertions, 5 deletions
diff --git a/src/urweb.grm b/src/urweb.grm index 1879b241..8d5f8bb7 100644 --- a/src/urweb.grm +++ b/src/urweb.grm @@ -193,7 +193,7 @@ fun tagIn bt = | INCLUDE | OPEN | CONSTRAINT | CONSTRAINTS | EXPORT | TABLE | SEQUENCE | CASE | IF | THEN | ELSE - | XML_BEGIN of string | XML_END + | XML_BEGIN of string | XML_END | XML_BEGIN_END of string | NOTAGS of string | BEGIN_TAG of string | END_TAG of string @@ -801,10 +801,37 @@ eterm : LPAREN eexp RPAREN (#1 eexp, s (LPARENleft, RPARENright)) end) | FOLD (EFold, s (FOLDleft, FOLDright)) - | XML_BEGIN xml XML_END (xml) - | XML_BEGIN XML_END (EApp ((EVar (["Basis"], "cdata"), s (XML_BEGINleft, XML_ENDright)), - (EPrim (Prim.String ""), s (XML_BEGINleft, XML_ENDright))), - s (XML_BEGINleft, XML_ENDright)) + | XML_BEGIN xml XML_END (let + val loc = s (XML_BEGINleft, XML_ENDright) + in + if XML_BEGIN = "xml" then + () + else + ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\"."; + xml + end) + | XML_BEGIN XML_END (let + val loc = s (XML_BEGINleft, XML_ENDright) + in + if XML_BEGIN = "xml" then + () + else + ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\"."; + (EApp ((EVar (["Basis"], "cdata"), loc), + (EPrim (Prim.String ""), loc)), + loc) + end) + | XML_BEGIN_END (let + val loc = s (XML_BEGIN_ENDleft, XML_BEGIN_ENDright) + in + if XML_BEGIN_END = "xml" then + () + else + ErrorMsg.errorAt loc "Initial XML tag pair aren't both tagged \"xml\"."; + (EApp ((EVar (["Basis"], "cdata"), loc), + (EPrim (Prim.String ""), loc)), + loc) + end) | LPAREN query RPAREN (query) | LPAREN CWHERE sqlexp RPAREN (sqlexp) |