------------------------------------------------------------------------------
--                                                                          --
--                            GNATPP COMPONENTS                             --
--                                                                          --
--                    G N A T P P . P R O C E S S I N G                     --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                     Copyright (C) 2001-2011, 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.Text_IO;                     use Ada.Text_IO;
with Ada.Wide_Text_IO;
with Ada.Unchecked_Deallocation;

with GNAT.OS_Lib;                     use GNAT.OS_Lib;
with Hostparm;

with Asis.Compilation_Units;          use Asis.Compilation_Units;
with Asis.Elements;                   use Asis.Elements;
with Asis.Exceptions;
with Asis.Extensions;                 use Asis.Extensions;
with Asis.Extensions.Flat_Kinds;      use Asis.Extensions.Flat_Kinds;
with Asis.Text;                       use Asis.Text;

with ASIS_UL.Output;                  use ASIS_UL.Output;

with GNATPP.Comments;                 use GNATPP.Comments;
with GNATPP.Common;                   use GNATPP.Common;
with GNATPP.General_Traversal_Stacks; use GNATPP.General_Traversal_Stacks;
with GNATPP.Layout;                   use GNATPP.Layout;
with GNATPP.Options;                  use GNATPP.Options;
with GNATPP.Output;                   use GNATPP.Output;
with GNATPP.Paragraphs;               use GNATPP.Paragraphs;
with GNATPP.PP_Output;                use GNATPP.PP_Output;
with GNATPP.Source_Traversal;         use GNATPP.Source_Traversal;
with GNATPP.State;                    use GNATPP.State;
with GNATPP.Utilities;                use GNATPP.Utilities;

