[r2003-06-13 17:03:43 by cvscast] Rewrote Value.iter_xml -- Alain

Original author: cvscast
Date: 2003-06-13 17:03:43+00:00

misc/encodings.ml

@@ -158,4 +158,24 @@ struct
 
   let get_substr s i j =
     String.sub s i (j - i)
+
+  let mk_char p =
+    if p <= 127 then 
+      String.make 1 (Char.chr p)
+    else if p <= 0x7ff then
+      let s = String.make 2 (Char.chr (0xc0 lor (p lsr 6))) in
+      s.[1] <- Char.chr (0x80 lor (p land 0x3f));
+      s
+    else if p <= 0xffff then
+      let s = String.make 3 (Char.chr (0xe0 lor (p lsr 12))) in
+      s.[1] <- Char.chr (0x80 lor ((p lsr 6) land 0x3f));
+      s.[2] <- Char.chr (0x80 lor (p land 0x3f));
+      s
+    else
+      let s = String.make 4 (Char.chr (0xf0 lor (p lsr 18))) in
+      s.[1] <- Char.chr (0x80 lor ((p lsr 12) land 0x3f));
+      s.[2] <- Char.chr (0x80 lor ((p lsr 6)  land 0x3f));
+      s.[3] <- Char.chr (0x80 lor (p land 0x3f));
+      s
+
 end

misc/encodings.mli

@@ -18,6 +18,7 @@ sig
   val equal_index: uindex -> uindex -> bool
   val mk: string -> t
   val mk_latin1: string -> t
+  val mk_char: int -> t
   val mk_idx: int -> uindex
   val get_str: t -> string
   val get_idx: uindex -> int

runtime/value.ml

@@ -288,21 +288,19 @@ let explode_rev s =
 let iter_xml pcdata_callback other_callback =
   let rec aux = function
     | v when compare v nil = 0 -> ()
-    | Pair ((Char c) as hd, tl) ->
-        pcdata_callback (U.mk (String.make 1 (Chars.to_char c)));
+    | Pair (Char c, tl) ->
+        pcdata_callback (U.mk_char (Chars.to_int c));
         aux tl
-    | Pair ((String_latin1 (i,j,s,_)) as hd, tl) ->
-        pcdata_callback (U.mk (String.sub s i j));
+    | String_latin1 (i,j,s,tl) ->
+        pcdata_callback (U.mk_latin1 (String.sub s i j));
         aux tl
-    | Pair ((String_utf8 (i,j,s,_)) as hd, tl) ->
+    | String_utf8 (i,j,s,tl) ->
         pcdata_callback (U.mk (U.get_substr s i j));
         aux tl
     | Pair (hd, tl) ->
         other_callback hd;
         aux tl
-    | String_latin1 (i,j,s,_) -> pcdata_callback (U.mk (String.sub s i j))
-    | String_utf8 (i,j,s,_) -> pcdata_callback (U.mk (U.get_substr s i j))
-    | v -> other_callback v
+    | v -> raise (Invalid_argument "Value.iter_xml")
   in
   function
     | Xml (_,_,cont) -> aux cont