------------------------------------------------------------------------------
--                                                                          --
--                            GCH COMPONENTS                                --
--                                                                          --
--                           G C H . I N I T                                --
--                                                                          --
--                              B o d y                                     --
--                                                                          --
--                                                                          --
--              Copyright (c) 1999, Vitali Sh.Kaufman.                      --
--                                                                          --
--  Gch is distributed as free software; that is with full sources          --
--  and 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. You can freely copy, modify and redistribute  --
--  this software, provided that full sources are available for the version --
--  being distribute (original and modified), and for a modified version,   --
--  any changes that you have made are clearly indicated.                   --
--                                                                          --
--  Gch was developed by Vitali Sh. Kaufman using a prototype               --
--  and consultations by Sergey I. Rybin.                                   --
------------------------------------------------------------------------------

with Ada.Characters.Handling;   use Ada.Characters.Handling;
with Ada.Command_Line;          use Ada.Command_Line; --  ???
with Ada.Text_IO;               use Ada.Text_IO;
with Ada.Wide_Text_IO;          use Ada.Wide_Text_IO;
with Ada.Integer_Wide_Text_IO;  use Ada.Integer_Wide_Text_IO;

with GNAT.OS_Lib;               use GNAT.OS_Lib;

with Gch.Options;               use Gch.Options;
with Gch.Output;                use Gch.Output;
with Gch.Rules;