package body GNATPP.Processing is

   ------------------
   -- Pretty_Print --
   ------------------

   procedure Pretty_Print (Unit : Asis.Compilation_Unit; SF : SF_Id) is
      Program_Unit  : constant Asis.Element      := Unit_Declaration (Unit);

      Contex_Clause : constant Asis.Element_List :=
         Context_Clause_Elements (Unit, True);

      Comp_Pragmas : constant Asis.Element_List :=
        Compilation_Pragmas (Unit);

      First_Pragma_After : List_Index := Comp_Pragmas'Last + 1;

      Full_Span : constant Asis.Text.Span := Compilation_Span (Program_Unit);
      Unit_Span : constant Asis.Text.Span := Element_Span (Program_Unit);

      Source_Control    : Traverse_Control       := Continue;
      Source_State      : Source_Traversal_State := Initial_State;

      Success : Boolean := False;

      --  The following declarations are needed to process the parent unit name
      --  of a subunit. The problem with this construct is that in ASIS we
      --  do not have any means to represent this parent unit name as ASIS
      --  Element, so we have to simulate the corresponding traversing.

      type Program_Text_Access is access Program_Text;

      procedure Free is new
        Ada.Unchecked_Deallocation (Program_Text, Program_Text_Access);

      Parent_Name : Program_Text_Access;
      --  Represents image of the parent unit name.

      Next_Name_Start, Next_Name_End : Natural := 1;
      --  Pointers to the next component of the parent name.

      procedure Set_Next_Name_Component;
      --  Sets Next_Name_Start and Next_Name_End. If Next_Name_Start is already
      --  outside Parent_Name, does nothing.

      procedure Set_Next_Name_Component is
      begin

         if Next_Name_Start < Parent_Name'Last then
            Next_Name_End := Next_Name_Start;

            while Next_Name_End < Parent_Name'Last and then
                  Parent_Name (Next_Name_End + 1) /= '.'
            loop
               Next_Name_End := Next_Name_End + 1;
            end loop;

         end if;

      end Set_Next_Name_Component;

   begin
      GNATPP.State.Initialize;

      --  Feeding the line table

      Lines_Table.Set_Last (Full_Span.Last_Line);

      Lines_Table.Table (1 .. Full_Span.Last_Line) :=
         Lines_Table.Table_Type
           (Lines (Element    => Program_Unit,
                   First_Line => Full_Span.First_Line,
                   Last_Line  => Full_Span.Last_Line));

      GNATPP.Common.The_Unit      := Program_Unit; --  ??? why do we need this
      --  To keep the reference to this Element in the global variable

      GNATPP.Common.The_Last_Line := Full_Span.Last_Line;

      --  We separate the following parts of the original source:
      --
      --  1. Lines before the first context clause (if any). These lines may
      --     be either empty lines of comment lines
      --
      --  2. Context clause (starting from the first context item or pragma
      --     and down to the library item or subunit, including all the
      --     comments in between
      --
      --  3. Library item (or subunit) itself (Unit_Declaration in ASIS
      --     terms)
      --
      --  4. Lines after the end of the end of the Library item (or subunit),
      --     they may be empty lines, comment lines or they may contain
      --     pragmas

      --  Step #1: Lines before the first context clause

      Before_CU := True;

      GNATPP.State.Current_Line := 0;

      Get_Next_Ada_Lexem (Keep_Empty_Lines       => True,
                          Called_After_Ada_Token => False);

      --  Step #2: Context clause

      Traversal_Stack.Push ((Nil_Element, Nil_Span, Nil_Layout_Info));

      Before_CU         := False;
      In_Context_Clause := True;

      Compute_Alignment_In_Context_Clause (Contex_Clause);

      for J in Contex_Clause'Range loop

         if Flat_Element_Kind (Contex_Clause (J)) in Flat_Pragma_Kinds then
            Set_No_Paragraph;
         else

            if not In_Paragraph then
               Set_New_Paragraph;
            end if;

         end if;

         Traverse_Source (Contex_Clause (J), Source_Control, Source_State);
      end loop;

      --  Step #3: Library item (or subunit) itself

      In_Context_Clause := False;
      In_Unit           := True;

      if Unit_Kind (Unit) in A_Subunit then
         --  We have to print out 'separate (Parent_Unit_Name)'

         --  ???!!!

         --  The solution provided below is very simple and can NOT
         --  reproduce comments inside 'separate (Parent_Unit_Name)'!!!

         PP_New_Line; --  ???
         PP_Keyword (KW_Separate);
         Get_Next_Ada_Lexem;
         PP_Continue_Line (No_Space => RM_Style_Spacing);
         PP_Delimiter (Left_Parenthesis_Dlm);
         Get_Next_Ada_Lexem;

         Parent_Name :=
           new Program_Text'(Unit_Full_Name
             (Corresponding_Subunit_Parent_Body (Unit)));

         Set_Next_Name_Component;

         while Next_Name_Start > 0 loop

            if Next_Name_End - Next_Name_Start + 1 > Available_In_Output then
               --  We check the space needed for the next name component
               --  and '.' or ')'
               PP_New_Continuation_Line;
            end if;

            PP_Word
              (Capitalize_Image
                 (Parent_Name (Next_Name_Start .. Next_Name_End),
                  PP_Name_Casing));

            Get_Next_Ada_Lexem;

            if Next_Name_End = Parent_Name'Last then
               --  The parent name is over!
               PP_Delimiter (Right_Parenthesis_Dlm);
               exit;
            else
               PP_Delimiter (Dot_Dlm);
               Next_Name_Start := Next_Name_End + 2;
               Set_Next_Name_Component;
               Get_Next_Ada_Lexem;
            end if;

         end loop;

         Free (Parent_Name);

         Get_Next_Ada_Lexem;
      end if;

      Traverse_Source (Program_Unit, Source_Control, Source_State);

      --  Step # 4: Lines after the end of the end of the Library item
      --  (or subunit)

      In_Unit     := False;
      Behind_Unit := True;

      --  Not sure that we need anything specific here... ???
      null;

      for J in Comp_Pragmas'Range loop

         if Unit_Span.Last_Line <=
            Element_Span (Comp_Pragmas (J)).First_Line
         then
            First_Pragma_After := J;
            exit;
         end if;

      end loop;

      for J in First_Pragma_After .. Comp_Pragmas'Last loop

         if Is_Equal (Enclosing_Compilation_Unit (Comp_Pragmas (J)), Unit) then
            --  We may have configuration pragmas in the list
            Traverse_Source (Comp_Pragmas (J), Source_Control, Source_State);
         end if;

      end loop;

      Behind_Unit := False;

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

         --  New architecture should solve this problem properly
         Correct_Trailing_Spaces;

         if Out_File_Format /= Default then
            Correct_EOL;
         end if;
      end if;

      Set_Source_Status (SF, Processed);

      if Output_Mode in Replace .. Replace_No_Backup then

         if Hostparm.OpenVMS then
            Copy_File
              (Name     => Res_File_Name.all,
               Pathname => Source_Name (SF),
               Success  => Success,
               Mode     => Overwrite,
               Preserve => None);

         else
            Copy_File
              (Name     => Res_File_Name.all,
               Pathname => Source_Name (SF),
               Success  => Success,
               Mode     => Overwrite);
         end if;

         if not Success then
            Put (Standard_Error, "gnatpp: cannot write the reformatted ");
            Put (Standard_Error, "source into ");
            Put (Standard_Error, Source_Name (SF));
            New_Line (Standard_Error);

            Set_Source_Status (SF, Error_Detected);
         end if;

         GNAT.OS_Lib.Delete_File (Res_File_Name.all, Success);

         if not Success then
            Put (Standard_Error, "gnatpp: cannot delete intermediate ");
            Put (Standard_Error, "file for ");
            Put (Standard_Error, Source_Name (SF));
            New_Line (Standard_Error);

            Set_Source_Status (SF, Error_Detected);
         end if;

      end if;

   exception
      when Ex : Asis.Exceptions.ASIS_Inappropriate_Context          |
                Asis.Exceptions.ASIS_Inappropriate_Container        |
                Asis.Exceptions.ASIS_Inappropriate_Compilation_Unit |
                Asis.Exceptions.ASIS_Inappropriate_Element          |
                Asis.Exceptions.ASIS_Inappropriate_Line             |
                Asis.Exceptions.ASIS_Inappropriate_Line_Number      |
                Asis.Exceptions.ASIS_Failed                         =>

         Report_Unhandled_ASIS_Exception (Ex);

         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;

         Set_Source_Status (SF, Error_Detected);

      when Ex : others =>
         Report_Unhandled_Exception (Ex);

         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;

         Set_Source_Status (SF, Error_Detected);

   end Pretty_Print;

end GNATPP.Processing;
