]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/mlminidom/ominidom.ml
HBugs compile again (but it does not do anything right now: still to be
[helm.git] / helm / DEVEL / mlminidom / ominidom.ml
1 (* Copyright (C) 2000, Luca Padovani <luca.padovani@cs.unibo.it>.
2  *
3  * This file is part of mlminidom, the Ocaml binding for minidom.
4  * 
5  * mlminidom is free software; you can redistribute it and/or
6  * modify it under the terms of the GNU General Public License
7  * as published by the Free Software Foundation; either version 2
8  * of the License, or (at your option) any later version.
9  *
10  * mlminidom is distributed in the hope that it will be useful,
11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13  * GNU General Public License for more details.
14  *
15  * You should have received a copy of the GNU General Public License
16  * along with mlminidom; if not, write to the Free Software
17  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
18  * 
19  * For details, send a mail to the author.
20  *)
21
22 exception Node_has_no_parent;;
23 exception Node_has_no_sibling of string;;
24 exception Node_has_no_children;;
25 exception Node_has_no_attributes;;
26 exception Attribute_has_no_sibling of string;;
27 exception Attribute_has_no_parent;;
28 exception Undefined_entity;;
29
30 let option_to_exception v e =
31   match v with
32     Some x -> x
33   | None   -> raise e
34 ;;
35
36 class o_mDOMString (str: Minidom.mDOMString) =
37   object
38     method get_dom_string = str
39     method get_string = Minidom.string_of_mDOMString str
40   end;;
41   
42 let o_mDOMString_of_string str =
43   new o_mDOMString (Minidom.mDOMString_of_string str)
44
45 class o_mDOMEntity (ent : Minidom.mDOMEntity) =
46   object
47     method get_dom_entity = ent
48     method get_content =
49       new o_mDOMString (Minidom.entity_get_content ent)
50   end
51 ;;
52
53 class o_mDOMDoc (doc : Minidom.mDOMDoc) =
54   object
55     method get_dom_doc = doc
56
57     method get_root_node =
58       new o_mDOMNode (Minidom.doc_get_root_node doc)
59     method add_entity (name : o_mDOMString) (value : o_mDOMString) =
60       new o_mDOMEntity
61         (Minidom.doc_add_entity doc
62           (name#get_dom_string) (value#get_dom_string)
63         )
64     method get_entity (name : o_mDOMString) =
65       match Minidom.doc_get_entity doc (name#get_dom_string) with
66       | Some x -> new o_mDOMEntity x
67       | None -> raise Undefined_entity
68     method get_predefined_entity (name : o_mDOMString) =
69       match Minidom.doc_get_predefined_entity doc (name#get_dom_string) with
70       | Some x -> new o_mDOMEntity x
71       | None -> raise Undefined_entity
72   end
73 and o_mDOMNode (node : Minidom.mDOMNode) =
74   object
75     method get_dom_node = node
76
77     method is_text = Minidom.node_is_text node
78     method is_element = Minidom.node_is_element node
79     method is_blank = Minidom.node_is_blank node
80     method is_entity_ref = Minidom.node_is_entity_ref node
81
82     method get_type = Minidom.node_get_type node
83     method get_name = 
84       match Minidom.node_get_name node with
85       | Some x -> Some (new o_mDOMString x)
86       | None   -> None
87     method get_ns_uri =
88       match Minidom.node_get_ns_uri node with
89       | Some x -> Some (new o_mDOMString x)
90       | None   -> None
91     method get_attribute (name : o_mDOMString) =
92       match Minidom.node_get_attribute node (name#get_dom_string) with
93       | Some x -> Some (new o_mDOMString x)
94       | None   -> None
95     method get_attribute_ns (name : o_mDOMString) (uri : o_mDOMString) =
96       match 
97         Minidom.node_get_attribute_ns node
98           (name#get_dom_string) (uri#get_dom_string)
99       with
100       | Some x -> Some (new o_mDOMString x)
101       | None   -> None
102     method has_attribute (name : o_mDOMString) =
103      Minidom.node_has_attribute node (name#get_dom_string)
104     method has_attribute_ns (name : o_mDOMString) (uri : o_mDOMString) =
105      Minidom.node_has_attribute_ns node (name#get_dom_string) (uri#get_dom_string)
106     method get_content =
107       match Minidom.node_get_content node with
108       | Some x -> Some (new o_mDOMString x)
109       | None   -> None
110     method get_parent =
111       new o_mDOMNode
112         (option_to_exception (Minidom.node_get_parent node) Node_has_no_parent)
113     method get_prev_sibling =
114       new o_mDOMNode
115         (option_to_exception
116          (Minidom.node_get_prev_sibling node)
117          (Node_has_no_sibling "left")
118         )
119     method get_next_sibling =
120       new o_mDOMNode
121         (option_to_exception
122          (Minidom.node_get_next_sibling node)
123          (Node_has_no_sibling "right")
124         )
125     method get_first_child =
126       new o_mDOMNode
127         (option_to_exception
128          (Minidom.node_get_first_child node)
129          (Node_has_no_children)
130         )
131     method get_first_attribute =
132       new o_mDOMAttr
133         (option_to_exception
134           (Minidom.node_get_first_attribute node)
135           (Node_has_no_attributes)
136         )
137     method is_first = Minidom.node_is_first node
138     method is_last = Minidom.node_is_last node
139
140     method get_children =
141       List.map (function x -> new o_mDOMNode x) (Minidom.node_get_children node)
142     method get_attributes = List.map
143       (function x -> new o_mDOMAttr x) (Minidom.node_get_attributes node)
144   end
145 and o_mDOMAttr (attr : Minidom.mDOMAttr) =
146   object
147     method get_dom_attr = attr
148
149     method get_name =
150       match Minidom.attr_get_name attr with
151       | Some x -> Some (new o_mDOMString x)
152       | None   -> None
153     method get_ns_uri =
154       match Minidom.attr_get_ns_uri attr with
155       | Some x -> Some (new o_mDOMString x)
156       | None   -> None
157     method get_value =
158       match Minidom.attr_get_value attr with
159       | Some x -> Some (new o_mDOMString x)
160       | None   -> None
161     method get_prev_sibling =
162       new o_mDOMAttr
163         (option_to_exception
164           (Minidom.attr_get_prev_sibling attr)
165           (Attribute_has_no_sibling "left")
166         )
167     method get_next_sibling =
168       new o_mDOMAttr
169         (option_to_exception
170           (Minidom.attr_get_next_sibling attr)
171           (Attribute_has_no_sibling "right")
172         )
173     method get_parent =
174       new o_mDOMNode
175         (option_to_exception
176           (Minidom.attr_get_parent attr) Attribute_has_no_parent
177         )
178   end
179 ;;
180