Author: Xavier Grave This patch remove warnings and style warnings in order to ease compilation with -gnatwe and -gnaty all together. --- a/mckae-xml-ez_out-string_stream.ads +++ b/mckae-xml-ez_out-string_stream.ads @@ -32,31 +32,31 @@ with Ada.Text_IO; use Ada.Text_IO; -with Mckae.XML.EZ_Out.Generic_Medium; +with McKae.XML.EZ_Out.Generic_Medium; -package Mckae.XML.EZ_Out.String_Stream is +package McKae.XML.EZ_Out.String_Stream is - -- A basic in-memory string-based XML document construction + -- A basic in-memory string-based XML document construction -- utility. This is not intended to be a robust, full-function -- memory buffering package. --------------------------------------------------------------------------- - -- This nested package provides a basic string-based buffering + -- This nested package provides a basic string-based buffering -- capability. The purpose of the EZ_Out String_Stream package is -- to provide a simple means of constructing an XML document in a -- memory buffer. To do this, a memory buffering capability was -- needed--there were three approaches: -- - -- o Locate and employ an existing memory buffering component, + -- o Locate and employ an existing memory buffering component, -- modifying it as needed to provide the required Put and New_Line -- functions - -- o Write a McKae component to do memory buffering and reference + -- o Write a McKae component to do memory buffering and reference -- it in this package. - -- o Embed a memory buffering capability within the String_Stream + -- o Embed a memory buffering capability within the String_Stream -- package. -- - -- The first option was discarded not because there's anything + -- The first option was discarded not because there's anything -- wrong with existing memory buffer components, but rather -- because of questions about which one should be chosen, what are -- its distribution and modification requirements, and so on. The @@ -66,14 +66,14 @@ -- functionality, and then instantiate EZ_Out.Generic_Medium with -- it. -- - -- The second option was discarded because the focus of EZ_Out is + -- The second option was discarded because the focus of EZ_Out is -- on XML document generation, not providing a general purpose -- memory buffering component. While a limited capability one -- could have been created, it would be over-specific to EZ_Out -- and its (intentional) limitations would distract from its -- intended use as an EZ_Out adjunct package. -- - -- This left the third option. By embedding the above-mentioned + -- This left the third option. By embedding the above-mentioned -- limited capability memory buffering capability within -- String_Stream, it's clearly associated as just an aspect of the -- String_Stream implementation, as any relevant capabilities @@ -81,55 +81,56 @@ package String_Buffering is - -- There's little point in having a small buffer for building XML + -- There's little point in having a small buffer for building XML -- documents, so the minimum size and expansion is 500 characters. subtype Buffer_Size_Range is Positive range 500 .. Positive'Last; type String_Buffer (Initial_Size : Buffer_Size_Range := 5000; - Expansion : Buffer_Size_Range := 5000) is limited private; + Expansion : Buffer_Size_Range := 5000) + is limited private; - -- Copy the given string into the buffer, expanding it if needed. - procedure Put(F : in String_Buffer; - S : in String); + -- Copy the given string into the buffer, expanding it if needed. + procedure Put (F : in String_Buffer; + S : in String); - -- Insert a new line indicator into the buffer. However, in + -- Insert a new line indicator into the buffer. However, in -- this case do nothing, since this buffering package is being -- instantiated for Continuous_Stream formatting. procedure New_Line (F : in String_Buffer; Spacing : in Ada.Text_IO.Positive_Count := 1); - -- Clear the buffer. Note that this does not free any allocated + -- Clear the buffer. Note that this does not free any allocated -- resources. - procedure Clear(S : String_Buffer); + procedure Clear (S : String_Buffer); - -- Free ressources in order to avoid memory leak + -- Free ressources in order to avoid memory leak procedure Full_Clear (S : in out String_Buffer); - -- Return the current contents of the string buffer - function Get_String(S : String_Buffer) return String; + -- Return the current contents of the string buffer + function Get_String (S : String_Buffer) return String; private - -- Handle to the buffer + -- Handle to the buffer type Buffer_Ptr is access all String; - -- String buffer self-access ("Rosen Trick"); + -- String buffer self-access ("Rosen Trick"); type String_Self_Access (SB : access String_Buffer) is limited null record; - -- String buffer type definition. By default, a newly created - -- string buffer is initialized to be empty. + -- String buffer type definition. By default, a newly created + -- string buffer is initialized to be empty. type String_Buffer (Initial_Size : Buffer_Size_Range := 5000; Expansion : Buffer_Size_Range := 5000) is new Ada.Finalization.Limited_Controlled with record Allocation : Buffer_Size_Range := Initial_Size; Size : Natural := 0; - Buff : Buffer_Ptr := new String(1 .. Initial_Size); - Self : String_Self_Access(String_Buffer'Access); + Buff : Buffer_Ptr := new String (1 .. Initial_Size); + Self : String_Self_Access (String_Buffer'Access); end record; - -- Release the string buffer's resources when the buffer goes - -- out of scope + -- Release the string buffer's resources when the buffer goes + -- out of scope procedure Finalize (Object : in out String_Buffer); end String_Buffering; @@ -140,24 +141,24 @@ subtype String_Buffer is String_Buffering.String_Buffer; - -- Clear the buffer. Note that this does not free any allocated + -- Clear the buffer. Note that this does not free any allocated -- resources. - procedure Clear(S : String_Buffer) + procedure Clear (S : String_Buffer) renames String_Buffering.Clear; - -- Free ressources in order to avoid memory leak + -- Free ressources in order to avoid memory leak procedure Full_Clear (S : in out String_Buffer) renames String_Buffering.Full_Clear; - -- Return the current contents of the string buffer - function Get_String(S : String_Buffer) return String + -- Return the current contents of the string buffer + function Get_String (S : String_Buffer) return String renames String_Buffering.Get_String; --------------------------------------------------------------------------- - -- "Use" this XML_String_Buffer package for constructing an EZ_Out + -- "Use" this XML_String_Buffer package for constructing an EZ_Out -- XML document. - package XML_String_Buffer is new Mckae.XML.EZ_Out.Generic_Medium + package XML_String_Buffer is new McKae.XML.EZ_Out.Generic_Medium (Output_Medium => String_Buffering.String_Buffer, Put => String_Buffering.Put, New_Line => String_Buffering.New_Line, @@ -165,4 +166,4 @@ --------------------------------------------------------------------------- -end Mckae.XML.EZ_Out.String_Stream; +end McKae.XML.EZ_Out.String_Stream; --- a/mckae-xml-ez_out.ads +++ b/mckae-xml-ez_out.ads @@ -30,31 +30,33 @@ package McKae.XML.EZ_Out is - -- This package is the parent package for a collection of packages + -- This package is the parent package for a collection of packages -- that provide a simple means of XML output generation to a -- variety of output media. + -- Continuous_Stream : No indenting, line breaks, or other + -- extraneous whitespace. + -- Spread_Indented : Start and end tags are indented, and + -- each resides on its own line. type Formatting_Options is - (Continuous_Stream, -- No indenting, line breaks, or other - -- extraneous whitespace. - Spread_Indented -- Start and end tags are indented, and - -- each resides on its own line. - ); + (Continuous_Stream, + Spread_Indented + ); Element_Not_Open : exception; - -- An attempt was made to end, or add content to, an element when + -- An attempt was made to end, or add content to, an element when -- there were no open elements awaiting text or completion. Element_End_Mismatch : exception; - -- The specified end tag does not match that of the currently open + -- The specified end tag does not match that of the currently open -- element. Nesting_Too_Deep : exception; - -- The number of open, nested elements has exceeded the maximum + -- The number of open, nested elements has exceeded the maximum -- level that was specified. Invalid_Construction : exception; - -- An attempt was made to create a malformed document, such as + -- An attempt was made to create a malformed document, such as -- inserting a process instruction into an open element. end McKae.XML.EZ_Out; --- a/mckae-xml-ez_out-generic_medium.adb +++ b/mckae-xml-ez_out-generic_medium.adb @@ -30,14 +30,12 @@ with Ada.Strings.Fixed; use Ada.Strings.Fixed; -with Ada.Strings.Unbounded; -use Ada.Strings.Unbounded; package body McKae.XML.EZ_Out.Generic_Medium is ------------------------------------------------------------------------ - -- A very basic bounded stack implementation for keeping track of + -- A very basic bounded stack implementation for keeping track of -- nested XML elements. type Stack_Size is new Natural range 0 .. Max_Element_Nesting; @@ -48,20 +46,24 @@ Tag_Stack : Element_Stacks; Top_Of_Stack : Stack_Size := 0; - procedure Push(Tag : Unbounded_String) is + procedure Push (Tag : Unbounded_String); + + procedure Push (Tag : Unbounded_String) is begin if Top_Of_Stack /= Stack_Size'Last then Top_Of_Stack := Top_Of_Stack + 1; - Tag_Stack(Top_Of_Stack) := Tag; + Tag_Stack (Top_Of_Stack) := Tag; else raise Nesting_Too_Deep; end if; end Push; - procedure Pop(Tag : out Unbounded_String) is + procedure Pop (Tag : out Unbounded_String); + + procedure Pop (Tag : out Unbounded_String) is begin if Top_Of_Stack /= 0 then - Tag := Tag_Stack(Top_Of_Stack); + Tag := Tag_Stack (Top_Of_Stack); Top_Of_Stack := Top_Of_Stack - 1; else raise Element_Not_Open; @@ -75,46 +77,52 @@ Content_Component, End_Tag_Component); - Tab_Size : constant Natural := 3; - ------------------------------------------------------------------------ - -- Constructed Put_Line from provided primitives - procedure Put_Line(F : in Output_Medium; - S : in String) is + -- Constructed Put_Line from provided primitives + + procedure Put_Line (F : in Output_Medium; + S : in String); + + procedure Put_Line (F : in Output_Medium; + S : in String) is begin - Put(F, S); - New_Line(F); + Put (F, S); + New_Line (F); end Put_Line; ------------------------------------------------------------------------ procedure Replace_Special (C : in String; R : in String; + S : in out Unbounded_String); + + procedure Replace_Special (C : in String; + R : in String; S : in out Unbounded_String) is P : Natural := 0; begin - if Index(R, C) /= 0 then - -- The string to be replaced is present within the replacing + if Index (R, C) /= 0 then + -- The string to be replaced is present within the replacing -- string (e.g., "&" by "&"), so the replacement has to -- take this into account. P := 1; - while (P + C'Length - 1) <= Length(S) loop - if Slice(S, P, P + C'Length - 1) = C then - Replace_Slice(S, P, P + C'Length - 1, R); - P := P + R'Length; -- Skip over replacement string + while (P + C'Length - 1) <= Length (S) loop + if Slice (S, P, P + C'Length - 1) = C then + Replace_Slice (S, P, P + C'Length - 1, R); + P := P + R'Length; -- Skip over replacement string else P := P + 1; end if; end loop; else - -- The string to be replaced is not present within the + -- The string to be replaced is not present within the -- replacing string, so a simple find and replace can be -- done. loop - P := Index(S, C); + P := Index (S, C); exit when P = 0; - Replace_Slice(S, P, P + C'Length - 1, R); + Replace_Slice (S, P, P + C'Length - 1, R); end loop; end if; end Replace_Special; @@ -125,23 +133,29 @@ Subst : Boolean; Replace_Quotes : Boolean := False; Replace_Apos : Boolean := False) + return Unbounded_String; + + function Replace_Specials (S : Unbounded_String; + Subst : Boolean; + Replace_Quotes : Boolean := False; + Replace_Apos : Boolean := False) return Unbounded_String is New_S : Unbounded_String := S; begin if Subst then - -- Ampersands must be replaced first, since the replacement + -- Ampersands must be replaced first, since the replacement -- strings contain ampersands - Replace_Special("&", "&", New_S); + Replace_Special ("&", "&", New_S); - Replace_Special("<", "<", New_S); - Replace_Special("]]>", "]]>", New_S); + Replace_Special ("<", "<", New_S); + Replace_Special ("]]>", "]]>", New_S); if Replace_Quotes then - Replace_Special("""", """, New_S); + Replace_Special ("""", """, New_S); end if; if Replace_Apos then - Replace_Special("'", "'", New_S); + Replace_Special ("'", "'", New_S); end if; end if; return New_S; @@ -149,83 +163,87 @@ ------------------------------------------------------------------------ - -- Output the string in accordance with the specified format option. - procedure Formatted_Put(F : in Output_Medium; - S : in Unbounded_String; - K : in XML_Component_Kind) is + -- Output the string in accordance with the specified format option. - -- The number of items in the element nesting stack is directly + procedure Formatted_Put (F : in Output_Medium; + S : in Unbounded_String; + K : in XML_Component_Kind); + + procedure Formatted_Put (F : in Output_Medium; + S : in Unbounded_String; + K : in XML_Component_Kind) is + -- The number of items in the element nesting stack is directly -- proportional to the amount of required indenting - Indentation : constant Natural := Natural(Top_Of_Stack) * 3; - Value : constant String := To_String(S); + Indentation : constant Natural := Natural (Top_Of_Stack) * 3; + Value : constant String := To_String (S); begin case K is when Header_Component => - pragma Assert(Top_Of_Stack = 0); + pragma Assert (Top_Of_Stack = 0); case Current_Format is when Continuous_Stream => - Put(F, Value); + Put (F, Value); when Spread_Indented => - Put_Line(F, Value); + Put_Line (F, Value); end case; when Start_Tag_Component => case Current_Format is when Continuous_Stream => - Put(F, value); + Put (F, Value); when Spread_Indented => - Put(F, Indentation * ' '); - Put_Line(F, value); + Put (F, Indentation * ' '); + Put_Line (F, Value); end case; when Content_Component => case Current_Format is when Continuous_Stream => - Put(F, value); + Put (F, Value); when Spread_Indented => - Put(F, Indentation * ' '); - Put_Line(F, value); + Put (F, Indentation * ' '); + Put_Line (F, Value); end case; when End_Tag_Component => case Current_Format is when Continuous_Stream => - Put(F, value); + Put (F, Value); when Spread_Indented => - Put(F, Indentation * ' '); - Put_Line(F, value); + Put (F, Indentation * ' '); + Put_Line (F, Value); end case; end case; end Formatted_Put; ------------------------------------------------------------------------ - -- Output a standard XML header line, as amended by the supplied + -- Output a standard XML header line, as amended by the supplied -- arguments. To omit the attribute, pass an empty string. - -- + -- procedure Output_XML_Header (F : in Output_Medium; Standalone : in Standalone_Values := Omit; Encoding : in String := "UTF-8"; Version : in String := "1.0") is - Header : Unbounded_String := To_Unbounded_String(""); - Formatted_Put(F, Header, Header_Component); + Append (Header, " ?>"); + Formatted_Put (F, Header, Header_Component); else raise Invalid_Construction; end if; @@ -233,15 +251,16 @@ ------------------------------------------------------------------------ - -- Add a processing instruction to the XML document. + -- Add a processing instruction to the XML document. procedure Output_Processing_Instruction (F : in Output_Medium; Target : in String; Data : in String) is begin if Top_Of_Stack = 0 then - Formatted_Put(F, - To_Unbounded_String(""), - Header_Component); + Formatted_Put + (F, + To_Unbounded_String (""), + Header_Component); else raise Invalid_Construction; end if; @@ -249,37 +268,41 @@ ------------------------------------------------------------------------ - -- Generate an entire element designated with the given tag and + -- Generate an entire element designated with the given tag and -- containing the provided content and list of attributes procedure Output_Element (F : in Output_Medium; Tag : in String; Content : in String; Attrs : in Attributes_List := No_Attributes; Subst : in Boolean := True) is - Tag_Start : Unbounded_String := "<" & To_Unbounded_String(Tag); - Tag_End : Unbounded_String := ""; + Tag_Start : Unbounded_String := "<" & To_Unbounded_String (Tag); + Tag_End : constant Unbounded_String := + ""; begin if Attrs /= No_Attributes then for A in Attrs'Range loop if (Attrs (A).Value /= Null_Unbounded_String) or Default_Output_Null_Attributes then - Append(Tag_Start, " " & Attrs(A).Attr - & "=""" & Replace_Specials(Attrs(A).Value, Subst, - Replace_Quotes => True, - Replace_Apos => True) & """"); + Append (Tag_Start, + " " & Attrs (A).Attr & + "=""" & + Replace_Specials (Attrs (A).Value, Subst, + Replace_Quotes => True, + Replace_Apos => True) & """"); end if; end loop; end if; - Append(Tag_Start, ">"); - Formatted_Put(F, Tag_Start, Start_Tag_Component); - Formatted_Put(F, Replace_Specials(To_Unbounded_String(Content), Subst), - Content_Component); - Formatted_Put(F, Tag_End, End_Tag_Component); + Append (Tag_Start, ">"); + Formatted_Put (F, Tag_Start, Start_Tag_Component); + Formatted_Put (F, + Replace_Specials (To_Unbounded_String (Content), Subst), + Content_Component); + Formatted_Put (F, Tag_End, End_Tag_Component); end Output_Element; ------------------------------------------------------------------------ - -- Generate an entire element designated with the given tag and + -- Generate an entire element designated with the given tag and -- containing the provided content single attribute specification procedure Output_Element (F : in Output_Medium; Tag : in String; @@ -287,14 +310,14 @@ Attrs : in Attribute_Value_Pairs; Subst : in Boolean := True) is begin - Output_Element(F, Tag, Content, + Output_Element (F, Tag, Content, Attributes_List'(1 => Attrs), Subst); end Output_Element; ------------------------------------------------------------------------ - -- Generate an entire element designated with the given tag and + -- Generate an entire element designated with the given tag and -- containing zero or more attributes. By default the element is -- created using the compact, no-end-tag notation; to force -- generation of an element that has both start and end tags and @@ -304,34 +327,37 @@ Attrs : in Attributes_List := No_Attributes; End_Tag : in Boolean := False; Subst : in Boolean := True) is - Tag_Start : Unbounded_String := "<" & To_Unbounded_String(Tag); - Tag_End : Unbounded_String := ""; + Tag_Start : Unbounded_String := "<" & To_Unbounded_String (Tag); + Tag_End : constant Unbounded_String := + ""; begin if Attrs /= No_Attributes then for A in Attrs'Range loop if (Attrs (A).Value /= Null_Unbounded_String) or Default_Output_Null_Attributes then - Append(Tag_Start, " " & Attrs(A).Attr - & "=""" & Replace_Specials(Attrs(A).Value, Subst, - Replace_Quotes => True, - Replace_Apos => True) & """"); + Append (Tag_Start, + " " & Attrs (A).Attr & + "=""" & + Replace_Specials (Attrs (A).Value, Subst, + Replace_Quotes => True, + Replace_Apos => True) & """"); end if; end loop; end if; if End_Tag then - Append(Tag_Start, ">"); - Formatted_Put(F, Tag_Start, Start_Tag_Component); - Formatted_Put(F, Tag_End, End_Tag_Component); + Append (Tag_Start, ">"); + Formatted_Put (F, Tag_Start, Start_Tag_Component); + Formatted_Put (F, Tag_End, End_Tag_Component); else - Append(Tag_Start, "/>"); - Formatted_Put(F, Tag_Start, Start_Tag_Component); + Append (Tag_Start, "/>"); + Formatted_Put (F, Tag_Start, Start_Tag_Component); end if; end Output_Tag; ------------------------------------------------------------------------ - -- Generate an element tag with a single attribute specElementification. + -- Generate an element tag with a single attribute specElementification. -- By default the element is created using the compact, no-end-tag -- notation; to force generation of an element that has both start -- and end tags and no content, set End_Tag to True. @@ -341,12 +367,12 @@ End_Tag : in Boolean := False; Subst : in Boolean := True) is begin - Output_Tag(F, Tag, Attributes_List'(1 => Attrs), End_Tag, Subst); + Output_Tag (F, Tag, Attributes_List'(1 => Attrs), End_Tag, Subst); end Output_Tag; ------------------------------------------------------------------------ - -- Initiate the generation of an XML element with the given tag and + -- Initiate the generation of an XML element with the given tag and -- zero or more attribute specifications using an Attributes_List -- initializing aggregate. If there is only one attribute to be -- specified, the single attribute version of Start_Element may be @@ -356,41 +382,43 @@ Tag : in String; Attrs : in Attributes_List := No_Attributes; Subst : in Boolean := True) is - Tag_Start : Unbounded_String := "<" & To_Unbounded_String(Tag); + Tag_Start : Unbounded_String := "<" & To_Unbounded_String (Tag); begin - -- First output the tag and any attributes. + -- First output the tag and any attributes. if Attrs /= No_Attributes then for A in Attrs'Range loop if (Attrs (A).Value /= Null_Unbounded_String) or Default_Output_Null_Attributes then - Append(Tag_Start, " " & Attrs(A).Attr - & "=""" & Replace_Specials(Attrs(A).Value, Subst, - Replace_Quotes => True, - Replace_Apos => True) & """"); + Append (Tag_Start, + " " & Attrs (A).Attr & + "=""" & + Replace_Specials (Attrs (A).Value, Subst, + Replace_Quotes => True, + Replace_Apos => True) & """"); end if; end loop; end if; - Append(Tag_Start, ">"); - Formatted_Put(F, Tag_Start, Start_Tag_Component); + Append (Tag_Start, ">"); + Formatted_Put (F, Tag_Start, Start_Tag_Component); - Push(To_Unbounded_String(Tag)); + Push (To_Unbounded_String (Tag)); end Start_Element; ------------------------------------------------------------------------ - -- Initiate the generation of an XML element with the given tag and + -- Initiate the generation of an XML element with the given tag and -- a single attribute specification. procedure Start_Element (F : in Output_Medium; Tag : in String; Attrs : in Attribute_Value_Pairs; Subst : in Boolean := True) is begin - Start_Element(F, Tag, Attributes_List'(1 => Attrs), Subst); + Start_Element (F, Tag, Attributes_List'(1 => Attrs), Subst); end Start_Element; ------------------------------------------------------------------------ - -- Indicate the completion of the output of an XML element. If a + -- Indicate the completion of the output of an XML element. If a -- Tag is specified, compare it against the element tag that is -- currently open, and raise Element_End_Mismatch if the two do -- not match. If there is no open element, then raise @@ -401,10 +429,10 @@ Open_Tag : Unbounded_String; begin - Pop(Open_Tag); - -- Validate the tag only if one was supplied - if (Tag = "") or else (Tag = To_String(Open_Tag)) then - Formatted_Put(F, + Pop (Open_Tag); + -- Validate the tag only if one was supplied + if (Tag = "") or else (Tag = To_String (Open_Tag)) then + Formatted_Put (F, "", End_Tag_Component); else @@ -414,7 +442,7 @@ ------------------------------------------------------------------------ - -- Place the text, as is, as the content of the currently open XML + -- Place the text, as is, as the content of the currently open XML -- element. Output_Content can be called repeatedly, and will -- simply continue to append the additional content. If there is -- no open element, raise Element_Not_Open. @@ -422,178 +450,150 @@ S : in String; Subst : in Boolean := True) is begin - Formatted_Put(F, Replace_Specials(To_Unbounded_String(S), Subst), + Formatted_Put (F, Replace_Specials (To_Unbounded_String (S), Subst), Content_Component); end Output_Content; ------------------------------------------------------------------------ - -- Place the numeric value, as a base 10 text representation, as + -- Place the numeric Value, as a base 10 text representation, as -- the content of the currently open XML element. Output_Content -- can be called repeatedly, and will simply continue to append -- the additional content. If there is no open element, raise -- Element_Not_Open. - procedure Output_Content(F : in Output_Medium; - N : in Integer'Base) is - N_Rep : constant String := Integer'Base'Image(N); - Start_Index : constant Positive := Boolean'Pos(N >= 0) + 1; + procedure Output_Content (F : in Output_Medium; + N : in Integer'Base) is + N_Rep : constant String := Integer'Base'Image (N); + Start_Index : constant Positive := Boolean'Pos (N >= 0) + 1; begin - Output_Content(F, N_Rep(Start_Index .. N_Rep'Length)); + Output_Content (F, N_Rep (Start_Index .. N_Rep'Length)); end Output_Content; ------------------------------------------------------------------------ - -- Place the text represenatation of the numeric value as the + -- Place the text represenatation of the numeric Value as the -- content of the currently open XML element. Output_Content can -- be called repeatedly, and will simply continue to append the -- additional content. If there is no open element, raise -- Element_Not_Open. - procedure Output_Content(F : in Output_Medium; - N : in Float'Base) is - N_Rep : constant String := Float'Base'Image(N); - Start_Index : constant Positive := Boolean'Pos(N >= 0.0) + 1; + procedure Output_Content (F : in Output_Medium; + N : in Float) is + N_Rep : constant String := Float'Image (N); + Start_Index : constant Positive := Boolean'Pos (N >= 0.0) + 1; begin - Output_Content(F, N_Rep(Start_Index .. N_Rep'Length)); + Output_Content (F, N_Rep (Start_Index .. N_Rep'Length)); end Output_Content; ------------------------------------------------------------------------ - -- The following overloaded "=" functions are the only means by - -- which to create attribute/value pairs. + -- The following overloaded "=" functions are the only means by + -- which to create attribute/Value pairs. - -- Attribute provided as String + -- Attribute provided as String - -- Associate an attribute with a string value. - function "="(Attr : String; - Value : String) - return Attribute_Value_Pairs is + -- Associate an attribute with a string Value. + function "=" (Attr : String; + Value : String) + return Attribute_Value_Pairs is begin - return To_Unbounded_String(Attr) = To_Unbounded_String(Value); + return To_Unbounded_String (Attr) = To_Unbounded_String (Value); end "="; - -- Associate an attribute with a string value. - function "="(Attr : String; - Value : Character) - return Attribute_Value_Pairs is + -- Associate an attribute with a string Value. + function "=" (Attr : String; + Value : Character) + return Attribute_Value_Pairs is begin - return To_Unbounded_String(Attr) = To_Unbounded_String((1 => Value)); + return To_Unbounded_String (Attr) = To_Unbounded_String ((1 => Value)); end "="; - -- Associate an attribute with a string value. - function "="(Attr : String; - Value : Unbounded_String) - return Attribute_Value_Pairs is + -- Associate an attribute with a string Value. + function "=" (Attr : String; + Value : Unbounded_String) + return Attribute_Value_Pairs is begin - return To_Unbounded_String(Attr) = Value; + return To_Unbounded_String (Attr) = Value; end "="; - -- Associate an attribute with an integral value. - function "="(Attr : String; - Value : Integer'Base) - return Attribute_Value_Pairs is - Value_Rep : constant String := Integer'Base'Image(Value); + -- Associate an attribute with an integral Value. + function "=" (Attr : String; + Value : Integer'Base) + return Attribute_Value_Pairs is + Value_Rep : constant String := Integer'Base'Image (Value); Is_Natural : constant Boolean := Value >= 0; begin if Is_Natural then - return Attr = Value_Rep(2 .. Value_Rep'Last); + return Attr = Value_Rep (2 .. Value_Rep'Last); else return Attr = Value_Rep; end if; end "="; - -- Associate an attribute with a floating point value. - function "="(Attr : String; - Value : Float'Base) - return Attribute_Value_Pairs is - Value_Rep : constant String := Float'Base'Image(Value); + -- Associate an attribute with a floating point Value. + function "=" (Attr : String; + Value : Float) + return Attribute_Value_Pairs is + Value_Rep : constant String := Float'Image (Value); Is_Nonnegative : constant Boolean := Value >= 0.0; begin if Is_Nonnegative then - return Attr = Value_Rep(2 .. Value_Rep'Last); + return Attr = Value_Rep (2 .. Value_Rep'Last); else return Attr = Value_Rep; end if; end "="; - -- Associate an attribute with a floating point value. - function "="(Attr : String; - Value : Long_Float'Base) - return Attribute_Value_Pairs is - Value_Rep : constant String := Long_Float'Base'Image(Value); - Is_Nonnegative : constant Boolean := Value >= 0.0; - begin - if Is_Nonnegative then - return Attr = Value_Rep(2 .. Value_Rep'Last); - else - return Attr = Value_Rep; - end if; - end "="; - - -- Attribute provided as Unbounded_String + -- Attribute provided as Unbounded_String - -- Associate an attribute with a string value. - function "="(Attr : Unbounded_String; - Value : String) - return Attribute_Value_Pairs is + -- Associate an attribute with a string Value. + function "=" (Attr : Unbounded_String; + Value : String) + return Attribute_Value_Pairs is begin - return Attr = To_Unbounded_String(Value); + return Attr = To_Unbounded_String (Value); end "="; - -- Associate an attribute with a string value. - function "="(Attr : Unbounded_String; - Value : Character) - return Attribute_Value_Pairs is + -- Associate an attribute with a string Value. + function "=" (Attr : Unbounded_String; + Value : Character) + return Attribute_Value_Pairs is begin - return Attr = To_Unbounded_String((1 => Value)); + return Attr = To_Unbounded_String ((1 => Value)); end "="; - -- Associate an attribute with a string value. - function "="(Attr : Unbounded_String; - Value : Unbounded_String) - return Attribute_Value_Pairs is + -- Associate an attribute with a string Value. + function "=" (Attr : Unbounded_String; + Value : Unbounded_String) + return Attribute_Value_Pairs is begin return (Attr, Value); end "="; - -- Associate an attribute with an integral value. - function "="(Attr : Unbounded_String; - Value : Integer'Base) - return Attribute_Value_Pairs is - Value_Rep : constant String := Integer'Base'Image(Value); + -- Associate an attribute with an integral Value. + function "=" (Attr : Unbounded_String; + Value : Integer'Base) + return Attribute_Value_Pairs is + Value_Rep : constant String := Integer'Base'Image (Value); Is_Natural : constant Boolean := Value >= 0; begin if Is_Natural then - return Attr = To_Unbounded_String(Value_Rep(2 .. Value_Rep'Last)); - else - return Attr = To_Unbounded_String(Value_Rep); - end if; - end "="; - - -- Associate an attribute with a floating point value. - function "="(Attr : Unbounded_String; - Value : Float'Base) - return Attribute_Value_Pairs is - Value_Rep : constant String := Float'Base'Image(Value); - Is_Nonnegative : constant Boolean := Value >= 0.0; - begin - if Is_Nonnegative then - return Attr = To_Unbounded_String(Value_Rep(2 .. Value_Rep'Last)); + return Attr = To_Unbounded_String (Value_Rep (2 .. Value_Rep'Last)); else - return Attr = To_Unbounded_String(Value_Rep); + return Attr = To_Unbounded_String (Value_Rep); end if; end "="; - -- Associate an attribute with a floating point value. - function "="(Attr : Unbounded_String; - Value : Long_Float'Base) - return Attribute_Value_Pairs is - Value_Rep : constant String := Long_Float'Base'Image(Value); + -- Associate an attribute with a floating point Value. + function "=" (Attr : Unbounded_String; + Value : Float) + return Attribute_Value_Pairs is + Value_Rep : constant String := Float'Image (Value); Is_Nonnegative : constant Boolean := Value >= 0.0; begin if Is_Nonnegative then - return Attr = To_Unbounded_String(Value_Rep(2 .. Value_Rep'Last)); + return Attr = To_Unbounded_String (Value_Rep (2 .. Value_Rep'Last)); else - return Attr = To_Unbounded_String(Value_Rep); + return Attr = To_Unbounded_String (Value_Rep); end if; end "="; --- a/mckae-xml-ez_out-string_stream.adb +++ b/mckae-xml-ez_out-string_stream.adb @@ -28,29 +28,28 @@ -- (http://www.mckae.com). -- ------------------------------------------------------------------------ -with Mckae.XML.EZ_Out.Generic_Medium; -with Ada.Strings.Fixed; -with Ada.Text_IO; -use Ada.Text_IO; with Unchecked_Deallocation; -package body Mckae.XML.EZ_Out.String_Stream is +package body McKae.XML.EZ_Out.String_Stream is package body String_Buffering is - procedure Free is new Unchecked_Deallocation(String, Buffer_Ptr); + procedure Free is new Unchecked_Deallocation (String, Buffer_Ptr); - -- A basic in-memory string buffering package for building XML + -- A basic in-memory string buffering package for building XML -- documents with EZ_Out. This is not intended to be a robust, -- full-function memory buffering package. procedure Extend (F : in String_Buffer; - To_Add : in Positive)is + To_Add : in Positive); + + procedure Extend (F : in String_Buffer; + To_Add : in Positive) is Temp_Buff : Buffer_Ptr := F.Buff; Size_Delta : Positive; Expansion_Factor : Positive; - New_Size : Positive := F.Size + To_Add; + New_Size : constant Positive := F.Size + To_Add; begin if New_Size > F.Allocation then @@ -59,38 +58,37 @@ F.Self.Sb.Allocation := F.Allocation + (Expansion_Factor * F.Expansion); - F.Self.Sb.Buff := new String(1 .. F.Allocation); - F.Self.Sb.Buff(1 .. F.Size) := Temp_Buff(1 .. F.Size); + F.Self.Sb.Buff := new String (1 .. F.Allocation); + F.Self.Sb.Buff (1 .. F.Size) := Temp_Buff (1 .. F.Size); Free (Temp_Buff); end if; end Extend; - -- Copy the given string into the buffer, expanding it if needed. - procedure Put(F : in String_Buffer; - S : in String) is + -- Copy the given string into the buffer, expanding it if needed. + procedure Put (F : in String_Buffer; + S : in String) is begin if S'Length > 0 then - Extend(F, S'Length); - F.Buff(F.Size + 1 .. F.Size + S'Length) := S; + Extend (F, S'Length); + F.Buff (F.Size + 1 .. F.Size + S'Length) := S; F.Self.Sb.Size := F.Size + S'Length; end if; end Put; - -- Insert a new line indicator into the buffer. + -- Insert a new line indicator into the buffer. procedure New_Line (F : in String_Buffer; Spacing : in Ada.Text_IO.Positive_Count := 1) is - use Ada.Strings.Fixed; begin null; end New_Line; - -- Clear the buffer - procedure Clear(S : String_Buffer) is + -- Clear the buffer + procedure Clear (S : String_Buffer) is begin S.Self.Sb.Size := 0; end Clear; - -- Free ressources in order to avoid memory leak + -- Free ressources in order to avoid memory leak procedure Full_Clear (S : in out String_Buffer) is begin Clear (S); @@ -98,10 +96,10 @@ S.Buff := null; end Full_Clear; - -- Return the current contents of the string buffer - function Get_String(S : String_Buffer) return String is + -- Return the current contents of the string buffer + function Get_String (S : String_Buffer) return String is begin - return S.Buff(1 .. S.Size); + return S.Buff (1 .. S.Size); end Get_String; procedure Finalize (Object : in out String_Buffer) is @@ -111,7 +109,7 @@ end String_Buffering; -end Mckae.XML.EZ_Out.String_Stream; +end McKae.XML.EZ_Out.String_Stream; --- a/mckae-xml-ez_out-text_file.ads +++ b/mckae-xml-ez_out-text_file.ads @@ -28,12 +28,12 @@ -- (http://www.mckae.com). -- ------------------------------------------------------------------------ -with Mckae.XML.EZ_Out.Generic_Medium; +with McKae.XML.EZ_Out.Generic_Medium; with Ada.Text_IO; use Ada.Text_IO; -package Mckae.XML.EZ_Out.Text_File is - new Mckae.XML.EZ_Out.Generic_Medium +package McKae.XML.EZ_Out.Text_File is + new McKae.XML.EZ_Out.Generic_Medium (Output_Medium => Ada.Text_IO.File_Type); --- a/mckae-xml-ez_out-generic_medium.ads +++ b/mckae-xml-ez_out-generic_medium.ads @@ -36,90 +36,91 @@ type Output_Medium is limited private; - with procedure Put(F : in Output_Medium; - S : in String) is <>; - with procedure New_Line (F : in Output_Medium; - Spacing : in Ada.Text_IO.Positive_Count := 1) is <>; - - -- DEPRECATED - -- Control formatting by setting the Current_Format variable in the - -- package spec. + with procedure Put (F : in Output_Medium; + S : in String) is <>; + with procedure New_Line + (F : in Output_Medium; + Spacing : in Ada.Text_IO.Positive_Count := 1) is <>; + + -- DEPRECATED + -- Control formatting by setting the Current_Format variable in the + -- package spec. -- - -- Specify whether the XML that is created is to have indenting and - -- line breaks. + -- Specify whether the XML that is created is to have indenting and + -- line breaks. Format : Formatting_Options := Spread_Indented; - -- DEPRECATED + -- DEPRECATED - -- The maximum element nesting depth of an XML document + -- The maximum element nesting depth of an XML document Max_Element_Nesting : Positive := 200; package McKae.XML.EZ_Out.Generic_Medium is - ------------------------------------------------------------------- - -- This package provides the means to easily write XML elements and + -------------------------------------------------------------------- + -- This package provides the means to easily write XML elements and -- associated attributes to a provided medium that provides the -- required interface. - -- Note that this package is designed in such a way that + -- Note that this package is designed in such a way that -- instantiations of it are meant to be "used" by the application. -- When accompanied with a "use" clause, specifying the XML to be -- produced is very simple and clear. Insisting on using qualified -- names will make for very obtuse code. Likewise, "named -- parameter" notation would obscure the complementarity of the Ada - -- and XML, so apply for a waiver from any such style standards. + -- and XML, so apply for a waiver from any such style standards. ------------------------------------------------------------------- - -- The medium must be open and ready to accept content before + -- The medium must be open and ready to accept content before -- invoking any of these XML output subprograms. - -- If the medium raises any exceptions as a result of invoking the + -- If the medium raises any exceptions as a result of invoking the -- supplied Put or New_Line procedures, those exceptions will be -- passed through to the caller. ------------------------------------------------------------------- - -- The identation format of the XML that is output. This can be - -- altered at any time. + -- The identation format of the XML that is output. This can be + -- altered at any time. Current_Format : Formatting_Options := Format; - -- Whether to output an attribute if it has a null value. + -- Whether to output an attribute if it has a null value. Default_Output_Null_Attributes : Boolean := False; ------------------------------------------------------------------- - -- These procedures for outputting XML header elements cannot be + -- These procedures for outputting XML header elements cannot be -- invoked when there are any nested elements opening, i.e., -- Start_Element has been called. Doing so will result in the -- raising of an Invalid_Construction exception. - -- Settings for the document header's standalone attribute. + -- Settings for the document header's standalone attribute. type Standalone_Values is (Yes, No, Omit); - -- Output a standard XML header line, as amended by the supplied + -- Output a standard XML header line, as amended by the supplied -- arguments. To omit the attribute, pass an empty string. - -- + -- procedure Output_XML_Header (F : in Output_Medium; Standalone : in Standalone_Values := Omit; Encoding : in String := "UTF-8"; Version : in String := "1.0"); - -- Add a processing instruction to the XML document. + -- Add a processing instruction to the XML document. procedure Output_Processing_Instruction (F : in Output_Medium; Target : in String; Data : in String); ------------------------------------------------------------------- - -- Representation of attribute/value pairs + -- Representation of attribute/value pairs type Attribute_Value_Pairs is private; - -- List of attributes and corresponding values to associated with + -- List of attributes and corresponding values to associated with -- an element - type Attributes_List is array(Natural range <>) of Attribute_Value_Pairs; + type Attributes_List is array (Natural range <>) of Attribute_Value_Pairs; --- Indicator that the element has no associated attributes + -- Indicator that the element has no associated attributes No_Attributes : constant Attributes_List; - -- Generate an entire element designated with the given tag and + -- Generate an entire element designated with the given tag and -- containing the provided content and list of attributes procedure Output_Element (F : in Output_Medium; Tag : in String; @@ -127,7 +128,7 @@ Attrs : in Attributes_List := No_Attributes; Subst : in Boolean := True); - -- Generate an entire element designated with the given tag and + -- Generate an entire element designated with the given tag and -- containing the provided content single attribute specification procedure Output_Element (F : in Output_Medium; Tag : in String; @@ -135,7 +136,7 @@ Attrs : in Attribute_Value_Pairs; Subst : in Boolean := True); - -- Generate an element tag containing zero or more attributes. By + -- Generate an element tag containing zero or more attributes. By -- default the element is created using the compact, no-end-tag -- notation; to force generation of an element that has both start -- and end tags and no content, set End_Tag to True. @@ -145,7 +146,7 @@ End_Tag : in Boolean := False; Subst : in Boolean := True); - -- Generate an element tag with a single attribute specification. + -- Generate an element tag with a single attribute specification. -- By default the element is created using the compact, no-end-tag -- notation; to force generation of an element that has both start -- and end tags and no content, set End_Tag to True. @@ -155,7 +156,7 @@ End_Tag : in Boolean := False; Subst : in Boolean := True); - -- Initiate the generation of an XML element with the given tag and + -- Initiate the generation of an XML element with the given tag and -- zero or more attribute specifications using an Attributes_List -- initializing aggregate. If there is only one attribute to be -- specified, the single attribute version of Start_Element may be @@ -166,14 +167,14 @@ Attrs : in Attributes_List := No_Attributes; Subst : in Boolean := True); - -- Initiate the generation of an XML element with the given tag and + -- Initiate the generation of an XML element with the given tag and -- a single attribute specification. procedure Start_Element (F : in Output_Medium; Tag : in String; Attrs : in Attribute_Value_Pairs; Subst : in Boolean := True); - -- Indicate the completion of the output of an XML element. If a + -- Indicate the completion of the output of an XML element. If a -- Tag is specified, compare it against the element tag that is -- currently open, and raise Element_End_Mismatch if the two do -- not match. If there is no open element, then raise @@ -181,7 +182,7 @@ procedure End_Element (F : in Output_Medium; Tag : in String := ""); - -- Place the text, as is, as the content of the currently open XML + -- Place the text, as is, as the content of the currently open XML -- element. Output_Content can be called repeatedly, and will -- simply continue to append the additional content. If there is -- no open element, raise Element_Not_Open. @@ -189,79 +190,79 @@ S : in String; Subst : in Boolean := True); - -- Place the numeric value, as a base 10 text representation, as + -- Place the numeric value, as a base 10 text representation, as -- the content of the currently open XML element. Output_Content -- can be called repeatedly, and will simply continue to append -- the additional content. If there is no open element, raise -- Element_Not_Open. - procedure Output_Content(F : in Output_Medium; - N : in Integer'Base); + procedure Output_Content (F : in Output_Medium; + N : in Integer'Base); - -- Place the text represenatation of the numeric value as the + -- Place the text represenatation of the numeric value as the -- content of the currently open XML element. Output_Content can -- be called repeatedly, and will simply continue to append the -- additional content. If there is no open element, raise -- Element_Not_Open. - procedure Output_Content(F : in Output_Medium; - N : in Float'Base); + procedure Output_Content (F : in Output_Medium; + N : in Float); - -- The following overloaded "=" functions are the only means by + -- The following overloaded "=" functions are the only means by -- which to create attribute/value pairs. - -- Attribute provided as String - - -- Associate an attribute with a string value. - function "="(Attr : String; - Value : String) - return Attribute_Value_Pairs; - - -- Associate an attribute with a character value. - function "="(Attr : String; - Value : Character) - return Attribute_Value_Pairs; - - -- Associate an attribute with a string value. - function "="(Attr : String; - Value : Unbounded_String) - return Attribute_Value_Pairs; - - -- Associate an attribute with an integral value. - function "="(Attr : String; - Value : Integer'Base) - return Attribute_Value_Pairs; - - -- Associate an attribute with a floating point value. - function "="(Attr : String; - Value : Float'Base) - return Attribute_Value_Pairs; + -- Attribute provided as String - -- Attribute provided as Unbounded_String + -- Associate an attribute with a string value. + function "=" (Attr : String; + Value : String) + return Attribute_Value_Pairs; + + -- Associate an attribute with a character value. + function "=" (Attr : String; + Value : Character) + return Attribute_Value_Pairs; + + -- Associate an attribute with a string value. + function "=" (Attr : String; + Value : Unbounded_String) + return Attribute_Value_Pairs; + + -- Associate an attribute with an integral value. + function "=" (Attr : String; + Value : Integer'Base) + return Attribute_Value_Pairs; + + -- Associate an attribute with a floating point value. + function "=" (Attr : String; + Value : Float) + return Attribute_Value_Pairs; + + -- Attribute provided as Unbounded_String + + -- Associate an attribute with a string value. + function "=" (Attr : Unbounded_String; + Value : String) + return Attribute_Value_Pairs; + + -- Associate an attribute with a character value. + function "=" (Attr : Unbounded_String; + Value : Character) + return Attribute_Value_Pairs; - -- Associate an attribute with a string value. - function "="(Attr : Unbounded_String; - Value : String) - return Attribute_Value_Pairs; - - -- Associate an attribute with a character value. - function "="(Attr : Unbounded_String; - Value : Character) - return Attribute_Value_Pairs; - - -- Associate an attribute with a string value. + -- Associate an attribute with a string value. function "="(Attr : Unbounded_String; Value : Unbounded_String) return Attribute_Value_Pairs; - -- Associate an attribute with an integral value. - function "="(Attr : Unbounded_String; - Value : Integer'Base) - return Attribute_Value_Pairs; - - -- Associate an attribute with a floating point value. - function "="(Attr : Unbounded_String; - Value : Float'Base) - return Attribute_Value_Pairs; + -- Associate an attribute with an integral value. + function "=" (Attr : Unbounded_String; + Value : Integer'Base) + return Attribute_Value_Pairs; + + -- Associate an attribute with a floating point value. + function "=" (Attr : Unbounded_String; + Value : Float) + return Attribute_Value_Pairs; private type Attribute_Value_Pairs is @@ -270,6 +271,6 @@ Value : Unbounded_String; end record; - No_Attributes : constant Attributes_List(1..0) + No_Attributes : constant Attributes_List (1 .. 0) := (others => (others => Null_Unbounded_String)); end McKae.XML.EZ_Out.Generic_Medium;