package body Gch.Init is

   ------------------------
   -- Local declarations --
   ------------------------

   Create_Obj_Args_String      : String_Access;
   Create_Tree_Args_String     : String_Access;
   Args_String_Tmp             : String_Access;
   --  These temporary variables are needed to collect all the arguments
   --  and separately - all the '-I' options passed to Gch

   GCC_Tree_Args_Count   : Natural := 0;
   GCC_Object_Args_Count : Natural := 0;
   --  Counters for all the arguments and all the '-I' options separately
   --  for the arguments passed to Gch

   procedure Add_To_String (S : in String; To : in out String_Access);
   --  Adds S prepended by the blank character to the string value on which
   --  To points at the moment (or makes To pointing to the string value S in
   --  case if To is null). This procedure uses the global variable
   --  Args_String_Tmp as a temporary buffer when replacing the value of To
   --  with the new value. The procedure deallocates all the old access values.

   procedure Set_Arguments
     (Arg_String :        String_Access;
      Agr_List   : in out Argument_List_Access);
   --  Converts a string containing a list of arguments into the beginning of
   --  an argument list for calling gcc. This procedure supposes, that there
   --  is enough elements in the argument list to place all the arguments.

   procedure Set_Default_Options;
   --  Sets default values for Gch options. Do we really need it???
   --  Currently it is a placeholder

   -------------------
   -- Add_To_String --
   -------------------

   procedure Add_To_String (S : in String; To : in out String_Access) is
   begin

      if To = null then
         To := new String'(S);
      else
         Args_String_Tmp := new String'(To.all);
         Free (To);
         To := new String'(Args_String_Tmp.all & ' ' & S);
         Free (Args_String_Tmp);
      end if;

   end Add_To_String;

   --------------------
   -- Check_Settings --
   --------------------

   procedure Check_Settings is
   begin

      --  Currently this procedure only creates argument lists for calling GNAT
      --  to create a tree and an object file

      --  First, convering the string representing Gch options and
      --  the string representing the search path into argument lists for
      --  calling gcc

      if Create_Object then
         --  One more position for the name of the file to compile
         GCC_Object_Args_Count := GCC_Object_Args_Count + 1;
         Create_Obj_Args := new Argument_List (1 .. GCC_Object_Args_Count);
         Set_Arguments (Create_Obj_Args_String, Create_Obj_Args);
      end if;

      Free (Create_Obj_Args_String);

      --  Then, creating the argument list for calling gcc to create the
      --  tree file:

      --  Adding positions for '-c' , '-gnatc', '-gnatt', 'gnatws'
      --  and for a file name
      GCC_Tree_Args_Count := GCC_Tree_Args_Count + 5;

      if Check_GNAT_Style then
         --  Adding position for '-gnatg'
         GCC_Tree_Args_Count := GCC_Tree_Args_Count + 1;
      end if;

      Create_Tree_Args := new Argument_List (1 .. GCC_Tree_Args_Count);
      Set_Arguments (Create_Tree_Args_String, Create_Tree_Args);

      --  Setting '-c', '-gnatc', '-gnatt' '-gnatws' and, if needed, '-gnatg'
      GCC_Tree_Args_Count := GCC_Tree_Args_Count - 1;
      Create_Tree_Args (GCC_Tree_Args_Count) := new String'("-c");

      GCC_Tree_Args_Count := GCC_Tree_Args_Count - 1;
      Create_Tree_Args (GCC_Tree_Args_Count) := new String'("-gnatc");

      GCC_Tree_Args_Count := GCC_Tree_Args_Count - 1;
      Create_Tree_Args (GCC_Tree_Args_Count) := new String'("-gnatt");

      GCC_Tree_Args_Count := GCC_Tree_Args_Count - 1;
      Create_Tree_Args (GCC_Tree_Args_Count) := new String'("-gnatws");

      if Check_GNAT_Style then
         GCC_Tree_Args_Count := GCC_Tree_Args_Count - 1;
         Create_Tree_Args (GCC_Tree_Args_Count) := new String'("-gnatg");
      end if;

      Free (Create_Tree_Args_String);
   end Check_Settings;

   --------------
   -- Clean_Up --
   --------------

   procedure Clean_Up is
   begin
      null;
   end Clean_Up;

   ----------------
   -- Clean_Tree --
   ----------------

   procedure Clean_Tree (Tree_Name : String_Access) is
      Tree_File : Ada.Wide_Text_IO.File_Type;
   begin

      if Delete_Tree_Mode then
         --  Deleting the tree file itself
         begin
            Open (Tree_File, In_File, Tree_Name.all, "");
            Delete (Tree_File);
         exception
            when Ada.Wide_Text_IO.Name_Error => null;
            --  it means that the file is absent
            when others =>
               Ada.Wide_Text_IO.New_Line;
               Ada.Wide_Text_IO.Put
                  ("Gch: Clean_Tree: Non-implemented feature for ");
               Put_Line (To_Wide_String (Tree_Name.all));

         end; --  of Deleting the tree file itself

         --  Deleting the ALI file which was created along with the tree file
         --  We use the modified Tree_Name for this, because we do not need
         --  Tree_Name any more
         begin
            Tree_Name (Tree_Name'Last - 2 .. Tree_Name'Last) := "ali";
            Open (Tree_File, In_File, Tree_Name.all, "");
            Delete (Tree_File);
         exception
            when Ada.Wide_Text_IO.Name_Error => null;
            --  it means that the file is absent
            when others =>
               Ada.Wide_Text_IO.New_Line;
               Ada.Wide_Text_IO.Put
                 ("Gch: Clean_Tree: Non-implemented feature for ");
               Put_Line (To_Wide_String (Tree_Name.all));

         end; --  of deleting the ALI file
      end if;

   end Clean_Tree;

   -----------------------
   -- Scan_Command_Line --
   -----------------------

   procedure Scan_Command_Line is

      Arg_N : Natural := Argument_Count;

      procedure Process_Arg_String (Arg_V : String);
      --  Processes a single argument which is not supposed to be a file
      --  name.

      procedure Process_File_Name (Arg_V : String);
      --  Processes the last argument in the gch command line which is
      --  supposed to be a file name.

      procedure Process_Arg_String (Arg_V : String) is
         Curr_Arg_Str : constant String (1 .. Arg_V'Length) := Arg_V;
      begin

         Add_To_String (Curr_Arg_Str, Create_Obj_Args_String);
         GCC_Object_Args_Count := GCC_Object_Args_Count + 1;

         if Curr_Arg_Str'Length >= 3 and then
            Curr_Arg_Str (1 .. 2) = "-I"
         then
            Add_To_String (Curr_Arg_Str, Create_Tree_Args_String);
            GCC_Tree_Args_Count := GCC_Tree_Args_Count + 1;

         elsif Curr_Arg_Str = "-gnatg" then
            Check_GNAT_Style := True;

         elsif Curr_Arg_Str = "-gnatc" or else
               Curr_Arg_Str = "-gnats"
         then
            Create_Object := False;
         end if;

      end Process_Arg_String;

      procedure Process_File_Name (Arg_V : String) is
         File_Name : constant String (1 .. Arg_V'Length) := Arg_V;
         Curr_FN_Num : File_Id;

      begin
         Curr_FN_Num := Source_File_Table.Allocate;
         Sources (Curr_FN_Num).File_Name := new String'(File_Name);
         Sources (Curr_FN_Num).Checked_Successfully := False;
      end Process_File_Name;

   begin --  Scan_Command_Line

      if Arg_N < 2 then
         if Arg_N = 1 then
            Ada.Text_IO.Put_Line ("Gch: too few arguments");
         end if;

         Brief_Help;

         raise Fatal_Error;

      end if;

      for I in 1 .. Arg_N loop

         if Argument (I) (Argument (I)'First) = '-' then
            Process_Arg_String (Argument (I));
         else
            Process_File_Name (Argument (I));
         end if;

      end loop;

      if Create_Tree_Args_String /= null then
         GCC_Tree_Args := new String'(Create_Tree_Args_String.all);
      else
         GCC_Tree_Args := new String'("");
      end if;

   end Scan_Command_Line;

   -------------------
   -- Scan_Ini_File --
   -------------------

   procedure Scan_Ini_File is

      Path          : String_Access := Getenv ("path");
      Ini_Full_Name : String_Access;

      Max_Line_Length : constant := 80;
      Line_Buf : Wide_String (1 .. Max_Line_Length);
      Line_Length : Natural;
      Ini_File   : Ada.Wide_Text_IO.File_Type;

      --  the following constants are used to denote specific parameters
      Verbose  : constant String_Access
                     := new String'("Verbose_Mode=");
      Gnat   : constant String_Access
                     := new String'("Gnat_Mode=");
      Hide_Rejected : constant String_Access
                     := new String'("Hide_Rejected_Files=");
      Show_Global : constant String_Access
                     := new String'("Show_Global_Statistics=");
      Delete_Tree : constant String_Access
                     := new String'("Delete_Tree_Mode=");
      Infrequently  : constant String_Access
                     := new String'("Meaning_of_'infrequently used'=");
      Many          :  constant String_Access
                     := new String'("Meaning_of_'many formal parameters'=");
      Lines_Between :  constant String_Access :=
         new String'("Number_of_lines_between_'infrequently_used_calls'=");
      End_Of_Ini :  constant String_Access
                     := new String'("End_Of_Gch.ini");

      Last_Col : Positive; --  to get a column number

      Str : Wide_String (1 .. Max_Line_Length);
      --  a buffer string set by the following function Check_Line

      --  check if a current line Line_Buf match the parameter string S
      function Check_Line (S : String_Access) return Boolean is -- sets Str
      begin
         if Line_Length >= S'Length and then
            Line_Buf (1 .. S'Length) = To_Wide_String (S.all)
         then
            Str (1 .. Line_Length - S'Length) :=
                  Line_Buf (S'Length + 1 .. Line_Length);
            return True;
         else
            return False;
         end if;
      end Check_Line;

   begin --  Scan_Ini_File

      Set_Default_Options;
      --  ??? Do we need this? Are not initializations in the corresponding
      --  ??? declarations of variables used to store Gch options enough?

      --  First, we check, if there is Gch.ini file to scan
      Ini_Full_Name := Locate_Regular_File (File_Name => "Gch.ini",
                                            Path      => Path.all);

      if Ini_Full_Name /= null then

      --  Here we scan the file Gch.ini and set some Gch options

         declare
            package Boolean_IO is new
               Ada.Wide_Text_IO.Enumeration_IO (Boolean);
            use Boolean_IO;
         begin
            Open (Ini_File, In_File, Ini_Full_Name.all, "");

            Setting_Parameters :
            loop
               Get_line (Ini_File, Line_Buf, Line_Length);

               if Check_Line (Verbose) then
                  Get (Str, Verbose_Mode, Last_Col);
               elsif Check_Line (Gnat) then
                  Get (Str, Gnat_Mode, Last_Col);
               elsif Check_Line (Hide_Rejected) then
                  Get (Str, Hide_Rejected_Files, Last_Col);
               elsif Check_Line (Show_Global) then
                  Get (Str, Show_Global_Statistics, Last_Col);
               elsif Check_Line (Delete_Tree) then
                  Get (Str, Delete_Tree_Mode, Last_Col);
               elsif Check_Line (Infrequently) then
                  Get (Str, Infrequently_Used_Subprograms, Last_Col);
               elsif Check_Line (Many) then
                  Get (Str, Many_Formal_Parameters, Last_Col);
               elsif Check_Line (Lines_Between) then
                  Get (Str, Lines_Between_Infrequently_Used_Calls, Last_Col);
               elsif Check_Line (End_Of_Ini) then
                  exit Setting_Parameters;
               end if;

            end loop Setting_Parameters;

            Close (Ini_File);
         exception
            when Ada.Wide_TExt_IO.End_Error
               =>
               if Is_Open (Ini_File) then
                  Close (Ini_File);
               end if;
               Ada.Wide_TExt_IO.New_Line;
               Put_Line (To_Wide_String
                        ("Impossible to set some options from "));
               Put_Line (To_Wide_String (Ini_Full_Name.all));
            when Ada.Wide_TExt_IO.Data_Error
            =>
               if Is_Open (Ini_File) then
                  Close (Ini_File);
               end if;
               Put_Line (To_Wide_String
                        ("Impossible to get some parameter from "));
               Put_Line (To_Wide_String (Ini_Full_Name.all));

         end;

      end if;

   end Scan_Ini_File;

   ------------------------
   -- Scan_Rule_Ini_File --
   ------------------------

   procedure Scan_Rule_Ini_File is

      Path          : String_Access := Getenv ("path");
      Rule_Ini_Full_Name : String_Access;

      Max_Line_Length : constant Natural := 78;
      Line_Buf : Wide_String (1 .. Max_Line_Length + 1);
      Line_Length : Natural;
      Next_Line_Buf : Wide_String (1 .. Max_Line_Length + 1);
      Next_Line_Length : Natural;
      Rules_File   : Ada.Wide_Text_IO.File_Type;
      Rules_Ini_File   : Ada.Wide_Text_IO.File_Type;

      Begin_Of_Rule_Setting : constant String_Access
                     := new String'("   Rules : Rule_Array := (");
      End_Of_Rule_Setting  : constant String_Access
         := new String'("      );  -- end of Rules array initialization");

      Str : Wide_String (1 .. Max_Line_Length);
      --  a buffer string set by the following function Check_Line

      --  check if a current line Line_Buf match the parameter string S
      function Check_Line (S : String_Access) return Boolean is -- sets Str
      begin
         if Line_Length >= S'Length and then
            Line_Buf (1 .. S'Length) = To_Wide_String (S.all)
         then
            Str (1 .. Line_Length - S'Length) :=
                  Line_Buf (S'Length + 1 .. Line_Length);
            return True;
         else
            return False;
         end if;
      end Check_Line;

   begin --  Scan_Rule_Ini_File

      Rule_Ini_Full_Name := Locate_Regular_File (File_Name => "rules.ini",
                                                 Path      => Path.all);

      if Rule_Ini_Full_Name /= null then
         --  Here we have to scan the ini file:
         Open (Rules_Ini_File, In_File, Rule_Ini_Full_Name.all, "");

         Check_The_Rules_Ini : --  just in case, to be more stable
                               --  and avoid a damage of the file rules.ini
         loop
            Get_line (Rules_Ini_File, Line_Buf, Line_Length);
            if Check_Line (Begin_Of_Rule_Setting) then
               exit Check_The_Rules_Ini;
            end if;
         end loop Check_The_Rules_Ini;

         Setting_Flags:
         for I in Gch.Rules.Rules'Range loop

            Search_For_A_Setting_Comment:
            loop
               Get_line (Rules_Ini_File, Line_Buf, Line_Length);

               if Line_Length >= 5 and then
                           (Line_Buf (1 .. 5) = "--  +" or else
                           Line_Buf (1 .. 5) = "--  -")
               then
                  Get_line (Rules_Ini_File, Next_Line_Buf, Next_Line_Length);
                  exit Search_For_A_Setting_Comment
                     when Next_Line_Length >= 7 and then
                        Next_Line_Buf (1 .. 7) = "      (";
                        --  the simplest check is implement for now;
                        --  should be improved
               end if;

            end loop Search_For_A_Setting_Comment;

            -- Setting the "On" flag of the specific rule
            if Line_Buf (1 .. 5) = "--  +" then
                  Gch.Rules.Rules (I).On := True;

            else

               if Line_Buf (1 .. 5) = "--  -" then
                  Gch.Rules.Rules (I).On := False;
               end if;

            end if;
         end loop Setting_Flags;

         Close (Rules_Ini_File);
      end if;

   exception
      when Ada.Wide_Text_IO.End_Error
         =>
         if Is_Open (Rules_File) then
            Close (Rules_File);
         end if;
         Ada.Wide_Text_IO.New_Line;
         Put_Line (To_Wide_String
                  ("Impossible to set some 'On' rule flags in "));
         Put_Line (To_Wide_String (Rule_Ini_Full_Name.all));
         Ada.Wide_Text_IO.New_line;
         Put_Line (To_Wide_String
                  ("The line '--  +' or '--  -' should "));
         Put_Line (To_Wide_String
                  ("forego each rule record in Rules array initialization"));

   end Scan_Rule_Ini_File;

   -------------------
   -- Set_Arguments --
   -------------------

   procedure Set_Arguments
     (Arg_String :        String_Access;
      Agr_List   : in out Argument_List_Access)
   is
      Next_Arg              : Positive := 1;
      Next_Arg_String_Start : Integer;
      Next_Arg_String_End   : Integer;
      Max_Arg_String_End    : Integer;
   begin
      if Arg_String = null then
         return;
      end if;

      Next_Arg_String_Start := Arg_String'First;
      Max_Arg_String_End    := Arg_String'Last;

      while Next_Arg_String_Start <= Max_Arg_String_End loop
         --  Computing Next_Arg_String_End:
         Next_Arg_String_End := Next_Arg_String_Start;

         while Next_Arg_String_End < Max_Arg_String_End loop

            exit when Arg_String (Next_Arg_String_End + 1) = ' ';

            Next_Arg_String_End := Next_Arg_String_End + 1;
         end loop;

         --  Setting the next argument:
         Agr_List (Next_Arg) := new String'
           (Arg_String (Next_Arg_String_Start .. Next_Arg_String_End));

         Next_Arg := Next_Arg + 1;

         --  Resetting Next_Arg_String_Start: jumping over space separator
         Next_Arg_String_Start := Next_Arg_String_End + 1;

      end loop;

   end Set_Arguments;

   -------------------------
   -- Set_Default_Options --
   -------------------------

   procedure Set_Default_Options is
   begin
      --  Placeholder for now
      null;
   end Set_Default_Options;

end Gch.Init;