| Ink of attr
| H of attr * ('expr box) list
| V of attr * ('expr box) list
+ | HV of attr * ('expr box) list
+ | HOV of attr * ('expr box) list
| Object of attr * 'expr
| Action of attr * ('expr box) list
(* BoxML prefix *)
let prefix = "b";;
+
+let tag_of_box = function
+ | H _ -> "h"
+ | V _ -> "v"
+ | HV _ -> "hv"
+ | HOV _ -> "hov"
+ | _ -> assert false
let box2xml ~obj2xml box =
let rec aux =
Text (attr,s) -> X.xml_nempty ~prefix "text" attr (X.xml_cdata s)
| Space attr -> X.xml_empty ~prefix "space" attr
| Ink attr -> X.xml_empty ~prefix "ink" attr
- | H (attr,l) ->
- X.xml_nempty ~prefix "h" attr
- [< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>])
- >]
- | V (attr,l) ->
- X.xml_nempty ~prefix "v" attr
+ | H (attr,l)
+ | V (attr,l)
+ | HV (attr,l)
+ | HOV (attr,l) as box ->
+ X.xml_nempty ~prefix (tag_of_box box) attr
[< (List.fold_right (fun x i -> [< (aux x) ; i >]) l [<>])
>]
| Object (attr,m) ->
| (Ink _) as box -> box
| H (attr, l) -> H (attr, List.map (map f) l)
| V (attr, l) -> V (attr, List.map (map f) l)
+ | HV (attr, l) -> HV (attr, List.map (map f) l)
+ | HOV (attr, l) -> HOV (attr, List.map (map f) l)
| Action (attr, l) -> Action (attr, List.map (map f) l)
| Object (attr, obj) -> Object (attr, f obj)
;;