Commit 1bc89a55 authored by gerd's avatar gerd

New ~minimization option for the

[write] and [display] methods (user wish).

Fix: [Pxp_document.liquefy] terminates now when invoked
only on a subtree of a document

Cleaned up the code a bit so fewer warnings are emitted in the build.



git-svn-id: https://godirepo.camlcity.org/svn/lib-pxp/trunk@719 dbe99aee-44db-0310-b2b3-d33182c8eb97
parent c09a3eaf
......@@ -50,6 +50,13 @@ for PXP; if you are looking for the stable distribution, please go
<sect1>
<title>Version History</title>
<ul>
<li><p><em>SVN:</em> New ~minimization option for the
[write] and [display] methods (user wish).</p>
<p>Fix: [Pxp_document.liquefy] terminates now when invoked
only on a subtree of a document</p>
<p>Cleaned up the code a bit so fewer warnings are emitted
in the build.</p>
</li>
<li><p><em>1.1.96:</em> Works now for O'Caml 3.09, too.</p>
<p>Fix: The "root element check" is disabled
......
......@@ -238,7 +238,7 @@ class virtual core_parser
let mapping = ref [] in
List.iter
(fun (srcprefix, uri) ->
let normprefix =
let _normprefix =
mng # lookup_or_add_namespace srcprefix uri in
mapping := (srcprefix, uri) :: !mapping;
)
......@@ -947,11 +947,11 @@ declaration():
{{ () }}
| attlistdecl()
{{ () }}
| entid:Decl_entity ws:Ignore Ignore* e:entitydecl(entid)
| entid:Decl_entity ws:Ignore Ignore* _e:entitydecl(entid)
{{ () }}
? {{ match !yy_position with
"ws" -> raise(WF_error("Whitespace is missing after ENTITY"))
| "e" -> raise(WF_error("Name or `%' expected"))
| "_e" -> raise(WF_error("Name or `%' expected"))
| _ -> raise(WF_error("Bad entity declaration"))
}}
| notationdecl()
......@@ -991,7 +991,7 @@ declaration():
raise(WF_error("Restriction of the internal subset: Conditional sections not allowed"));
}}
Ignore*
cond:conditional_section() end_entid:Conditional_end
_cond:conditional_section() end_entid:Conditional_end
{{ (* Check whether Conditional_begin and Conditional_end are in the same
* entity. (This restriction is explained in the file SPECS.)
*)
......@@ -1000,7 +1000,7 @@ declaration():
}}
? {{ match !yy_position with
"end_entid" -> raise(WF_error("`>]>' expected"))
| "cond" -> raise(WF_error("INCLUDE or IGNORE expected"))
| "_cond" -> raise(WF_error("INCLUDE or IGNORE expected"))
| _ -> raise(WF_error("Bad conditional section"))
}}
......@@ -1023,7 +1023,7 @@ conditional_section():
}}
[ parsing_function ] ()
{{ () }}
? {{ raise(WF_error("Bad conditional section")) }}
? {{ ignore(!yy_position); raise(WF_error("Bad conditional section")) }}
included_section():
Conditional_body declaration()*
......@@ -1372,13 +1372,13 @@ atttype():
name: name_or_nametoken()
Ignore*
names: nmtoken_factor()*
rp: Rparen
_rp: Rparen
/* Enumeration */
{{ A_enum(name :: names) }}
? {{ match !yy_position with
"name" -> raise(WF_error("Name expected"))
| "names" -> raise(WF_error("`|' and more names expected, or `)'"))
| "rp" -> raise(WF_error("`|' and more names expected, or `)'"))
| "_rp" -> raise(WF_error("`|' and more names expected, or `)'"))
| _ -> raise(WF_error("Bad enumeration type"))
}}
......@@ -1393,18 +1393,18 @@ never():
notation():
Ignore Ignore*
lp: Lparen
_lp: Lparen
Ignore*
name: Name
Ignore*
names: notation_factor()*
rp: Rparen
_rp: Rparen
{{ A_notation(name :: names) }}
? {{ match !yy_position with
"lp" -> raise(WF_error("`(' expected"))
"_lp" -> raise(WF_error("`(' expected"))
| "name" -> raise(WF_error("Name expected"))
| "names" -> raise(WF_error("`|' and more names expected, or `)'"))
| "rp" -> raise(WF_error("`|' and more names expected, or `)'"))
| "_rp" -> raise(WF_error("`|' and more names expected, or `)'"))
| _ -> raise(WF_error("Bad NOTATION type"))
}}
......@@ -1843,7 +1843,7 @@ start_tag():
let attlist = ref [] in
let attspace = ref true in
}}
ws: Ignore? Ignore*
_ws: Ignore? Ignore*
attribute(attlist,attspace)*
emptiness: start_tag_rangle()
/* Note: it is guaranteed that there is whitespace between Tag_beg and
......
......@@ -132,8 +132,11 @@ class type [ 'ext ] node =
method validate : unit -> unit
method write : ?prefixes:string list ->
?default:string ->
?minimization:[`AllEmpty | `DeclaredEmpty | `None] ->
output_stream -> encoding -> unit
method display : ?prefixes:(string StringMap.t) -> output_stream -> encoding -> unit
method display : ?prefixes:(string StringMap.t) ->
?minimization:[`AllEmpty | `DeclaredEmpty | `None] ->
output_stream -> encoding -> unit
method internal_adopt : 'ext node option -> int -> unit
method internal_set_pos : int -> unit
method internal_delete : 'ext node -> unit
......@@ -197,7 +200,7 @@ let make_spec_from_alist
(fun (name,ex) -> Hashtbl.add pinstr_mapping name ex)
pinstr_alist;
let n = List.length element_alist in
let element_mapping = Hashtbl.create m in
let element_mapping = Hashtbl.create n in
List.iter
(fun (name,ex) -> Hashtbl.add element_mapping name ex)
element_alist;
......@@ -266,6 +269,8 @@ object (self)
val mutable node_position = -1
val mutable dtd = (None : dtd option)
method virtual remove : unit -> unit
method delete = self # remove()
(* Not every class defines [remove]! *)
......@@ -630,11 +635,11 @@ class ['ext] data_impl an_ext : ['ext] node =
method set_data str =
content <- str
method write ?(prefixes = ([]: string list)) ?default os enc =
method write ?(prefixes = ([]: string list)) ?default ?minimization os enc =
let encoding = self # encoding in
write_data_string ~from_enc:encoding ~to_enc:enc os content
method display ?prefixes os enc =
method display ?prefixes ?minimization os enc =
let encoding = self # encoding in
write_data_string ~from_enc:encoding ~to_enc:enc os content
......@@ -783,8 +788,8 @@ class ['ext] attribute_impl ~element ~name value init_dtd : ['ext] node =
method_na "create_element"
method create_data _ _ = method_na "create_data"
method create_other ?position _ _ = method_na "create_other"
method write ?prefixes ?default _ _ = method_na "write"
method display ?prefixes _ _ = method_na "display"
method write ?prefixes ?default ?minimization _ _ = method_na "write"
method display ?prefixes ?minimization _ _ = method_na "display"
end
;;
......@@ -839,7 +844,7 @@ class [ 'ext ] comment_impl an_ext : ['ext] node =
None -> raise Not_found
| Some s -> s
method write ?prefixes ?default os enc =
method write ?prefixes ?default ?minimization os enc =
let encoding = self # encoding in
let wms =
write_markup_string ~from_enc:encoding ~to_enc:enc os in
......@@ -850,7 +855,7 @@ class [ 'ext ] comment_impl an_ext : ['ext] node =
);
wms ("-->");
method display ?prefixes os enc =
method display ?prefixes ?minimization os enc =
self # write os enc
method dump fmt =
......@@ -908,6 +913,8 @@ class virtual [ 'ext ] pinstr_features =
* in clone operations.
*)
method virtual encoding : rep_encoding
method add_pinstr pi =
if pi # encoding <> self # encoding then
failwith "Pxp_document.pinstr_features # add_pinstr: Inconsistent encodings";
......@@ -987,10 +994,10 @@ class [ 'ext ] pinstr_impl an_ext : ['ext] node =
[ pi ] -> pi # value
| _ -> assert false
method write ?prefixes ?default os enc =
method write ?prefixes ?default ?minimization os enc =
self # write_pinstr os enc
method display ?prefixes os enc =
method display ?prefixes ?minimization os enc =
self # write_pinstr os enc
method dump fmt =
......@@ -2500,7 +2507,7 @@ class [ 'ext ] element_impl an_ext (* : ['ext] element_node *) =
(* to be overridden *)
name
method write ?(prefixes = ([] : string list)) ?default os enc =
method write ?(prefixes = ([] : string list)) ?default ?(minimization=`None) os enc =
let encoding = self # encoding in
let wms =
write_markup_string ~from_enc:encoding ~to_enc:enc os in
......@@ -2544,25 +2551,45 @@ class [ 'ext ] element_impl an_ext (* : ['ext] element_node *) =
attlist_iter vr (write_att "") attributes;
List.iter (fun (n,v) -> write_att "xmlns:" n v) nsdecls;
List.iter (fun ( v) -> write_att "" "xmlns" v) nsdefault;
wms "\n>";
self # write_pinstr os enc;
let sub_nodes = self # sub_nodes in
let prefixes' = (List.map fst nsdecls) @ prefixes in
let prefixes'' =
if nsdefault <> [] then "" :: prefixes' else prefixes' in
(* Check for minimization: *)
let can_minimize =
(pinstr = StringMap.empty) && (sub_nodes = []) in
let do_minimize =
can_minimize &&
match minimization with
| `None -> false
| `AllEmpty -> true
| `DeclaredEmpty -> vr.content_model = Empty in
List.iter
(fun n -> n # write ?prefixes:(Some prefixes'') ?default os enc)
(self # sub_nodes);
if do_minimize then
wms "\n/>"
else (
wms "\n>";
wms ("</" ^ name' ^ "\n>");
self # write_pinstr os enc;
method display ?prefixes os enc =
let prefixes' = (List.map fst nsdecls) @ prefixes in
let prefixes'' =
if nsdefault <> [] then "" :: prefixes' else prefixes' in
List.iter
(fun n ->
n # write ?prefixes:(Some prefixes'') ?default
?minimization:(Some minimization) os enc
)
sub_nodes;
wms ("</" ^ name' ^ "\n>");
)
method display ?prefixes ?minimization os enc =
(* Overriden in namespace_element_impl, so this is only for the
* non-namespace case:
*)
self # write os enc
self # write ?minimization os enc
method internal_init_other new_pos new_dtd new_ntype =
method_na "internal_init_other"
......@@ -2634,22 +2661,16 @@ class [ 'ext ] super_root_impl an_ext : ['ext] node =
(List.rev rev_nodes);
Format.pp_close_box fmt ();
method write ?prefixes ?default os enc =
let encoding = self # encoding in
let wms =
write_markup_string ~from_enc:encoding ~to_enc:enc os in
method write ?prefixes ?default ?minimization os enc =
self # write_pinstr os enc;
List.iter
(fun n -> n # write ?prefixes ?default os enc)
(fun n -> n # write ?prefixes ?default ?minimization os enc)
(self # sub_nodes);
method display ?prefixes os enc =
let encoding = self # encoding in
let wms =
write_markup_string ~from_enc:encoding ~to_enc:enc os in
method display ?prefixes ?minimization os enc =
self # write_pinstr os enc;
List.iter
(fun n -> n # display ?prefixes os enc)
(fun n -> n # display ?prefixes ?minimization os enc)
(self # sub_nodes);
method create_element ?name_pool_for_attribute_values ?position
......@@ -2805,8 +2826,8 @@ class [ 'ext ] namespace_impl srcprefix normprefix init_dtd : ['ext] node =
method_na "create_element"
method create_data _ _ = method_na "create_data"
method create_other ?position _ _ = method_na "create_other"
method write ?prefixes ?default _ _ = method_na "write"
method display ?prefixes _ _ = method_na "display"
method write ?prefixes ?default ?minimization _ _ = method_na "write"
method display ?prefixes ?minimization _ _ = method_na "display"
method localname = method_na "localname"
method previous_node = method_na "previous_node"
method next_node = method_na "next_node"
......@@ -2973,7 +2994,7 @@ class [ 'ext ] namespace_element_impl an_ext =
value
dtd
method display ?(prefixes = StringMap.empty) os enc =
method display ?(prefixes = StringMap.empty) ?(minimization=`None) os enc =
let encoding = self # encoding in
let wms =
write_markup_string ~from_enc:encoding ~to_enc:enc os in
......@@ -3088,15 +3109,34 @@ class [ 'ext ] namespace_element_impl an_ext =
else
write_att "xmlns:" n (Value v))
(eff_decl_to_add @ !eff_decl_to_add');
wms "\n>";
let sub_nodes = self # sub_nodes in
(* Check for minimization: *)
let can_minimize =
(pinstr = StringMap.empty) && (sub_nodes = []) in
let do_minimize =
can_minimize &&
match minimization with
| `None -> false
| `AllEmpty -> true
| `DeclaredEmpty -> vr.content_model = Empty in
if do_minimize then
wms "\n/>"
else (
wms "\n>";
super # write_pinstr os enc;
super # write_pinstr os enc;
List.iter
(fun n -> n # display ?prefixes:(Some !prefixes') os enc)
(self # sub_nodes);
List.iter
(fun n ->
n # display ?prefixes:(Some !prefixes')
?minimization:(Some minimization) os enc)
sub_nodes;
wms ("</" ^ name ^ "\n>");
wms ("</" ^ name ^ "\n>")
)
end
;;
......@@ -3777,7 +3817,7 @@ class ['ext] document ?swarner the_warner enc =
if not (dtd_r # arbitrary_allowed) then begin
match dtd_r # root with
Some declared_root_element_name ->
let real_root_element =
let _real_root_element =
try
List.find
(fun r' ->
......@@ -3858,7 +3898,7 @@ class ['ext] document ?swarner the_warner enc =
None -> failwith "Pxp_document.document#raw_root_name: Document has no root element"
| Some _ -> raw_root_name
method write ?default ?(prefer_dtd_reference = false) os enc =
method write ?default ?(prefer_dtd_reference = false) ?minimization os enc =
let encoding = self # encoding in
let wms =
write_markup_string ~from_enc:encoding ~to_enc:enc os in
......@@ -3883,10 +3923,10 @@ class ['ext] document ?swarner the_warner enc =
end;
self # write_pinstr os enc;
r # write ?default os enc;
r # write ?default ?minimization os enc;
wms "\n";
method display ?(prefer_dtd_reference = false) os enc =
method display ?(prefer_dtd_reference = false) ?minimization os enc =
let encoding = self # encoding in
let wms =
write_markup_string ~from_enc:encoding ~to_enc:enc os in
......@@ -3911,7 +3951,7 @@ class ['ext] document ?swarner the_warner enc =
end;
self # write_pinstr os enc;
r # display os enc;
r # display ?minimization os enc;
wms "\n";
method dump fmt =
......@@ -4169,7 +4209,7 @@ let solidify ?dtd cfg spec next_ev : 'ext solid_xml =
if (!doc_state = Start_seen) ||
(!super_state = Start_seen) ||
(!root_state <> End_seen) then
unexpected "E_end_of_stream/actual end"
unexpected "E_end_of_stream/actual end";
pos := None;
eof := (ev = None)
done;
......@@ -4192,7 +4232,8 @@ type 'ext flux_state =
let liquefy_node ?(omit_end = false) ?(omit_positions = false)
(init_fstate : 'ext flux_state) =
(init_fstate : 'ext flux_state)
(init_node : 'ext node) =
let fstate = ref init_fstate in
let eid = Pxp_dtd.Entity.create_entity_id() in
let rec generate arg =
......@@ -4273,17 +4314,20 @@ let liquefy_node ?(omit_end = false) ?(omit_positions = false)
| `Node_end n ->
let fstate' =
( try
`Node_start(n # next_node)
with
Not_found ->
( try
`Node_end(n # parent)
with
Not_found ->
if omit_end then `None else `EOS
)
) in
if n = init_node then
( if omit_end then `None else `EOS)
else
( try
`Node_start(n # next_node)
with
Not_found ->
( try
`Node_end(n # parent)
with
Not_found ->
if omit_end then `None else `EOS
)
) in
fstate := fstate';
(* Do action for n: *)
( match n # node_type with
......@@ -4340,7 +4384,8 @@ let liquefy_doc ?(omit_end = false) ?(omit_positions = false)
let node_fstate =
`Output(out_pinstr, `Node_start(doc#root)) in
fstate := `Nodes
(liquefy_node ~omit_end:true ~omit_positions node_fstate);
(liquefy_node ~omit_end:true ~omit_positions
node_fstate doc#root);
Some(E_start_doc(doc#xml_version,doc#dtd))
| `Nodes g ->
let e = g arg in
......@@ -4364,6 +4409,6 @@ let liquefy_doc ?(omit_end = false) ?(omit_positions = false)
let liquefy ?omit_end ?omit_positions solid =
match solid with
`Node n -> liquefy_node ?omit_end ?omit_positions (`Node_start n)
`Node n -> liquefy_node ?omit_end ?omit_positions (`Node_start n) n
| `Document d -> liquefy_doc ?omit_end ?omit_positions d
;;
......@@ -1512,6 +1512,7 @@ class type [ 'ext ] node =
method write :
?prefixes:string list ->
?default:string ->
?minimization:[`AllEmpty | `DeclaredEmpty | `None] ->
Pxp_core_types.output_stream -> Pxp_core_types.encoding -> unit
(* <ID:type-node-write>
* <CALL> obj # [write] ~prefixes stream enc
......@@ -1533,6 +1534,12 @@ class type [ 'ext ] node =
*
* Option [~default]: Specifies the normprefix that becomes the
* default namespace in the output.
*
* Option [~minimization]: How to write out empty elements. [`AllEmpty]
* means that all empty elements are minimized (using the <name/>
* form). [`DeclaredEmpty] minimizes only empty elements that are
* declared as empty in the DTD. [`None] does not minimize at all
* and is the default.
* <DOMAIN> All regular node types (elements, data nodes, comments,
* processing instructions, super root nodes).
* </ID>
......@@ -1540,8 +1547,9 @@ class type [ 'ext ] node =
method display :
?prefixes:string StringMap.t ->
?minimization:[`AllEmpty | `DeclaredEmpty | `None] ->
Pxp_core_types.output_stream -> Pxp_core_types.encoding -> unit
(* <ID:type-node-write>
(* <ID:type-node-display>
* <CALL> obj # [display] ~prefixes stream enc
* <SIG> AUTO
* <DESCR> Write the contents of this node and the subtrees to the passed
......@@ -1560,6 +1568,12 @@ class type [ 'ext ] node =
* effect as pairs of [(prefix,uri)]. The option
* defaults to [] forcing the method to output all necessary prefix
* declarations.
*
* Option [~minimization]: How to write out empty elements. [`AllEmpty]
* means that all empty elements are minimized (using the <name/>
* form). [`DeclaredEmpty] minimizes only empty elements that are
* declared as empty in the DTD. [`None] does not minimize at all
* and is the default.
* <DOMAIN> All regular node types (elements, data nodes, comments,
* processing instructions, super root nodes).
* </ID>
......@@ -2527,6 +2541,7 @@ class [ 'ext ] document :
method write : ?default : string ->
?prefer_dtd_reference : bool ->
?minimization:[`AllEmpty | `DeclaredEmpty | `None] ->
Pxp_core_types.output_stream ->
Pxp_core_types.encoding ->
unit
......@@ -2544,10 +2559,17 @@ class [ 'ext ] document :
* the DTD cannot printed as reference, it is included as text.
* The default is not to try DTD references, i.e. to always include
* the DTD as text.
*
* Option [~minimization]: How to write out empty elements. [`AllEmpty]
* means that all empty elements are minimized (using the <name/>
* form). [`DeclaredEmpty] minimizes only empty elements that are
* declared as empty in the DTD. [`None] does not minimize at all
* and is the default.
*)
method display : ?prefer_dtd_reference : bool ->
?minimization:[`AllEmpty | `DeclaredEmpty | `None] ->
Pxp_core_types.output_stream ->
Pxp_core_types.encoding ->
unit
......@@ -2564,6 +2586,12 @@ class [ 'ext ] document :
* the DTD cannot printed as reference, it is included as text.
* The default is not to try DTD references, i.e. to always include
* the DTD as text.
*
* Option [~minimization]: How to write out empty elements. [`AllEmpty]
* means that all empty elements are minimized (using the <name/>
* form). [`DeclaredEmpty] minimizes only empty elements that are
* declared as empty in the DTD. [`None] does not minimize at all
* and is the default.
*)
method dump : Format.formatter -> unit
......
......@@ -666,7 +666,7 @@ class dtd ?swarner the_warner init_encoding =
try Str_hashtbl.find gen_entities name with Not_found -> assert false
in
if ent # is_ndata then begin
let xid = ent # ext_id in
let _xid = ent # ext_id in
let notation = ent # notation in
try
ignore(self # notation notation)
......
......@@ -500,7 +500,7 @@ class virtual entity the_dtd the_name the_swarner the_warner init_encoding =
cd
(* If there are CRLF sequences in a PI value, normalize them, too *)
| PI(name,value,_) as pi ->
| PI(name,value,_) ->
if v.normalize_newline then
PI(name,
normalize_line_separators v.lfactory value,
......
......@@ -242,7 +242,6 @@ let process_entity
(-1)
lit_root
in
let resolver = mgr # current_resolver in
let init_lexer =
match entry with
`Entry_document _ -> Document
......@@ -288,7 +287,6 @@ let process_expr
cfg mgr eh =
let lit_root = ref "" in
let pobj = new event_parser mgr#dtd cfg eh false (-1) lit_root in
let resolver = mgr # current_resolver in
let en = mgr # current_entity in
begin try
let context = make_context ?first_token mgr in
......@@ -343,7 +341,6 @@ let create_pull_parser
100 (* the number of loops until Interrupt_parsing *)
lit_root
in
let resolver = mgr # current_resolver in
let init_lexer =
match entry with
`Entry_document _ -> Document
......
......@@ -226,7 +226,7 @@ type dtd_style =
]
;;
let wr_dsp do_display default_prefix dtd_style out enc rep_enc get_ev =
let wr_dsp do_display default_prefix dtd_style minimization out enc rep_enc get_ev =
(* do_display: whether [display_events] was called, not [write_events].
* default_prefix: The (optional) default prefix (only [write_events])
*)
......@@ -245,7 +245,7 @@ let wr_dsp do_display default_prefix dtd_style out enc rep_enc get_ev =
* (literal tag name, map of declared prefixes => uris, declared default uri)
*)
let write_start_tag name atts scope_opt =
let write_start_tag name atts scope_opt minimized =
let (_, prefixes, default) =
try Stack.top write_stack
with Stack.Empty -> ("", StringMap.empty, None) in
......@@ -318,10 +318,15 @@ let wr_dsp do_display default_prefix dtd_style out enc rep_enc get_ev =
(* Non-namespace case: *)
Stack.push (name', prefixes, default) write_stack;
);
wms "\n>";
if minimized then (
wms "\n/>";
ignore(Stack.pop write_stack)
)
else
wms "\n>";
in
let display_start_tag name atts scope_opt =
let display_start_tag name atts scope_opt minimized =
let (_, prefixes, default) =
try Stack.top write_stack
with Stack.Empty -> ("", StringMap.empty, None) in
......@@ -430,17 +435,25 @@ let wr_dsp do_display default_prefix dtd_style out enc rep_enc get_ev =
else
write_att "xmlns:" (n,v))
(eff_decl_to_add @ !eff_decl_to_add');
wms "\n>";
Stack.push (name', !prefixes', default) write_stack;
if minimized then
wms "\n/>"
else (
wms "\n>";
Stack.push (name', !prefixes', default) write_stack;
)
| None ->
(* non-namespace case *)
(* Output start tag, and contained attributes: *)
wms ("<" ^ name);
List.iter (write_att "") atts;
wms "\n>";
Stack.push (name, prefixes, default) write_stack;
if minimized then
wms "\n/>"
else (
wms "\n>";
Stack.push (name, prefixes, default) write_stack;
)
in
let write_end_tag() =
......@@ -454,9 +467,13 @@ let wr_dsp do_display default_prefix dtd_style out enc rep_enc get_ev =
wms "\n>"
in
let wr_dsp_event =
function
| E_start_doc(version,dtd) ->
let rec wr_dsp_event ev_opt =
let ev =
match ev_opt with
| Some ev -> ev
| None -> get_ev() in
match ev with
| Some(E_start_doc(version,dtd)) ->
wms ("<?xml version=\"" ^ version ^ "\" ");
wms ("encoding=\"" ^ Netconversion.string_of_encoding enc ^ "\" ");
if dtd # standalone_declaration then
......@@ -473,41 +490,67 @@ let wr_dsp do_display default_prefix dtd_style out enc rep_enc get_ev =
| _ ->
failwith "Pxp_event.write/display: Cannot output DTD as reference"
)
)
| E_end_doc lit_name ->
()
| E_start_tag (name, atts, scope_opt, _) ->
);
wr_dsp_event None
| Some (E_end_doc lit_name) ->
wr_dsp_event None
| Some (E_start_tag (name, atts, scope_opt, _)) ->
let minimized, ev_opt =
match minimization with
| `None ->
(false, None)
| `AllEmpty ->
(* Peek at the next event: *)
let ev' = get_ev() in
let do_minimize =
match ev' with
| Some(E_end_tag (name', _)) ->
name = name'
| _ ->
false in
if do_minimize then
(true, None) (* ==> consume ev'! *)
else
(false, Some ev') in
if do_display then
display_start_tag name atts scope_opt
display_start_tag name atts scope_opt minimized
else
write_start_tag name atts scope_opt
| E_end_tag (_, _) ->
write_end_tag()
| E_char_data data ->
write_data_string ~from_enc:rep_enc ~to_enc:enc out data
| E_pinstr (target, value, ent_id) ->
write_start_tag name atts scope_opt minimized;
wr_dsp_event ev_opt
| Some (E_end_tag (_, _)) ->
write_end_tag();
wr_dsp_event None
| Some (E_char_data data) ->
write_data_string ~from_enc:rep_enc ~to_enc:enc out data;
wr_dsp_event None
| Some (E_pinstr (target, value, ent_id)) ->
wms "<? "; wms target; wms " "; wms value; wms "?>";
| E_pinstr_member (target, value, ent_id) ->
wr_dsp_event None
| Some (E_pinstr_member (target, value, ent_id)) ->
wms "<? "; wms target; wms " "; wms value; wms "?>";
| E_comment data ->
wr_dsp_event None
| Some (E_comment data) ->
wms "<!--"; wms data; wms "-->";
| E_start_super ->
()
| E_end_super ->
()