From 954936dd180e34b79baca71e43d55a204dda9594 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 5 Nov 2011 15:05:13 -0400 Subject: Support the full set of XHTML character entities --- src/urweb.lex | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) (limited to 'src/urweb.lex') diff --git a/src/urweb.lex b/src/urweb.lex index 19f28738..a989d933 100644 --- a/src/urweb.lex +++ b/src/urweb.lex @@ -113,6 +113,14 @@ fun initialize () = (xmlTag := []; xmlString := false) +structure StringMap = BinaryMapFn(struct + type ord_key = string + val compare = String.compare + end) + +val entities = foldl (fn ((key, value), entities) => StringMap.insert (entities, key, value)) + StringMap.empty Entities.all + fun unescape loc s = let fun process (s, acc) = @@ -141,20 +149,16 @@ fun unescape loc s = let val code = Substring.string (Substring.slice (code, 1, NONE)) in - Option.map chr (Int.fromString code) + Option.map Utf8.encode (Int.fromString code) end - else case Substring.string code of - "amp" => SOME #"&" - | "lt" => SOME #"<" - | "gt" => SOME #">" - | "quot" => SOME #"\"" - | _ => NONE + else + Option.map Utf8.encode (StringMap.find (entities, Substring.string code)) in case special of NONE => (ErrorMsg.errorAt' loc ("Unsupported XML character entity " ^ Substring.string code); "") - | SOME ch => process (s, Substring.full (String.str ch) :: pre :: acc) + | SOME sp => process (s, Substring.full sp :: pre :: acc) end end end -- cgit v1.2.3