Commit 61e42e21 authored by gerd's avatar gerd

Moved namespace_manager from Pxp_document to Pxp_dtd. This

makes it possible that the DTD can recognize the processing instructions
<?pxp:dtd namespace prefix="..." uri="..."?>, and add the namespace
declaration to the manager.


git-svn-id: https://godirepo.camlcity.org/svn/lib-pxp/trunk@360 dbe99aee-44db-0310-b2b3-d33182c8eb97
parent 2257cb53
(* $Id: pxp_codewriter.ml,v 1.9 2001/06/07 22:39:20 gerd Exp $
(* $Id: pxp_codewriter.ml,v 1.10 2001/06/08 01:15:46 gerd Exp $
* ----------------------------------------------------------------------
* PXP: The polymorphic XML parser for Objective Caml.
* Copyright by Gerd Stolpmann. See LICENSE for details.
......@@ -85,13 +85,13 @@ let write_document out d =
output_string out ";;\n"
;;
(*
let write_dtd out dtd =
output_string out "let create_dtd config =\n";
write_local_dtd out dtd;
output_string out ";;\n"
;;
*)
let write_subtree out t =
output_string out "let create_subtree ?enable_namespace_processing dtd spec =\n";
......@@ -103,6 +103,12 @@ let write_subtree out t =
* History:
*
* $Log: pxp_codewriter.ml,v $
* Revision 1.10 2001/06/08 01:15:46 gerd
* Moved namespace_manager from Pxp_document to Pxp_dtd. This
* makes it possible that the DTD can recognize the processing instructions
* <?pxp:dtd namespace prefix="..." uri="..."?>, and add the namespace
* declaration to the manager.
*
* Revision 1.9 2001/06/07 22:39:20 gerd
* Pxp_codewriter now uses Pxp_marshal to generate the code.
* This simply reduces the complexity of the whole package a lot...
......
(* $Id: pxp_document.ml,v 1.21 2001/06/08 00:12:56 gerd Exp $
(* $Id: pxp_document.ml,v 1.22 2001/06/08 01:15:46 gerd Exp $
* ----------------------------------------------------------------------
* PXP: The polymorphic XML parser for Objective Caml.
* Copyright by Gerd Stolpmann. See LICENSE for details.
......@@ -49,77 +49,6 @@ type data_node_classification =
;;
class namespace_manager =
object (self)
val uri_of_prefix = Hashtbl.create 10 (* not unique *)
val prefix_of_uri = Hashtbl.create 10 (* unique *)
val primary_uri_of_prefix = Hashtbl.create 10 (* unique *)
initializer
ignore(self # add_namespace "xml" "http://www.w3.org/XML/1998/namespace")
method add_uri (np:string) (uri:string) =
if not (Hashtbl.mem uri_of_prefix np) then raise Not_found;
try
let np' = Hashtbl.find prefix_of_uri uri in
if np <> np' then
raise(Namespace_error "add_uri: the URI is already managed")
with
Not_found ->
Hashtbl.add uri_of_prefix np uri;
Hashtbl.add prefix_of_uri uri np;
()
method add_namespace np uri =
let l = Hashtbl.find_all uri_of_prefix np in
if l = [] then begin
if Hashtbl.mem prefix_of_uri uri then
raise(Namespace_error "add_namespace: the URI is already managed");
Hashtbl.add uri_of_prefix np uri;
Hashtbl.add primary_uri_of_prefix np uri;
Hashtbl.add prefix_of_uri uri np;
end
else
if l <> [ uri ] then
raise(Namespace_error "add_namespace: the namespace does already exist")
method lookup_or_add_namespace prefix (uri:string) =
let rec add_loop n =
let p = prefix ^ (if n=0 then "" else string_of_int n) in
if Hashtbl.mem uri_of_prefix p then begin
add_loop (n+1)
end
else begin
Hashtbl.add uri_of_prefix p uri;
Hashtbl.add primary_uri_of_prefix p uri;
Hashtbl.add prefix_of_uri uri p;
p
end
in
try
Hashtbl.find prefix_of_uri uri
with
Not_found ->
add_loop (if prefix = "" then 1 else 0)
(* prefix = "": make sure that such a prefix is never added *)
method get_primary_uri normprefix =
Hashtbl.find primary_uri_of_prefix normprefix
method get_uri_list normprefix =
Hashtbl.find_all uri_of_prefix normprefix
method get_normprefix uri =
Hashtbl.find prefix_of_uri uri
method iter_namespaces f =
Hashtbl.iter
(fun p uri -> f p)
primary_uri_of_prefix
end
;;
class type ['node] extension =
object ('self)
method clone : 'self
......@@ -182,7 +111,6 @@ class type [ 'ext ] node =
method namespace_info : 'ext namespace_info
method set_namespace_info : 'ext namespace_info option -> unit
method namespace_manager : namespace_manager
method set_namespace_manager : namespace_manager -> unit
method dtd : dtd
method encoding : rep_encoding
method create_element :
......@@ -623,8 +551,6 @@ class virtual ['ext] node_impl an_ext =
= nsmethod_na "set_namespace_info"
method namespace_manager
= nsmethod_na "namespace_manager"
method set_namespace_manager (m : namespace_manager)
= nsmethod_na "set_namespace_manager"
(************* METHODS THAT NEED TO BE DEFINED **************)
......@@ -933,8 +859,6 @@ class ['ext] attribute_impl ~element ~name value dtd =
method set_namespace_info info =
nsmethod_na "set_namespace_info"
method namespace_manager = nsmethod_na "namespace_manager"
method set_namespace_manager =
nsmethod_na "set_namespace_manager"
end
: ['ext] node)
;;
......@@ -2156,7 +2080,10 @@ class ['ext] markup_impl an_ext (* : ['ext] node *) =
wms "\n>";
| T_comment ->
wms ("<!--");
wms (self # comment);
( match self # comment with
None -> ()
| Some c -> wms c;
);
wms ("-->");
| _ ->
()
......@@ -2375,7 +2302,6 @@ class ['ext] namespace_attribute_impl ~element ~name value dtd =
object (self)
inherit [ 'ext ] attribute_impl ~element ~name value dtd as super
val mutable mng = (None : namespace_manager option)
val mutable normprefix = ""
val mutable localname = ""
......@@ -2396,10 +2322,7 @@ class ['ext] namespace_attribute_impl ~element ~name value dtd =
method localname = localname
method namespace_uri =
match mng with
None ->
failwith "Pxp_document.namespace_attribute_impl#namespace_uri"
| Some m -> m # get_primary_uri normprefix
self # namespace_manager # get_primary_uri normprefix
method namespace_info =
self # parent # namespace_info
......@@ -2408,13 +2331,7 @@ class ['ext] namespace_attribute_impl ~element ~name value dtd =
method_na "set_namespace_info"
method namespace_manager =
match mng with
None ->
failwith "Pxp_document.namespace_attribute_impl#namespace_manager"
| Some m -> m
method set_namespace_manager m =
mng <- Some m
self # dtd # namespace_manager
end
;;
......@@ -2424,7 +2341,6 @@ class [ 'ext ] namespace_element_impl an_ext =
object (self)
inherit [ 'ext ] element_impl an_ext as super
val mutable mng = (None : namespace_manager option)
val mutable normprefix = ""
val mutable localname = ""
val mutable nsinfo = None
......@@ -2432,9 +2348,7 @@ class [ 'ext ] namespace_element_impl an_ext =
method normprefix = normprefix
method localname = localname
method namespace_uri =
match mng with
None -> failwith "Pxp_document.namespace_element_impl#namespace_uri"
| Some m -> m # get_primary_uri normprefix
self # namespace_manager # get_primary_uri normprefix
method namespace_info =
match nsinfo with
......@@ -2445,13 +2359,7 @@ class [ 'ext ] namespace_element_impl an_ext =
nsinfo <- x
method namespace_manager =
match mng with
None ->
failwith "Pxp_document.namespace_element_impl#namespace_manager"
| Some m -> m
method set_namespace_manager m =
mng <- Some m
self # dtd # namespace_manager
method internal_init new_pos attval_name_pool valcheck_element_exists
new_dtd new_name
......@@ -2535,7 +2443,6 @@ class [ 'ext ] namespace_impl srcprefix normprefix dtd =
(object (self)
val mutable parent = (None : 'ext node option)
val mutable node_position = -1
val mutable mng = (None : namespace_manager option)
val normprefix = normprefix
val srcprefix = srcprefix
......@@ -2593,12 +2500,7 @@ class [ 'ext ] namespace_impl srcprefix normprefix dtd =
raise Not_found
method namespace_manager =
match mng with
None -> failwith "Pxp_document.namespace_impl#namespace_manager"
| Some m -> m
method set_namespace_manager m =
mng <- Some m
self # dtd # namespace_manager
(* Senseless methods: *)
......@@ -2706,7 +2608,6 @@ object
let s = if srcprefix = "!" then "" else srcprefix in
let nsnode = new namespace_impl s normprefix dtd in
nsnode # internal_adopt (Some parent) !pos;
nsnode # set_namespace_manager (parent # namespace_manager);
d := nsnode :: !d;
done_srcprefixes := srcprefix :: !done_srcprefixes;
end
......@@ -3079,7 +2980,7 @@ let iter_tree_sibl ?(pre=(fun _ _ _ -> ())) ?(post=(fun _ _ _ -> ())) base =
let validate tree =
iter
iter_tree
~pre:(fun n -> n # validate())
tree
;;
......@@ -3498,6 +3399,12 @@ class ['ext] document the_warner =
* History:
*
* $Log: pxp_document.ml,v $
* Revision 1.22 2001/06/08 01:15:46 gerd
* Moved namespace_manager from Pxp_document to Pxp_dtd. This
* makes it possible that the DTD can recognize the processing instructions
* <?pxp:dtd namespace prefix="..." uri="..."?>, and add the namespace
* declaration to the manager.
*
* Revision 1.21 2001/06/08 00:12:56 gerd
* Implemented rev. 1.16 of pxp_document.mli.
*
......
(* $Id: pxp_document.mli,v 1.16 2001/06/08 00:12:40 gerd Exp $
(* $Id: pxp_document.mli,v 1.17 2001/06/08 01:15:46 gerd Exp $
* ----------------------------------------------------------------------
* PXP: The polymorphic XML parser for Objective Caml.
* Copyright by Gerd Stolpmann. See LICENSE for details.
......@@ -291,85 +291,6 @@ type data_node_classification =
;;
(* Very experimental namespace support: *)
class namespace_manager :
(* This class manages mappings from URIs to normalized prefixes. For every
* namespace a namespace_manager object contains a set of mappings
* uri1 |-> np, uri2 |-> np, ..., uriN |-> np.
* The normalized prefix np is characterical of the namespace, and
* identifies the namespace uniquely.
* The first URI uri1 is the primary URI, the other URIs are aliases.
* The following operations are supported:
* - add_uri np uri: The passed uri is added to the already existing
* namespace which is identified by the normprefix np. This means
* that the precondition is that there is already some mapping
* uri' |-> np, and that there is no mapping for uri. Postcondition
* is that uri |-> np is a new mapping.
* add_uri thus adds a new alias URI for an existing namespace.
* - add_namespace np uri: Precondition is that neither np nor uri
* are used in the namespace_manager object. The effect is that the
* mapping uri |-> np is added.
* - lookup_or_add_namespace p uri: If there is already some mapping
* uri |-> np, the normprefix np is simply returned ("lookup"). In this
* case p is ignored. Otherwise uri is not yet mapped, and in this
* case some unique np must be found such that uri |-> np can be
* added ("add_namespace"). First, the passed prefix p is tried.
* If p is free, it can be taken as new normprefix: np = p. Otherwise
* some number n is found such that the concatenation p + n is free:
* np = p + n. The operation returns np.
*)
object
method add_uri : string -> string -> unit
(* add_uri np uri: adds uri as alias URI to the namespace identified
* by the normprefix np (see above for detailed semantics). The method
* raises Not_found if the normprefix np is unknown to the object,
* and it fails (Namespace_error) if the uri is member of a
* different namespace. Nothing happens if the uri is already member
* of the namespace np.
*)
method add_namespace : string -> string -> unit
(* add_namespace np uri: adds a new namespace to the object. The
* namespace is identified by the normprefix np and contains initially
* the primary URI uri.
* The method fails (Namespace_error) if either np already identifies
* some namespace or if uri is already member of some namespace.
* Nothing happens if uri is the sole member of the namespace np.
* It is required that np <> "".
*)
method lookup_or_add_namespace : string -> string -> string
(* lookup_or_add_namespace p uri: first, the method looks up if
* the namespace for uri does already exist. If so, p is ignored,
* and the method returns the normprefix identifying the namespace.
* Otherwise, a new namespace is added for some normprefix np which
* initially contains uri. The normprefix np is calculated upon p
* serving as suggestion for the normprefix. The method returns
* the normprefix.
*)
method get_primary_uri : string -> string
(* Return the primary URI for a normprefix, or raises Not_found.
* get_uri "" raises always Not_found.
*)
method get_uri_list : string -> string list
(* Return all URIs for a normprefix, or [] if the normprefix is
* unused. get_uri_list "" returns always []. The last URI of the
* returned list is the primary URI.
*)
method get_normprefix : string -> string
(* Return the normprefix for a URI, or raises Not_found *)
method iter_namespaces : (string -> unit) -> unit
(* Iterates over all namespaces contained in the object, and
* calls the passed function for every namespace. The argument of the
* invoked function is the normprefix of the namespace.
*)
(* Encodings: prefixes and URIs are always encoded in the default
* encoding of the document
*)
end
;;
(* Regular definition: *)
......@@ -698,14 +619,6 @@ class type [ 'ext ] node =
* When invoked for other classes, it will fail.
*)
method set_namespace_manager : namespace_manager -> unit
(* Sets the namespace manager as returned by namespace_manager.
*
* This method is only supported by the implementations
* namespace_element_impl, namespace_attribute_impl, namespace_impl.
* When invoked for other classes, it will fail.
*)
method namespace_info : 'ext namespace_info
(* Returns additional information about the namespace prefixes
* in the parsed XML source. This method has been added for
......@@ -1446,6 +1359,12 @@ class [ 'ext ] document :
* History:
*
* $Log: pxp_document.mli,v $
* Revision 1.17 2001/06/08 01:15:46 gerd
* Moved namespace_manager from Pxp_document to Pxp_dtd. This
* makes it possible that the DTD can recognize the processing instructions
* <?pxp:dtd namespace prefix="..." uri="..."?>, and add the namespace
* declaration to the manager.
*
* Revision 1.16 2001/06/08 00:12:40 gerd
* Numerous changes:
* - Method add_node has been deprecated in favor of
......
(* $Id: pxp_dtd.ml,v 1.16 2001/06/07 22:48:38 gerd Exp $
(* $Id: pxp_dtd.ml,v 1.17 2001/06/08 01:15:46 gerd Exp $
* ----------------------------------------------------------------------
* PXP: The polymorphic XML parser for Objective Caml.
* Copyright by Gerd Stolpmann. See LICENSE for details.
......@@ -27,10 +27,82 @@ type validation_record =
;;
class namespace_manager =
object (self)
val uri_of_prefix = Hashtbl.create 10 (* not unique *)
val prefix_of_uri = Hashtbl.create 10 (* unique *)
val primary_uri_of_prefix = Hashtbl.create 10 (* unique *)
initializer
ignore(self # add_namespace "xml" "http://www.w3.org/XML/1998/namespace")
method add_uri (np:string) (uri:string) =
if not (Hashtbl.mem uri_of_prefix np) then raise Not_found;
try
let np' = Hashtbl.find prefix_of_uri uri in
if np <> np' then
raise(Namespace_error "add_uri: the URI is already managed")
with
Not_found ->
Hashtbl.add uri_of_prefix np uri;
Hashtbl.add prefix_of_uri uri np;
()
method add_namespace np uri =
let l = Hashtbl.find_all uri_of_prefix np in
if l = [] then begin
if Hashtbl.mem prefix_of_uri uri then
raise(Namespace_error "add_namespace: the URI is already managed");
Hashtbl.add uri_of_prefix np uri;
Hashtbl.add primary_uri_of_prefix np uri;
Hashtbl.add prefix_of_uri uri np;
end
else
if l <> [ uri ] then
raise(Namespace_error "add_namespace: the namespace does already exist")
method lookup_or_add_namespace prefix (uri:string) =
let rec add_loop n =
let p = prefix ^ (if n=0 then "" else string_of_int n) in
if Hashtbl.mem uri_of_prefix p then begin
add_loop (n+1)
end
else begin
Hashtbl.add uri_of_prefix p uri;
Hashtbl.add primary_uri_of_prefix p uri;
Hashtbl.add prefix_of_uri uri p;
p
end
in
try
Hashtbl.find prefix_of_uri uri
with
Not_found ->
add_loop (if prefix = "" then 1 else 0)
(* prefix = "": make sure that such a prefix is never added *)
method get_primary_uri normprefix =
Hashtbl.find primary_uri_of_prefix normprefix
method get_uri_list normprefix =
Hashtbl.find_all uri_of_prefix normprefix
method get_normprefix uri =
Hashtbl.find prefix_of_uri uri
method iter_namespaces f =
Hashtbl.iter
(fun p uri -> f p)
primary_uri_of_prefix
end
;;
class dtd the_warner init_encoding =
object (self)
val mutable root = (None : string option)
val mutable id = (None : dtd_id option)
val mutable mng = (None : namespace_manager option)
val warner = (the_warner : collect_warnings)
val encoding = init_encoding
......@@ -105,6 +177,13 @@ class dtd the_warner init_encoding =
method root = root
method id = id
method namespace_manager =
match mng with
None -> raise(Namespace_method_not_applicable "namespace_manager")
| Some m -> m
method set_namespace_manager m =
mng <- Some m
method add_element el =
(* raises Not_found if 'el' has already been added *)
......@@ -218,6 +297,26 @@ class dtd the_warner init_encoding =
e # allow_arbitrary
)
el
| "namespace" ->
let prefix =
try List.assoc "prefix" atts
with Not_found ->
raise(Error("Missing `prefix' attribute for pxp:dtd"))
in
let uri =
try List.assoc "uri" atts
with Not_found ->
raise(Error("Missing `uri' attribute for pxp:dtd"))
in
( match mng with
None ->
raise(Error("Cannot do pxp:dtd instruction: namespaces not enabled"))
| Some m ->
( try m # add_uri prefix uri
with Not_found ->
m # add_namespace prefix uri
)
)
| _ ->
raise(Error("Unknown PXP option `" ^
optname ^ "'"))
......@@ -225,35 +324,6 @@ class dtd the_warner init_encoding =
| _ ->
raise(Error("The processing instruction target `" ^
name ^ "' is not defined by this PXP version"))
end
else begin
(*----------------------------------------------------------------------
* SUPPORT FOR DEPRECATED PI OPTIONS:
* - <?xml:allow_undeclared_elements_and_notations?>
* is now <?pxp:dtd optional-element-and-notation-declarations?>
* - <?xml:allow_undeclared_attributes <elementname>?>
* is now <?pxp:dtd optional-attribute-declarations
* elements='<elementname> ...'?>
* Please update your DTDs! Alternatively, you may uncommment the
* following piece of code.
*)
(* if name = "xml:allow_undeclared_elements_and_notations" then *)
(* self # allow_arbitrary; *)
(* if name = "xml:allow_undeclared_attributes" then begin *)
(* let v = pi # value in *)
(* let e = *)
(* try *)
(* Str_hashtbl.find elements v *)
(* with *)
(* Not_found -> *)
(* raise(Validation_error("Reference to undeclared element `"*)
(* ^ v ^ "'")) *)
(* in *)
(* e # allow_arbitrary; *)
(* end; *)
(*----------------------------------------------------------------------
*)
()
end;
Str_hashtbl.add pinstr name pi;
if not (List.mem name pinstr_names) then
......@@ -1037,6 +1107,12 @@ object (self)
* History:
*
* $Log: pxp_dtd.ml,v $
* Revision 1.17 2001/06/08 01:15:46 gerd
* Moved namespace_manager from Pxp_document to Pxp_dtd. This
* makes it possible that the DTD can recognize the processing instructions
* <?pxp:dtd namespace prefix="..." uri="..."?>, and add the namespace
* declaration to the manager.
*
* Revision 1.16 2001/06/07 22:48:38 gerd
* Improvement: 'write' writes sorted attributes. This makes
* many regression tests simpler.
......
(* $Id: pxp_dtd.mli,v 1.12 2001/06/07 22:49:11 gerd Exp $
(* $Id: pxp_dtd.mli,v 1.13 2001/06/08 01:15:47 gerd Exp $
* ----------------------------------------------------------------------
* PXP: The polymorphic XML parser for Objective Caml.
* Copyright by Gerd Stolpmann. See LICENSE for details.
......@@ -45,6 +45,86 @@ type validation_record =
* Please do not use this type in your own programs.
*)
(* Very experimental namespace support: *)
class namespace_manager :
(* This class manages mappings from URIs to normalized prefixes. For every
* namespace a namespace_manager object contains a set of mappings
* uri1 |-> np, uri2 |-> np, ..., uriN |-> np.
* The normalized prefix np is characterical of the namespace, and
* identifies the namespace uniquely.
* The first URI uri1 is the primary URI, the other URIs are aliases.
* The following operations are supported:
* - add_uri np uri: The passed uri is added to the already existing
* namespace which is identified by the normprefix np. This means
* that the precondition is that there is already some mapping
* uri' |-> np, and that there is no mapping for uri. Postcondition
* is that uri |-> np is a new mapping.
* add_uri thus adds a new alias URI for an existing namespace.
* - add_namespace np uri: Precondition is that neither np nor uri
* are used in the namespace_manager object. The effect is that the
* mapping uri |-> np is added.
* - lookup_or_add_namespace p uri: If there is already some mapping
* uri |-> np, the normprefix np is simply returned ("lookup"). In this
* case p is ignored. Otherwise uri is not yet mapped, and in this
* case some unique np must be found such that uri |-> np can be
* added ("add_namespace"). First, the passed prefix p is tried.
* If p is free, it can be taken as new normprefix: np = p. Otherwise
* some number n is found such that the concatenation p + n is free:
* np = p + n. The operation returns np.
*)
object
method add_uri : string -> string -> unit
(* add_uri np uri: adds uri as alias URI to the namespace identified
* by the normprefix np (see above for detailed semantics). The method
* raises Not_found if the normprefix np is unknown to the object,
* and it fails (Namespace_error) if the uri is member of a
* different namespace. Nothing happens if the uri is already member
* of the namespace np.
*)
method add_namespace : string -> string -> unit
(* add_namespace np uri: adds a new namespace to the object. The
* namespace is identified by the normprefix np and contains initially
* the primary URI uri.
* The method fails (Namespace_error) if either np already identifies
* some namespace or if uri is already member of some namespace.
* Nothing happens if uri is the sole member of the namespace np.
* It is required that np <> "".
*)
method lookup_or_add_namespace : string -> string -> string
(* lookup_or_add_namespace p uri: first, the method looks up if
* the namespace for uri does already exist. If so, p is ignored,
* and the method returns the normprefix identifying the namespace.
* Otherwise, a new namespace is added for some normprefix np which
* initially contains uri. The normprefix np is calculated upon p
* serving as suggestion for the normprefix. The method returns
* the normprefix.
*)
method get_primary_uri : string -> string
(* Return the primary URI for a normprefix, or raises Not_found.
* get_uri "" raises always Not_found.
*)
method get_uri_list : string -> string list
(* Return all URIs for a normprefix, or [] if the normprefix is
* unused. get_uri_list "" returns always []. The last URI of the
* returned list is the primary URI.
*)
method get_normprefix : string -> string
(* Return the normprefix for a URI, or raises Not_found *)
method iter_namespaces : (string -> unit) -> unit
(* Iterates over all namespaces contained in the object, and
* calls the passed function for every namespace. The argument of the
* invoked function is the normprefix of the namespace.
*)
(* Encodings: prefixes and URIs are always encoded in the default
* encoding of the document
*)
end
;;
class dtd :
(* Creation:
* new dtd
......@@ -95,6 +175,16 @@ class dtd :
(* Sets the 'standalone' declaration. *)
method namespace_manager : namespace_manager
(* For namespace-aware implementations of the node class, this method
* returns the namespace manager. If the namespace manager has not been
* set, the exception Not_found is raised.
*)
method set_namespace_manager : namespace_manager -> unit
(* Sets the namespace manager as returned by namespace_manager.
*)
method add_element : dtd_element -> unit
(* add the given element declaration to this DTD. Raises Not_found
* if there is already an element declaration with the same name.
......@@ -384,6 +474,12 @@ and proc_instruction : string -> string -> Pxp_types.rep_encoding ->
* History:
*
* $Log: pxp_dtd.mli,v $
* Revision 1.13 2001/06/08 01:15:47 gerd
* Moved namespace_manager from Pxp_document to Pxp_dtd. This
* makes it possible that the DTD can recognize the processing instructions
* <?pxp:dtd namespace prefix="..." uri="..."?>, and add the namespace
* declaration to the manager.
*
* Revision 1.12 2001/06/07 22:49:11 gerd
* Removed: method write_compact_as_latin1
*
......
(* $Id: pxp_marshal.ml,v 1.3 2001/06/07 22:46:15 gerd Exp $
(* $Id: pxp_marshal.ml,v 1.4 2001/06/08 01:15:47 gerd Exp $
* ----------------------------------------------------------------------
*
*)
......@@ -220,8 +220,7 @@ let subtree_to_channel ?(omit_positions = false) ch n =
;;
let subtree_from_cmd_sequence_nohead ?enable_namespace_processing
~f:f0 dtd spec =
let subtree_from_cmd_sequence_nohead ~f:f0 dtd spec =
let current_array = ref( [| |] ) in
let current_pos = ref 0 in
let rec f() =
......@@ -245,10 +244,12 @@ let subtree_from_cmd_sequence_nohead ?enable_namespace_processing
let atts = ref (Array.create 100 "") in
let mng = new namespace_manager in
let mng_found = ref false in
let dest_mng =
match enable_namespace_processing with
Some m -> m
| None -> mng (* value does not matter *)
let enable_mng, dest_mng =
try
true, dtd # namespace_manager
with
Namespace_method_not_applicable _ ->
false, mng (* value does not matter *)
in
let map_nsprefix name =
let p, l = namespace_split name in
......@@ -320,8 +321,6 @@ let subtree_from_cmd_sequence_nohead ?enable_namespace_processing
dtd
eltype
[] in
if enable_namespace_processing <> None then
e # set_namespace_manager dest_mng;
e
| Start_super_root_node pos ->
create_super_root_node ?position:pos spec dtd
......@@ -349,7 +348,7 @@ let subtree_from_cmd_sequence_nohead ?enable_namespace_processing
dtd
(new proc_instruction target value (dtd # encoding))
| Namespace_mapping (normprefix, uris) ->
if enable_namespace_processing <> None then begin
if enable_mng then begin
let primary_uri = uris.( Array.length uris - 1 ) in
if normprefix <> "xml" then
mng # add_namespace normprefix primary_uri;
......@@ -393,8 +392,7 @@ let subtree_from_cmd_sequence_nohead ?enable_namespace_processing
;;
let subtree_from_cmd_sequence ?enable_namespace_processing
~f dtd spec =
let subtree_from_cmd_sequence ~f dtd spec =
match f() with
Head(enc_s,_) ->
let enc = Netconversion.encoding_of_string enc_s in
......@@ -406,18 +404,16 @@ let subtree_from_cmd_sequence ?enable_namespace_processing