All pastes #450940 Raw Edit

Unnamed

public text v1 · immutable
·published 2007-04-21 04:30 UTC
rendered paste body
with Ada.Strings.Unbounded;

package XML is
   type Attribute is limited private;
   type Element is limited private;
   
   function Create (Name, Value : String) return Element;
   function Create (Name, Value : String) return Attribute;
   
   procedure Add_Child   (To : in Element; Item : in Element);
   procedure Add_Sibling (To : in Element; Item : in Element);
   procedure Add_Attr    (To : in Element; Item : in Attribute);
private
   type Attribute_Type;
   type Attribute is access Attribute_Type;
   type Attribute_Type is
      record
	 Name, Value : Ada.Strings.Unbounded.Unbounded_String := Ada.Strings.Unbounded.Null_Unbounded_String;
	 Next        : Attribute                              := null;
      end record;
   
   type Element_Type;
   type Element is access Element_Type;
   type Element_Type is
      record
	 Name, Value : Ada.Strings.Unbounded.Unbounded_String := Ada.Strings.Unbounded.Null_Unbounded_String;
	 Attr        : Attribute                              := null;
	 Next, Child : Element                                := null;
      end record;
end XML;
with Ada.Strings.Unbounded;

package body XML is
   function "+" (Source : String) return Ada.Strings.Unbounded.Unbounded_String
      renames Ada.Strings.Unbounded.To_Unbounded_String;

   function Create (Name, Value : String) return Element is
      New_Element : Element := new Element_Type;
   begin
      New_Element.Name := +Name;

      if Value /= "" then
         New_Element.Value := +Value;
      end if;

      return New_Element;

   end Create;

   function Create (Name, Value : String) return Attribute is
      New_Attribute : Attribute := new Attribute_Type;
   begin
      New_Attribute.Name := +Name;
      New_Attribute.Value := +Value;
      return New_Attribute;
   end Create;

   procedure Add_Sibling (To : in Element; Item : in Element) is
   begin
      if To.Next = null then
         To.Next := Item;
      else
         Add_Sibling (To => To.Next, Item => Item);
      end if;

   end Add_Sibling;

   procedure Add_Child (To : in Element; Item : in Element) is
   begin
      if To.Child = null then
         To.Child := Item;
      else
         Add_Sibling (To => To.Child, Item => Item);
      end if;

   end Add_Child;

   procedure Add_Attr (To : in Attribute; Item : in Attribute) is
   begin
      if To.Next = null then
         To.Next := Item;
      else
         Add_Attr (To => To.Next, Item => Item);
      end if;

   end Add_Attr;

   procedure Add_Attr (To : in Element; Item : in Attribute) is
   begin
      if To.Attr = null then
         To.Attr := Item;
      else
         Add_Attr (To => To.Attr, Item => Item);
      end if;

   end Add_Attr;

end XML;