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/[email protected] 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. * PXP: The polymorphic XML parser for Objective Caml.
* Copyright by Gerd Stolpmann. See LICENSE for details. * Copyright by Gerd Stolpmann. See LICENSE for details.
...@@ -85,13 +85,13 @@ let write_document out d = ...@@ -85,13 +85,13 @@ let write_document out d =
output_string out ";;\n" output_string out ";;\n"
;; ;;
(*
let write_dtd out dtd = let write_dtd out dtd =
output_string out "let create_dtd config =\n"; output_string out "let create_dtd config =\n";
write_local_dtd out dtd; write_local_dtd out dtd;
output_string out ";;\n" output_string out ";;\n"
;; ;;
*)
let write_subtree out t = let write_subtree out t =
output_string out "let create_subtree ?enable_namespace_processing dtd spec =\n"; output_string out "let create_subtree ?enable_namespace_processing dtd spec =\n";
...@@ -103,6 +103,12 @@ let write_subtree out t = ...@@ -103,6 +103,12 @@ let write_subtree out t =
* History: * History:
* *
* $Log: pxp_codewriter.ml,v $ * $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 * Revision 1.9 2001/06/07 22:39:20 gerd
* Pxp_codewriter now uses Pxp_marshal to generate the code. * Pxp_codewriter now uses Pxp_marshal to generate the code.
* This simply reduces the complexity of the whole package a lot... * 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. * PXP: The polymorphic XML parser for Objective Caml.
* Copyright by Gerd Stolpmann. See LICENSE for details. * Copyright by Gerd Stolpmann. See LICENSE for details.
...@@ -49,77 +49,6 @@ type data_node_classification = ...@@ -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 = class type ['node] extension =
object ('self) object ('self)
method clone : 'self method clone : 'self
...@@ -182,7 +111,6 @@ class type [ 'ext ] node = ...@@ -182,7 +111,6 @@ class type [ 'ext ] node =
method namespace_info : 'ext namespace_info method namespace_info : 'ext namespace_info
method set_namespace_info : 'ext namespace_info option -> unit method set_namespace_info : 'ext namespace_info option -> unit
method namespace_manager : namespace_manager method namespace_manager : namespace_manager
method set_namespace_manager : namespace_manager -> unit
method dtd : dtd method dtd : dtd
method encoding : rep_encoding method encoding : rep_encoding
method create_element : method create_element :
...@@ -623,8 +551,6 @@ class virtual ['ext] node_impl an_ext = ...@@ -623,8 +551,6 @@ class virtual ['ext] node_impl an_ext =
= nsmethod_na "set_namespace_info" = nsmethod_na "set_namespace_info"
method namespace_manager method namespace_manager
= nsmethod_na "namespace_manager" = nsmethod_na "namespace_manager"
method set_namespace_manager (m : namespace_manager)
= nsmethod_na "set_namespace_manager"
(************* METHODS THAT NEED TO BE DEFINED **************) (************* METHODS THAT NEED TO BE DEFINED **************)
...@@ -933,8 +859,6 @@ class ['ext] attribute_impl ~element ~name value dtd = ...@@ -933,8 +859,6 @@ class ['ext] attribute_impl ~element ~name value dtd =
method set_namespace_info info = method set_namespace_info info =
nsmethod_na "set_namespace_info" nsmethod_na "set_namespace_info"
method namespace_manager = nsmethod_na "namespace_manager" method namespace_manager = nsmethod_na "namespace_manager"
method set_namespace_manager =
nsmethod_na "set_namespace_manager"
end end
: ['ext] node) : ['ext] node)
;; ;;
...@@ -2156,7 +2080,10 @@ class ['ext] markup_impl an_ext (* : ['ext] node *) = ...@@ -2156,7 +2080,10 @@ class ['ext] markup_impl an_ext (* : ['ext] node *) =
wms "\n>"; wms "\n>";
| T_comment -> | T_comment ->
wms ("<!--"); wms ("<!--");
wms (self # comment); ( match self # comment with
None -> ()
| Some c -> wms c;
);
wms ("-->"); wms ("-->");
| _ -> | _ ->
() ()
...@@ -2375,7 +2302,6 @@ class ['ext] namespace_attribute_impl ~element ~name value dtd = ...@@ -2375,7 +2302,6 @@ class ['ext] namespace_attribute_impl ~element ~name value dtd =
object (self) object (self)
inherit [ 'ext ] attribute_impl ~element ~name value dtd as super inherit [ 'ext ] attribute_impl ~element ~name value dtd as super
val mutable mng = (None : namespace_manager option)
val mutable normprefix = "" val mutable normprefix = ""
val mutable localname = "" val mutable localname = ""
...@@ -2396,10 +2322,7 @@ class ['ext] namespace_attribute_impl ~element ~name value dtd = ...@@ -2396,10 +2322,7 @@ class ['ext] namespace_attribute_impl ~element ~name value dtd =
method localname = localname method localname = localname
method namespace_uri = method namespace_uri =
match mng with self # namespace_manager # get_primary_uri normprefix
None ->
failwith "Pxp_document.namespace_attribute_impl#namespace_uri"
| Some m -> m # get_primary_uri normprefix
method namespace_info = method namespace_info =
self # parent # namespace_info self # parent # namespace_info
...@@ -2408,13 +2331,7 @@ class ['ext] namespace_attribute_impl ~element ~name value dtd = ...@@ -2408,13 +2331,7 @@ class ['ext] namespace_attribute_impl ~element ~name value dtd =
method_na "set_namespace_info" method_na "set_namespace_info"
method namespace_manager = method namespace_manager =
match mng with self # dtd # namespace_manager
None ->
failwith "Pxp_document.namespace_attribute_impl#namespace_manager"
| Some m -> m
method set_namespace_manager m =
mng <- Some m
end end
;; ;;
...@@ -2424,7 +2341,6 @@ class [ 'ext ] namespace_element_impl an_ext = ...@@ -2424,7 +2341,6 @@ class [ 'ext ] namespace_element_impl an_ext =
object (self) object (self)
inherit [ 'ext ] element_impl an_ext as super inherit [ 'ext ] element_impl an_ext as super
val mutable mng = (None : namespace_manager option)
val mutable normprefix = "" val mutable normprefix = ""
val mutable localname = "" val mutable localname = ""
val mutable nsinfo = None val mutable nsinfo = None
...@@ -2432,9 +2348,7 @@ class [ 'ext ] namespace_element_impl an_ext = ...@@ -2432,9 +2348,7 @@ class [ 'ext ] namespace_element_impl an_ext =
method normprefix = normprefix method normprefix = normprefix
method localname = localname method localname = localname
method namespace_uri = method namespace_uri =
match mng with self # namespace_manager # get_primary_uri normprefix
None -> failwith "Pxp_document.namespace_element_impl#namespace_uri"
| Some m -> m # get_primary_uri normprefix
method namespace_info = method namespace_info =
match nsinfo with match nsinfo with
...@@ -2445,13 +2359,7 @@ class [ 'ext ] namespace_element_impl an_ext = ...@@ -2445,13 +2359,7 @@ class [ 'ext ] namespace_element_impl an_ext =
nsinfo <- x nsinfo <- x
method namespace_manager = method namespace_manager =
match mng with self # dtd # namespace_manager
None ->
failwith "Pxp_document.namespace_element_impl#namespace_manager"
| Some m -> m
method set_namespace_manager m =
mng <- Some m
method internal_init new_pos attval_name_pool valcheck_element_exists method internal_init new_pos attval_name_pool valcheck_element_exists
new_dtd new_name new_dtd new_name
...@@ -2535,7 +2443,6 @@ class [ 'ext ] namespace_impl srcprefix normprefix dtd = ...@@ -2535,7 +2443,6 @@ class [ 'ext ] namespace_impl srcprefix normprefix dtd =
(object (self) (object (self)
val mutable parent = (None : 'ext node option) val mutable parent = (None : 'ext node option)
val mutable node_position = -1 val mutable node_position = -1
val mutable mng = (None : namespace_manager option)
val normprefix = normprefix val normprefix = normprefix
val srcprefix = srcprefix val srcprefix = srcprefix
...@@ -2593,12 +2500,7 @@ class [ 'ext ] namespace_impl srcprefix normprefix dtd = ...@@ -2593,12 +2500,7 @@ class [ 'ext ] namespace_impl srcprefix normprefix dtd =
raise Not_found raise Not_found
method namespace_manager = method namespace_manager =
match mng with self # dtd # namespace_manager
None -> failwith "Pxp_document.namespace_impl#namespace_manager"
| Some m -> m
method set_namespace_manager m =
mng <- Some m
(* Senseless methods: *) (* Senseless methods: *)
...@@ -2706,7 +2608,6 @@ object ...@@ -2706,7 +2608,6 @@ object
let s = if srcprefix = "!" then "" else srcprefix in let s = if srcprefix = "!" then "" else srcprefix in
let nsnode = new namespace_impl s normprefix dtd in let nsnode = new namespace_impl s normprefix dtd in
nsnode # internal_adopt (Some parent) !pos; nsnode # internal_adopt (Some parent) !pos;
nsnode # set_namespace_manager (parent # namespace_manager);
d := nsnode :: !d; d := nsnode :: !d;
done_srcprefixes := srcprefix :: !done_srcprefixes; done_srcprefixes := srcprefix :: !done_srcprefixes;
end end
...@@ -3079,7 +2980,7 @@ let iter_tree_sibl ?(pre=(fun _ _ _ -> ())) ?(post=(fun _ _ _ -> ())) base = ...@@ -3079,7 +2980,7 @@ let iter_tree_sibl ?(pre=(fun _ _ _ -> ())) ?(post=(fun _ _ _ -> ())) base =
let validate tree = let validate tree =
iter iter_tree
~pre:(fun n -> n # validate()) ~pre:(fun n -> n # validate())
tree tree
;; ;;
...@@ -3498,6 +3399,12 @@ class ['ext] document the_warner = ...@@ -3498,6 +3399,12 @@ class ['ext] document the_warner =
* History: * History:
* *
* $Log: pxp_document.ml,v $ * $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 * Revision 1.21 2001/06/08 00:12:56 gerd
* Implemented rev. 1.16 of pxp_document.mli. * 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. * PXP: The polymorphic XML parser for Objective Caml.
* Copyright by Gerd Stolpmann. See LICENSE for details. * Copyright by Gerd Stolpmann. See LICENSE for details.
...@@ -291,85 +291,6 @@ type data_node_classification = ...@@ -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: *) (* Regular definition: *)
...@@ -698,14 +619,6 @@ class type [ 'ext ] node = ...@@ -698,14 +619,6 @@ class type [ 'ext ] node =
* When invoked for other classes, it will fail. * 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 method namespace_info : 'ext namespace_info
(* Returns additional information about the namespace prefixes (* Returns additional information about the namespace prefixes
* in the parsed XML source. This method has been added for * in the parsed XML source. This method has been added for
...@@ -1446,6 +1359,12 @@ class [ 'ext ] document : ...@@ -1446,6 +1359,12 @@ class [ 'ext ] document :
* History: * History:
* *
* $Log: pxp_document.mli,v $ * $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 * Revision 1.16 2001/06/08 00:12:40 gerd
* Numerous changes: * Numerous changes:
* - Method add_node has been deprecated in favor of * - 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. * PXP: The polymorphic XML parser for Objective Caml.
* Copyright by Gerd Stolpmann. See LICENSE for details. * Copyright by Gerd Stolpmann. See LICENSE for details.
...@@ -27,10 +27,82 @@ type validation_record = ...@@ -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 = class dtd the_warner init_encoding =
object (self) object (self)
val mutable root = (None : string option) val mutable root = (None : string option)
val mutable id = (None : dtd_id option) val mutable id = (None : dtd_id option)
val mutable mng = (None : namespace_manager option)
val warner = (the_warner : collect_warnings) val warner = (the_warner : collect_warnings)
val encoding = init_encoding val encoding = init_encoding
...@@ -105,6 +177,13 @@ class dtd the_warner init_encoding = ...@@ -105,6 +177,13 @@ class dtd the_warner init_encoding =
method root = root method root = root
method id = id 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 = method add_element el =
(* raises Not_found if 'el' has already been added *) (* raises Not_found if 'el' has already been added *)
...@@ -218,6 +297,26 @@ class dtd the_warner init_encoding = ...@@ -218,6 +297,26 @@ class dtd the_warner init_encoding =
e # allow_arbitrary e # allow_arbitrary
) )
el 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 `" ^ raise(Error("Unknown PXP option `" ^
optname ^ "'")) optname ^ "'"))
...@@ -225,35 +324,6 @@ class dtd the_warner init_encoding = ...@@ -225,35 +324,6 @@ class dtd the_warner init_encoding =
| _ -> | _ ->
raise(Error("The processing instruction target `" ^ raise(Error("The processing instruction target `" ^
name ^ "' is not defined by this PXP version")) 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; end;
Str_hashtbl.add pinstr name pi; Str_hashtbl.add pinstr name pi;
if not (List.mem name pinstr_names) then if not (List.mem name pinstr_names) then
...@@ -1037,6 +1107,12 @@ object (self) ...@@ -1037,6 +1107,12 @@ object (self)
* History: * History:
* *
* $Log: pxp_dtd.ml,v $ * $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 * Revision 1.16 2001/06/07 22:48:38 gerd
* Improvement: 'write' writes sorted attributes. This makes * Improvement: 'write' writes sorted attributes. This makes
* many regression tests simpler. * 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. * PXP: The polymorphic XML parser for Objective Caml.
* Copyright by Gerd Stolpmann. See LICENSE for details. * Copyright by Gerd Stolpmann. See LICENSE for details.
...@@ -45,6 +45,86 @@ type validation_record = ...@@ -45,6 +45,86 @@ type validation_record =
* Please do not use this type in your own programs. * 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