1------------------------------------------------------------------------------
2--                     XML/Ada - An XML suite for Ada95                     --
3--                                                                          --
4--                     Copyright (C) 2001-2017, AdaCore                     --
5--                                                                          --
6-- This library is free software;  you can redistribute it and/or modify it --
7-- under terms of the  GNU General Public License  as published by the Free --
8-- Software  Foundation;  either version 3,  or (at your  option) any later --
9-- version. This library is distributed in the hope that it will be useful, --
10-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
12--                                                                          --
13-- As a special exception under Section 7 of GPL version 3, you are granted --
14-- additional permissions described in the GCC Runtime Library Exception,   --
15-- version 3.1, as published by the Free Software Foundation.               --
16--                                                                          --
17-- You should have received a copy of the GNU General Public License and    --
18-- a copy of the GCC Runtime Library Exception along with this program;     --
19-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
20-- <http://www.gnu.org/licenses/>.                                          --
21--                                                                          --
22------------------------------------------------------------------------------
23
24pragma Ada_05;
25
26with Sax.Attributes;       use Sax.Attributes;
27with Sax.Symbols;          use Sax.Symbols;
28with Sax.Utils;            use Sax.Utils;
29with Unicode;              use Unicode;
30with Unicode.CES;          use Unicode.CES;
31with DOM.Core.Attrs;       use DOM.Core.Attrs;
32with DOM.Core.Nodes;       use DOM.Core.Nodes;
33with DOM.Core.Documents;   use DOM.Core.Documents;
34with DOM.Core.Elements;    use DOM.Core.Elements;
35with DOM.Core.Character_Datas; use DOM.Core.Character_Datas;
36
37package body DOM.Readers is
38
39   --------------------
40   -- Start_Document --
41   --------------------
42
43   procedure Start_Document (Handler : in out Tree_Reader) is
44      Implementation : DOM_Implementation;
45   begin
46      Handler.Tree := Create_Document
47        (Implementation, Symbols => Get_Symbol_Table (Handler));
48      Handler.Current_Node := Handler.Tree;
49   end Start_Document;
50
51   -------------------
52   -- Start_Element --
53   -------------------
54
55   procedure Start_Element
56     (Handler       : in out Tree_Reader;
57      NS            : Sax.Utils.XML_NS;
58      Local_Name    : Sax.Symbols.Symbol;
59      Atts          : Sax_Attribute_List)
60   is
61      Att, Att2 : Attr;
62      pragma Warnings (Off, Local_Name);
63      pragma Warnings (Off, Att2);
64      Name : Qualified_Name;
65   begin
66      Handler.Current_Node := Append_Child
67        (Handler.Current_Node,
68         Create_Element_NS
69           (Handler.Tree,
70            Symbols        => Get_Symbol_Table (Handler),
71            Namespace_URI  => Get_URI (NS),
72            Prefix         => Get_Prefix (NS),
73            Local_Name     => Local_Name));
74
75      --  Insert the attributes in the right order.
76      for J in 1 .. Get_Length (Atts) loop
77         Name := Get_Name (Atts, J);
78         Att := Create_Attribute_NS
79           (Handler.Tree,
80            Symbols       => Get_Symbol_Table (Handler),
81            Namespace_URI => Name.NS,
82            Prefix        => Get_Prefix (Atts, J),
83            Local_Name    => Name.Local);
84         Set_Value (Att, Get_Value (Atts, J));
85         Att2 := Set_Attribute_Node (Handler.Current_Node, Att);
86         if Get_Type (Atts, J) = Sax.Attributes.Id then
87            Set_Id_Attribute_Node (Handler.Current_Node, Att, Is_Id => True);
88         end if;
89      end loop;
90   end Start_Element;
91
92   -----------------
93   -- End_Element --
94   -----------------
95
96   procedure End_Element
97     (Handler : in out Tree_Reader;
98      NS            : Sax.Utils.XML_NS;
99      Local_Name    : Sax.Symbols.Symbol)
100   is
101      pragma Warnings (Off, NS);
102      pragma Warnings (Off, Local_Name);
103   begin
104      Handler.Current_Node := Parent_Node (Handler.Current_Node);
105   end End_Element;
106
107   ----------------
108   -- Characters --
109   ----------------
110
111   procedure Characters
112     (Handler : in out Tree_Reader; Ch : Unicode.CES.Byte_Sequence)
113   is
114      pragma Unmodified (Handler);
115      Tmp : Node;
116      pragma Unreferenced (Tmp);
117   begin
118      --  If previous child is already a text node, we should just concatenate
119      --  the two, as required in DOM specifications (in Text node description)
120      if Last_Child (Handler.Current_Node) /= null
121        and then Node_Type (Last_Child (Handler.Current_Node)) = Text_Node
122      then
123         Append_Data (Last_Child (Handler.Current_Node), Ch);
124      else
125         Tmp := Append_Child
126           (Handler.Current_Node, Create_Text_Node (Handler.Tree, Ch));
127      end if;
128   end Characters;
129
130   -------------
131   -- Comment --
132   -------------
133
134   procedure Comment
135     (Handler : in out Tree_Reader;
136      Comment : Unicode.CES.Byte_Sequence)
137   is
138      pragma Unmodified (Handler);
139      Tmp : Node;
140      pragma Unreferenced (Tmp);
141   begin
142      Tmp := Append_Child
143        (Handler.Current_Node, Create_Comment (Handler.Tree, Comment));
144   end Comment;
145
146   --------------------------
147   -- Ignorable_Whitespace --
148   --------------------------
149
150   procedure Ignorable_Whitespace
151     (Handler : in out Tree_Reader; Ch : Unicode.CES.Byte_Sequence)
152   is
153      pragma Unmodified (Handler);
154      Tmp : Node;
155      pragma Unreferenced (Tmp);
156   begin
157      --  Ignore these white spaces at the toplevel
158      if Handler.Current_Node /= Handler.Tree then
159         Tmp := Append_Child
160           (Handler.Current_Node, Create_Text_Node (Handler.Tree, Ch));
161      end if;
162   end Ignorable_Whitespace;
163
164   ----------------------------
165   -- Processing_Instruction --
166   ----------------------------
167
168   procedure Processing_Instruction
169     (Handler : in out Tree_Reader;
170      Target  : Unicode.CES.Byte_Sequence;
171      Data    : Unicode.CES.Byte_Sequence)
172   is
173      pragma Unmodified (Handler);
174      Tmp : Node;
175      pragma Unreferenced (Tmp);
176   begin
177      if not Handler.In_DTD then
178         Tmp := Append_Child
179           (Handler.Current_Node,
180            Create_Processing_Instruction (Handler.Tree, Target, Data));
181      end if;
182   end Processing_Instruction;
183
184   --------------
185   -- Get_Tree --
186   --------------
187
188   function Get_Tree (Read : Tree_Reader) return Document is
189   begin
190      return Read.Tree;
191   end Get_Tree;
192
193   ---------------
194   -- Start_DTD --
195   ---------------
196
197   procedure Start_DTD
198     (Handler   : in out Tree_Reader;
199      Name      : Unicode.CES.Byte_Sequence;
200      Public_Id : Unicode.CES.Byte_Sequence := "";
201      System_Id : Unicode.CES.Byte_Sequence := "")
202   is
203      pragma Unreferenced (Name, Public_Id, System_Id);
204   begin
205      Handler.In_DTD := True;
206   end Start_DTD;
207
208   -------------
209   -- End_DTD --
210   -------------
211
212   procedure End_DTD (Handler : in out Tree_Reader) is
213   begin
214      Handler.In_DTD := False;
215   end End_DTD;
216
217   -----------
218   -- Error --
219   -----------
220
221   procedure Error
222     (Handler : in out Tree_Reader;
223      Except  : Sax.Exceptions.Sax_Parse_Exception'Class) is
224   begin
225      Fatal_Error (Handler, Except);
226   end Error;
227
228   -------------
229   -- Warning --
230   -------------
231
232   procedure Warning
233     (Handler : in out Tree_Reader;
234      Except  : Sax.Exceptions.Sax_Parse_Exception'Class) is
235   begin
236      if Handler.Warnings_As_Error then
237         Fatal_Error (Handler, Except);
238      end if;
239   end Warning;
240
241   ----------
242   -- Free --
243   ----------
244
245   procedure Free (Read : in out Tree_Reader) is
246   begin
247      Free (Read.Tree);
248      Read.Tree := null;
249   end Free;
250
251   ----------------------------
252   -- Set_Warnings_As_Errors --
253   ----------------------------
254
255   procedure Set_Warnings_As_Errors
256     (Read : in out Tree_Reader; Warnings_As_Error : Boolean) is
257   begin
258      Read.Warnings_As_Error := Warnings_As_Error;
259   end Set_Warnings_As_Errors;
260
261   ------------------
262   -- Current_Node --
263   ------------------
264
265   function Current_Node (Read : Tree_Reader) return Node is
266   begin
267      return Read.Current_Node;
268   end Current_Node;
269
270end DOM.Readers;
271