------------------------------------------------------------------------------
--                                                                          --
--                            GNATPP COMPONENTS                             --
--                                                                          --
--                     G N A T P P . U T I L I T I E S                      --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2001-2014, AdaCore                      --
--                                                                          --
-- GNATPP is free software; you can redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNATPP is  distributed in the  hope that it will  be  useful, but --
-- WITHOUT ANY WARRANTY; without even the implied warranty of  MERCHANTABI- --
-- LITY 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  distributed with GNAT; see file COPYING. If not, --
-- write to the Free Software Foundation,  51 Franklin Street, Fifth Floor, --
-- Boston, MA 02110-1301, USA.                                              --
--                                                                          --
-- GNATPP is maintained by AdaCore (http://www.adacore.com)                 --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling; use Ada.Characters.Handling;

with Asis.Elements;           use Asis.Elements;
with Asis.Exceptions;         use Asis.Exceptions;
with Asis.Declarations;       use Asis.Declarations;
with Asis.Expressions;        use Asis.Expressions;
with Asis.Extensions;         use Asis.Extensions;

with GNATPP.Asis_Utilities;             use GNATPP.Asis_Utilities;
with Ada_Trees.Formatting.Dictionaries; use Ada_Trees.Formatting.Dictionaries;
with GNATPP.Options;                    use GNATPP.Options;

package body GNATPP.Utilities is

   -----------------------
   -- Local subprograms --
   -----------------------

   function Capitalize_String
     (Name   : Program_Text;
      Casing : PP_Casing)
      return   Program_Text;
   --  Supposing that Name is a string name image in the Ada sense, this
   --  function changes its casing according to the value of Casing parameter.

   ----------------
   -- Capitalize --
   ----------------

   function Capitalize
     (Name   : Element;
      Casing : PP_Casing)
      return   Program_Text
   is
      Arg : Asis.Element := Name;
   begin

      if Defining_Name_Kind (Arg) = A_Defining_Identifier then
         Arg := Corresponding_First_Definition (Arg);
      end if;

      if Defining_Name_Kind (Arg) = A_Defining_Expanded_Name then

         return Capitalize (Defining_Prefix (Arg), Casing)
              & "."
              & Capitalize (Defining_Selector (Arg), Casing);

      elsif Expression_Kind (Arg) = A_Selected_Component then

         --  Prefix of a defining expanded name

         return Capitalize (Prefix (Arg), Casing)
              & "."
              & Capitalize (Selector (Arg), Casing);

      else

         --  We can get here if we capitalize a name of a child unit that
         --  follows the END keyword. If we have A.B.C, we have to get the
         --  original casing from the *defining identifiers* for A, B amd C.

         if Expression_Kind (Arg) in An_Identifier .. An_Operator_Symbol then

            begin
               Arg := Corresponding_Name_Definition (Arg);
            exception
               when ASIS_Inappropriate_Element =>
                  null;
            end;

            if Defining_Name_Kind (Arg) = A_Defining_Expanded_Name then
               Arg := Defining_Selector (Arg);
            end if;
         end if;

         declare
            Result : Program_Text := Name_Text_Image (Arg);
         begin

            if Is_Standard_Name (Arg) and then
               Use_Predefined_Casing
            then
               --  No change in predefined casing is needed,

               null;
            elsif Use_Dictionary then
               Check_With_Dictionary
                 (Ada_Name => Result,
                  Casing   => Casing);
            else
               Result := Capitalize_String (Result, Casing);
            end if;

            return Result;

         end;

      end if;

   end Capitalize;

   ----------------------
   -- Capitalize_Image --
   ----------------------

   function Capitalize_Image
     (Name   : Program_Text;
      Casing : PP_Casing)
      return   Program_Text
   is
      Result : Program_Text := Name;
   begin

      if Use_Dictionary then
         Check_With_Dictionary
           (Ada_Name   => Result,
            Casing => Casing);
      else
         Result := Capitalize_String (Result, Casing);
      end if;

      return Result;

   end Capitalize_Image;

   -----------------------
   -- Capitalize_String --
   -----------------------

   function Capitalize_String
     (Name   : Program_Text;
      Casing : PP_Casing)
      return   Program_Text
   is
      pragma Assert (not Use_New_PP);
      Result               : Program_Text := Name;
      Capitalize_Next_Char : Boolean      := True;
      W_Ch                 : Wide_Character;
   begin

      case Casing is

         when As_Declared => --  ???
            null;

         when Lower_Case =>
            Result := To_Wide_String (To_Lower (To_String (Result)));

         when Upper_Case =>
            Result := To_Wide_String (To_Upper (To_String (Result)));

         when Mixed =>

            for J in Result'Range loop

               W_Ch := Result (J);

               if Capitalize_Next_Char then

                  if Is_Character (W_Ch) then
                     Result (J) :=
                        To_Wide_Character (To_Upper (To_Character (W_Ch)));
                  end if;

                  Capitalize_Next_Char := False;

               elsif Is_Character (W_Ch) then
                  Result (J) :=
                     To_Wide_Character (To_Lower (To_Character (W_Ch)));
               end if;

               if W_Ch = '.' or else W_Ch = '_' then
                  Capitalize_Next_Char := True;
               end if;

            end loop;

      end case;

      return Result;
   end Capitalize_String;

   ---------------
   -- KW_Length --
   ---------------

   function KW_Length (KW : Keyword_Kinds) return Natural is
      Result : Natural := 0;
   begin

      case KW is
         when KW_At |
              KW_Do |
              KW_If |
              KW_In |
              KW_Is |
              KW_Of |
              KW_Or =>

            Result := 2;

         when KW_Abs |
              KW_All |
              KW_And |
              KW_End |
              KW_For |
              KW_Mod |
              KW_New |
              KW_Not |
              KW_Out |
              KW_Rem |
              KW_Use |
              KW_Xor =>

            Result := 3;

         when KW_Body |
              KW_Case |
              KW_Else |
              KW_Exit |
              KW_Goto |
              KW_Loop |
              KW_Null |
              KW_Task |
              KW_Then |
              KW_Type |
              KW_When |
              KW_With =>

            Result := 4;

         when KW_Abort |
              KW_Array |
              KW_Begin |
              KW_Delay |
              KW_Delta |
              KW_Elsif |
              KW_Entry |
              KW_Raise |
              KW_Range |
              KW_Until |
              KW_While =>

            Result := 5;

         when KW_Accept |
              KW_Access |
              KW_Digits |
              KW_Others |
              KW_Pragma |
              KW_Record |
              KW_Return |
              KW_Select |
              KW_Tagged =>

            Result := 6;

         when KW_Aliased |
              KW_Declare |
              KW_Generic |
              KW_Limited |
              KW_Package |
              KW_Private |
              KW_Renames |
              KW_Requeue |
              KW_Reverse |
              KW_Subtype =>

            Result := 7;

         when KW_Abstract |
              KW_Constant |
              KW_Function |
              KW_Separate =>

            Result := 8;

         when KW_Exception |
              KW_Procedure |
              KW_Protected |
              KW_Terminate =>

            Result := 9;

         when others =>
            null;
      end case;

      return Result;
   end KW_Length;

end GNATPP.Utilities;
