Commit fd94bd59 authored by gerd's avatar gerd

Adding [dtd_style] option for document-level [write] and [display].


git-svn-id: https://godirepo.camlcity.org/svn/lib-pxp/trunk@720 dbe99aee-44db-0310-b2b3-d33182c8eb97
parent 1bc89a55
......@@ -52,6 +52,8 @@ for PXP; if you are looking for the stable distribution, please go
<ul>
<li><p><em>SVN:</em> New ~minimization option for the
[write] and [display] methods (user wish).</p>
<p>Improvement: better control what is printed as DTD for
document#write and #display</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
......
......@@ -3874,6 +3874,32 @@ class ['ext] document ?swarner the_warner enc =
| _ ->
failwith "Pxp_document.document#init_root: the root node must be an element or super-root"
method private top_element =
(* Top-most element node *)
match root with
| None ->
failwith "Pxp_document.document: No top-level element found"
| Some r ->
( match r # node_type with
| T_super_root ->
( try
List.find
(fun r' ->
match r' # node_type with
| T_element _ -> true
| _ -> false)
(r # sub_nodes)
with
Not_found ->
failwith "Pxp_document.document: No top-level element found"
)
| T_element _ ->
r
| _ ->
failwith "Pxp_document.document: No top-level element found"
)
method xml_version = xml_version
method xml_standalone =
......@@ -3898,7 +3924,11 @@ 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) ?minimization os enc =
method write ?default ?(prefer_dtd_reference = false)
?(dtd_style=`Included) ?minimization os enc =
let (dtd_style : [`Omit|`Reference|`Included|`Auto]) =
if prefer_dtd_reference then `Reference else dtd_style in
let encoding = self # encoding in
let wms =
write_markup_string ~from_enc:encoding ~to_enc:enc os in
......@@ -3911,26 +3941,82 @@ class ['ext] document ?swarner the_warner enc =
begin match dtd with
None -> ()
| Some d ->
if prefer_dtd_reference &&
( match d # id with
Some (External _) -> true
| _ -> false
)
then
d # write_ref os enc
else
d # write os enc true;
let have_dtd_root =
d # root <> None in
let eff_dtd_style =
match dtd_style with
| `Omit ->
`Omit
| `Reference ->
( match d # id with
| Some (External _) -> `Reference
| _ -> `Included
)
| `Included ->
`Included
| `Auto ->
if have_dtd_root then
match d # id with
| Some (External _) -> `Reference
| _ -> `Included
else
`Omit in
let root_to_write = lazy (
match d # root with
| None ->
(* No DTD root: Look at the tree, and find out what
will be printed for the topmost element
*)
let e = self # top_element in
( match e # node_type with
| T_element name ->
( match default with
| None ->
name
| Some defns ->
(* our best effort... *)
let prefix, localname =
namespace_split name in
if prefix = defns then
localname
else
name
)
| _ -> assert false
)
| Some r ->
(* If there is a DTD root, always write this *)
r
) in
( match eff_dtd_style with
| `Omit ->
()
| `Reference ->
let root = Lazy.force root_to_write in
d # write_ref ~root os enc
| `Included ->
let root = Lazy.force root_to_write in
d # write ~root os enc true
)
end;
self # write_pinstr os enc;
r # write ?default ?minimization os enc;
wms "\n";
method display ?(prefer_dtd_reference = false) ?minimization os enc =
method display ?(prefer_dtd_reference = false) ?(dtd_style=`Included)
?minimization os enc =
let encoding = self # encoding in
let wms =
write_markup_string ~from_enc:encoding ~to_enc:enc os in
let (dtd_style : [`Omit|`Reference|`Included|`Auto]) =
if prefer_dtd_reference then `Reference else dtd_style in
let r = self # root in
wms ("<?xml version='1.0' encoding='" ^
Netconversion.string_of_encoding enc ^
......@@ -3939,15 +4025,68 @@ class ['ext] document ?swarner the_warner enc =
begin match dtd with
None -> ()
| Some d ->
if prefer_dtd_reference &&
( match d # id with
Some (External _) -> true
| _ -> false
)
then
d # write_ref os enc
else
d # write os enc true;
let have_dtd_root =
d # root <> None in
let eff_dtd_style =
match dtd_style with
| `Omit ->
`Omit
| `Reference ->
( match d # id with
| Some (External _) -> `Reference
| _ -> `Included
)
| `Included ->
`Included
| `Auto ->
if have_dtd_root then
match d # id with
| Some (External _) -> `Reference
| _ -> `Included
else
`Omit in
let root_to_write = lazy (
match d # root with
| None ->
(* No DTD root: Look at the tree, and find out what
will be printed for the topmost element
*)
let e = self # top_element in
( match e # node_type with
| T_element name ->
( try
let pr = e # display_prefix in
(* If now a Namespace_not_in_scope is
raised, we cannot do anything!
*)
if pr = "" then
e # localname
else
pr ^ ":" ^ e # localname
with
| Namespace_method_not_applicable _ ->
name
)
| _ -> assert false
)
| Some r ->
(* If there is a DTD root, always write this *)
r
) in
( match eff_dtd_style with
| `Omit ->
()
| `Reference ->
let root = Lazy.force root_to_write in
d # write_ref ~root os enc
| `Included ->
let root = Lazy.force root_to_write in
d # write ~root os enc true
)
end;
self # write_pinstr os enc;
......
......@@ -2541,6 +2541,7 @@ class [ 'ext ] document :
method write : ?default : string ->
?prefer_dtd_reference : bool ->
?dtd_style:[`Omit|`Reference|`Included|`Auto] ->
?minimization:[`AllEmpty | `DeclaredEmpty | `None] ->
Pxp_core_types.output_stream ->
Pxp_core_types.encoding ->
......@@ -2548,17 +2549,22 @@ class [ 'ext ] document :
(* Write the document to the passed
* output stream; the passed encoding used. The format
* is compact (the opposite of "pretty printing").
* If a DTD is present, the DTD is included into the internal subset.
* If a DTD is present, the DTD is included as internal subset.
*
* Option [~default]: Specifies the normprefix that becomes the
* default namespace in the output.
*
* Option [~prefer_dtd_reference]: If true, it is tried to print
* the DTD as reference, i.e. with SYSTEM or PUBLIC identifier.
* This works only if the DTD has an [External] identifier. If
* 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 [~dtd_style]: Selects how to print the DTD. [`Omit] means
* to omit the DTD at all (no DOCTYPE clause).
* [`Reference] prints the DTD reference to an
* external entity (using SYSTEM or PUBLIC identifier), if possible,
* and falls back to [`Included] otherwise. [`Included] means to
* always include the DTD as internal subset. [`Auto] tries to find
* the best way: If there is a DTD, try [`Reference] then [`Included].
* Otherwise, [`Omit]. The default is [`Included].
*
* Option [~prefer_dtd_reference]: Same as [~dtd_style:`Reference]
* (backward-compatible).
*
* Option [~minimization]: How to write out empty elements. [`AllEmpty]
* means that all empty elements are minimized (using the <name/>
......@@ -2569,6 +2575,7 @@ class [ 'ext ] document :
method display : ?prefer_dtd_reference : bool ->
?dtd_style:[`Omit|`Reference|`Included|`Auto] ->
?minimization:[`AllEmpty | `DeclaredEmpty | `None] ->
Pxp_core_types.output_stream ->
Pxp_core_types.encoding ->
......@@ -2576,22 +2583,15 @@ class [ 'ext ] document :
(* Write the document to the passed
* output stream; the passed encoding used. The format
* is compact (the opposite of "pretty printing").
* If a DTD is present, the DTD is included into the internal subset.
* If a DTD is present, the DTD is included as internal subset.
* In contrast to [write], this method uses the display namespace
* prefixes instead of the normprefixes.
*
* Option [~prefer_dtd_reference]: If true, it is tried to print
* the DTD as reference, i.e. with SYSTEM or PUBLIC identifier.
* This works only if the DTD has an [External] identifier. If
* 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 [~dtd_style]: Same meaning as in [write].
*
* 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.
* Option [~prefer_dtd_reference]: Same meaning as in [write].
*
* Option [~minimization]: Same meaning as in [write].
*)
method dump : Format.formatter -> unit
......
......@@ -511,7 +511,7 @@ class dtd ?swarner the_warner init_encoding =
method pinstr_names = pinstr_names
method write_ref os enc =
method write_ref ?root:proot os enc =
let write_sysid s =
write_markup_string
~from_enc:`Enc_utf8 ~to_enc:enc os
......@@ -525,8 +525,12 @@ class dtd ?swarner the_warner init_encoding =
write_markup_string ~from_enc:encoding ~to_enc:enc os in
wms "<!DOCTYPE ";
( match root with
None -> failwith "#write: DTD without root";
( match proot with
| None ->
( match root with
None -> failwith "#write: DTD without root";
| Some r -> wms r
)
| Some r -> wms r
);
begin match id with
......@@ -550,7 +554,7 @@ class dtd ?swarner the_warner init_encoding =
wms ">\n";
method write os enc doctype =
method write ?root:proot os enc doctype =
let wms =
write_markup_string ~from_enc:encoding ~to_enc:enc os in
......@@ -566,9 +570,13 @@ class dtd ?swarner the_warner init_encoding =
if doctype then begin
wms "<!DOCTYPE ";
( match root with
None -> failwith "#write: DTD without root";
| Some r -> wms r
( match proot with
| None ->
( match root with
None -> failwith "#write: DTD without root";
| Some r -> wms r
);
| Some r -> wms r
);
wms " [\n";
end;
......
......@@ -407,6 +407,7 @@ class dtd :
*)
method write :
?root:string ->
Pxp_core_types.output_stream ->
Pxp_core_types.encoding ->
bool ->
......@@ -420,9 +421,13 @@ class dtd :
* the generated string does not contain any reference to an entity.
* The reason for the omission of the entites is that there is no
* generic way of writing references to external entities.
*
* Option [root]: Override the name of the root element in the
* DOCTYPE clause.
*)
method write_ref :
?root:string ->
Pxp_core_types.output_stream ->
Pxp_core_types.encoding ->
unit
......@@ -436,6 +441,9 @@ class dtd :
* - dtd#id = External(Public ...)
* If the DTD is internal or mixed, the method [write_ref] will fail.
* If the ID is anonymous or private, the method will fail, too.
*
* Option [root]: Override the name of the root element in the
* DOCTYPE clause.
*)
(*----------------------------------------*)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment