-----------------------------------------------------------------------
--                XML/Ada - An XML suite for Ada95                   --
--                                                                   --
--                       Copyright (C) 2005                          --
--                            AdaCore                                --
--                                                                   --
-- This library is free software; you can redistribute it and/or     --
-- modify it under the terms of the GNU General Public               --
-- License as published by the Free Software Foundation; either      --
-- version 2 of the License, 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    --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
-- General Public License for more details.                          --
--                                                                   --
-- You should have received a copy of the GNU General Public         --
-- License along with this library; if not, write to the             --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
-- Boston, MA 02111-1307, USA.                                       --
--                                                                   --
-- As a special exception, if other files instantiate generics from  --
-- this unit, or you link this unit with other files to produce an   --
-- executable, this  unit  does not  by itself cause  the resulting  --
-- executable to be covered by the GNU General Public License. This  --
-- exception does not however invalidate any other reasons why the   --
-- executable file  might be covered by the  GNU Public License.     --
-----------------------------------------------------------------------

with Interfaces;                use Interfaces;

with Unicode.CES;               use Unicode, Unicode.CES;
with Sax.Encodings;             use Sax.Encodings;
with Unicode.Names.Basic_Latin; use Unicode.Names.Basic_Latin;

package body Sax.Utils is

   ----------------------------
   -- Is_Valid_Language_Name --
   ----------------------------

   function Is_Valid_Language_Name
     (Lang : Unicode.CES.Byte_Sequence) return Boolean
   is
      C, C2 : Unicode_Char;
      Index : Natural := Lang'First;
   begin
      Encoding.Read (Lang, Index, C2);

      if not (C2 in Latin_Small_Letter_A .. Latin_Small_Letter_Z
              or else C2 in Latin_Capital_Letter_A .. Latin_Capital_Letter_Z)
        or else Index > Lang'Last
      then
         return False;
      end if;

      Encoding.Read (Lang, Index, C);
      if C in Latin_Small_Letter_A .. Latin_Small_Letter_Z
        or else C in Latin_Capital_Letter_A .. Latin_Capital_Letter_Z
      then
         if Index <= Lang'Last then
            Encoding.Read (Lang, Index, C);
         end if;

      elsif C2 /= Latin_Small_Letter_I
        and then C2 /= Latin_Capital_Letter_I
        and then C2 /= Latin_Small_Letter_X
        and then C2 /= Latin_Capital_Letter_X
      then
         return False;
      end if;

      if C = Hyphen_Minus and then Index > Lang'Last then
         return False;
      end if;

      while Index <= Lang'Last loop
         if C /= Hyphen_Minus
           or else Index > Lang'Last
         then
            return False;
         end if;

         loop
            Encoding.Read (Lang, Index, C);

            exit when Index > Lang'Last
              or else not
              (C in Latin_Small_Letter_A .. Latin_Small_Letter_Z
                or else C in Latin_Capital_Letter_A .. Latin_Capital_Letter_Z);
         end loop;
      end loop;

      return True;
   end Is_Valid_Language_Name;

   ------------------------
   -- Is_Valid_Name_Char --
   ------------------------

   function Is_Valid_Name_Char (Char : Unicode.Unicode_Char) return Boolean is
   begin
      return Char = Period
        or else Char = Hyphen_Minus
        or else Char = Spacing_Underscore
        or else Is_Digit (Char)
        or else Is_Letter (Char)
        or else Is_Combining_Char (Char)
        or else Is_Extender (Char);
   end Is_Valid_Name_Char;

   ----------------------
   -- Is_Valid_Nmtoken --
   ----------------------

   function Is_Valid_Nmtoken
     (Nmtoken : Unicode.CES.Byte_Sequence) return Boolean
   is
      C     : Unicode_Char;
      Index : Natural := Nmtoken'First;
   begin
      while Index <= Nmtoken'Last loop
         Encoding.Read (Nmtoken, Index, C);
         if not Is_Valid_Name_Char (C) then
            return False;
         end if;
      end loop;

      return True;
   end Is_Valid_Nmtoken;

   -------------------
   -- Is_Valid_Name --
   -------------------

   function Is_Valid_Name
     (Name : Unicode.CES.Byte_Sequence) return Boolean
   is
      C     : Unicode_Char;
      Index : Natural := Name'First;
   begin
      Encoding.Read (Name, Index, C);

      if C /= Spacing_Underscore
        and then C /= Colon
        and then not Is_Letter (C)
      then
         return False;
      end if;

      return Is_Valid_Nmtoken (Name (Index .. Name'Last));
   end Is_Valid_Name;

   ---------------------
   -- Is_Valid_NCname --
   ---------------------

   function Is_Valid_NCname
     (Name : Unicode.CES.Byte_Sequence) return Boolean
   is
      C     : Unicode_Char;
      Index : Natural := Name'First;
   begin
      if Name'Length = 0 then
         return False;
      end if;

      Encoding.Read (Name, Index, C);

      if C /= Spacing_Underscore and then not Is_Letter (C) then
         return False;
      end if;

      while Index <= Name'Last loop
         Encoding.Read (Name, Index, C);

         if C = Colon or else not Is_Valid_Name_Char (C) then
            return False;
         end if;
      end loop;

      return True;
   end Is_Valid_NCname;

   --------------------
   -- Is_Valid_QName --
   --------------------

   function Is_Valid_QName
     (Name : Unicode.CES.Byte_Sequence) return Boolean is
   begin
      for N in Name'Range loop
         if Name (N) = ':' then
            return N /= Name'Last
              and then Is_Valid_NCname (Name (Name'First .. N - 1))
              and then Is_Valid_NCname (Name (N + 1 .. Name'Last));
         end if;
      end loop;
      return Is_Valid_NCname (Name);

   end Is_Valid_QName;

   ----------
   -- Hash --
   ----------

   function Hash
     (Key : Unicode.CES.Byte_Sequence) return Interfaces.Unsigned_32
   is
      type Uns is mod 2 ** 32;
      function Rotate_Left (Value : Uns; Amount : Natural) return Uns;
      pragma Import (Intrinsic, Rotate_Left);

      Tmp : Uns := 0;
   begin
      for J in Key'Range loop
         Tmp := Rotate_Left (Tmp, 1) + Character'Pos (Key (J));
      end loop;

      return Interfaces.Unsigned_32 (Tmp);
   end Hash;

   -----------------
   -- Split_Qname --
   -----------------

   function Split_Qname (Qname : Unicode.CES.Byte_Sequence) return Integer is
   begin
      --  ??? This function assumes we are using UTF8 internally
      for Q in Qname'Range loop
         if Qname (Q) = ':' then
            return Q;
         end if;
      end loop;
      return Qname'First - 1;
   end Split_Qname;

   ------------------
   -- Is_Valid_URI --
   ------------------

   function Is_Valid_URI
     (Name : Unicode.CES.Byte_Sequence) return Boolean
   is
      Index    : Integer := Name'First;
      Previous : Integer;
      C        : Unicode_Char;
   begin
      while Index <= Name'Last loop
         Previous := Index;
         Encoding.Read (Name, Index, C);
         if C = Character'Pos ('/') then
            Encoding.Read (Name, Index, C);
            if C = Character'Pos ('/') then
               return Is_Valid_Name (Name (Name'First .. Previous - 1));
            else
               return False;
            end if;
         end if;
      end loop;
      return False;
   end Is_Valid_URI;

   ------------------------
   -- Is_Valid_HexBinary --
   ------------------------

   function Is_Valid_HexBinary
     (Str : Unicode.CES.Byte_Sequence) return Boolean
   is
      Index : Integer := Str'First;
      C     : Unicode_Char;
   begin
      while Index <= Str'Last loop
         Encoding.Read (Str, Index, C);
         if C not in Character'Pos ('0') .. Character'Pos ('9')
           and then C not in Character'Pos ('a') .. Character'Pos ('f')
           and then C not in Character'Pos ('A') .. Character'Pos ('F')
         then
            return False;
         end if;
      end loop;
      return True;
   end Is_Valid_HexBinary;

end Sax.Utils;
