gnoga_2.1.2_5f127c56/deps/zanyblue/src/text/zanyblue-text-locales.adb

--  -*- coding: utf-8 -*-
--
--  ZanyBlue, an Ada library and framework for finite element analysis.
--
--  Copyright (c) 2012, 2018, Michael Rohan <mrohan@zanyblue.com>
--  All rights reserved.
--
--  Redistribution and use in source and binary forms, with or without
--  modification, are permitted provided that the following conditions
--  are met:
--
--    * Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    * Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in the
--      documentation and/or other materials provided with the distribution.
--
--    * Neither the name of ZanyBlue nor the names of its contributors may
--      be used to endorse or promote products derived from this software
--      without specific prior written permission.
--
--  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
--  "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
--  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
--  A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
--  HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
--  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
--  TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--

with Ada.Environment_Variables;
with ZanyBlue.OS;
with ZanyBlue.Text.Utils;
pragma Elaborate_All (ZanyBlue.OS);
pragma Elaborate_All (ZanyBlue.Text.Utils);

package body ZanyBlue.Text.Locales is

   use ZanyBlue.Text.Utils;

   Max_Tag_Length : constant :=
     Max_Language_Length + Max_Script_Length + Max_Territory_Length;
   --  Maximum length of the internal locale name, it's simply a concatenation
   --  of the language, script and territory names, uppercased.

   subtype Tag_Type is String;
   --  Internal locale identification: Lang + Script + Terr padded with
   --  spaces, e.g., "EN LATNUS " for "en_Latn_US".

   type String_Index_Type is new Positive range 1 .. 12_000;
   --  Strings are accessed via a simple table giving start and ending indexes
   --  of the string within the "global" string pool.  Each string is stored
   --  within locale structures as a index into this table.  Loading all
   --  available CLDR locales generates a pool with ~6500 strings.  This
   --  range should be sufficient for definitions for quite some time.

   type String_Address_Type is record
      First : Positive;
      Last  : Natural;
   end record;
   --  Start and end of a string with the pool

   type String_Addresses_Type is
     array (String_Index_Type range <>) of String_Address_Type;
   --  The collection of strings defined for all locales accessed by index.

   type Month_Names_Type is array (Month_Type) of String_Index_Type;
   --  List of strings (by index) for month names in a locale.

   type Day_Names_Type is array (Day_Type) of String_Index_Type;
   --  List of strings (by index) for day names in a locale.

   type Day_Period_Names_Type is array (Day_Period_Type) of String_Index_Type;
   --  List of strings (by index) for day period names in a locale.

   type Day_Period_Map_Type is array (Hour_Type) of Day_Period_Type;
   --  Mapping from hour number to day period name.

   type Era_Names_Type is array (Era_Type) of String_Index_Type;
   --  List of strings (by index) for era names in a locale.

   type Date_Time_Styles_Type is
     array (Date_Time_Style_Type) of String_Index_Type;
   --  List of strings (by index) for various time/date formats in a locale.

   type Numeric_Items_Type is array (Numeric_Item_Type) of String_Index_Type;
   --  List of strings (by index) for various numeric items in a locale.

   type Numeric_Format_Type is array (Numeric_Style_Type) of String_Index_Type;
   --  List of strings (by index) for various numeric formats in a locale.

   type Locale_Traits_Type is record
      Tag                : Tag_Type;
      Level              : Level_Type;
      Name               : String_Index_Type;
      Text_Layout        : Text_Layout_Type;
      Short_Month_Names  : Month_Names_Type;
      Full_Month_Names   : Month_Names_Type;
      Short_Day_Names    : Day_Names_Type;
      Full_Day_Names     : Day_Names_Type;
      Day_Period_Names   : Day_Period_Names_Type;
      Exact_Day_Periods  : Day_Period_Map_Type;
      Within_Day_Periods : Day_Period_Map_Type;
      Era_Names          : Era_Names_Type;
      Date_Formats       : Date_Time_Styles_Type;
      Time_Formats       : Date_Time_Styles_Type;
      Date_Time_Formats  : Date_Time_Styles_Type;
      Numeric_Items      : Numeric_Items_Type;
      Numeric_Formats    : Numeric_Format_Type;
   end record;
   --  Collection of strings used for each locale.

   type Trait_Array_Type is
     array (Trait_Index_Type range <>) of Locale_Traits_Type;
   --  List of predefined traits

   Current_Locale_Value : Locale_Type;
   --  Current locale initialized by the environment (variable or underlying
   --  OS defintion).

   function Locale_Data return Trait_Array_Type;
   --  The definition of the various attributes for each known locale.

   function Pool return String;
   --  Pool of accumulated string data for the known locales.

   function String_Addresses return String_Addresses_Type;
   --  Definition of strings within the pool referenced by the Locale_Data.

   procedure Environment_Initialize;
   --  Initialize the current locale based on the ZB_LANG/LANG environment
   --  variables.

   procedure Decompose_Name
     (Name      :     String;
      Language  : out Language_Type;
      Script    : out Script_Type;
      Territory : out Territory_Type;
      Encoding  : out Encoding_Type);
   --  Decompose a locale name, e.g., "en", "en_Latn_US.UTF8", etc. into it's
   --  component language, script and territory values.

   function Find_Traits
     (Language  : String;
      Script    : String;
      Territory : String)
      return Trait_Index_Type;
   --  Locate the traits entry "matching" the given locale data (matching
   --  attempts locale resolution, i.e., "fr_FR" => "fr", etc.

   function Latin_Digit
     (Ch   : Unicode_Character;
      Zero : Unicode_Character)
      return Unicode_Character;
   --  Convert a localized digit character to the corresponding Latin (ASCII)
   --  digit.  The Zero character gives the zero character for the localized
   --  digits.  E.g., for Arabic Latin_Digit ('٣', '٠') => '3'

   procedure Lookup_Traits
     (Language  :     String;
      Script    :     String;
      Territory :     String;
      Index     : out Trait_Index_Type;
      Found     : out Boolean);
   --  Binary search lookup of a traits by tag value.

   function To_String
     (Index : String_Index_Type)
      return String;
   --  Convert a string index of a pooled string to a string value.

   ---------
   -- "=" --
   ---------

   overriding function "="
     (Left, Right : Locale_Type)
      return Boolean
   is
   begin
      return
        Left.Language_Code = Right.Language_Code
        and then Left.Script_Code = Right.Script_Code
        and then Left.Territory_Code = Right.Territory_Code;
   end "=";

   ------------
   -- Codecs --
   ------------

   function Codecs
     (Locale : Locale_Type)
      return Codecs_Type
   is
   begin
      return Locale.Codecs;
   end Codecs;

   --------------------
   -- Current_Locale --
   --------------------

   function Current_Locale return Locale_Type is
   begin
      return Current_Locale_Value;
   end Current_Locale;

   -----------------
   -- Date_Format --
   -----------------

   function Date_Format
     (Locale : Locale_Type;
      Style  : Date_Time_Style_Type)
      return String
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return To_String (Locale_Data (Index).Date_Formats (Style));
   end Date_Format;

   ----------------------
   -- Date_Time_Format --
   ----------------------

   function Date_Time_Format
     (Locale : Locale_Type;
      Style  : Date_Time_Style_Type)
      return String
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return To_String (Locale_Data (Index).Date_Time_Formats (Style));
   end Date_Time_Format;

   -------------------------
   -- Day_Period_For_Time --
   -------------------------

   function Day_Period_For_Time
     (Locale : Locale_Type;
      Hour   : Hour_Type;
      Minute : Minute_Type;
      Second : Second_Type)
      return Day_Period_Type
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      if Minute = 0 and then Second = 0 then
         return Locale_Data (Index).Exact_Day_Periods (Hour);
      else
         return Locale_Data (Index).Within_Day_Periods (Hour);
      end if;
   end Day_Period_For_Time;

   ---------------------
   -- Day_Period_Name --
   ---------------------

   function Day_Period_Name
     (Locale     : Locale_Type;
      Day_Period : Day_Period_Type)
      return String
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return To_String (Locale_Data (Index).Day_Period_Names (Day_Period));
   end Day_Period_Name;

   --------------------
   -- Decompose_Name --
   --------------------

   procedure Decompose_Name
     (Name      :     String;
      Language  : out Language_Type;
      Script    : out Script_Type;
      Territory : out Territory_Type;
      Encoding  : out Encoding_Type)
   is

      Separator : Unicode_Character := '_';
      First     : Positive          := Name.First;
      Last      : Natural           := 0;

      procedure Get_Separated_Item
        (Result :    out String;
         From   : in out Positive;
         Last   :        Natural);

      procedure Get_Separated_Item
        (Result :    out String;
         From   : in out Positive;
         Last   :        Natural)
      is

         First    : constant Positive := From;
         Position : Natural           := First;

      begin
         Find_Separator :
         loop
            Position := Position + 1;
            exit Find_Separator when Position >= Last
              or else Name (Position) = Separator;
         end loop Find_Separator;
         From := Position + 1;
         if Position >= Last then
            Position := Last;
         elsif Name (Position) = Separator then
            Position := Position - 1;
         end if;
         Result := Head (Name.Slice (First, Position), Result.Length);
      end Get_Separated_Item;

   begin
      --  Get any encoding info, e.g., "en_US.utf8"
      Encoding := Empty_Encoding;
      Last     := Index (Name, ".", First);
      if Last = 0 then
         Last := Name.Last;
      else
         Last := Last - 1;
         Encoding.Replace_Slice
           (1, Natural'Min (Name.Last - Last - 1, Encoding.Last),
            Name.Slice
              (Last + 2,
               Natural'Min (Name.Last - Last - 1, Encoding.Last) + Last + 1));
      end if;
      --  If strings contains dashes, assume it's the separator, e.g., "en-us"
      if Index (Name.Slice (First, Last), "-", First) /= 0 then
         Separator := '-';
      end if;
      Language  := Empty_Language;
      Script    := Empty_Script;
      Territory := Empty_Territory;
      Get_Separated_Item (Language, First, Last);
      Get_Separated_Item (Script, First, Last);
      Get_Separated_Item (Territory, First, Last);
      if Script (Script.Last) = ' ' then
         --  Fix up, the script is really the territory
         Territory := Script;
         Script    := Empty_Script;
      end if;
   end Decompose_Name;

   -----------------------
   -- Delocalize_Digits --
   -----------------------

   function Delocalize_Digits
     (Locale : Locale_Type;
      Value  : String)
      return String
   is
      Digit_Str : constant String :=
        Numeric_Item (Locale, Decimal_Digits_String);
      Zero   : constant Unicode_Character := Digit_Str (Digit_Str.First);
      Result : String                     := Value;
      Offset : Integer;
   begin
      for I in Value loop
         Offset :=
           Unicode_Character'Pos (Value (I)) - Unicode_Character'Pos (Zero);
         if Offset >= 0 and then Offset <= 9 then
            Result.Replace_Unicode (I, Latin_Digit (Result (I), Zero));
         end if;
      end loop;
      return Result;
   end Delocalize_Digits;

   ----------------------
   -- Encode_To_String --
   ----------------------

   function Encode_To_String
     (Locale : Locale_Type;
      Value  : String)
      return String
   is
   begin
      return Locale.Codecs.Encode (Value);
   end Encode_To_String;

   --------------
   -- Encoding --
   --------------

   function Encoding
     (Locale : Locale_Type)
      return String
   is
   begin
      return Non_Blank_Prefix (Locale.Encoding_Code);
   end Encoding;

   -----------------------------
   -- Encoding_Implementation --
   -----------------------------

   function Encoding_Implementation
     (Locale : Locale_Type)
      return String
   is
   begin
      return Locale.Codecs.Name;
   end Encoding_Implementation;

   ----------------------------
   -- Environment_Initialize --
   ----------------------------

   procedure Environment_Initialize is

      use Ada.Environment_Variables;

      ZBLang : constant String := "ZB_LANG";

   begin
      if Exists (To_Latin_1 (ZBLang)) then
         Set_Locale (From_Latin_1 (Value (To_Latin_1 (ZBLang))));
      else
         Set_Locale (ZanyBlue.OS.OS_Locale_Name);
      end if;
   end Environment_Initialize;

   --------------
   -- Era_Name --
   --------------

   function Era_Name
     (Locale : Locale_Type;
      Era    : Era_Type)
      return String
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return To_String (Locale_Data (Index).Era_Names (Era));
   end Era_Name;

   -----------------
   -- Find_Traits --
   -----------------

   function Find_Traits
     (Language  : String;
      Script    : String;
      Territory : String)
      return Trait_Index_Type
   is
      Result : Trait_Index_Type := 1;
      Found  : Boolean          := False;
   begin
      Lookup_Traits (Language, Script, Territory, Result, Found);
      if Found then
         return Result;
      end if;
      Lookup_Traits (Language, Script, "", Result, Found);
      if Found then
         return Result;
      end if;
      Lookup_Traits (Language, "", Territory, Result, Found);
      if Found then
         return Result;
      end if;
      Lookup_Traits (Language, "", "", Result, Found);
      if Found then
         return Result;
      end if;
      Lookup_Traits ("", "", "", Result, Found);
      return Result;
   end Find_Traits;

   -------------------
   -- Full_Day_Name --
   -------------------

   function Full_Day_Name
     (Locale : Locale_Type;
      Day    : Day_Type)
      return String
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return To_String (Locale_Data (Index).Full_Day_Names (Day));
   end Full_Day_Name;

   ---------------------
   -- Full_Month_Name --
   ---------------------

   function Full_Month_Name
     (Locale : Locale_Type;
      Month  : Month_Type)
      return String
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return To_String (Locale_Data (Index).Full_Month_Names (Month));
   end Full_Month_Name;

   ----------------------
   -- Get_Locale_Codes --
   ----------------------

   procedure Get_Locale_Codes
     (Locale    :        Locale_Type;
      Language  : in out Language_Type;
      Script    : in out Script_Type;
      Territory : in out Territory_Type)
   is
   begin
      Language  := Locale.Language_Code;
      Script    := Locale.Script_Code;
      Territory := Locale.Territory_Code;
   end Get_Locale_Codes;

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

   function Hash
     (Key : Locale_Type)
      return Ada.Containers.Hash_Type
   is
   begin
      return Wide_Hash (Locale_Name (Key));
   end Hash;

   -----------------------
   -- Is_Locale_Defined --
   -----------------------

   function Is_Locale_Defined
     (Language  : String;
      Script    : String;
      Territory : String)
      return Boolean
   is
      Index : Trait_Index_Type;
      Found : Boolean;
   begin
      Lookup_Traits (Language, Script, Territory, Index, Found);
      return Found;
   end Is_Locale_Defined;

   --------------------
   -- Is_Root_Locale --
   --------------------

   function Is_Root_Locale
     (Locale : Locale_Type)
      return Boolean
   is
   begin
      return
        Locale.Language_Code = Empty_Language
        and then Locale.Script_Code = Empty_Script
        and then Locale.Territory_Code = Empty_Territory;
   end Is_Root_Locale;

   --------------
   -- Language --
   --------------

   function Language
     (Locale : Locale_Type)
      return String
   is
   begin
      return Non_Blank_Prefix (Locale.Language_Code);
   end Language;

   -----------------
   -- Latin_Digit --
   -----------------

   function Latin_Digit
     (Ch   : Unicode_Character;
      Zero : Unicode_Character)
      return Unicode_Character
   is
      Result : Unicode_Character := Ch;
   begin
      --  Quick check, might already a Latin digit
      if Zero /= '0' then
         Result :=
           Unicode_Character'Val
             (Unicode_Character'Pos ('0') +
              (Unicode_Character'Pos (Ch) - Unicode_Character'Pos (Zero)));
      end if;
      return Result;
   end Latin_Digit;

   -----------------
   -- Locale_Data --
   -----------------

   function Locale_Data return Trait_Array_Type is separate;

   -------------------
   -- Locale_Digits --
   -------------------

   function Locale_Digits
     (Locale    : Locale_Type;
      Lowercase : Boolean)
      return String
   is
      Result : String := 16 * '0';
   begin
      Result.Replace_Slice
        (1, 10, Head (Numeric_Item (Locale, Decimal_Digits_String), 10));
      if Lowercase then
         Result.Replace_Slice (11, 16, "abcdef");
      else
         Result.Replace_Slice (11, 16, "ABCDEF");
      end if;
      return Result;
   end Locale_Digits;

   ------------------
   -- Locale_Level --
   ------------------

   function Locale_Level
     (Locale : Locale_Type)
      return Level_Type
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return Locale_Data (Index).Level;
   end Locale_Level;

   -----------------
   -- Locale_Name --
   -----------------

   function Locale_Name
     (Language  : Language_Type;
      Script    : Script_Type;
      Territory : Territory_Type)
      return String
   is

      procedure Append
        (Result   : in out String;
         Position : in out Natural;
         Value    :        Unicode_Character);

      procedure Append
        (Result     : in out String;
         Position   : in out Natural;
         Value      :        String;
         Include_UC :        Boolean := True);

      procedure Append
        (Result   : in out String;
         Position : in out Natural;
         Value    :        Unicode_Character)
      is
      begin
         Position := Position + 1;
         Append (Result, Value);
      end Append;

      procedure Append
        (Result     : in out String;
         Position   : in out Natural;
         Value      :        String;
         Include_UC :        Boolean := True)
      is
      begin
         if Value (Value.First) = ' ' then
            return;
         end if;
         if Include_UC then
            Append (Result, Position, '_');
         end if;
         for I in Value loop
            if Value (I) /= ' ' then
               Append (Result, Position, Value (I));
            end if;
         end loop;
      end Append;

      Result   : String;
      Position : Natural := 0;

   begin
      if Language (Language.First) /= ' ' then
         Append (Result, Position, Language, Include_UC => False);
         Append (Result, Position, Script);
         Append (Result, Position, Territory);
      end if;
      return Result;
   end Locale_Name;

   -----------------
   -- Locale_Name --
   -----------------

   function Locale_Name
     (Locale : Locale_Type)
      return String
   is
      Result : constant String :=
        Locale_Name
          (Locale.Language_Code, Locale.Script_Code, Locale.Territory_Code);
      Encoding_Name : constant String := Encoding (Locale);
   begin
      if Encoding_Name.Length > 0 then
         return Result & "." & Encoding_Implementation (Locale);
      else
         return Result;
      end if;
   end Locale_Name;

   -------------------
   -- Lookup_Traits --
   -------------------

   procedure Lookup_Traits
     (Language  :     String;
      Script    :     String;
      Territory :     String;
      Index     : out Trait_Index_Type;
      Found     : out Boolean)
   is

      Key : Tag_Type :=
        Head (Language, Max_Language_Length) &
        Head (Script, Max_Script_Length) &
        Head (Territory, Max_Territory_Length);

      Left      : Trait_Index_Type := Locale_Data'First;
      Right     : Trait_Index_Type := Locale_Data'Last + 1;
      Center    : Trait_Index_Type;
      Candidate : Tag_Type;

   begin
      ASCII_Uppercase (Key);
      Found := False;
      if Key < Locale_Data (Left).Tag then
         return;
      end if;
      loop
         Center    := Left + (Right - Left) / 2;
         Candidate := Locale_Data (Center).Tag;
         if Key = Candidate then
            Index := Center;
            Found := True;
            return;
         end if;

         if Right - Left <= 1 then
            return;
         elsif Key < Candidate then
            Right := Center;
         else
            Left := Center;
         end if;
      end loop;
   end Lookup_Traits;

   -------------------------
   -- Make_Encoded_Locale --
   -------------------------

   function Make_Encoded_Locale
     (Language  : String;
      Territory : String;
      Encoding  : String)
      return Locale_Type
   is
   begin
      return Make_Locale (Language, "", Territory, Encoding);
   end Make_Encoded_Locale;

   -----------------
   -- Make_Locale --
   -----------------

   function Make_Locale
     (Locale_String : String)
      return Locale_Type
   is

      Language  : Language_Type;
      Script    : Script_Type;
      Territory : Territory_Type;
      Encoding  : Encoding_Type;

   begin
      Decompose_Name (Locale_String, Language, Script, Territory, Encoding);
      return Make_Locale (Language, Script, Territory, Encoding);
   end Make_Locale;

   -----------------
   -- Make_Locale --
   -----------------

   function Make_Locale
     (Language  : String;
      Territory : String)
      return Locale_Type
   is
   begin
      return Make_Locale (Language, "", Territory, "");
   end Make_Locale;

   -----------------
   -- Make_Locale --
   -----------------

   function Make_Locale
     (Language  : String;
      Script    : String;
      Territory : String)
      return Locale_Type
   is
   begin
      return Make_Locale (Language, Script, Territory, "");
   end Make_Locale;

   -----------------
   -- Make_Locale --
   -----------------

   function Make_Locale
     (Language  : String;
      Script    : String;
      Territory : String;
      Encoding  : String)
      return Locale_Type
   is
   begin
      return Result : Locale_Type do
         Result.Language_Code  := Head (Language, Max_Language_Length);
         Result.Script_Code    := Head (Script, Max_Script_Length);
         Result.Territory_Code := Head (Territory, Max_Territory_Length);
         Result.Encoding_Code  := Head (Encoding, Max_Encoding_Length);
         ASCII_Lowercase (Result.Language_Code);
         ASCII_Capitalize (Result.Script_Code);
         ASCII_Uppercase (Result.Territory_Code);
         ASCII_Uppercase (Result.Encoding_Code);
         Result.Traits_Index :=
           Find_Traits
             (Result.Language_Code, Result.Script_Code, Result.Territory_Code);
         Result.Codecs := Make_Codecs (Non_Blank_Prefix (Encoding));
      end return;
   end Make_Locale;

   ------------------------
   -- Make_Locale_Narrow --
   ------------------------

   function Make_Locale_Narrow
     (Locale_String : String)
      return Locale_Type
   is
   begin
      return Make_Locale (Locale_String);
   end Make_Locale_Narrow;

   -------------------------------
   -- Number_Of_Defined_Locales --
   -------------------------------

   function Number_Of_Defined_Locales return Positive is
   begin
      return Locale_Data'Length;
   end Number_Of_Defined_Locales;

   --------------------
   -- Numeric_Format --
   --------------------

   function Numeric_Format
     (Locale : Locale_Type;
      Style  : Numeric_Style_Type)
      return String
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return To_String (Locale_Data (Index).Numeric_Formats (Style));
   end Numeric_Format;

   ------------------
   -- Numeric_Item --
   ------------------

   function Numeric_Item
     (Locale : Locale_Type;
      Item   : Numeric_Item_Type)
      return String
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return To_String (Locale_Data (Index).Numeric_Items (Item));
   end Numeric_Item;

   ------------------
   -- Parent_Codes --
   ------------------

   procedure Parent_Codes
     (Language       : in out Language_Type;
      Script         : in out Script_Type;
      Territory      : in out Territory_Type;
      Base_Territory :        Territory_Type := Empty_Territory)
   is

      Language_P    : constant Boolean := Language (1) /= ' ';
      Script_P      : constant Boolean := Script (1) /= ' ';
      Territory_P   : constant Boolean := Territory (1) /= ' ';
      B_Territory_P : constant Boolean := Base_Territory (1) /= ' ';

   begin
      if Language_P and then Script_P and then Territory_P then
         Territory := Empty_Territory;
         return;
      end if;

      if Language_P and then Script_P and then not Territory_P
        and then B_Territory_P
      then
         Script    := Empty_Script;
         Territory := Base_Territory;
         return;
      end if;

      if Language_P and then Script_P and then not Territory_P
        and then not B_Territory_P
      then
         Script    := Empty_Script;
         Territory := Empty_Territory;
         return;
      end if;

      if Language_P and then not Script_P and then Territory_P then
         Script    := Empty_Script;
         Territory := Empty_Territory;
         return;
      end if;

      Language  := Empty_Language;
      Script    := Empty_Script;
      Territory := Empty_Territory;
   end Parent_Codes;

   ----------
   -- Pool --
   ----------

   function Pool return String is separate;

   ------------
   -- Script --
   ------------

   function Script
     (Locale : Locale_Type)
      return String
   is
   begin
      return Non_Blank_Prefix (Locale.Script_Code);
   end Script;

   ----------------
   -- Set_Locale --
   ----------------

   procedure Set_Locale (Locale : Locale_Type) is
   begin
      Current_Locale_Value := Locale;
   end Set_Locale;

   ----------------
   -- Set_Locale --
   ----------------

--     procedure Set_Locale (Name : String) is
--     begin
--        Set_Locale (Name);
--     end Set_Locale;

   ----------------
   -- Set_Locale --
   ----------------

   procedure Set_Locale (Wide_Name : String) is
   begin
      Set_Locale (Make_Locale (Wide_Name));
   end Set_Locale;

   ----------------
   -- Set_Traits --
   ----------------

--     procedure Set_Traits
--       (Locale : in out Locale_Type;
--        Name   :        String)
--     is
--     begin
--        Set_Traits (Locale, Name);
--     end Set_Traits;

   ----------------
   -- Set_Traits --
   ----------------

   procedure Set_Traits
     (Locale    : in out Locale_Type;
      Wide_Name :        String)
   is
      Language  : Language_Type;
      Script    : Script_Type;
      Territory : Territory_Type;
      Encoding  : Encoding_Type;
   begin
      Decompose_Name (Wide_Name, Language, Script, Territory, Encoding);
      Locale.Traits_Index := Find_Traits (Language, Script, Territory);
   end Set_Traits;

   --------------------
   -- Short_Day_Name --
   --------------------

   function Short_Day_Name
     (Locale : Locale_Type;
      Day    : Day_Type)
      return String
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return To_String (Locale_Data (Index).Short_Day_Names (Day));
   end Short_Day_Name;

   ----------------------
   -- Short_Month_Name --
   ----------------------

   function Short_Month_Name
     (Locale : Locale_Type;
      Month  : Month_Type)
      return String
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return To_String (Locale_Data (Index).Short_Month_Names (Month));
   end Short_Month_Name;

   ----------------------
   -- String_Addresses --
   ----------------------

   function String_Addresses return String_Addresses_Type is separate;

   ---------------
   -- Territory --
   ---------------

   function Territory
     (Locale : Locale_Type)
      return String
   is
   begin
      return Non_Blank_Prefix (Locale.Territory_Code);
   end Territory;

   -----------------
   -- Text_Layout --
   -----------------

   function Text_Layout
     (Locale : Locale_Type)
      return Text_Layout_Type
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return Locale_Data (Index).Text_Layout;
   end Text_Layout;

   -----------------
   -- Time_Format --
   -----------------

   function Time_Format
     (Locale : Locale_Type;
      Style  : Date_Time_Style_Type)
      return String
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return To_String (Locale_Data (Index).Time_Formats (Style));
   end Time_Format;

   ---------------
   -- To_String --
   ---------------

   function To_String
     (Index : String_Index_Type)
      return String
   is
      Address : constant String_Address_Type := String_Addresses (Index);
   begin
      return Pool.Slice (Address.First, Address.Last);
   end To_String;

   -----------------
   -- Traits_Name --
   -----------------

   function Traits_Name
     (Locale : Locale_Type)
      return String
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return To_String (Locale_Data (Index).Name);
   end Traits_Name;

   ----------------
   -- Traits_Tag --
   ----------------

   function Traits_Tag
     (Locale : Locale_Type)
      return String
   is
      Index : constant Trait_Index_Type := Locale.Traits_Index;
   begin
      return Locale_Data (Index).Tag;
   end Traits_Tag;

   --------------------------
   -- Transfer_Locale_Data --
   --------------------------

   function Transfer_Locale_Data
     (Source_Locale : Locale_Type;
      Extra_Data    : Locale_Type)
      return Locale_Type
   is
      S_L, E_L : Language_Type;
      S_S, E_S : Script_Type;
      S_T, E_T : Territory_Type;
   begin
      Get_Locale_Codes (Source_Locale, S_L, S_S, S_T);
      Get_Locale_Codes (Extra_Data, E_L, E_S, E_T);
      if S_L = Empty_Language then
         S_L := E_L;
      end if;
      if S_L /= Empty_Language and then S_S = Empty_Script then
         S_S := E_S;
      end if;
      if S_L /= Empty_Language and then S_T = Empty_Territory then
         S_T := E_T;
      end if;
      return Make_Locale (S_L, S_S, S_T);
   end Transfer_Locale_Data;

begin  --  ZanyBlue.Text.Locales
   Environment_Initialize;
end ZanyBlue.Text.Locales;