------------------------------------------------------------------------------
--                     XML/Ada - An XML suite for Ada95                     --
--                                                                          --
--                     Copyright (C) 2001-2012, AdaCore                     --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  or (at your  option) any later --
-- version. This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Strings.Fixed; use Ada.Strings.Fixed;
with Unicode.CES;       use Unicode.CES;
with Unchecked_Deallocation;
with Sax.Models;        use Sax.Models;

package body Sax.Attributes is

   procedure Free (Attr : in out attribute);
   --  Free the memory allocated for a single attribute.
   --  This doesn't free the memory allocated for Attr itself, nor any other
   --  node in the list.

   procedure Free_Node is new Unchecked_Deallocation
     (attribute,
      attribute_access);

   function Get
     (Attr  : attributes'class;
      Index : Natural) return attribute_access;
   --  Return the Index-th attribute in the list, or raise Out_Of_Bounds if
   --  Index is too big

   procedure Get
     (Attr  :     attributes'class;
      Qname :     byte_sequence;
      Index : out Integer;
      Att   : out attribute_access);
   --  Return the first attribute whose Qname matches

   procedure Get
     (Attr       :     attributes'class;
      URI        :     byte_sequence;
      Local_Name :     byte_sequence;
      Index      : out Integer;
      Att        : out attribute_access);
   --  Return the first attribute whose name matches

   ----------
   -- Free --
   ----------

   procedure Free (Attr : in out attribute) is
   begin
      Free (Attr.URI);
      Free (Attr.Local_Name);

      if Attr.Non_Normalized_Value /= Attr.Value then
         Free (Attr.Non_Normalized_Value);
      end if;

      Attr.Non_Normalized_Value := null;
      Free (Attr.Value);
      Free (Attr.Qname);
      Unref (Attr.Content);

      --  Do not free Attr.Content, since this is a pointer to an external
      --  structure, shared by all attributes with the same model
   end Free;

   ---------
   -- Get --
   ---------

   function Get
     (Attr  : attributes'class;
      Index : Natural) return attribute_access
   is
      Tmp : attribute_access := Attr.First;
   begin
      if Index >= Attr.Length then
         raise Out_Of_Bounds;
      end if;

      for J in 0 .. Index - 1 loop
         Tmp := Tmp.Next;
      end loop;
      pragma assert (Tmp /= null, "Get returned a null attribute");
      return Tmp;
   end Get;

   ---------
   -- Get --
   ---------

   procedure Get
     (Attr  :     attributes'class;
      Qname :     byte_sequence;
      Index : out Integer;
      Att   : out attribute_access)
   is
   begin
      Index := 0;
      Att   := Attr.First;
      while Att /= null loop
         if Att.Qname.all = Qname then
            return;
         end if;
         Index := Index + 1;
         Att   := Att.Next;
      end loop;
      Index := -1;
   end Get;

   ---------
   -- Get --
   ---------

   procedure Get
     (Attr       :     attributes'class;
      URI        :     byte_sequence;
      Local_Name :     byte_sequence;
      Index      : out Integer;
      Att        : out attribute_access)
   is
   begin
      Index := 0;
      Att   := Attr.First;
      while Att /= null loop
         if Att.URI.all = URI and then Att.Local_Name.all = Local_Name then
            return;
         end if;
         Att   := Att.Next;
         Index := Index + 1;
      end loop;
      Index := -1;
   end Get;

   -------------------
   -- Add_Attribute --
   -------------------

   procedure Add_Attribute
     (Attr         : in out attributes;
      URI          :        Unicode.CES.byte_sequence;
      Local_Name   :        Unicode.CES.byte_sequence;
      Qname        :        Unicode.CES.byte_sequence;
      Att_Type     :        attribute_type;
      Content      :        Sax.Models.content_model;
      Value        :        Unicode.CES.byte_sequence;
      Default_Decl :        default_declaration := default)
   is
   begin
      if Attr.Last = null then
         Attr.First := new attribute;
         Attr.Last  := Attr.First;
      else
         Attr.Last.Next := new attribute;
         Attr.Last      := Attr.Last.Next;
      end if;

      Attr.Last.URI                  := new byte_sequence'(URI);
      Attr.Last.Local_Name           := new byte_sequence'(Local_Name);
      Attr.Last.Att_Type             := Att_Type;
      Attr.Last.Value                := new byte_sequence'(Value);
      Attr.Last.Non_Normalized_Value := Attr.Last.Value;
      Attr.Last.Qname                := new byte_sequence'(Qname);
      Attr.Last.Default_Decl         := Default_Decl;
      Attr.Last.Content              := Content;
      Ref (Attr.Last.Content);
      Attr.Length := Attr.Length + 1;
   end Add_Attribute;

   -----------
   -- Clear --
   -----------

   procedure Clear (Attr : in out attributes) is
      Tmp : attribute_access;
   begin
      while Attr.First /= null loop
         Tmp := Attr.First.Next;
         Free (Attr.First.all);
         Free_Node (Attr.First);
         Attr.First := Tmp;
      end loop;
      Attr.Last   := null;
      Attr.Length := 0;
   end Clear;

   ----------------------
   -- Remove_Attribute --
   ----------------------

   procedure Remove_Attribute (Attr : in out attributes; Index : Natural) is
      Tmp  : attribute_access;
      Tmp2 : attribute_access;
   begin
      if Index = 0 then
         Tmp := Attr.First;
         if Attr.Last = Attr.First then
            Attr.Last := null;
         end if;
         Attr.First := Attr.First.Next;
         Free (Tmp.all);
         Free_Node (Tmp);
      else
         Tmp := Get (Attr, Index - 1);
         if Attr.Last = Tmp then
            Attr.Last := Attr.First;
            while Attr.Last.Next /= null loop
               Attr.Last := Attr.Last.Next;
            end loop;
         end if;
         Tmp2     := Tmp.Next;
         Tmp.Next := Tmp2.Next;
         Free (Tmp2.all);
         Free_Node (Tmp2);
      end if;
      Attr.Length := Attr.Length - 1;
   end Remove_Attribute;

   -------------------
   -- Set_Attribute --
   -------------------

   procedure Set_Attribute
     (Attr         : in out attributes;
      Index        :        Natural;
      URI          :        Unicode.CES.byte_sequence;
      Local_Name   :        Unicode.CES.byte_sequence;
      Qname        :        Unicode.CES.byte_sequence;
      Att_Type     :        attribute_type;
      Content      :        Sax.Models.content_model;
      Value        :        Unicode.CES.byte_sequence;
      Default_Decl :        default_declaration := default)
   is
      Att : constant attribute_access := Get (Attr, Index);
   begin
      Free (Att.all);
      Att.URI                  := new byte_sequence'(URI);
      Att.Local_Name           := new byte_sequence'(Local_Name);
      Att.Att_Type             := Att_Type;
      Att.Value                := new byte_sequence'(Value);
      Att.Non_Normalized_Value := Att.Value;
      Att.Qname                := new byte_sequence'(Qname);
      Att.Default_Decl         := Default_Decl;
      Att.Content              := Content;
      Ref (Att.Content);
   end Set_Attribute;

   --------------------
   -- Set_Attributes --
   --------------------

   procedure Set_Attributes
     (Attr : in out attributes;
      From :        attributes'class)
   is
      Length : constant Natural := Get_Length (From);
      Att    : attribute_access;
   begin
      for J in 0 .. Length - 1 loop
         Att := Get (From, J);
         Add_Attribute
           (Attr,
            URI        => Att.URI.all,
            Local_Name => Att.Local_Name.all,
            Qname      => Att.Qname.all,
            Att_Type   => Att.Att_Type,
            Content    => Att.Content,
            Value      => Att.Value.all);
      end loop;
   end Set_Attributes;

   --------------------
   -- Set_Local_Name --
   --------------------

   procedure Set_Local_Name
     (Attr       : in out attributes;
      Index      :        Natural;
      Local_Name :        Unicode.CES.byte_sequence)
   is
      Tmp : constant attribute_access := Get (Attr, Index);
   begin
      Free (Tmp.Local_Name);
      Tmp.Local_Name := new byte_sequence'(Local_Name);
   end Set_Local_Name;

   ---------------
   -- Set_Qname --
   ---------------

   procedure Set_Qname
     (Attr  : in out attributes;
      Index :        Natural;
      Qname :        Unicode.CES.byte_sequence)
   is
      Tmp : constant attribute_access := Get (Attr, Index);
   begin
      Free (Tmp.Qname);
      Tmp.Qname := new byte_sequence'(Qname);
   end Set_Qname;

   --------------
   -- Set_Type --
   --------------

   procedure Set_Type
     (Attr     : in out attributes;
      Index    :        Natural;
      Att_Type :        attribute_type)
   is
   begin
      Get (Attr, Index).Att_Type := Att_Type;
   end Set_Type;

   -------------
   -- Set_URI --
   -------------

   procedure Set_URI
     (Attr  : in out attributes;
      Index :        Natural;
      URI   :        Unicode.CES.byte_sequence)
   is
      Tmp : constant attribute_access := Get (Attr, Index);
   begin
      Free (Tmp.URI);
      Tmp.URI := new byte_sequence'(URI);
   end Set_URI;

   ---------------
   -- Set_Value --
   ---------------

   procedure Set_Value
     (Attr  : attributes;
      Index : Natural;
      Value : Unicode.CES.byte_sequence)
   is
      Tmp : constant attribute_access := Get (Attr, Index);
   begin
      pragma assert (Tmp /= null, "Unexpected null attribute");
      if Tmp.Non_Normalized_Value /= Tmp.Value then
         Free (Tmp.Value);
      end if;

      Tmp.Value := new byte_sequence'(Value);
   end Set_Value;

   ---------------
   -- Get_Index --
   ---------------

   function Get_Index
     (Attr       : attributes;
      URI        : Unicode.CES.byte_sequence;
      Local_Name : Unicode.CES.byte_sequence) return Integer
   is
      J   : Integer;
      Tmp : attribute_access;
   begin
      Get (Attr, URI, Local_Name, J, Tmp);
      return J;
   end Get_Index;

   ---------------
   -- Get_Index --
   ---------------

   function Get_Index
     (Attr       : attributes;
      Local_Name : Unicode.CES.byte_sequence)  --  no namespace
      return Integer
   is
   begin
      return Get_Index (Attr, URI => "", Local_Name => Local_Name);
   end Get_Index;

   ----------------
   -- Get_Length --
   ----------------

   function Get_Length (Attr : attributes) return Natural is
   begin
      return Attr.Length;
   end Get_Length;

   --------------------
   -- Get_Local_Name --
   --------------------

   function Get_Local_Name
     (Attr  : attributes;
      Index : Natural) return Unicode.CES.byte_sequence
   is
   begin
      return Get (Attr, Index).Local_Name.all;
   end Get_Local_Name;

   ---------------
   -- Get_Qname --
   ---------------

   function Get_Qname
     (Attr  : attributes;
      Index : Natural) return Unicode.CES.byte_sequence
   is
   begin
      return Get (Attr, Index).Qname.all;
   end Get_Qname;

   ----------------
   -- Get_Prefix --
   ----------------

   function Get_Prefix
     (Attr  : attributes;
      Index : Natural) return Unicode.CES.byte_sequence
   is
      QName : constant Unicode.CES.byte_sequence_access :=
        Get (Attr, Index).Qname;
      Pos : constant Natural :=
        Ada.Strings.Fixed.Index (String (QName.all), ":");
   begin
      if Pos < QName'first then
         return "";
      else
         return QName (QName'first .. Pos - 1);
      end if;
   end Get_Prefix;

   --------------
   -- Get_Type --
   --------------

   function Get_Type
     (Attr  : attributes;
      Index : Natural) return attribute_type
   is
   begin
      return Get (Attr, Index).Att_Type;
   end Get_Type;

   --------------
   -- Get_Type --
   --------------

   function Get_Type
     (Attr  : attributes;
      Qname : Unicode.CES.byte_sequence) return attribute_type
   is
      J   : Integer;
      Tmp : attribute_access;
   begin
      Get (Attr, Qname, J, Tmp);
      if Tmp = null then
         return cdata;   --  3.3.3: If not defined, treated as CDATA
      end if;
      return Tmp.Att_Type;
   end Get_Type;

   --------------
   -- Get_Type --
   --------------

   function Get_Type
     (Attr       : attributes;
      URI        : Unicode.CES.byte_sequence;
      Local_Name : Unicode.CES.byte_sequence) return attribute_type
   is
      J   : Integer;
      Tmp : attribute_access;
   begin
      Get (Attr, URI, Local_Name, J, Tmp);
      return Tmp.Att_Type;
   end Get_Type;

   -------------
   -- Get_URI --
   -------------

   function Get_URI
     (Attr  : attributes;
      Index : Natural) return Unicode.CES.byte_sequence
   is
   begin
      return Get (Attr, Index).URI.all;
   end Get_URI;

   ---------------
   -- Get_Value --
   ---------------

   function Get_Value
     (Attr  : attributes;
      Index : Natural) return Unicode.CES.byte_sequence
   is
   begin
      return Get (Attr, Index).Value.all;
   end Get_Value;

   --------------------------
   -- Get_Value_As_Boolean --
   --------------------------

   function Get_Value_As_Boolean
     (Attr  : attributes;
      Index : Natural) return Boolean
   is
      Val : constant byte_sequence_access := Get (Attr, Index).Value;
   begin
      return Val.all = "true" or else Val.all = "1";
   end Get_Value_As_Boolean;

   ---------------
   -- Get_Value --
   ---------------

   function Get_Value
     (Attr  : attributes;
      Qname : Unicode.CES.byte_sequence) return Unicode.CES.byte_sequence
   is
      J   : Integer;
      Tmp : attribute_access;
   begin
      Get (Attr, Qname, J, Tmp);
      return Tmp.Value.all;
   end Get_Value;

   ------------------------------
   -- Get_Non_Normalized_Value --
   ------------------------------

   function Get_Non_Normalized_Value
     (Attr       : attributes;
      URI        : Unicode.CES.byte_sequence;
      Local_Name : Unicode.CES.byte_sequence) return Unicode.CES.byte_sequence
   is
      J   : Integer;
      Tmp : attribute_access;
   begin
      Get (Attr, URI, Local_Name, J, Tmp);
      if Tmp /= null then
         return Tmp.Non_Normalized_Value.all;
      else
         return "";
      end if;
   end Get_Non_Normalized_Value;

   --------------------------
   -- Get_Value_As_Boolean --
   --------------------------

   function Get_Value_As_Boolean
     (Attr  : attributes;
      Qname : Unicode.CES.byte_sequence) return Boolean
   is
      J   : Integer;
      Tmp : attribute_access;
   begin
      Get (Attr, Qname, J, Tmp);
      return Tmp.Value.all = "true" or else Tmp.Value.all = "1";
   end Get_Value_As_Boolean;

   ---------------
   -- Get_Value --
   ---------------

   function Get_Value
     (Attr       : attributes;
      URI        : Unicode.CES.byte_sequence;
      Local_Name : Unicode.CES.byte_sequence) return Unicode.CES.byte_sequence
   is
      J   : Integer;
      Tmp : attribute_access;
   begin
      Get (Attr, URI, Local_Name, J, Tmp);
      if Tmp /= null then
         return Tmp.Value.all;
      else
         return "";
      end if;
   end Get_Value;

   --------------------------
   -- Get_Value_As_Boolean --
   --------------------------

   function Get_Value_As_Boolean
     (Attr       : attributes;
      URI        : Unicode.CES.byte_sequence;
      Local_Name : Unicode.CES.byte_sequence) return Boolean
   is
      J   : Integer;
      Tmp : attribute_access;
   begin
      Get (Attr, URI, Local_Name, J, Tmp);
      return Tmp.Value.all = "true" or else Tmp.Value.all = "1";
   end Get_Value_As_Boolean;

   -----------------------------
   -- Get_Default_Declaration --
   -----------------------------

   function Get_Default_Declaration
     (Attr  : attributes;
      Index : Natural) return default_declaration
   is
   begin
      return Get (Attr, Index).Default_Decl;
   end Get_Default_Declaration;

   -----------------
   -- Set_Content --
   -----------------

   procedure Set_Content
     (Attr    : attributes;
      Index   : Natural;
      Content : Sax.Models.content_model)
   is
   begin
      Unref (Get (Attr, Index).Content);
      Get (Attr, Index).Content := Content;
      Ref (Content);
   end Set_Content;

   -----------------
   -- Get_Content --
   -----------------

   function Get_Content
     (Attr  : attributes;
      Index : Natural) return Sax.Models.content_model
   is
   begin
      return Get (Attr, Index).Content;
   end Get_Content;

end Sax.Attributes;