------------------------------------------------------------------------------
--                                                                          --
--                            GNATPP COMPONENTS                             --
--                                                                          --
--                   G N A T P P . E N V I R O N M E N T                    --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                    Copyright (C) 2001-2006, 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,                                                                  --
--                                                                          --
-- GNATPP is maintained by AdaCore (http://www.adacore.com)                 --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Characters.Handling;   use Ada.Characters.Handling;
with Ada.Command_Line;
with Ada.Text_IO;               use Ada.Text_IO;
with Ada.Wide_Text_IO;

with GNAT.Command_Line;         use GNAT.Command_Line;
with GNAT.Directory_Operations; use GNAT.Directory_Operations;
with GNAT.OS_Lib;               use GNAT.OS_Lib;

with Asis.Ada_Environments;     use Asis.Ada_Environments;
with Asis.Implementation;       use Asis.Implementation;

with ASIS_UL.Common;            use ASIS_UL.Common;
with ASIS_UL.Compiler_Options;  use ASIS_UL.Compiler_Options;
with ASIS_UL.Options;

with GNATPP.Common;             use GNATPP.Common;
with GNATPP.Dictionaries;       use GNATPP.Dictionaries;
with GNATPP.Options;            use GNATPP.Options;
with GNATPP.Output;             use GNATPP.Output;
with GNATPP.State;              use GNATPP.State;

package body GNATPP.Environment is

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

   procedure Scan_Arguments;
   --  Scans the command-line arguments

   procedure Check_Parameters;
   --  Checks, that GNATPP settings made as the result of parameter processing
   --  are compatible (as a side effect, some internal parameters are
   --  computed) and that the argument source file exist. If the check
   --  fails, generates the diagnostic message and raises Parameter_Error.

   procedure Read_Args_From_File (Par_File_Name : String);
   --  Reads argument files from the file. Performs the same checks as when
   --  file names are read from the command line. This procedure assumes that
   --  the file named by Par_File_Name contains argiment file names separated
   --  by one or more spaces.
   --  ??? This is the direct duplication of the gnatmetric code!!!
   --  We definitely need a common package for ASIS tools.

   PP_Cont_Line_Indentation_Set : Boolean := False;
   --  If this flag is OFF after scanning the gnatpp arguments, we have to
   --  set the default value for PP_Cont_Line_Indentation

   Temp_Dir : String_Access;
   --  Contains the name of the temporary directory created by gnatpp for the
   --  tree files

   procedure Create_Temp_Dir;
   --  Creates the temporary directory and stores its name in Temp_Dir. In case
   --  if the directory is successfully created, changes the working directory
   --  to this temporary directory. In case of a replace out mode
   --  (Replace .. Replace_No_Backup) creates the out file in the temporary dir
   --  to place the reformatted code before the reformatting is complete

   ----------------------
   -- Check_Parameters --
   ----------------------

   procedure Check_Parameters is
   begin

      Total_Sources := Natural (Last_Source);
      Sources_Left  := Total_Sources;

      --  Check that GNAT_Comment_Inden and Standard_Comment_Indent
      --  are not set together

      if GNAT_Comment_Inden and then Standard_Comment_Indent then
         Put      (Standard_Error,
                   "gnatpp: comment processing modes -c1 and -c2 ");
         Put_Line (Standard_Error, "can not be set together");
         Brief_Help;
         raise Parameter_Error;
      end if;

      --  Check that the out file format is not set for the pipe output mode:

      if Output_Mode = Pipe and then Out_File_Format /= Default then
         Put_Line (Standard_Error,
                   "gnatpp: out file format can not be set in pipe mode");
         Brief_Help;
         raise Parameter_Error;

      end if;

      --  Check that the out file encoding is not set for the pipe output mode,
      --  and set the needed value for the Form parameter for the Create
      --  and Open procedures:

      if Output_Mode = Pipe and then Output_Encoding /= Default then
         Put_Line (Standard_Error,
                   "gnatpp: out file encoding can not be set in pipe mode");
         Brief_Help;
         raise Parameter_Error;

      elsif Output_Mode /= Pipe then
         Set_Form_String;
      end if;

      if Last_Source = No_SF_Id then
         Put      (Standard_Error, "gnatpp: No input source file set");
         New_Line;
         Brief_Help;
         raise Parameter_Error;

      elsif Last_Source = First_SF_Id then
         --  If we have only one source to reformat, we have to check
         --  the settings of the output file, if it is set

         Progress_Indicator_Mode := False;
         --  We do not need this in case of one file, and we may be in the
         --  mode of outputting the reformatted source into Stdout

         Arg_Source_Name := new String'(Source_Name (Last_Source));

         if Output_Mode in Create_File .. Force_Create_File then
            --  We have to set the output file here, before we get into the
            --  temporary directory

            Out_File_Exists := False;

            if Res_File_Name /= null and then
               Is_Regular_File (Res_File_Name.all)
            then

               if Output_Mode = Create_File then
                  Put (Standard_Error, "gnatpp: file ");
                  Put (Standard_Error, Res_File_Name.all);
                  Put (Standard_Error, " exists. Use '-of' option");
                  Put (Standard_Error, " to override");
                  New_Line (Standard_Error);
                  raise Parameter_Error;
               else
                  Out_File_Exists := True;
               end if;

            end if;

            if Out_File_Exists then
               Ada.Wide_Text_IO.Open
                 (File => Result_Out_File,
                  Mode => Ada.Wide_Text_IO.Out_File,
                  Name => Res_File_Name.all,
                  Form => Form_String.all);
            else
               Ada.Wide_Text_IO.Create
                 (File => Result_Out_File,
                  Mode => Ada.Wide_Text_IO.Out_File,
                  Name => Res_File_Name.all,
                  Form => Form_String.all);
            end if;

         end if;

      else
         --  If we have more then one file to reformat, we can not have options
         --  '-pipe', '-o' or '-of' set

         Multiple_File_Mode := True;

         if Output_Mode = Pipe then
            Put (Standard_Error, "gnatpp: can not send the output ");
            Put (Standard_Error, "into Stdout when multiple ");
            Put (Standard_Error, "argument sources set");
            raise Parameter_Error;

         elsif Output_Mode = Create_File or else
               Output_Mode = Force_Create_File
         then
            Put (Standard_Error, "gnatpp: explicit output file name is not ");
            Put (Standard_Error, "allowed when multiple ");
            Put (Standard_Error, "argument sources set");
            raise Parameter_Error;
         end if;

      end if;

      if Output_Mode = Default and then  --  ???
         Arg_Source_Name /= null and then
         Is_Regular_File (Arg_Source_Name.all & PP_Suffix)
      then
         Out_File_Exists := True;
      end if;

      --  And  now - some preparations:

      --  1. Compute the default continuation line indentation, if needed

      if not PP_Cont_Line_Indentation_Set then
         PP_Cont_Line_Indentation := PP_Indentation;

         if PP_Cont_Line_Indentation > 1 then
            PP_Cont_Line_Indentation := PP_Cont_Line_Indentation - 1;
         end if;

      end if;

      --  2. Compute the max nesting level for which we can indent the code
      Set_Max_Nesting_Level;

      --  3. Collect all the -I options into the argument list for gcc call

      Set_Arg_List;

      --  4. Set all the alignments ON if needed

      if Alignment_On then
         Align_Colons_In_Decl := True;
         Align_Asign_In_Decl  := True;
         Align_Asign_In_Stmts := True;
         Align_Arrows         := True;
         Allign_Ats           := True;
      end if;

   end Check_Parameters;

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

   procedure Clean_Up is
   begin
      Report_Total_Failures;

      if Is_Open (The_Context) then
         Close (The_Context);
      end if;

      Dissociate (The_Context);
      Finalize;

      if Output_Mode /= Pipe and then                --  ???
         Ada.Wide_Text_IO.Is_Open (Result_Out_File)
      then
         Ada.Wide_Text_IO.Close (Result_Out_File);
      end if;

      --  Delete_Files;

      Free (Arg_Source_Name);
      Free (Res_File_Name);

      --  Cleaning up temporary dir

      if Temp_Dir /= null then

         if not Is_Directory (Temp_Dir.all) then
            --  We may be inside this temporary directory
            Change_Dir ("..");
         end if;

         begin
            Remove_Dir (Temp_Dir.all, Recursive => True);
         exception
            when Directory_Error =>
               Free (Temp_Dir);  -- to avoid cycling
               Error ("gnatpp: can not remove temporary directory");
               raise Fatal_Error;
         end;

         Free (Temp_Dir);

      end if;

      --  In case if we have only one argument file, set exit status according
      --  to the success of the processing of this single file:

      if Last_Source = First_SF_Id
        and then
         Source_Status (First_SF_Id) /= Processed
      then
         Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
      end if;

   end Clean_Up;

   ---------------------
   -- Create_Temp_Dir --
   ---------------------

   procedure Create_Temp_Dir is
      FD        : File_Descriptor;
      Temp_Name : Temp_File_Name;
      Success   : Boolean;
   begin
      --  Here we use exactly the same approach as in gnatelim

      --  ??? We create the temp dir by first creating the temp file, then
      --  closing and deleting it, then creating a dir with the same name.
      --  This is not atomary as another program can sneak in between file
      --  deletion and dir creation and snatch this name for itself. This is
      --  quite unlikely and anyway we don't have any other system-independent
      --  way at the moment
      Create_Temp_File (FD, Temp_Name);
      Close (FD);
      Delete_File (Temp_Name, Success);

      if not Success then
         Error ("gnatpp: can not delete the temporary file that was "
              & "just created");

         raise Fatal_Error;
      end if;

      Make_Dir (Temp_Name);

      Temp_Dir :=
        new String'(Temp_Name (Temp_Name'First .. Temp_Name'Last - 1));

      Change_Dir (Temp_Dir.all);

      if Output_Mode in Replace .. Replace_No_Backup then

         Res_File_Name := new String'(Temp_Dir.all & PP_Suffix);

         Ada.Wide_Text_IO.Create (File => Result_Out_File,
                                  Mode => Ada.Wide_Text_IO.Out_File,
                                  Name => Res_File_Name.all,
                                  Form => Form_String.all);

         Ada.Wide_Text_IO.Close (File => Result_Out_File);

         Out_File_Exists := True;

      end if;

   exception
      when Directory_Error =>
         Error ("gnatpp: can not create the temporary directory");
         raise Fatal_Error;
      when Ex : others =>
         Report_Unhandled_Exception (Ex);
         raise Fatal_Error;
   end Create_Temp_Dir;

   ----------
   -- Init --
   ----------

   procedure Init is
   begin
      GNATPP.Source_Table.Init;
      Scan_Arguments;
      Check_Parameters;
      Create_Temp_Dir;
   exception
      when Parameter_Error =>
         raise Fatal_Error;
   end Init;

   -------------------------
   -- Read_Args_From_File --
   -------------------------

   procedure Read_Args_From_File (Par_File_Name : String) is
      No_More_Args : Boolean := False;

      Arg_File         : File_Type;
      File_Name_Buffer : String (1 .. 16 * 1024);
      File_Name_Len    : Natural := 0;
      Next_Ch          : Character;
      End_Of_Line      : Boolean;

      function Get_File_Name return String;
      --  Reads from Par_File_Name the name of the next file (the file to read
      --  from should exist and be opened). Returns an empty string if there is
      --  no file names in Par_File_Name any more

      function Get_File_Name return String is
      begin
         File_Name_Len := 0;

         if not End_Of_File (Arg_File) then
            Get (Arg_File, Next_Ch);

            while Next_Ch = ' ' loop
               exit when End_Of_File (Arg_File);
               Get (Arg_File, Next_Ch);
            end loop;

            while Next_Ch /= ' ' loop
               File_Name_Len := File_Name_Len + 1;
               File_Name_Buffer (File_Name_Len) := Next_Ch;

               Look_Ahead (Arg_File, Next_Ch, End_Of_Line);

               exit when End_Of_Line or else End_Of_File (Arg_File);

               Get (Arg_File, Next_Ch);
            end loop;

         end if;

         return File_Name_Buffer (1 .. File_Name_Len);
      end Get_File_Name;

   begin

      if not Is_Regular_File (Par_File_Name) then
         Error ("gnatpp: " & To_Wide_String (Par_File_Name) &
                "does not exist");
         return;
      end if;

      Open (Arg_File, In_File, Par_File_Name);

      loop
         Add_Source_To_Process (Get_File_Name, No_More_Args);
         exit when No_More_Args;
      end loop;

      Close (Arg_File);
   exception
      when others =>
         Error ("gnatpp: can not read arguments from " &
                To_Wide_String (Par_File_Name));
         --  Exception info will be generated in main driver
         raise;
   end Read_Args_From_File;

   --------------------
   -- Scan_Arguments --
   --------------------

   procedure Scan_Arguments is

      No_More_Args : Boolean := False;
      Nat          : Natural;

      function Get_Nat_Switch_Parameter (Val : String) return Natural;
      --  Computes a natural parameter for switch from its string
      --  representation. Raises Parameter_Error if Val can not be considered
      --  as a string image of a natural number. This function supposes that
      --  Val is not an empty string.

      function Get_Out_File_Format (Val : String) return Out_File_Formats;
      --  Converts its parameter into the corresponding value of
      --  GNATPP.Options.Out_File_Formats type. Only CRLF or LF are expected
      --  as the result. Generates the error message and raises Parameter_Error
      --  if such a conversion is not possible.

      function Get_Nat_Switch_Parameter (Val : String) return Natural is
         Result : Natural := 0;
      begin
         for I in Val'Range loop

            if not Is_Digit (Val (I)) then
               Put_Line ("gnatpp: wrong switch integer parameter " & Val);
               raise Parameter_Error;
            else
               Result := Result * 10 +
                  Character'Pos (Val (I)) - Character'Pos ('0');
            end if;

         end loop;

         return Result;

      end Get_Nat_Switch_Parameter;

      function Get_Out_File_Format (Val : String) return Out_File_Formats is
      begin

         if Val = "dos" or else Val = "crlf" then
            return CRLF;
         elsif Val = "unix" or else Val = "lf" then
            return LF;
         else
            raise Parameter_Error;
         end if;

      end Get_Out_File_Format;

   begin
      PP_Cont_Line_Indentation_Set := False;

      Initialize_Option_Scan
        (Stop_At_First_Non_Switch => True,
         Section_Delimiters       => "cargs");

      loop

         case
            GNAT.Command_Line.Getopt
              ("aL aU aM cl! c0 c1 c2 c3 c4 "       &
               "e ff i! kL kU l1 l2 l3 M! "         &
               "N notab nL nU nM nD D- D: "         &
               "pL pU pM "                          &
               "A0 A1 A2 A3 A4 A5 T! "              &
               "-no-separate-is "                   &
               "I: gnatec! -RTS= v w q dd "         &
               "gnat05 "                            & --  Ada 2005 mode
               --  output file control
               "-eol= files= pipe o= of= r rf rnb " &
               --  encoding of the result file(s)
               "Wh Wu Ws We W8 Wb")
         is
            when ASCII.NUL =>
               exit;

            when 'A' =>

               if Full_Switch = "A0" then
                  Alignment_On := False;
               elsif Full_Switch = "A1" then
                  Align_Colons_In_Decl := True;
               elsif Full_Switch = "A2" then
                  Align_Colons_In_Decl := True;
                  Align_Asign_In_Decl := True;
               elsif Full_Switch = "A3" then
                  Align_Asign_In_Stmts := True;
               elsif Full_Switch = "A4" then
                  Align_Arrows := True;
               elsif Full_Switch = "A5" then
                  Allign_Ats := True;
               end if;

            when 'a' =>

               if Full_Switch = "aL" then
                  PP_Attribute_Casing := Lower_Case;
               elsif Full_Switch = "aU" then
                  PP_Attribute_Casing := Upper_Case;
               elsif Full_Switch = "aM" then
                  PP_Attribute_Casing := Mixed;
               end if;

            when 'c' =>

               if Full_Switch = "c0" then
                  Format_Comments := False;
               elsif Full_Switch = "c1" then
                  GNAT_Comment_Inden      := True;
                  Standard_Comment_Indent := False;
               elsif Full_Switch = "c2" then
                  GNAT_Comment_Inden      := False;
                  Standard_Comment_Indent := True;
               elsif Full_Switch = "c3" then
                  GNAT_Comment_Start := True;
               elsif Full_Switch = "c4" then
                  Reformat_Comment_Block := True;
               elsif Full_Switch = "cl" then
                  Nat := Get_Nat_Switch_Parameter (Parameter);

                  if Nat not in 1 .. 9 then
                     Put_Line ("gnatpp: wrong continuation line indentation ("
                              & Parameter & ")");
                     raise Parameter_Error;
                  else
                     PP_Cont_Line_Indentation := Nat;
                     PP_Cont_Line_Indentation_Set := True;
                  end if;

               end if;

            when 'D' =>

               if Full_Switch = "D-" then
                  Use_Predefined_Casing := False;
               else
                  Use_Dictionary := True;
                  Scan_Dictionary (Parameter);
               end if;

            when 'd' =>
               Progress_Indicator_Mode := True;

            when 'f' =>

               if Full_Switch = "files" then
                  Read_Args_From_File (Parameter);
               elsif Full_Switch = "ff" then
                  Add_FF := True;
               end if;

            when 'e' =>
               End_Labels := False;

            when 'i' =>
               Nat := Get_Nat_Switch_Parameter (Parameter);

               if Nat not in 1 .. 9 then
                  Put_Line ("gnatpp: wrong indentation (" & Parameter & ")");
                  raise Parameter_Error;
               else
                  PP_Indentation := Nat;
               end if;

            when 'k' =>

               if Full_Switch = "kL" then
                  PP_Keyword_Casing := Lower_Case;
               elsif Full_Switch = "kU" then
                  PP_Keyword_Casing := Upper_Case;
               end if;

            when 'l' =>

               if Full_Switch = "l1" then
                  Compact_Layout  := True;
                  Add_Empty_Lines := True;
               elsif Full_Switch = "l2" then
                  Compact_Layout  := True;
                  Add_Empty_Lines := False;
               elsif Full_Switch = "l3" then
                  Compact_Layout  := False;
                  Add_Empty_Lines := False;
               end if;

            when 'M' =>

               Nat := Get_Nat_Switch_Parameter (Parameter);

               if Nat not in 32 .. 256 then
                  Put      ("gnatpp: wrong max line length (");
                  Put      (Parameter);
                  Put_Line (")");
                  raise Parameter_Error;
               else
                  Max_Line_Length := Nat;
               end if;

            when 'n' =>

               if Full_Switch = "nL" then
                  PP_Name_Casing := Lower_Case;
               elsif Full_Switch = "nU" then
                  PP_Name_Casing := Upper_Case;
               elsif Full_Switch = "nM" then
                  PP_Name_Casing := Mixed;
               elsif Full_Switch = "nD" then
                  PP_Name_Casing := As_Declared;
               elsif Full_Switch = "notab" then
                  --  -notab is an obsolete feature, replaced with -N
                  No_Tab_In_Comments := True;
               end if;

            when 'N' =>
               No_Tab_In_Comments := True;

            when 'p' =>

               if Full_Switch = "pL" then
                  PP_Pragma_Casing := Lower_Case;
               elsif Full_Switch = "pU" then
                  PP_Pragma_Casing := Upper_Case;
               elsif Full_Switch = "pM" then
                  PP_Pragma_Casing := Mixed;
               elsif Full_Switch = "pipe" then
                  Output_Mode := Pipe;
               end if;

            when 'q' =>
               Quiet_Mode := True;

            when 'r' =>

               if Full_Switch = "r" then
                  Output_Mode := Replace;
               elsif Full_Switch = "rnb" then
                  Output_Mode := Replace_No_Backup;
               elsif Full_Switch = "rf" then
                  Output_Mode := Force_Replace;
               end if;

            when 'T' =>

               Case_Threshold := Get_Nat_Switch_Parameter (Parameter);

            when 'I' | 'g' | '-' =>

               if Full_Switch = "I" then
                  Store_I_Option (Parameter);
               elsif Full_Switch = "gnatec" then
                  Store_GNAT_Option_With_Path (Full_Switch, Parameter);
               elsif Full_Switch = "-RTS" then
                  Store_Option ("--RTS=" & Parameter);

               elsif Full_Switch = "-eol" then
                  Out_File_Format := Get_Out_File_Format (Parameter);
               elsif Full_Switch = "-no-separate-is" then
                  Separate_Line_For_IS := False;
               elsif Full_Switch = "gnat05" then
                  ASIS_UL.Options.ASIS_2005_Mode := True;
               else
                  Brief_Help;
                  raise Parameter_Error;
               end if;

            when 'o' =>

               if Full_Switch = "o" then
                  Output_Mode := Create_File;
               elsif Full_Switch = "of" then
                  Output_Mode := Force_Create_File;
               else
                  Brief_Help;
                  raise Parameter_Error;
               end if;

               Res_File_Name := new String'(Parameter);

            when 'v' =>

               Verbose_Mode := True;

            when 'W' =>

               if Full_Switch = "Wh" then
                  Output_Encoding := Hex_ESC;
               elsif Full_Switch = "Wu" then
                  Output_Encoding := Upper_Half;
               elsif Full_Switch = "Ws" then
                  Output_Encoding := Shift_JIS;
               elsif Full_Switch = "We" then
                  Output_Encoding := EUC;
               elsif Full_Switch = "W8" then
                  Output_Encoding := UTF_8;
               elsif Full_Switch = "Wb" then
                  Output_Encoding := Brackets;
               end if;

            when 'w' =>

               Warnings_ON := True;

            when others =>
               Brief_Help;
               raise Parameter_Error;
         end case;

      end loop;

      if Verbose_Mode then
         Version_Info;
      end if;

      loop
         Add_Source_To_Process (Get_Argument, No_More_Args);
         exit when No_More_Args;
      end loop;

      Process_cargs_Section (No_Preprocessing => True);

   exception
      when GNAT.Command_Line.Invalid_Switch =>
         Ada.Text_IO.Put_Line (Standard_Error,
                              "gnatpp: invalid switch : "
                             & GNAT.Command_Line.Full_Switch);
         Brief_Help;

         raise Parameter_Error;

      when GNAT.Command_Line.Invalid_Parameter =>
         Ada.Text_IO.Put_Line (Standard_Error,
                              "gnatpp: parameter missed for : "
                               & GNAT.Command_Line.Full_Switch);
         Brief_Help;

         raise Parameter_Error;
   end Scan_Arguments;

   ---------------------
   -- Source_Clean_Up --
   ---------------------

   procedure Source_Clean_Up (SF : SF_Id) is
      Success : Boolean;
   begin

      if Is_Open (The_Context) then
         Close (The_Context);
      end if;

      if Has_Associations (The_Context) then
         Dissociate (The_Context);
      end if;

      if Output_Mode /= Pipe and then
         Ada.Wide_Text_IO.Is_Open (Result_Out_File)
      then
         Ada.Wide_Text_IO.Close (Result_Out_File);
      end if;

      Delete_File (Suffixless_Name (SF) & ".adt", Success); --  ???
      Delete_File (Suffixless_Name (SF) & ".ali", Success); --  ???

   end Source_Clean_Up;

end GNATPP.Environment;
