X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2FDEVEL%2Fpxp%2Fpxp%2Fpxp_dtd.ml;fp=helm%2FDEVEL%2Fpxp%2Fpxp%2Fpxp_dtd.ml;h=0000000000000000000000000000000000000000;hp=ee62c4ff00fb77c3cb19aa619ee75149dc59df70;hb=869549224eef6278a48c16ae27dd786376082b38;hpb=89262281b6e83bd2321150f81f1a0583645eb0c8 diff --git a/helm/DEVEL/pxp/pxp/pxp_dtd.ml b/helm/DEVEL/pxp/pxp/pxp_dtd.ml deleted file mode 100644 index ee62c4ff0..000000000 --- a/helm/DEVEL/pxp/pxp/pxp_dtd.ml +++ /dev/null @@ -1,1090 +0,0 @@ -(* $Id$ - * ---------------------------------------------------------------------- - * PXP: The polymorphic XML parser for Objective Caml. - * Copyright by Gerd Stolpmann. See LICENSE for details. - *) - -open Pxp_types -open Pxp_lexer_types -open Pxp_lexers -open Pxp_entity -open Pxp_aux -open Pxp_dfa - -(**********************************************************************) - -class dtd the_warner init_encoding = - object (self) - val mutable root = (None : string option) - val mutable id = (None : dtd_id option) - - val warner = (the_warner : collect_warnings) - val encoding = init_encoding - val lexerset = Pxp_lexers.get_lexer_set init_encoding - - val elements = (Hashtbl.create 100 : (string,dtd_element) Hashtbl.t) - val gen_entities = (Hashtbl.create 100 : (string,entity * bool) Hashtbl.t) - val par_entities = (Hashtbl.create 100 : (string,entity) Hashtbl.t) - val notations = (Hashtbl.create 100 : (string,dtd_notation) Hashtbl.t) - val pinstr = (Hashtbl.create 100 : (string,proc_instruction) Hashtbl.t) - val mutable element_names = [] - val mutable gen_entity_names = [] - val mutable par_entity_names = [] - val mutable notation_names = [] - val mutable pinstr_names = [] - - val mutable allow_arbitrary = false - val mutable standalone_declaration = false - - val mutable validated = false - - initializer - let w = new drop_warnings in - self # add_gen_entity - (new internal_entity self "lt" w "&#60;" false false false encoding) - false; - self # add_gen_entity - (new internal_entity self "gt" w ">" false false false encoding) - false; - self # add_gen_entity - (new internal_entity self "amp" w "&#38;" false false false encoding) - false; - self # add_gen_entity - (new internal_entity self "apos" w "'" false false false encoding) - false; - self # add_gen_entity - (new internal_entity self "quot" w """ false false false encoding) - false; - - - method encoding = encoding - - method warner = warner - - method set_root r = - if root = None then - root <- Some r - else - assert false - - - method set_id j = - if id = None then - id <- Some j - else - assert false - - - method standalone_declaration = standalone_declaration - - method set_standalone_declaration b = - standalone_declaration <- b - - method allow_arbitrary = - allow_arbitrary <- true - - method disallow_arbitrary = - allow_arbitrary <- false - - method arbitrary_allowed = allow_arbitrary - - method root = root - method id = id - - - method add_element el = - (* raises Not_found if 'el' has already been added *) - (* Note: 'el' is encoded in the same way as 'self'! *) - let name = el # name in - check_name warner name; - if Hashtbl.mem elements name then - raise Not_found; - Hashtbl.add elements name el; - element_names <- name :: element_names; - validated <- false - - - method add_gen_entity en extdecl = - (* The following is commented out; perhaps there should be an option - * to reactivate it on demand - *) - (* raises Validation_error if the predefines entities 'lt', 'gt', 'amp', - * 'quot', and 'apos' are redeclared with an improper value. - *) - if en # encoding <> encoding then - failwith "Pxp_dtd.dtd # add_gen_entity: Inconsistent encodings"; - let name = en # name in - check_name warner name; - if Hashtbl.mem gen_entities name then begin - if List.mem name [ "lt"; "gt"; "amp"; "quot"; "apos" ] then begin - (* These are allowed to be declared several times *) - let (rt,_) = en # replacement_text in - let toks = tokens_of_content_string lexerset rt in - try - begin match toks with - [CRef 60] -> if name <> "lt" then raise Not_found - | [CharData ">"] -> if name <> "gt" then raise Not_found - | [CRef 62] -> if name <> "gt" then raise Not_found - | [CRef 38] -> if name <> "amp" then raise Not_found - | [CharData "'"] -> if name <> "apos" then raise Not_found - | [CRef 39] -> if name <> "apos" then raise Not_found - | [CharData "\""] -> if name <> "quot" then raise Not_found - | [CRef 34] -> if name <> "quot" then raise Not_found - | _ -> raise Not_found - end - with - Not_found -> - raise (Validation_error("Predefined entity `" ^ name ^ - "' redeclared")) - end - else - warner # warn ("Entity `" ^ name ^ "' declared twice") - end - else begin - Hashtbl.add gen_entities name (en, extdecl); - gen_entity_names <- name :: gen_entity_names - end - - - method add_par_entity en = - if en # encoding <> encoding then - failwith "Pxp_dtd.dtd # add_par_entity: Inconsistent encodings"; - let name = en # name in - check_name warner name; - if not (Hashtbl.mem par_entities name) then begin - Hashtbl.add par_entities name en; - par_entity_names <- name :: par_entity_names - end - else - warner # warn ("Entity `" ^ name ^ "' declared twice") - - - method add_notation no = - (* raises Validation_error if 'no' already added *) - if no # encoding <> encoding then - failwith "Pxp_dtd.dtd # add_notation: Inconsistent encodings"; - let name = no # name in - check_name warner name; - if Hashtbl.mem notations name then - raise (Validation_error("Notation `" ^ name ^ "' declared twice")); - Hashtbl.add notations name no; - notation_names <- name :: notation_names - - - method add_pinstr pi = - if pi # encoding <> encoding then - failwith "Pxp_dtd.dtd # add_pinstr: Inconsistent encodings"; - let name = pi # target in - check_name warner name; - - if String.length name >= 4 && String.sub name 0 4 = "pxp:" then begin - match name with - "pxp:dtd" -> - let _, optname, atts = pi # parse_pxp_option in - begin match optname with - "optional-element-and-notation-declarations" -> - self # allow_arbitrary - | "optional-attribute-declarations" -> - let lexers = Pxp_lexers.get_lexer_set encoding in - let el_string = - try List.assoc "elements" atts - with Not_found -> - raise(Error("Missing `elements' attribute for pxp:dtd")) - in - let el = split_attribute_value lexers el_string in - List.iter - (fun e_name -> - let e = - try Hashtbl.find elements e_name - with - Not_found -> - raise(Error("Reference to unknown element `" ^ - e_name ^ "'")) - in - e # allow_arbitrary - ) - el - | _ -> - raise(Error("Unknown PXP option `" ^ - optname ^ "'")) - end - | _ -> - raise(Error("The processing instruction target `" ^ - name ^ "' is not defined by this PXP version")) - end - else begin - (*---------------------------------------------------------------------- - * SUPPORT FOR DEPRECATED PI OPTIONS: - * - - * is now - * - ?> - * is now ...'?> - * 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 *) -(* Hashtbl.find elements v *) -(* with *) -(* Not_found -> *) -(* raise(Validation_error("Reference to undeclared element `"*) -(* ^ v ^ "'")) *) -(* in *) -(* e # allow_arbitrary; *) -(* end; *) - (*---------------------------------------------------------------------- - *) - () - end; - Hashtbl.add pinstr name pi; - pinstr_names <- name :: pinstr_names; - - - method element name = - (* returns the element 'name' or raises Validation_error if not found *) - try - Hashtbl.find elements name - with - Not_found -> - if allow_arbitrary then - raise Undeclared - else - raise(Validation_error("Reference to undeclared element `" ^ name ^ "'")) - - method element_names = - (* returns the list of all names of element declarations *) - element_names - - - method gen_entity name = - (* returns the entity 'name' or raises WF_error if not found *) - try - Hashtbl.find gen_entities name - with - Not_found -> - raise(WF_error("Reference to undeclared general entity `" ^ name ^ "'")) - - - method gen_entity_names = gen_entity_names - - - method par_entity name = - (* returns the entity 'name' or raises WF_error if not found *) - try - Hashtbl.find par_entities name - with - Not_found -> - raise(WF_error("Reference to undeclared parameter entity `" ^ name ^ "'")) - - - method par_entity_names = par_entity_names - - - method notation name = - (* returns the notation 'name' or raises Validation_error if not found *) - try - Hashtbl.find notations name - with - Not_found -> - if allow_arbitrary then - raise Undeclared - else - raise(Validation_error("Reference to undeclared notation `" ^ name ^ "'")) - - - method notation_names = notation_names - - - method pinstr name = - (* returns the list of all processing instructions contained in the DTD - * with target 'name' - *) - Hashtbl.find_all pinstr name - - - method pinstr_names = pinstr_names - - method write os enc doctype = - let wms = - write_markup_string ~from_enc:encoding ~to_enc:enc os in - - let write_sysid s = - if String.contains s '"' then - wms ("'" ^ s ^ "'") - else - wms ("\"" ^ s ^ "\""); - in - - if doctype then begin - wms " failwith "#write: DTD without root"; - | Some r -> wms r - ); - wms " [\n"; - end; - - (* Notations: *) - List.iter - (fun name -> - let notation = - try Hashtbl.find notations name with Not_found -> assert false in - notation # write os enc) - (List.sort compare notation_names); - - (* Unparsed entities: *) - List.iter - (fun name -> - let ent,_ = - try Hashtbl.find gen_entities name with Not_found -> assert false - in - if ent # is_ndata then begin - let xid = ent # ext_id in - let notation = ent # notation in - wms (" - wms "SYSTEM "; - write_sysid s; - | Public (p,s) -> - wms "PUBLIC "; - write_sysid p; - if (s <> "") then begin - wms " "; - write_sysid s; - end; - | Anonymous -> - failwith "#write: External ID Anonymous cannot be represented" - ); - wms (" NDATA " ^ notation ^ ">\n"); - end - ) - (List.sort compare gen_entity_names); - - (* Elements: *) - List.iter - (fun name -> - let element = - try Hashtbl.find elements name with Not_found -> assert false in - element # write os enc) - (List.sort compare element_names); - - (* Processing instructions: *) - List.iter - (fun name -> - let pi = - try Hashtbl.find pinstr name with Not_found -> assert false in - pi # write os enc) - (List.sort compare pinstr_names); - - if doctype then - wms "]>\n"; - - method write_compact_as_latin1 os doctype = - self # write os `Enc_iso88591 doctype - - - - (************************************************************) - (* VALIDATION *) - (************************************************************) - - method only_deterministic_models = - Hashtbl.iter - (fun n el -> - let cm = el # content_model in - match cm with - Regexp _ -> - if el # content_dfa = None then - raise(Validation_error("The content model of element `" ^ - n ^ "' is not deterministic")) - | _ -> - () - ) - elements; - - - method validate = - if validated or allow_arbitrary then - () - else begin - (* Validity constraint: Notations in NDATA entity declarations must - * be declared - *) - List.iter - (fun name -> - let ent,_ = - try Hashtbl.find gen_entities name with Not_found -> assert false - in - if ent # is_ndata then begin - let xid = ent # ext_id in - let notation = ent # notation in - try - ignore(self # notation notation) - (* Raises Validation_error if the constraint is violated *) - with - Undeclared -> () - end - ) - gen_entity_names; - - (* Validate the elements: *) - Hashtbl.iter - (fun n el -> - el # validate) - elements; - - (* Check the root element: *) - (* TODO: Check if this piece of code is executed at all! *) - begin match root with - None -> () - | Some r -> - begin try - let _ = Hashtbl.find elements r in () - with - Not_found -> - raise(Validation_error("The root element is not declared")) - end - end; - validated <- true; - end - - method invalidate = - validated <- false - - (************************************************************) - - end - - -(**********************************************************************) - -and dtd_element the_dtd the_name = - object (self) - val dtd = (the_dtd : dtd) - val name = the_name - val lexerset = Pxp_lexers.get_lexer_set (the_dtd # encoding) - val mutable content_model = Unspecified - val mutable content_model_validated = false - val mutable content_dfa = lazy None - - val mutable externally_declared = false - - val mutable attributes = - ([] : (string * ((att_type * att_default) * bool)) list) - val mutable attributes_validated = false - - val mutable id_att_name = None - val mutable idref_att_names = [] - - val mutable allow_arbitrary = false - - method name = name - - method set_cm_and_extdecl m extdecl = - if content_model = Unspecified then begin - content_model <- m; - content_model_validated <- false; - content_dfa <- lazy (self # compute_content_dfa); - externally_declared <- extdecl; - dtd # invalidate - end - else - raise(Validation_error("Element `" ^ name ^ "' has already a content model")) - - method content_model = content_model - - method content_dfa = Lazy.force content_dfa - - method private compute_content_dfa = - match content_model with - Regexp re -> - ( try Some (dfa_of_regexp_content_model re) - with Not_found -> None - ) - | _ -> - None - - method externally_declared = externally_declared - - method encoding = dtd # encoding - - method allow_arbitrary = - allow_arbitrary <- true - - method disallow_arbitrary = - allow_arbitrary <- false - - method arbitrary_allowed = allow_arbitrary - - method add_attribute aname t d extdecl = - if aname <> "xml:lang" & aname <> "xml:space" then - check_name (dtd#warner) aname; - if List.mem_assoc aname attributes then - dtd # warner # warn ("More than one declaration for attribute `" ^ - aname ^ "' of element type `" ^ name ^ "'") - else begin - begin match aname with - "xml:space" -> - begin match t with - A_enum l -> - let l' = Sort.list ( <= ) l in - if l' <> [ "default"; "preserve" ] then - raise(Validation_error("Declaration of attribute `xml:space' does not conform to XML specification")) - | _ -> - raise(Validation_error("Declaration of attribute `xml:space' does not conform to XML specification")) - end - | _ -> () - end; - begin match t with - A_id -> - id_att_name <- Some aname; - | (A_idref | A_idrefs) -> - idref_att_names <- aname :: idref_att_names - | _ -> - () - end; - attributes <- (aname, ((t,d),extdecl)) :: attributes; - attributes_validated <- false; - dtd # invalidate; - end - - method attribute attname = - try - fst (List.assoc attname attributes) - with - Not_found -> - if allow_arbitrary then - raise Undeclared - else - raise(Validation_error("Attribute `" ^ attname ^ "' of element `" - ^ name ^ "' not declared")) - - method attribute_violates_standalone_declaration attname v = - try - let (atype, adefault), extdecl = List.assoc attname attributes in - extdecl && - ( match v with - None -> - adefault <> D_required && adefault <> D_implied - (* i.e. adefault matches D_default or D_fixed *) - | Some s -> - atype <> A_cdata && - normalization_changes_value lexerset atype s - ) - with - Not_found -> - if allow_arbitrary then - raise Undeclared - else - raise(Validation_error("Attribute `" ^ attname ^ "' of element `" - ^ name ^ "' not declared")) - - - method attribute_names = - List.map fst attributes - - method names_of_required_attributes = - List.flatten - (List.map - (fun (n,((t,d),_)) -> - if d = D_required then - [n] - else - []) - attributes) - - method id_attribute_name = id_att_name - - method idref_attribute_names = idref_att_names - - - method write os enc = - let encoding = self # encoding in - let wms = - write_markup_string ~from_enc:encoding ~to_enc:enc os in - - let rec write_contentspec cs = - match cs with - Unspecified -> - failwith "#write: Unspecified content model found" - | Empty -> - wms "EMPTY" - | Any -> - wms "ANY" - | Mixed ml -> - wms "("; - write_mixedspec_list ml; - wms ")*"; - | Regexp re -> - write_children re false - - and write_mixedspec_list ml = - match ml with - MPCDATA :: ml' -> - wms "#PCDATA"; - if ml' <> [] then wms "|"; - write_mixedspec_list ml'; - | MChild s :: ml' -> - wms s; - if ml' <> [] then wms "|"; - write_mixedspec_list ml'; - | [] -> - () - - and write_children re cp = - match re with - Optional re' -> - let p = needs_parens re' in - if p then wms "("; - write_children re' cp; - if p then wms ")"; - wms "?"; - | Repeated re' -> - let p = needs_parens re' in - if p then wms "("; - write_children re' cp; - if p then wms ")"; - wms "*"; - | Repeated1 re' -> - let p = needs_parens re' in - if p then wms "("; - write_children re' cp; - if p then wms ")"; - wms "+"; - | Alt re' -> - wms "("; - ( match re' with - re1' :: rer' -> - write_children re1' true; - List.iter - (fun ren' -> - wms "|"; - write_children ren' true; - ) - rer'; - | [] -> - failwith "#write: Illegal content model" - ); - wms ")"; - | Seq re' -> - wms "("; - ( match re' with - re1' :: rer' -> - write_children re1' true; - List.iter - (fun ren' -> - wms ","; - write_children ren' true; - ) - rer'; - | [] -> - failwith "#write: Illegal content model" - ); - wms ")"; - | Child ch -> - if not cp then wms "("; - wms ch; - if not cp then wms ")"; - - and needs_parens re = - match re with - (Optional _ | Repeated _ | Repeated1 _ ) -> true - | _ -> false - in - - wms ("\n"; - - wms (" - wms ("\n " ^ n); - ( match t with - A_cdata -> wms " CDATA"; - | A_id -> wms " ID"; - | A_idref -> wms " IDREF"; - | A_idrefs -> wms " IDREFS"; - | A_entity -> wms " ENTITY"; - | A_entities -> wms " ENTITIES"; - | A_nmtoken -> wms " NMTOKEN"; - | A_nmtokens -> wms " NMTOKENS"; - | A_notation nl -> - wms " NOTATION ("; - ( match nl with - nl1:: nl' -> - wms nl1; - List.iter - (fun n -> - wms ("|" ^ n); - ) - nl' - | [] -> - failwith "#write: Illegal content model"; - ); - wms ")"; - | A_enum el -> - wms " ("; - ( match el with - el1:: el' -> - wms el1; - List.iter - (fun e -> - wms ("|" ^ e); - ) - el' - | [] -> - failwith "#write: Illegal content model"; - ); - wms ")"; - ); - ( match d with - D_required -> wms " #REQUIRED" - | D_implied -> wms " #IMPLIED" - | D_default s -> - wms " \""; - write_data_string ~from_enc:encoding ~to_enc:enc os s; - wms "\""; - | D_fixed s -> - wms " FIXED \""; - write_data_string ~from_enc:encoding ~to_enc:enc os s; - wms "\""; - ); - ) - attributes; - - wms ">\n"; - - method write_compact_as_latin1 os = - self # write os `Enc_iso88591 - - (************************************************************) - (* VALIDATION *) - (************************************************************) - - method validate = - self # validate_attributes(); - self # validate_content_model() - - method private validate_attributes() = - if attributes_validated then - () - else begin - (* Validity Constraint: One ID per Element Type *) - let n = count (fun (n,((t,d),_)) -> t = A_id) attributes in - if n > 1 then - raise(Validation_error("More than one ID attribute for element `" ^ name ^ "'")); - (* Validity Constraint: ID Attribute Default *) - if List.exists - (fun (n,((t,d),_)) -> - t = A_id & (d <> D_required & d <> D_implied)) - attributes - then - raise(Validation_error("ID attribute must be #IMPLIED or #REQUIRED; element `" ^ name ^ "'")); - (* Validity Constraint: One Notation per Element Type *) - let n = count (fun (n,((t,d),_)) -> - match t with A_notation _ -> true | _ -> false) - attributes in - if n > 1 then - raise(Validation_error("More than one NOTATION attribute for element `" ^ name ^ "'")); - (* Validity Constraint: Notation Attributes [second part] *) - List.iter - (fun (n,((t,d),_)) -> - match t with - A_notation l -> - List.iter - (fun nname -> - let _ = dtd # notation nname in ()) - l - | _ -> ()) - attributes; - (* Validity Constraint: Attribute Default Legal *) - List.iter - (fun (n,((t,d),_)) -> - - let check v = - let lexical_error() = - lazy (raise(Validation_error("Default value for attribute `" ^ n ^ "' is lexically malformed"))) in - check_attribute_value_lexically lexerset (lexical_error()) t v; - begin match t with - (A_entity|A_entities) -> - List.iter - (fun nd -> - let en, extdecl = dtd # gen_entity nd in - if not (en # is_ndata) then - raise(Validation_error("Attribute default value must be the name of an NDATA entity; attribute `" ^ n ^ "' in declaration for element `" ^ name ^ "'")); -(* if dtd # standalone_declaration && extdecl then - raise(Validation_error("Attribute default value violates the standalone declaration; attribute `" ^ n ^ "' in declaration for element `" ^ name ^ "'")); --- This is checked anyway when the attribute value is normalized -*) - ) - (split_attribute_value lexerset v) - | A_notation nl -> - if not (List.mem v nl) then - raise(Validation_error("Illegal default value for attribute `" ^ n ^ "' in declaration for element `" ^ name ^ "'")); - | A_enum nl -> - if not (List.mem v nl) then - raise(Validation_error("Illegal default value for attribute `" ^ n ^ "' in declaration for element `" ^ name ^ "'")); - | _ -> () - end - in - - match d with - D_required -> () - | D_implied -> () - | D_default v -> check v - | D_fixed v -> check v - ) - attributes; - - (* Ok: This element declaration is valid *) - attributes_validated <- true; - - end - - method private validate_content_model () = - (* checks: - * - Validity Constraint: No Duplicate Types - * It is not an error if there is a child in the declaration for which - * no element declaration is provided. - *) - match content_model with - Unspecified -> - dtd # warner # warn ("Element type `" ^ name ^ "' mentioned but not declared"); - () - | Empty -> () - | Any -> () - | Mixed (pcdata :: l) -> - (* MPCDATA is always the first element by construction *) - assert (pcdata = MPCDATA); - if check_dups l then - raise (Validation_error("Double children in declaration for element `" ^ name ^ "'")) - | Regexp _ -> () - | _ -> assert false - - - - (************************************************************) - - end - -and dtd_notation the_name the_xid init_encoding = -object (self) - val name = the_name - val xid = (the_xid : ext_id) - val encoding = (init_encoding : Pxp_types.rep_encoding) - method name = name - method ext_id = xid - method encoding = encoding - - method write os enc = - let wms = - write_markup_string ~from_enc:encoding ~to_enc:enc os in - - let write_sysid s = - if String.contains s '"' then - wms ("'" ^ s ^ "'") - else - wms ("\"" ^ s ^ "\""); - in - - wms (" - wms "SYSTEM "; - write_sysid s; - | Public (p,s) -> - wms "PUBLIC "; - write_sysid p; - if (s <> "") then begin - wms " "; - write_sysid s; - end; - | Anonymous -> - failwith "#write: External ID Anonymous cannot be represented" - ); - wms ">\n"; - - method write_compact_as_latin1 os = - self # write os `Enc_iso88591 - - end - -and proc_instruction the_target the_value init_encoding = -object (self) - val target = the_target - val value = (the_value : string) - val encoding = (init_encoding : Pxp_types.rep_encoding) - - initializer - match target with - ("xml"|"xmL"|"xMl"|"xML"|"Xml"|"XmL"|"XMl"|"XML") -> - (* This is an error, not a warning, because I do not have a - * "warner" object by hand. - *) - raise(WF_error("Reserved processing instruction")) - | _ -> () - - method target = target - method value = value - method encoding = encoding - - method write os enc = - let wms = - write_markup_string ~from_enc:encoding ~to_enc:enc os in - - wms ""; - - method write_compact_as_latin1 os = - self # write os `Enc_iso88591 - - method parse_pxp_option = - let lexers = get_lexer_set encoding in - try - let toks = tokens_of_xml_pi lexers value in (* may raise WF_error *) - begin match toks with - (Pro_name option_name) :: toks' -> - let atts = decode_xml_pi toks' in (* may raise WF_error *) - (target, option_name, atts) - | _ -> - raise(Error("Bad PXP processing instruction")) - end - with - WF_error _ -> - raise(Error("Bad PXP processing instruction")) - - end -;; - - -(* ====================================================================== - * History: - * - * $Log$ - * Revision 1.1 2000/11/17 09:57:29 lpadovan - * Initial revision - * - * Revision 1.10 2000/08/18 21:18:45 gerd - * Updated wrong comments for methods par_entity and gen_entity. - * These can raise WF_error and not Validation_error, and this is the - * correct behaviour. - * - * Revision 1.9 2000/07/25 00:30:01 gerd - * Added support for pxp:dtd PI options. - * - * Revision 1.8 2000/07/23 02:16:34 gerd - * Support for DFAs. - * - * Revision 1.7 2000/07/16 17:50:01 gerd - * Fixes in 'write' - * - * Revision 1.6 2000/07/16 16:34:41 gerd - * New method 'write', the successor of 'write_compact_as_latin1'. - * - * Revision 1.5 2000/07/14 13:56:48 gerd - * Added methods id_attribute_name and idref_attribute_names. - * - * Revision 1.4 2000/07/09 00:13:37 gerd - * Added methods gen_entity_names, par_entity_names. - * - * Revision 1.3 2000/07/04 22:10:55 gerd - * Update: collect_warnings -> drop_warnings. - * Update: Case ext_id = Anonymous. - * - * Revision 1.2 2000/06/14 22:19:06 gerd - * Added checks such that it is impossible to mix encodings. - * - * Revision 1.1 2000/05/29 23:48:38 gerd - * Changed module names: - * Markup_aux into Pxp_aux - * Markup_codewriter into Pxp_codewriter - * Markup_document into Pxp_document - * Markup_dtd into Pxp_dtd - * Markup_entity into Pxp_entity - * Markup_lexer_types into Pxp_lexer_types - * Markup_reader into Pxp_reader - * Markup_types into Pxp_types - * Markup_yacc into Pxp_yacc - * See directory "compatibility" for (almost) compatible wrappers emulating - * Markup_document, Markup_dtd, Markup_reader, Markup_types, and Markup_yacc. - * - * ====================================================================== - * - * Revision 1.18 2000/05/28 17:24:55 gerd - * Bugfixes. - * - * Revision 1.17 2000/05/27 19:21:25 gerd - * Implemented the changes of rev. 1.10 of markup_dtd.mli. - * - * Revision 1.16 2000/05/20 20:31:40 gerd - * Big change: Added support for various encodings of the - * internal representation. - * - * Revision 1.15 2000/05/14 21:50:07 gerd - * Updated: change in internal_entity. - * - * Revision 1.14 2000/05/06 23:08:46 gerd - * It is possible to allow undeclared attributes. - * - * Revision 1.13 2000/05/01 20:42:46 gerd - * New method write_compact_as_latin1. - * - * Revision 1.12 2000/05/01 15:16:57 gerd - * The errors "undeclared parameter/general entities" are - * well-formedness errors, not validation errors. - * - * Revision 1.11 2000/03/11 22:58:15 gerd - * Updated to support Markup_codewriter. - * - * Revision 1.10 2000/01/20 20:53:47 gerd - * Changed such that it runs with Markup_entity's new interface. - * - * Revision 1.9 1999/11/09 22:15:41 gerd - * Added method "arbitrary_allowed". - * - * Revision 1.8 1999/09/01 22:52:22 gerd - * If 'allow_arbitrary' is in effect, no validation happens anymore. - * - * Revision 1.7 1999/09/01 16:21:24 gerd - * Added several warnings. - * The attribute type of "xml:space" is now strictly checked. - * - * Revision 1.6 1999/08/15 20:34:21 gerd - * Improved error messages. - * Bugfix: It is no longer allowed to create processing instructions - * with target "xml". - * - * Revision 1.5 1999/08/15 02:20:16 gerd - * New feature: a DTD can allow arbitrary elements. - * - * Revision 1.4 1999/08/15 00:21:39 gerd - * Comments have been updated. - * - * Revision 1.3 1999/08/14 22:12:52 gerd - * Several functions have now a "warner" as argument which is - * an object with a "warn" method. This is used to warn about characters - * that cannot be represented in the Latin 1 alphabet. - * Bugfix: if two general entities with the same name are definied, - * the first counts, not the second. - * - * Revision 1.2 1999/08/11 14:56:35 gerd - * Declaration of the predfined entities {lt,gt,amp,quot,apos} - * is no longer forbidden; but the original definition cannot be overriddden. - * TODO: If these entities are redeclared with problematic values, - * the user should be warned. - * - * Revision 1.1 1999/08/10 00:35:51 gerd - * Initial revision. - * - * - *)