2 * ----------------------------------------------------------------------
9 class type [ 'node ] extension = [ 'node ] Pxp_document.extension
11 class type [ 'ext, 'node ] pxp_extension_type =
14 method node : 'self Pxp_document.node
15 method set_node : 'self Pxp_document.node -> unit
17 method markup_node : 'node
18 method set_markup_node : 'node -> unit
20 method set_index : 'self Pxp_yacc.index -> unit
21 method index : 'self Pxp_yacc.index
26 class type [ 'ext ] node =
28 constraint 'ext = 'ext node #extension
29 method pxp_node : (('ext, 'ext node) pxp_extension_type) Pxp_document.node
31 method extension : 'ext
33 method parent : 'ext node
34 method root : 'ext node
35 method orphaned_clone : 'ext node
36 method orphaned_flat_clone : 'ext node
37 method add_node : 'ext node -> unit
38 method add_pinstr : Markup_dtd.proc_instruction -> unit
39 method pinstr : string -> Markup_dtd.proc_instruction list
40 method pinstr_names : string list
41 method sub_nodes : 'ext node list
42 method iter_nodes : ('ext node -> unit) -> unit
43 method iter_nodes_sibl :
44 ('ext node option -> 'ext node -> 'ext node option -> unit) -> unit
45 method set_nodes : 'ext node list -> unit
47 method node_type : node_type
48 method attribute : string -> Markup_types.att_value
49 method attribute_names : string list
50 method attribute_type : string -> Markup_types.att_type
51 method attributes : (string * Markup_types.att_value) list
52 method required_string_attribute : string -> string
53 method required_list_attribute : string -> string list
54 method optional_string_attribute : string -> string option
55 method optional_list_attribute : string -> string list
56 method quick_set_attributes : (string * Markup_types.att_value) list -> unit
57 method find : string -> 'ext node
58 method reset_finder : unit
59 method dtd : Markup_dtd.dtd
60 method create_element :
61 Markup_dtd.dtd -> node_type -> (string * string) list -> 'ext node
62 method create_data : Markup_dtd.dtd -> string -> 'ext node
63 method local_validate : unit
64 method keep_always_whitespace_mode : unit
65 method write_compact_as_latin1 : Markup_types.output_stream -> unit
66 method internal_adopt : 'ext node option -> unit
67 method internal_delete : 'ext node -> unit
68 method internal_init : Markup_dtd.dtd -> string -> (string * string) list -> unit
73 class [ 'ext ] pxp_extension init_markup_node =
74 (object (self : 'self)
75 (* constraint 'ext = 'ext node #extension *)
76 val mutable pxp_node = (None :
77 'self Pxp_document.node option)
78 (* 'ext pxp_extension Pxp_document.node option *)
79 val mutable markup_node = (init_markup_node : 'ext node)
81 val mutable index = (None : 'self Pxp_yacc.index option)
95 method markup_node = markup_node
97 method set_markup_node n = markup_node <- n
108 : ['ext, 'ext node] pxp_extension_type )
112 class [ 'ext ] emulate_markup_node init_ext init_pxp_node =
114 constraint 'ext = 'ext node #extension
115 val mutable pxp_node = (init_pxp_node :
117 pxp_extension_type Pxp_document.node option)
118 val mutable extension = (init_ext : 'ext)
125 method extension = extension
126 method delete = self # pxp_node # delete
127 method parent = self # pxp_node # parent # extension # markup_node
128 method root = self # pxp_node # root # extension # markup_node
130 method orphaned_clone =
131 let ext' = extension # clone in
132 let pxp' = self # pxp_node # orphaned_clone in
133 let n = new emulate_markup_node ext' (Some pxp') in
134 ext' # set_node (n : 'ext #node :> 'ext node);
135 pxp' # extension # set_markup_node n;
138 method orphaned_flat_clone =
139 let ext' = extension # clone in
140 let pxp' = self # pxp_node # orphaned_flat_clone in
141 let n = new emulate_markup_node ext' (Some pxp') in
142 ext' # set_node (n : 'ext #node :> 'ext node);
143 pxp' # extension # set_markup_node n;
146 method dtd = self # pxp_node # dtd
148 method add_node (n : 'ext node) =
149 let n_pxp = n # pxp_node in
150 self # pxp_node # add_node n_pxp
152 method add_pinstr pi =
153 self # pxp_node # add_pinstr pi
156 let l = self # pxp_node # sub_nodes in
157 List.map (fun n_pxp -> n_pxp # extension # markup_node) l
160 self # pxp_node # pinstr name
162 method pinstr_names =
163 self # pxp_node # pinstr_names
165 method iter_nodes f =
166 self # pxp_node # iter_nodes
167 (fun n_pxp -> f (n_pxp # extension # markup_node))
169 method iter_nodes_sibl f =
170 self # pxp_node # iter_nodes_sibl
171 (fun left_pxp node_pxp right_pxp ->
175 | Some n_pxp -> Some (n_pxp # extension # markup_node) in
179 | Some n_pxp -> Some (n_pxp # extension # markup_node) in
181 node_pxp # extension # markup_node in
185 method set_nodes (l : 'ext node list) =
186 let l_pxp = List.map (fun n -> n # pxp_node) l in
187 self # pxp_node # set_nodes l_pxp
189 method data = self # pxp_node # data
192 match self # pxp_node # node_type with
193 Pxp_document.T_data -> T_data
194 | Pxp_document.T_element name -> T_element name
195 | Pxp_document.T_super_root -> T_element "-vr"
196 | Pxp_document.T_pinstr _ -> T_element "-pi"
199 method attribute name =
200 self # pxp_node # attribute name
202 method attribute_names =
203 self # pxp_node # attribute_names
205 method attribute_type name =
206 self # pxp_node # attribute_type name
209 self # pxp_node # attributes
211 method required_string_attribute name =
212 self # pxp_node # required_string_attribute name
214 method required_list_attribute name =
215 self # pxp_node # required_list_attribute name
217 method optional_string_attribute name =
218 self # pxp_node # optional_string_attribute name
220 method optional_list_attribute name =
221 self # pxp_node # optional_list_attribute name
223 method quick_set_attributes l =
224 self # pxp_node # quick_set_attributes l
226 method find (name : string) =
227 let index = self # root # pxp_node # extension # index in
228 let n = index # find name in (* may raise Not_found *)
229 n # extension # markup_node
231 method reset_finder = ()
233 method create_element dtd nt atts =
236 T_data -> Pxp_document.T_data
237 | T_element name -> Pxp_document.T_element name in
239 self # pxp_node # create_element dtd nt_pxp atts in
240 let ext' = extension # clone in
241 let n = new emulate_markup_node ext' (Some node_pxp) in
242 ext' # set_node (n : 'ext #node :> 'ext node);
243 node_pxp # extension # set_markup_node n;
246 method create_data dtd s =
248 self # pxp_node # create_data dtd s in
249 let ext' = extension # clone in
250 let n = new emulate_markup_node ext' (Some node_pxp) in
251 ext' # set_node (n : 'ext #node :> 'ext node);
252 node_pxp # extension # set_markup_node n;
255 method keep_always_whitespace_mode =
256 self # pxp_node # keep_always_whitespace_mode
258 method write_compact_as_latin1 out =
259 self # pxp_node # write_compact_as_latin1 out
261 method local_validate =
262 self # pxp_node # local_validate()
264 method internal_adopt (p:'ext node option) =
268 method internal_delete (n:'ext node) =
272 method internal_init (d:Markup_dtd.dtd) (s:string) (atts:(string*string)list) =
278 class [ 'ext ] data_impl ext data =
280 inherit [ 'ext ] emulate_markup_node ext None
281 constraint 'ext = 'ext node #extension
284 failwith "Emulation of Markup_document: Cannot instantiate data node with non-empty string";
285 let self' = (self : 'ext #node :> 'ext node ) in
286 pxp_node <- Some (new Pxp_document.data_impl (new pxp_extension self'))
291 class [ 'ext ] element_impl ext =
293 inherit [ 'ext ] emulate_markup_node ext None
295 let self' = (self : 'ext #node :> 'ext node ) in
296 pxp_node <- Some (new Pxp_document.element_impl (new pxp_extension self'))
301 class [ 'ext ] document w =
303 val pxp_doc = new Pxp_document.document
304 (w : Markup_types.collect_warnings :> Pxp_types.collect_warnings)
306 val mutable standalone_flag = false
308 method init_xml_version v =
309 pxp_doc # init_xml_version v
312 pxp_doc # xml_version
314 method init_xml_standalone b =
317 method xml_standalone = standalone_flag
319 method init_root (r : 'ext node) =
320 pxp_doc # init_root (r # pxp_node);
321 self # dtd # set_standalone_declaration standalone_flag
325 let pxp_root = pxp_doc # root in
326 pxp_root # extension # markup_node
331 method add_pinstr pi =
332 pxp_doc # add_pinstr pi
335 pxp_doc # pinstr name
337 method pinstr_names =
338 pxp_doc # pinstr_names
340 method write_compact_as_latin1 out =
341 pxp_doc # write_compact_as_latin1 out
346 (* ======================================================================
350 * Revision 1.1 2000/11/17 09:57:30 lpadovan
353 * Revision 1.6 2000/08/18 20:19:00 gerd
354 * Changed the emulation: there are now wrapper objects for nodes.
355 * This was necessary because node_type changed in PXP such that it became
356 * incompatible with Markup's node_type.
358 * Revision 1.5 2000/07/14 21:35:35 gerd
359 * Updated because of the simplification of Pxp_types.collect_warnings.
361 * Revision 1.4 2000/07/08 17:40:50 gerd
362 * Updated the simulation.
364 * Revision 1.3 2000/06/14 22:19:27 gerd
365 * Update because of additional 'encoding' methods.
367 * Revision 1.2 2000/05/30 00:08:40 gerd
370 * Revision 1.1 2000/05/29 23:43:51 gerd
371 * Initial compatibility revision.