[r2005-03-07 22:48:50 by afrisch] Empty log message

Original author: afrisch
Date: 2005-03-07 22:51:38+00:00

misc/ns.mli

@@ -10,6 +10,8 @@ val mk_ascii: string -> t
 val value: t -> Utf8.t
 val empty : t
 
+val xml_ns: t
+
 type qname = t * Utf8.t
 module QName : sig
   include Custom.T with type t = qname

runtime/cduce_pxp.ml

@@ -28,8 +28,10 @@ let channel_of_id rid =
   match rid.rid_system_base, rid.rid_system with
     | Some base, Some local -> 
 	let uri = Url.local base local in
+(*	Printf.printf "base=%s local=%s ==> %s\n" base local uri; *)
 	let ch = new Netchannels.input_string (get_uri uri) in
-	ch, None, None
+	let id = { rid with rid_system = Some uri } in
+	ch, None, Some id
     | _ -> raise Not_competent
 
 let alt = [ new resolve_to_any_obj_channel ~channel_of_id () ] 

schema/schema_parser.ml

@@ -608,13 +608,22 @@ let schema_of_uri uri =
 	print_endline ("Include " ^ uri); flush stdout;
 	parse_root uri (node_of_uri uri);
     | "xsd:import" ->
+	let i uri = 
+	  print_endline ("Import " ^ uri); flush stdout;
+	  ignore (parse_uri uri) in
 	(match _may_attr "schemaLocation" n with
 	   | None ->
-	       print_endline "Import ignored, no schemaLocation"
+	       (match _may_attr "namespace" n with
+		  | Some ns when Utf8.get_str ns = "http://www.w3.org/XML/1998/namespace" ->
+		      i "http://www.w3.org/2001/xml.xsd"
+		  | Some ns ->
+		      print_endline ("Import with no schemaLocation but a namespace:"^(Utf8.get_str ns));
+		      print_endline "Trying to use the namespace as a URI...";
+		      i (Utf8.get_str ns)
+		  | _ ->
+		      print_endline "Import ignored, no schemaLocation")
 	   | Some local ->
-	       let new_uri = Url.local uri (Utf8.get_str local) in
-	       print_endline ("Import " ^ new_uri); flush stdout;
-	       ignore (parse_uri new_uri)
+	       i (Url.local uri (Utf8.get_str local))
 	)
 	(* TODO: check namespace *)
     | "xsd:annotation" -> ()

schema/schema_xml.ml

@@ -54,7 +54,8 @@ let channel_of_id rid =
     | Some base, Some local -> 
 	let uri = Url.local base local in
 	let ch = new Netchannels.input_string (get_uri uri) in
-	ch, None, None
+	let id = { rid with rid_system = Some uri } in
+	ch, None, Some id
     | _ -> raise Not_competent
 
 let alt = [ new resolve_to_any_obj_channel ~channel_of_id () ]