+++ /dev/null
-(* $Id$
- * ----------------------------------------------------------------------
- *)
-
-open Markup_types
-open Markup_dtd
-open Markup_document
-
-type config =
- { warner : collect_warnings;
- errors_with_line_numbers : bool;
- processing_instructions_inline : bool;
- virtual_root : bool;
- debugging_mode : bool;
- }
-
-
-type source =
- Entity of ((dtd -> Pxp_entity.entity) * Markup_reader.resolver)
- | Channel of in_channel
- | File of string
- | Latin1 of string
- | ExtID of (ext_id * Markup_reader.resolver)
-
-type 'ext domspec =
- { map : (node_type, 'ext node) Hashtbl.t;
- default_element : 'ext node;
- }
-
-
-class default_ext =
- object(self)
- val mutable node = (None : ('a extension node as 'a) option)
- method clone = {< >}
- method node =
- match node with
- None ->
- assert false
- | Some n -> n
- method set_node n =
- node <- Some n
- end
-;;
-
-
-let default_extension = new default_ext;;
-
-let default_config =
- { warner = new collect_warnings;
- errors_with_line_numbers = true;
- processing_instructions_inline = false;
- virtual_root = false;
- debugging_mode = false;
- }
-
-
-let default_dom =
- let d = Hashtbl.create 2 in
- Hashtbl.add d T_data (new data_impl default_extension "");
- { map = d;
- default_element = new element_impl default_extension
- }
-;;
-
-
-let pxp_config cfg =
- { Pxp_yacc.default_config with
- Pxp_yacc.warner = (cfg.warner :> Pxp_types.collect_warnings);
- Pxp_yacc.errors_with_line_numbers = cfg.errors_with_line_numbers;
- Pxp_yacc.enable_pinstr_nodes = cfg.processing_instructions_inline;
- Pxp_yacc.enable_super_root_node = cfg.virtual_root;
- Pxp_yacc.encoding = `Enc_iso88591;
- Pxp_yacc.recognize_standalone_declaration = false;
- Pxp_yacc.debugging_mode = cfg.debugging_mode;
- }
-;;
-
-
-class pxp_resolver r =
- object (self)
- val markup_resolver = r
-
- method init_rep_encoding enc =
- assert (enc = `Enc_iso88591 )
-
- method init_warner w =
- ()
-
- method rep_encoding = `Enc_iso88591
-
- method open_in xid =
- markup_resolver # open_in xid
-
- method close_in =
- markup_resolver # close_in
-
- method close_all =
- markup_resolver # close_in
-
- method change_encoding enc =
- markup_resolver # change_encoding enc
-
- method clone =
- ( {< markup_resolver = markup_resolver # clone >}
- : #Pxp_reader.resolver :> Pxp_reader.resolver )
- end
-;;
-
-
-let pxp_source src =
- match src with
- Entity (mkent, res) -> Pxp_yacc.Entity(mkent, new pxp_resolver res)
- | ExtID (id, res) -> Pxp_yacc.ExtID(id, new pxp_resolver res)
- | Channel ch -> Pxp_yacc.from_channel
- ~system_encoding:`Enc_iso88591 ch
- | File f -> Pxp_yacc.from_file
- ~system_encoding:`Enc_iso88591 f
- | Latin1 s -> Pxp_yacc.from_string ~fixenc:`Enc_iso88591 s
-;;
-
-
-let pxp_dom dom =
- let dex =
- try Hashtbl.find dom.map T_data
- with Not_found -> assert false
- in
- let eex = dom.default_element in
- let m = Hashtbl.create 100 in
- Hashtbl.iter
- (fun nt ex ->
- match nt with
- T_element name when name <> "-vr" && name <> "-pi" ->
- let pxp_ex = ex # pxp_node in
- Hashtbl.add m name pxp_ex
- | _ -> ()
- )
- dom.map;
- let srex =
- try
- Some ((Hashtbl.find dom.map (T_element "-vr")) # pxp_node)
- with
- Not_found -> None
- in
- let piex =
- try
- Some ((Hashtbl.find dom.map (T_element "-pi")) # pxp_node)
- with
- Not_found -> None
- in
- Pxp_document.make_spec_from_mapping
- ?super_root_exemplar:srex
- ?default_pinstr_exemplar:piex
- ~data_exemplar:(dex # pxp_node)
- ~default_element_exemplar:(eex # pxp_node)
- ~element_mapping:m
- ()
-;;
-
-
-let markup_document w index doc =
- let mdoc = new document w in
- mdoc # init_xml_version (doc # xml_version);
- mdoc # init_xml_standalone (doc # xml_standalone);
- let r = doc # root # extension in
- r # set_index index;
- mdoc # init_root (r # markup_node);
- List.iter
- (fun piname ->
- let l = doc # pinstr piname in
- List.iter
- (fun pi -> mdoc # add_pinstr pi)
- l)
- (doc # pinstr_names);
- mdoc
-;;
-
-
-
-let parse_dtd_entity cfg src =
- Pxp_yacc.parse_dtd_entity
- (pxp_config cfg)
- (pxp_source src)
-;;
-
-
-let parse_document_entity cfg src dom =
- let index = (new Pxp_yacc.hash_index :> 'ext Pxp_yacc.index) in
- markup_document
- cfg.warner
- index
- (Pxp_yacc.parse_document_entity
- ~id_index:index
- (pxp_config cfg)
- (pxp_source src)
- (pxp_dom dom))
-;;
-
-
-let parse_content_entity cfg src dtd dom =
- let index = (new Pxp_yacc.hash_index :> 'ext Pxp_yacc.index) in
- let n =
- (Pxp_yacc.parse_content_entity
- ~id_index:index
- (pxp_config cfg)
- (pxp_source src)
- dtd
- (pxp_dom dom)) # extension in
- n # set_index index;
- n # markup_node
-;;
-
-
-let parse_wf_entity cfg src dom =
- let index = (new Pxp_yacc.hash_index :> 'ext Pxp_yacc.index) in
- (* Restriction: index is not filled! *)
- markup_document
- cfg.warner
- index
- (Pxp_yacc.parse_wfdocument_entity
- (pxp_config cfg)
- (pxp_source src)
- (pxp_dom dom))
-;;
-
-
-(* ======================================================================
- * History:
- *
- * $Log$
- * Revision 1.1 2000/11/17 09:57:30 lpadovan
- * Initial revision
- *
- * Revision 1.4 2000/08/18 20:19:16 gerd
- * Updates in the emulation because of PXP changes.
- *
- * Revision 1.3 2000/07/14 21:35:35 gerd
- * Updated because of the simplification of Pxp_types.collect_warnings.
- *
- * Revision 1.2 2000/07/08 17:40:50 gerd
- * Updated the simulation.
- *
- * Revision 1.1 2000/05/29 23:43:51 gerd
- * Initial compatibility revision.
- *
- *)
projects / helm.git / blobdiff