1------------------------------------------------------------------------------
2--                                                                          --
3--                            Matreshka Project                             --
4--                                                                          --
5--                               XML Processor                              --
6--                                                                          --
7--                        Runtime Library Component                         --
8--                                                                          --
9------------------------------------------------------------------------------
10--                                                                          --
11-- Copyright © 2010-2014, Vadim Godunko <vgodunko@gmail.com>                --
12-- All rights reserved.                                                     --
13--                                                                          --
14-- Redistribution and use in source and binary forms, with or without       --
15-- modification, are permitted provided that the following conditions       --
16-- are met:                                                                 --
17--                                                                          --
18--  * Redistributions of source code must retain the above copyright        --
19--    notice, this list of conditions and the following disclaimer.         --
20--                                                                          --
21--  * Redistributions in binary form must reproduce the above copyright     --
22--    notice, this list of conditions and the following disclaimer in the   --
23--    documentation and/or other materials provided with the distribution.  --
24--                                                                          --
25--  * Neither the name of the Vadim Godunko, IE nor the names of its        --
26--    contributors may be used to endorse or promote products derived from  --
27--    this software without specific prior written permission.              --
28--                                                                          --
29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS      --
30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT        --
31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR    --
32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT     --
33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,   --
34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED --
35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR   --
36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF   --
37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING     --
38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS       --
39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.             --
40--                                                                          --
41------------------------------------------------------------------------------
42--  $Revision: 4789 $ $Date: 2014-03-31 10:02:27 +0400 (Mon, 31 Mar 2014) $
43------------------------------------------------------------------------------
44private with Ada.Containers.Hashed_Maps;
45private with Ada.Containers.Ordered_Maps;
46private with Ada.Containers.Vectors;
47
48with League.Characters;
49with League.Strings.Hash;
50with XML.SAX.Attributes;
51with XML.SAX.Output_Destinations;
52with XML.SAX.Writers;
53
54package XML.SAX.Pretty_Writers is
55
56   type SAX_Output_Destination_Access is
57     access all XML.SAX.Output_Destinations.SAX_Output_Destination'Class;
58
59   type XML_Version is (XML_1_0, XML_1_1);
60
61   type XML_Pretty_Writer is limited new XML.SAX.Writers.SAX_Writer with private;
62
63   not overriding procedure Set_Version
64    (Self    : in out XML_Pretty_Writer;
65     Version : XML_Version);
66
67   not overriding procedure Set_Offset
68    (Self   : in out XML_Pretty_Writer;
69     Offset : Natural);
70   --  Sets offset for indentation.
71
72   not overriding procedure Set_Value_Delimiter
73    (Self      : in out XML_Pretty_Writer;
74     Delimiter : League.Characters.Universal_Character);
75   --  Sets value delimiter for attributes.
76   --  '"' (apostrophe) is used by default
77
78   procedure Set_Output_Destination
79    (Self   : in out XML_Pretty_Writer'Class;
80     Output : not null SAX_Output_Destination_Access);
81   --  Sets output destination to be used to output generated stream.
82
83   overriding procedure Characters
84    (Self    : in out XML_Pretty_Writer;
85     Text    : League.Strings.Universal_String;
86     Success : in out Boolean);
87
88   overriding procedure Comment
89    (Self    : in out XML_Pretty_Writer;
90     Text    : League.Strings.Universal_String;
91     Success : in out Boolean);
92
93   overriding procedure End_CDATA
94    (Self    : in out XML_Pretty_Writer;
95     Success : in out Boolean);
96
97   overriding procedure End_Document
98    (Self    : in out XML_Pretty_Writer;
99     Success : in out Boolean);
100
101   overriding procedure End_DTD
102    (Self    : in out XML_Pretty_Writer;
103     Success : in out Boolean);
104
105   overriding procedure End_Element
106    (Self           : in out XML_Pretty_Writer;
107     Namespace_URI  : League.Strings.Universal_String;
108     Local_Name     : League.Strings.Universal_String;
109     Qualified_Name : League.Strings.Universal_String;
110     Success        : in out Boolean);
111
112   overriding procedure End_Entity
113    (Self    : in out XML_Pretty_Writer;
114     Name    : League.Strings.Universal_String;
115     Success : in out Boolean);
116
117   overriding procedure End_Prefix_Mapping
118    (Self    : in out XML_Pretty_Writer;
119     Prefix  : League.Strings.Universal_String
120       := League.Strings.Empty_Universal_String;
121     Success : in out Boolean);
122
123   overriding function Error_String
124    (Self : XML_Pretty_Writer) return League.Strings.Universal_String;
125
126   overriding procedure Ignorable_Whitespace
127    (Self    : in out XML_Pretty_Writer;
128     Text    : League.Strings.Universal_String;
129     Success : in out Boolean);
130
131   overriding procedure Processing_Instruction
132    (Self    : in out XML_Pretty_Writer;
133     Target  : League.Strings.Universal_String;
134     Data    : League.Strings.Universal_String;
135     Success : in out Boolean);
136
137   overriding procedure Skipped_Entity
138    (Self    : in out XML_Pretty_Writer;
139     Name    : League.Strings.Universal_String;
140     Success : in out Boolean);
141
142   overriding procedure Start_CDATA
143    (Self    : in out XML_Pretty_Writer;
144     Success : in out Boolean);
145
146   overriding procedure Start_Document
147    (Self    : in out XML_Pretty_Writer;
148     Success : in out Boolean);
149
150   overriding procedure Start_DTD
151    (Self      : in out XML_Pretty_Writer;
152     Name      : League.Strings.Universal_String;
153     Public_Id : League.Strings.Universal_String;
154     System_Id : League.Strings.Universal_String;
155     Success   : in out Boolean);
156
157   overriding procedure Start_Element
158    (Self           : in out XML_Pretty_Writer;
159     Namespace_URI  : League.Strings.Universal_String;
160     Local_Name     : League.Strings.Universal_String;
161     Qualified_Name : League.Strings.Universal_String;
162     Attributes     : XML.SAX.Attributes.SAX_Attributes;
163     Success        : in out Boolean);
164
165   overriding procedure Start_Entity
166    (Self    : in out XML_Pretty_Writer;
167     Name    : League.Strings.Universal_String;
168     Success : in out Boolean);
169
170   overriding procedure Start_Prefix_Mapping
171    (Self          : in out XML_Pretty_Writer;
172     Prefix        : League.Strings.Universal_String
173       := League.Strings.Empty_Universal_String;
174     Namespace_URI : League.Strings.Universal_String;
175     Success       : in out Boolean);
176
177private
178
179   package Mappings is
180      new Ada.Containers.Hashed_Maps
181           (League.Strings.Universal_String,
182            League.Strings.Universal_String,
183            League.Strings.Hash,
184            League.Strings."=",
185            League.Strings."=");
186
187   package Banks is
188      new Ada.Containers.Ordered_Maps
189           (League.Strings.Universal_String,
190            League.Strings.Universal_String,
191            League.Strings."<",
192            League.Strings."=");
193
194   type Element_Record is record
195      Namespace_URI  : League.Strings.Universal_String;
196      Local_Name     : League.Strings.Universal_String;
197      Qualified_Name : League.Strings.Universal_String;
198      Mapping        : Mappings.Map;
199   end record;
200
201   package Element_Vector is
202      new Ada.Containers.Vectors (Natural, Element_Record);
203
204   procedure Merge (Current : in out Mappings.Map; Bank : Banks.Map);
205   --  Merges namespaces declared for current element into the set of all
206   --  namespaces.
207
208   type XML_Pretty_Writer is limited new XML.SAX.Writers.SAX_Writer with record
209      Nesting      : Natural := 0;
210      Version      : XML_Version := XML_1_0;
211      Tag_Opened   : Boolean := False;
212      DTD_Opened   : Boolean := False;
213      Error        : League.Strings.Universal_String;
214      Destination  : SAX_Output_Destination_Access;
215
216      Indent       : Natural := 0;
217      Offset       : Natural := 0;
218      Chars        : Boolean := False;
219      --  Indent, offset and chars are used for automatic indentation.
220
221      Stack       : Element_Vector.Vector;
222      --  Stack of elements.
223
224      Requested_NS : Banks.Map;
225      --  Set of namespace mappings requested for the next element.
226
227      Current      : Element_Record;
228      --  Current processing element including effective namespace mapping.
229
230      Delimiter    : League.Characters.Universal_Character
231        := League.Characters.To_Universal_Character (''');
232      -- Delimiter for atribute='value'.
233   end record;
234
235   function Escape
236    (Self       : XML_Pretty_Writer;
237     Text       : League.Strings.Universal_String;
238     Escape_All : Boolean := False)
239       return League.Strings.Universal_String;
240   --  Replaces special characters by their entity references.
241
242end XML.SAX.Pretty_Writers;
243